changed STR>TEMP to assembler

[rrq/rrqforth.git] / compile.asm

diff --git a/compile.asm b/compile.asm
index bcffaef4f02fda5c44ffd3cc0b48e2f281a1f636..c815291554239862cc17b422f4dfb1b92b947e9f 100644 (file)
--- a/compile.asm
+++ b/compile.asm
@@ -18,7 +18,7 @@
        mov qword [rbx+24],rcx  ; PFA (length)
        pop rsi                 ; chars* (source)
        lea rdi,[rbx+32]        ; (dest)
-       ;; clear DF
+       cld
 p_create_COPY:
        movsb
        dec rcx
@@ -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_return
        
-       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_return
 
        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_return
 
-       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
-       
-       WORD p_Ccomma,'C,',fasm
+       dq p_here, p_literal, 8, p_get_n_increment, p_put, p_return
+
+       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_return
 
        WORD p_does,"DOES>",fasm,IMMEDIATE
        ;; ( -- )
@@ -219,6 +193,8 @@ p_number_ALPHA:
        cmp al,'Z'
        jg p_number_alpha
        sub al,'A'-10
+       cmp rax,qword [p_base_DFA]
+       jge p_number_BAD
        jmp p_number_CONSUME
 p_number_alpha:
        cmp al,'a'
@@ -226,6 +202,8 @@ p_number_alpha:
        cmp al,'z'
        jg p_number_BAD
        sub al,'a'-10
+       cmp rax,qword [p_base_DFA]
+       jge p_number_BAD
        jmp p_number_CONSUME
 p_number_BAD:
        push qword 0
@@ -308,7 +286,8 @@ p_evaluate_stream_END:
        dq p_literal, 1
 p_evaluate_stream_BAD:
        dq p_Rgt, p_input, p_put ; restore previous stream
-       dq p_exit
+       dq p_literal,0, p_state, p_put ; set interactive mode
+       dq p_return
 
        WORD p_colon,':'
        ;; ( -- )
@@ -321,16 +300,12 @@ p_evaluate_stream_BAD:
        dq p_tfa2cfa
        dq p_put
        dq p_right_bracket
-       dq p_exit
+       dq p_return
 
        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
+       ;; Lay out p_return, and set interpreting mode
+       dq p_literal, p_return, p_comma, p_left_bracket, p_return
 
        WORD p_immediate,'IMMEDIATE',fasm,IMMEDIATE
        ;; ( -- )
@@ -340,24 +315,36 @@ 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* n -- fd )
+       ;; Open the nominated file
+       pushr rsi
+       add rsp,8 ; drop n ... assuming NUL-ended string
+       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* n -- )
+       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_exit
+       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_return