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.
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.
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/>.
14 \ word EXECUTE 12 define
15 16500 execute WORD 16500 29 execute
16 word DEFINE 29 29 execute
19 word MODE 14336 define
20 word EXECUTE-WORD 16680 define
21 word EXECUTE-NUM 16720 define
22 word INTERPRET 16400 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
32 word FIND-DOES 44 define
33 word DEFINE-DOES 45 define
34 word QUIT 16384 define
37 word CHANNEL-IN 35 define
38 word CHANNEL-OUT 48 define
39 word CHANNEL-OPEN 51 define
40 word CHANNEL-AWAIT 50 define
44 word STACKTRACE 46 define
72 \ ' "TICK" returns address of word's execution semantics
74 word word find , word find find , word ; find ,
76 \ : "COLON" sets execution semantics
78 word : here define-does
79 ' word , ' here , ' define , ' ; ,
81 \ :> "DOES" sets compilation semantics
82 word :> here define-does
83 : :> ' word , ' here , ' define-does , ' ; ,
85 \ ::> "COLON DOES" sets execution and compilation semantics
86 word ::> here define-does
88 ' word , ' 2dup , ' here , ' define-does , ' here , ' define , ' ; ,
90 \ write the execution semantics of a word to memory
91 : MEMORIZE-WORD ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; ,
92 ' 2dup , ' find , ' dup , ' JZ: , here 16 + , ' , , ' 2drop , ' ; ,
93 ' drop , ' lit , ' lit , ' , , ' execute-num , ' , , ' ; ,
95 \ change interpreter semantics to "memorize-word"
96 ::> MEMORIZING ' lit , ' mode , ' lit , ' memorize-word , ' ! , ' ; ,
98 \ memorize the compiler
100 \: executing lit mode lit execute-word ! ;
101 \: FINISH-" drop string-end ;
102 \: BSLASH-" drop key string-put JMP: \here \8 \+ \,
103 \: " string-start \: KLOOP key 92 =? JNZ: bslash-" 34 =? JNZ: finish-" string-put JMP: KLOOP
104 \: DO" \:> " " swap lit lit , , lit lit , , ;
105 \: DOIF \:> IF lit JZ: , here dup , ;
106 \: DOELSE \:> ELSE lit JMP: , here dup , swap here ! ;
107 \: DOTHEN \:> THEN here ! ;
109 \doif 2dup find-does dup
110 \doif rot 2drop execute ;
111 \dothen drop 2dup find dup
113 \dothen drop lit lit , execute-num , ;
114 \dothen 2drop \do" Compilation Error: null word" .s bye
115 \: compiling lit mode lit compile-word ! ;
117 \ compile the rest of the compiler
120 \ ; "RET" compilation semantics: ends a function and returns to executing mode
121 :> ; lit \' ; \, , lit \' ; \, , executing \' ; \,
123 \ ;; "SEMIRET" compilation semantics: simply writes a return instruction
124 :> ;; lit \' ; \, , ;
126 \ <: "OVERLOAD COLON" extend previous execution semantics of word
127 ::> <: \compiling word 2dup find dup if here swap , define else drop here define
130 \ <:> "OVERLOAD COLON DOES" extend previous compilation semantics of word
131 ::> <:> \compiling word 2dup find-does dup if here swap , define-does else drop
132 here define-does then compiling ;
134 \ execution semantics of COLON, DOES, and COLON DOES now extended to
135 \ automatically switch to compilation mode
140 \ Multi-line comments
141 ::> ( key 41 =? swap -1 =? swap drop + if ;; then JMP: \' ( \, ;
144 End of bootstrap process
145 beyond this point, all hope is lost
148 \ Set the number conversion base
149 : BASE 14348 swap ! ;
152 \ TICK compilation semantics
153 :> ' lit lit , word find , ;
154 \ "TICK DOES" (get compilation semantics execution token)
155 : '> word find-does ;
156 :> '> word find-does , ;
159 : CHAR: word drop @8_u ;
160 :> CHAR: lit lit , ' char: execute , ;
163 : JSON-CTRL-CHAR? char: { =? if 1 ;; then
164 char: } =? if 1 ;; then
165 char: [ =? if 1 ;; then
166 char: ] =? if 1 ;; then
172 : JSON-WORD word-start key JSON-CTRL-CHAR? if word-end ;; then ws? ;
176 \ Include a remote file
177 : REQUIRE" ' quit channel-open dup \' " \, fetch channel-await ;
180 REQUIRE" { \"url\": \"forth/test-watfor.forth\" }"
183 " watForth-32 Interactive CLI: