src/bootstrap.asm

   1 ;; We need some basic words to be available before we can implement
   2 ;; the actual interpreter. For this reason we need to write some words
   3 ;; in assembly, even though they depend only on other Forth words.
   4 ;; Such words are defined in this file.
   5 ;;
   6 ;; With these words, we can finally defined INTERPRET, and from there
   7 ;; we'll load everything else from an external file.
   8 ;;
   9 ;; This file is included from main.asm; see that file for more
  10 ;; information.
  11
  12 ;; Define a Forth word that is implemented in Forth. (The body will be
  13 ;; a list of 'dq' statements.)
  14 macro forth label, name, immediate {
  15   header label, name, immediate
  16   dq DOCOL
  17 }
  18
  19 forth COMMA, ','
  20   dq HERE, GET, PUT          ; Set the memory at the address pointed to by HERE
  21   dq HERE, GET, LIT, 8, PLUS ; Calculate new address for HERE to point to
  22   dq HERE, PUT               ; Update HERE to point to the new address
  23   dq EXIT
  24
  25 ;; Mark the last added word as immediate.
  26 forth IMMEDIATE, 'IMMEDIATE', 1
  27   dq LIT, 1
  28   dq LATEST, GET
  29   dq LIT, 8, PLUS
  30   dq PUT_BYTE
  31   dq EXIT
  32
  33 ;; Given the address of a word, return 0 if the given word is not immediate.
  34 forth IS_IMMEDIATE, 'IMMEDIATE?'
  35   dq LIT, 8, PLUS
  36   dq GET_BYTE
  37   dq EXIT
  38
  39 ;; Enter immediate mode, immediately
  40 forth INTO_IMMEDIATE, '[', 1
  41   dq LIT, 0, STATE, PUT_BYTE
  42   dq EXIT
  43
  44 ;; Enter compilation mode
  45 forth OUTOF_IMMEDIATE, ']'
  46   dq LIT, 1, STATE, PUT_BYTE
  47   dq EXIT
  48
  49 ;; INTERPRET-WORD expects a word as a (buffer, length) pair on the
  50 ;; stack. It interprets and executes the word. It's behavior depends
  51 ;; on the current STATE. It provides special handling for integers.
  52 forth INTERPRET_WORD, 'INTERPRET-WORD'
  53   dq PAIRDUP
  54   ;; Stack is (word length word length).
  55   dq FIND                       ; Try to find word
  56   dq DUP_
  57   dq ZBRANCH, 8 * 22            ; Check if word is found
  58
  59   ;; - Word is found -
  60
  61   dq STATE, GET, ZBRANCH, 8 * 11 ; Check whether we are in compilation
  62                                 ; or immediate mode
  63
  64   ;; (Word found, compilation mode)
  65   dq DUP_, IS_IMMEDIATE, NOT_, ZBRANCH, 8 * 6 ; If the word is
  66                                 ; immediate, continue as we would in
  67                                 ; immediate mode
  68
  69   ;; Otherwise, we want to compile this word
  70   dq TCFA
  71   dq COMMA
  72   dq DROP, DROP
  73   dq EXIT
  74
  75   ;; (Word found, immediate mode)
  76   ;; Execute word
  77   dq TCFA
  78   ;; Stack is (word length addr)
  79   dq SWAP, DROP
  80   dq SWAP, DROP
  81   ;; Stack is (addr)
  82   dq EXEC
  83   dq EXIT
  84
  85   ;; - No word is found, assume it is an integer literal -
  86   ;; Stack is (word length addr)
  87   dq DROP
  88   dq PARSE_NUMBER
  89
  90   dq STATE, GET, ZBRANCH, 8 * 5 ; Check whether we are in compilation
  91                                 ; or immediate mode
  92
  93   ;; (Number, compilation mode)
  94   dq LIT, LIT, COMMA
  95   dq COMMA
  96   dq EXIT
  97
  98   ;; (Number, immediate mode)
  99   dq EXIT
 100
 101 ;; The INTERPRET word reads and interprets a single word from the
 102 ;; user.
 103 forth INTERPRET, 'INTERPRET'
 104   dq READ_WORD
 105   dq INTERPRET_WORD
 106   dq EXIT
 107
 108 ;; INTERPRET_STRING is a variant of INTERPRET that reads from a string
 109 ;; instead of from the user. It takes a string as a (buffer, length)
 110 ;; pair on the stack and interprets the entire string, even if the
 111 ;; string has more than one word.
 112 forth INTERPRET_STRING, 'INTERPRET-STRING'
 113   dq INPUT_LENGTH, PUT
 114   dq INPUT_BUFFER, PUT
 115
 116   ;; Check if the buffer is-non-empty
 117   ;; [TODO] This probably won't work for strings with whitespace at
 118   ;; the end.
 119   dq INPUT_LENGTH, GET
 120   dq ZBRANCH, 8 * 5 ; to EXIT
 121
 122   dq READ_WORD
 123
 124   dq INTERPRET_WORD
 125   dq BRANCH, -8 * 7 ; to INPUT-LENGTH @
 126
 127   dq LIT, 0, INPUT_BUFFER, PUT
 128
 129   dq EXIT