debugging FIND

[rrq/rrqforth.git] / compile.asm

diff --git a/compile.asm b/compile.asm
index 1e76aeea96c355beec402cc9f59d3667526cbbad..be4f6526e9db02d510326ed9faa941592acf4329 100644 (file)
--- a/compile.asm
+++ b/compile.asm
@@ -4,14 +4,10 @@
        ;; The heap
        dq heap_start
        
-       ;; CREATE ( "[ \t\0]*([^ \t\0]+)" -- tfa )
-       ;; Skip leading whitespace and scan following non-whitespace
-       ;; as being a "word" to add into the current vocabulary. Add
-       ;; that word header, which consisits of:
        WORD p_create,'CREATE',fasm
+       ;; CREATE ( chars* n -- tfa )
+       ;; Add the pstring as a new word in the current wordlist.
        pushr rsi
-       push p_stdin_DFA        ; ( -- stream )
-       DOFORTH p_read_word     ; ( -- chars* n ) read next word
        mov rax,qword [p_wordlist_DFA] ; Current word list
        mov rax,[rax]           ; last word of current wordlist
        mov rbx,qword [p_here_DFA] 
@@ -51,26 +47,116 @@ p_create_COPY:
        mov qword [p_here_DFA],rax
        next
        
-       ;; DOES> ( -- )
-       ;; Change DOES offset of latest compilation word to current
-       ;; compilation address.
-       ;; LATEST @ TFA>DOES HERE @ OVER - SWAP !
-       WORD p_does,'DOES>',fasm
+       WORD p_comma,',',fasm
+       ;; ( v -- )
+       ;; Put cell value onto the heap and advance "HERE"
+       mov rax,qword [p_here_DFA]
+       pop rbx
+       mov qword [rax],rbx
+       add rax,8
+       mov qword [p_here_DFA],rax
+       next
+       
+       WORD p_Ccomma,'C,',fasm
+       ;; ( c -- )
+       ;; Put byte value onto the heap and advance "HERE"
+       mov rax,qword [p_here_DFA]
+       pop rbx
+       mov byte [rax],bl
+       inc rax
+       mov qword [p_here_DFA],rax
+       next
+
+       WORD p_does,'DOES>',fasm,IMMEDIATE
+       ;; ( -- )
+       ;; Change the "DOES offset" of latest compilation and assign
+       ;; it the "dodoes" execution semantics, 
        mov rax,qword [p_wordlist_DFA] 
        mov rax,[rax]           ; last word of current wordlist
-       add rax,8
-       ;add rax,byte [rax]
-       add rax,1
-       mov rbx,[p_here_DFA]
+       tfa2does rax            ; *rax is the DOES offset field
+       ;; offset = qword [p_here_DFA]) - (rax+2*8)
+       mov rbx,qword [p_here_DFA]
+       sub rbx,rax
+       sub rbx,16
        mov qword [rax],rbx
        mov qword [rax+8],dodoes
        next
+
+       WORD p_literal,'LIT',fasm
+       ;; ( -- v )
+       ;; Push the value of successor cell onto stack, and skip it
+       push qword [rsi]
+       add rsi,8
+       next
+
+       WORD p_literal_string,'S"',fasm
+                                     ;; " (fool emacs)
+       ;; ( -- chars* n )
+       ;; Push the value of successor cell onto stack, and skip it
+       mov rax,qword [rsi]
+       add rsi,8
+       push rsi
+       push rax
+       add rsi,rax
+       next
+
+;;; ========================================
+;;; The text interpreter
+
+       WORD p_state,'STATE',dovariable
+       ;; Interpretation state (0=interpreting, 1=compiling)
+       dq 0
+
+       WORD p_left_bracket,'[',fasm,IMMEDIATE
+       ;; ( -- )
+       ;; Change state to interpretation state.
+       mov qword[p_state_DFA],0
+       next
+
+       WORD p_right_bracket,']',fasm
+       ;; ( -- )
+       ;; Change state to compilation state.
+       mov qword[p_state_DFA],1
+       next
+
+       WORD p_number,'NUMBER'
+       ;; ( chars* n -- [ 0 ]/[ v 1 ] )
+
+       WORD p_this_word,'THIS-WORD',dovariable
+       dq 0,0                  ; ( n chars* )
+
+       WORD p_evaluate_stream,'EVALUATE-STREAM'
+       ;; ( stream -- *?* flag )
+       ;; Execute the words from the given stream
+       ;; returns 1 if stream ends and 0 if an unknown word is found
+
+p_evaluate_stream_LOOP:
+       dq p_read_word          ; ( -- chars* n )
+       dq p_zero_branch
+       dq   p_evaluate_stream_END - $ - 8
        
-       WORD p_literal,'LIT',IMMEDIATE
-       dq p_create
-       dq p_does
-       dq p_get
+       dq p_2dup
+       dq p_this_word
+       dq p_2put
+       dq p_find
+       dq p_dup
+       dq p_zero_branch
+       dq   p_evaluate_stream_NOTWORD - $ - 8
+       dq p_execute
+       dq p_branch
+       dq   p_evaluate_stream_LOOP - $ - 8
+
+p_evaluate_stream_NOTWORD:
+       dq p_this_word
+       dq p_2get
+       dq p_number
+       dq p_not
+       dq p_zero_branch
+       dq   p_evaluate_stream_LOOP - $ - 8
+
+       dq 0
        dq p_exit
-       
-       WORD p_execute,'EXECUTE'
 
+p_evaluate_stream_END:
+       dq 1
+       dq p_exit