various improvements

[rrq/rrqforth.git] / compile.asm

diff --git a/compile.asm b/compile.asm
index bcffaef4f02fda5c44ffd3cc0b48e2f281a1f636..53dbaecdd9ddb233439e5931984a8bc1e8304883 100644 (file)
--- a/compile.asm
+++ b/compile.asm
@@ -38,60 +38,34 @@ p_create_COPY:
        popr rsi
        next
 
-       WORD p_allot,'ALLOT',fasm
+       WORD p_allot,'ALLOT'
        ;; ( n -- )
        ;; Allocate n bytes on the heap
-       pop rax
-       add qword [p_here_DFA],rax
-       next
+       dq p_here, p_put_plus, p_exit
        
-       WORD p_quote,"'",fasm
+       WORD p_quote,"'"
        ;; ( "word" -- cfa )
        ;; Find the following word and push its cfa, or 0
-       pushr rsi
-       DOFORTH p_input, p_get, p_read_word, p_find
-       cmp qword[rsp],0
-       jne p_quote_tfa
-       add rsp,16
-       mov qword[rsp],0
-       jmp p_quote_end
-p_quote_tfa:
-       mov rax,qword [rsp]
-       tfa2cfa rax
-       mov qword [rsp],rax
+       dq p_input, p_get, p_read_word, p_find
+       BRANCH 0,p_quote_end
+       dq p_tfa2cfa
 p_quote_end:
-       popr rsi
-       next
+       dq p_exit
 
        WORD p_bracketed_quote,"[']",doforth,IMMEDIATE
        ;; Compilation ( "word" -- cfa )
-       ;; Find the following word and push its cfa, or 0
-       dq p_literal
-       dq p_literal
-       dq p_comma
-       dq p_quote
-       dq p_comma
-       dq p_exit
+       ;; Compile down " LIT value "
+       dq p_literal, p_literal, p_comma,p_quote, p_comma, p_exit
 
-       WORD p_comma,',',fasm
+       WORD p_comma,','
        ;; ( 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
+       dq p_here, p_put, p_literal, 8, p_here, p_put_plus, p_exit
        
-       WORD p_Ccomma,'C,',fasm
+       WORD p_Ccomma,'C,'
        ;; ( 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
+       dq p_here, p_Cput, p_literal, 1, p_here, p_put_plus, p_exit
 
        WORD p_does,"DOES>",fasm,IMMEDIATE
        ;; ( -- )
@@ -326,11 +300,7 @@ p_evaluate_stream_BAD:
        WORD p_semicolon,';',,IMMEDIATE
        ;; ( -- )
        ;; Lay out p_exit, and set interpreting mode
-       dq p_left_bracket
-       dq p_literal, p_exit
-       dq p_comma
-       dq p_left_bracket
-       dq p_exit
+       dq p_literal, p_exit, p_comma, p_left_bracket, p_exit
 
        WORD p_immediate,'IMMEDIATE',fasm,IMMEDIATE
        ;; ( -- )
@@ -340,24 +310,35 @@ p_evaluate_stream_BAD:
        mov qword [rax+16],1    ; set the flags field to 1
        next
 
-       WORD p_open_file_quote,'OPEN-FILE"'
-       ;; ( "name" -- fd )
-       dq p_double_quote
-       dq p_create
-       dq p_tfa2namez
-       dq p_literal,0
-       dq p_literal,0
-       dq sys_open
-       dq p_exit
+       WORD p_load_buffer_size,'LOAD-BUFFER-SIZE',dovariable
+       ;; ( -- a )
+       ;; The buffer size (in bytes) used by LOAD-FILE
+       dq 15000
+       
+       WORD p_open_file,'OPEN-FILE',fasm
+       ;; ( chaz* -- fd )
+       ;; Open the nominated file
+       pushr rsi
+       push qword 0
+       push qword 0
+       DOFORTH sys_open
+       popr rsi
+       next
 
-       WORD p_load_file_quote,'LOAD-FILE"'
-       ;; ( "name" -- )
-       ;; Create a word for the nominated file for a stream to,
-       ;; and store that stream pointer, then invoke evaluate-stream
-       dq p_open_file_quote ; fd
-       dq p_literal, 15000 ; buffer size
-       dq p_stream
-       dq p_dup
-       dq p_comma
+       WORD p_load_file,'LOAD-FILE'
+       ;; ( chaz* -- )
+       dq p_open_file
+       dq p_dup, p_0less
+       BRANCH 1,p_load_file_badfile
+       dq p_load_buffer_size, p_get
+       dq p_stream, p_dup, p_gtR
        dq p_evaluate_stream
+       dq p_Rgt, p_unstream
+       BRANCH ,p_load_file_exit
+p_load_file_badfile:
+       dq p_literal_string
+       STRING '** open file error: '
+       dq p_tell, p_dot, p_nl, p_emit
+       dq p_literal,1
+p_load_file_exit:
        dq p_exit