X-Git-Url: https://git.kengrimes.com/?p=watForth.git;a=blobdiff_plain;f=forth.forth;h=2f9ff874b794f7647daf41fcfee36ecde4642a4f;hp=63da4a722d15bac22241211b293a7a50acf12cb7;hb=b1197f8636a1b46b1eabc565cd41f0a30944cac4;hpb=63e17ddc993a5a04cc6ae55bad8420b61c37d1bf

diff --git a/forth.forth b/forth.forth
index 63da4a7..2f9ff87 100644
--- a/forth.forth
+++ b/forth.forth
@@ -10,13 +10,14 @@
 \
 \ You should have received a copy of the GNU General Public License
 \ along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+\ word EXECUTE 12 define
 16500 execute WORD 16500 29 execute
 word DEFINE 29 29 execute
-\ word EXECUTE 12 define
 word RINIT 3 define
 word NOOP 13 define
 word MODE 14336 define
-word EXECUTE-MODE 16680 define
+word EXECUTE-WORD 16680 define
 word EXECUTE-NUM 16720 define
 word INTERPRET 16400 define
 word KEY 5 define
@@ -33,10 +34,16 @@ word DEFINE-DOES 45 define
 word QUIT 16384 define
 word BYE 25 define
 word WORDS 27 define
-word !CHANNEL 35 define
+word CHANNEL-IN 35 define
+word CHANNEL-OUT 48 define
+word CHANNEL-OPEN 51 define
+word CHANNEL-AWAIT 50 define
 word !HERE 36 define
 word HERE 28 define
 
+word STACKTRACE 46 define
+word FETCH 47 define
+
 word ; 1 define
 word JZ: 14 define
 word JNZ: 15 define
@@ -50,6 +57,7 @@ word WS? 17 define
 word . 9 define
 word .S 38 define
 word @ 10 define
+word @8u 53 define
 word @+ 42 define
 word ! 11 define
 word !+ 43 define
@@ -60,43 +68,100 @@ word DROP 16 define
 word 2DROP 32 define
 word SWAP 26 define
 word ROT 31 define
+word -ROT 54 define
 
+\ ' "TICK" returns address of word's execution semantics
 word ' here define
 word word find , word find find , word ; find ,
 
+\ : "COLON" sets execution semantics
 word : here define
+word : here define-does
 ' word , ' here , ' define , ' ; ,
-' : dup define-does
 
-: IWRITE-MODE ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; ,
+\ :> "DOES" sets compilation semantics
+word :> here define-does
+: :> ' word , ' here , ' define-does , ' ; ,
+
+\ ::> "COLON DOES" sets execution and compilation semantics
+word ::> here define-does
+word ::> here define
+' word , ' 2dup , ' here , ' define-does , ' here , ' define , ' ; ,
+
+\ write the execution semantics of a word to memory
+: MEMORIZE-WORD ' dup , ' JNZ: , here 12 + , ' 2drop , ' ; , 
 ' 2dup , ' find , ' dup , ' JZ: , here 16 + , ' , , ' 2drop , ' ; ,
-' drop , ' LIT , ' LIT , ' , , ' EXECUTE-NUM , ' , , ' ; ,
-
-: i ' LIT , ' MODE , ' LIT , ' IWRITE-MODE , ' ! , ' ; ,
-
-\i
-\: e LIT MODE LIT EXECUTE-MODE ! ;
-\: :> word find here define-does ;
-\' :> \dup \define-does
-\: FINISH-" DROP STRING-END ;
-\: " STRING-START \: KLOOP KEY 34 =? JNZ: FINISH-" STRING-PUT JMP: KLOOP
-\:> " " swap lit lit , , lit lit , , ;
-\: IF JZ: \here \8 \+ \, ; word 2drop ;
-\:> IF \: DOIF LIT JZ: , HERE DUP , ;
-\: ELSE ;
-\:> ELSE \: DOELSE LIT JMP: , HERE DUP , SWAP HERE ! ;
-\: THEN ;
-\:> THEN \: DOTHEN HERE ! ;
-\: COMPILE-MODE dup
-\doif 2dup find dup
-  \doif dup find-does dup
-    \doif swap drop rot 2drop execute ;
-    \dothen drop , 2drop ;
+' drop , ' lit , ' lit , ' , , ' execute-num , ' , , ' ; , 
+
+\ change interpreter semantics to "memorize-word"
+::> MEMORIZING ' lit , ' memorize-word , ' lit , ' mode , ' ! , ' ; ,
+
+\ memorize the compiler
+\memorizing
+\: executing lit execute-word lit mode ! ;
+\: FINISH-" drop string-end ;
+\: BSLASH-" drop key string-put JMP: \here \8 \+ \,
+\: " string-start \: KLOOP key 92 =? JNZ: bslash-" 34 =? JNZ: finish-" string-put JMP: KLOOP
+\: DO"    \:> " " swap lit lit , , lit lit , , ;
+\: DOIF   \:> IF lit JZ: , here dup , ;
+\: DOELSE \:> ELSE lit JMP: , here dup , here -rot ! ;
+\: DOTHEN \:> THEN here swap ! ;
+\: COMPILE-WORD dup
+\doif 2dup find-does dup
+  \doif rot 2drop execute ;
+  \dothen drop 2dup find dup
+  \doif , 2drop ;
   \dothen drop lit lit , execute-num , ;
-\dothen 2drop ;
-\: c LIT MODE LIT COMPILE-MODE ! ;
-\: DO" 
-\e
+\dothen 2drop \do" Compilation Error: null word" .s bye
+\: compiling lit compile-word lit mode ! ;
+
+\ compile the rest of the compiler
+\compiling
+
+\ ; "RET" compilation semantics: ends a function and returns to executing mode
+:> ; lit \' ; \, , lit \' ; \, , executing \' ; \,
+
+\ ;; "SEMIRET" compilation semantics: simply writes a return instruction
+:> ;; lit \' ; \, , ;
+
+\ <: "OVERLOAD COLON" extend previous execution semantics of word
+::> <: \compiling word 2dup find dup if here swap , define else drop here define
+then compiling ;
+
+\ <:> "OVERLOAD COLON DOES" extend previous compilation semantics of word
+::> <:> \compiling word 2dup find-does dup if here swap , define-does else drop
+here define-does then compiling ;
+
+\ execution semantics of COLON, DOES, and COLON DOES now extended to
+\ automatically switch to compilation mode
+<: : compiling ;
+<: :> compiling ;
+<: ::> compiling ;
+
+\ Multi-line comments
+::> ( key 41 =? swap -1 =? swap drop + if ;; then JMP: \' ( \, ;
+
+(
+  End of bootstrap process
+  beyond this point, all hope is lost
+)
+
+\ Set the number conversion base
+: BASE 14348 ! ;
+: BASE10 10 base ;
+
+\ TICK compilation semantics
+:> ' lit lit , word find , ;
+\ "TICK DOES" (get compilation semantics execution token)
+: '> word find-does ;
+:> '> word find-does , ;
+
+\ Include a remote file
+: REQUIRE" ' quit channel-open dup \' " \, fetch channel-await ;
+
+\ Let's try it
+REQUIRE" { \"url\": \"forth/test-watfor.forth\" }"
 
+\ Print intro string
 " watForth-32 Interactive CLI:
 " .s