forth.forth

   1 \ This program is free software: you can redistribute it and/or modify
   2 \ it under the terms of the GNU General Public License as published by
   3 \ the Free Software Foundation, either version 3 of the License, or
   4 \ (at your option) any later version.
   5 \
   6 \ This program is distributed in the hope that it will be useful,
   7 \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   8 \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   9 \ GNU General Public License for more details.
  10 \
  11 \ You should have received a copy of the GNU General Public License
  12 \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
  13
  14 \ word EXECUTE 12 define
  15 16500 execute WORD 16500 29 execute
  16 word DEFINE 29 29 execute
  17 word RINIT 3 define
  18 word NOOP 13 define
  19 word MODE 14336 define
  20 word EXECUTE-WORD 16680 define
  21 word EXECUTE-NUM 16720 define
  22 word INTERPRET 16400 define
  23 word KEY 5 define
  24 word WORD-START 20 define
  25 word WORD-PUT 19 define
  26 word WORD-END 23 define
  27 word STRING-START 39 define
  28 word STRING-PUT 40 define
  29 word STRING-END 41 define
  30 word NUMBER 22 define
  31 word FIND 21 define
  32 word FIND-DOES 44 define
  33 word DEFINE-DOES 45 define
  34 word QUIT 16384 define
  35 word BYE 25 define
  36 word WORDS 27 define
  37 word !CHANNEL 35 define
  38 word !HERE 36 define
  39 word HERE 28 define
  40
  41 word STACKTRACE 46 define
  42
  43 word ; 1 define
  44 word JZ: 14 define
  45 word JNZ: 15 define
  46 word J-1: 24 define
  47 word JMP: 18 define
  48 word , 33 define
  49 word + 7 define
  50 word - 34 define
  51 word =? 37 define
  52 word WS? 17 define
  53 word . 9 define
  54 word .S 38 define
  55 word @ 10 define
  56 word @+ 42 define
  57 word ! 11 define
  58 word !+ 43 define
  59 word LIT 2 define
  60 word DUP 6 define
  61 word 2DUP 30 define
  62 word DROP 16 define
  63 word 2DROP 32 define
  64 word SWAP 26 define
  65 word ROT 31 define
  66
  67 \ ' "TICK" returns address of word's execution semantics
  68 word ' here define
  69 word word find , word find find , word ; find ,
  70
  71 \ : "COLON" sets execution semantics
  72 word : here define
  73 word : here define-does
  74 ' word , ' here , ' define , ' ; ,
  75
  76 \ :> "DOES" sets compilation semantics
  77 word :> here define-does
  78 : :> ' word , ' here , ' define-does , ' ; ,
  79
  80 \ ::> "COLON DOES" sets execution and compilation semantics
  81 word ::> here define-does
  82 word ::> here define
  83 ' word , ' 2dup , ' here , ' define-does , ' here , ' define , ' ; ,
  84
  85 \ write the execution semantics of a word to memory
  86 : MEMORIZE-WORD ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; ,
  87 ' 2dup , ' find , ' dup , ' JZ: , here 16 + , ' , , ' 2drop , ' ; ,
  88 ' drop , ' lit , ' lit , ' , , ' execute-num , ' , , ' ; ,
  89
  90 \ change interpreter semantics to "memorize-word"
  91 : memorizing ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; ,
  92
  93 \ memorize the compiler
  94 \memorizing
  95 \: executing lit mode lit execute-word ! ;
  96 \: FINISH-" drop string-end ;
  97 \: " string-start \: KLOOP key 34 =? JNZ: finish-" string-put JMP: KLOOP
  98 \: DO"    \:> " " swap lit lit , , lit lit , , ;
  99 \: DOIF   \:> IF lit JZ: , here dup , ;
 100 \: DOELSE \:> ELSE lit JMP: , here dup , swap here ! ;
 101 \: DOTHEN \:> THEN here ! ;
 102 \: COMPILE-WORD dup
 103 \doif 2dup find-does dup
 104   \doif rot 2drop execute ;
 105   \dothen drop 2dup find dup
 106   \doif , 2drop ;
 107   \dothen drop lit lit , execute-num , ;
 108 \dothen 2drop \do" Compilation Error: null word" .s bye
 109 \: compiling lit mode lit compile-word ! ;
 110
 111 \ compile the rest of the compiler
 112 \compiling
 113
 114 \ ; "RET" compilation semantics: ends a function and returns to executing mode
 115 :> ; lit \' ; \, , lit \' ; \, , executing \' ; \,
 116
 117 \ ;; "SEMIRET" compilation semantics: simply writes a return instruction
 118 :> ;; lit \' ; \, , ;
 119
 120 \ <: "OVERLOAD COLON" extend previous execution semantics of word
 121 ::> <: \compiling word 2dup find dup if here swap , define else drop here define
 122 then compiling ;
 123
 124 \ <:> "OVERLOAD COLON DOES" extend previous compilation semantics of word
 125 ::> <:> \compiling word 2dup find-does dup if here swap , define-does else drop
 126 here define-does then compiling ;
 127
 128 \ execution semantics of COLON, DOES, and COLON DOES now extended to
 129 \ automatically switch to compilation mode
 130 <: : compiling ;
 131 <: :> compiling ;
 132 <: ::> compiling ;
 133
 134 \ Multi-line comments
 135 ::> ( key 41 =? swap -1 =? swap drop + if ;; then JMP: \' ( \, ;
 136
 137 \ Set the number conversion base
 138 : BASE 14348 swap ! ;
 139
 140 (
 141   End of bootstrap process
 142   beyond this point, all hope is lost
 143 )
 144
 145 " watForth-32 Interactive CLI:
 146 " .s