From f998451ad1e6486ab7f9db3204bf830e82cb0f94 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Tue, 24 May 2016 00:31:32 +1200 Subject: [PATCH] Fixed residual INTERPRET bugs. Closes #3. --- src/forth.jl | 25 +++++++++++-------------- src/lib.4th | 36 +++++++++++++++++++++++++----------- 2 files changed, 36 insertions(+), 25 deletions(-) diff --git a/src/forth.jl b/src/forth.jl index 134b651..cdb56d5 100644 --- a/src/forth.jl +++ b/src/forth.jl @@ -567,7 +567,7 @@ RSPFETCH = defPrimWord("RSP@", () -> begin end) RSPSTORE = defPrimWord("RSP!", () -> begin - RSP = popPS() + reg.RSP = popPS() return NEXT end) @@ -584,7 +584,7 @@ PSPFETCH = defPrimWord("PSP@", () -> begin end) PSPSTORE = defPrimWord("PSP!", () -> begin - PSP = popPS() + reg.PSP = popPS() return NEXT end) @@ -764,7 +764,7 @@ NUMTIB, NUMTIB_CFA = defNewVar("#TIB", 0) TOIN, TOIN_CFA = defNewVar(">IN", 0) QUERY = defWord("QUERY", - [TIB_CFA, LIT, 80, EXPECT, + [TIB_CFA, LIT, 160, EXPECT, SPAN_CFA, FETCH, NUMTIB_CFA, STORE, LIT, 0, TOIN_CFA, STORE, EXIT]) @@ -876,11 +876,16 @@ PROMPT = defPrimWord("PROMPT", () -> begin end) QUIT = defWord("QUIT", - [RSP0_CFA, RSPSTORE, + [LIT, 0, STATE_CFA, STORE, + LIT, 0, NUMTIB_CFA, STORE, + RSP0_CFA, FETCH, RSPSTORE, QUERY, INTERPRET, PROMPT, BRANCH,-4]) +ABORT = defWord("ABORT", + [PSP0_CFA, FETCH, PSPSTORE, QUIT]) + INCLUDE = defPrimWord("INCLUDE", () -> begin pushPS(32) callPrim(mem[WORD]) @@ -995,16 +1000,8 @@ function run(;initialize=true) close(pop!(sources)) end - # Want backtrace in here eventually - println("reg.W: $(reg.W) reg.IP: $(reg.IP)") - print("PS: "); printPS() - print("RS: "); printRS() - - mem[STATE] = 0 - mem[NUMTIB] = 0 - reg.PSP = mem[PSP0] - reg.RSP = mem[RSP0] - reg.IP = QUIT + 1 + # QUIT + reg.IP = ABORT + 1 jmp = NEXT end end diff --git a/src/lib.4th b/src/lib.4th index 81b1e6f..301f9ac 100644 --- a/src/lib.4th +++ b/src/lib.4th @@ -427,9 +427,14 @@ ['] LITSTRING , ( compile LITSTRING ) HERE @ ( save the address of the length word on the stack ) 0 , ( dummy length - we don't know what it is yet ) - KEY DROP + BEGIN - KEY ( get next character of the string ) + >IN @ #TIB @ >= IF \ End of TIB? + QUERY \ Get next line + THEN + + TIB >IN @ + @ 1 >IN +! \ Get char from TIB + DUP [CHAR] " <> WHILE C, ( copy character ) @@ -441,9 +446,14 @@ SWAP ! ( and back-fill the length location ) ELSE ( immediate mode ) HERE @ ( get the start address of the temporary space ) - KEY DROP + BEGIN - KEY + >IN @ #TIB @ >= IF \ End of TIB? + QUERY \ Get next line + THEN + + TIB >IN @ + @ 1 >IN +! \ Get char from TIB + DUP [CHAR] " <> WHILE OVER C! ( save next character ) @@ -462,9 +472,13 @@ ; : .( - KEY DROP BEGIN - KEY + >IN @ #TIB @ >= IF \ End of TIB? + QUERY \ Get next line + THEN + + TIB >IN @ + @ 1 >IN +! \ Get char from TIB + DUP [CHAR] ) = IF DROP ( drop the double quote character ) EXIT ( return from this function ) @@ -494,11 +508,11 @@ ; : VARIABLE - CREATE + BL WORD HEADER + DOVAR , 1 CELLS ALLOT ( allocate 1 cell of memory, push the pointer to this memory ) ; - : VALUE ( n -- ) BL WORD HEADER ( make the dictionary entry (the name follows VALUE) ) DOCOL , ( append DOCOL ) @@ -630,14 +644,14 @@ ; : SEE - BL WORD 2DUP FIND ( find the dictionary entry to decompile ) + BL WORD DUP FIND ( find the dictionary entry to decompile ) ?DUP 0= IF - ." Word '" TYPE ." ' not found in dictionary." + ." Word '" COUNT TYPE ." ' not found in dictionary." EXIT THEN - -ROT 2DROP + SWAP DROP ( Now we search again, looking for the next word in the dictionary. This gives us the length of the word that we will be decompiling. (Well, mostly it does). ) -- 2.20.1