X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=compile.asm;h=be5a9088e76a186fe9e6e9c22e09e84ae1f301c1;hb=273afdbee113cc4d7a14052e54e5a1f7fbe255d8;hp=6ddf3a3387b916450ccf72ca5963ca0a75199580;hpb=66382e2941c3b774bb04cd27954258a50b1c402a;p=rrq%2Frrqforth.git diff --git a/compile.asm b/compile.asm index 6ddf3a3..be5a908 100644 --- a/compile.asm +++ b/compile.asm @@ -30,7 +30,6 @@ p_create_COPY: mov qword [rdi],0 ; OFF add rdi,8 mov qword [rbx+8],rdi ; pCFA - add rdi,8 mov qword [rdi],dovariable ; CFA add rdi,8 mov qword [p_here_DFA],rdi ; allocate the space @@ -39,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,IMMEDIATE + WORD p_quote,"'" ;; ( "word" -- cfa ) ;; Find the following word and push its cfa, or 0 - pushr rsi - DOFORTH p_stdin, 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 ;; ( -- ) @@ -108,7 +81,7 @@ p_quote_end: mov qword [rax+8],dodoes next - WORD p_literal,'LIT',fasm,IMMEDIATE + WORD p_literal,'LIT',fasm ;; ( -- v ) ;; Push the value of successor cell onto stack, and skip it. ;; not for interactive use!! @@ -116,10 +89,34 @@ p_quote_end: add rsi,8 next - WORD p_literal_string,'S"',fasm ;; " (fool emacs) + WORD p_literal_string,'S"',fasm,IMMEDIATE ;; " (fool emacs) ;; ( -- char* n ) ;; Save string on heap to make available at interpretation ;; not for interactive use!! + cmp qword [p_state_DFA],0 + je p_literal_string_executing + pushr rsi + mov rdi,qword [p_here_DFA] + mov qword [rdi],p_literal_string + add rdi,8 + mov qword [p_here_DFA],rdi + DOFORTH p_double_quote + pop rcx + pop rsi + mov rdi,qword [p_here_DFA] + mov qword [rdi],rcx + add rdi,8 +p_literal_string_copy: + dec rcx + jl p_literal_string_copied + movsb + jmp p_literal_string_copy +p_literal_string_copied: + mov qword [p_here_DFA],rdi + popr rsi + next + +p_literal_string_executing: mov rax,qword [rsi] add rsi,8 push rsi @@ -218,6 +215,10 @@ p_numper_POSITIVE: popr rsi next + WORD p_input,'INPUT',dovariable + ;; The current input stream for evaluate-stream + dq 0 + WORD p_this_word,'THIS-WORD',dovariable dq 0,0 ; ( n chars* ) @@ -225,23 +226,23 @@ p_numper_POSITIVE: ;; ( stream* -- *?* flag ) ;; Execute the words from the given stream ;; returns 1 if stream ends and 0 if an unknown word is found - dq p_ltR ; Keep the stream on the return stack. + dq p_input, p_get, p_gtR ; save old stream on R-stack + dq p_input, p_put p_evaluate_stream_PROMPT: - dq p_depth - dq p_dot + dq p_verboseQ, p_get + BRANCH 0,p_evaluate_stream_LOOP + dq p_depth, p_dot dq p_literal_string STRING '> ' dq p_tell - dq p_Rget + dq p_input, p_get dq p_clear_stream p_evaluate_stream_LOOP: - dq p_Rget + dq p_input, p_get dq p_read_word dq p_dup BRANCH 0,p_evaluate_stream_END ; branch if 0 on TOP - dq p_2dup - dq p_this_word - dq p_2put + dq p_2dup, p_this_word, p_2put dq p_find dq p_dup BRANCH 0,p_evaluate_stream_NOTWORD ; branch if 0 on TOP @@ -249,22 +250,30 @@ p_evaluate_stream_LOOP: dq p_get BRANCH 0,p_evaluate_stream_INTERPRET dq p_dup - dq p_cfa2flags_get - dq p_literal, 1 + dq p_tfa2flags_get + dq p_literal, 1 ; the immediate bit dq p_and - dq p_not - BRANCH 0,p_evaluate_stream_INTERPRET - dq p_comma - BRANCH ,p_evaluate_stream_AFTER + BRANCH 0,p_evaluate_stream_COMPILE p_evaluate_stream_INTERPRET: + dq p_tfa2cfa dq p_execute BRANCH ,p_evaluate_stream_AFTER +p_evaluate_stream_COMPILE: + dq p_tfa2cfa + dq p_comma + BRANCH ,p_evaluate_stream_AFTER p_evaluate_stream_NOTWORD: dq p_drop dq p_number + dq p_dup BRANCH 0,p_evaluate_stream_BAD ; branch if 0 + dq p_drop + dq p_state, p_get + BRANCH 0,p_evaluate_stream_AFTER ; branch if 0 + dq p_literal, p_literal + dq p_comma, p_comma p_evaluate_stream_AFTER: - dq p_Rget + dq p_input, p_get dq p_stream_nchars BRANCH 0,p_evaluate_stream_PROMPT BRANCH ,p_evaluate_stream_LOOP @@ -272,8 +281,7 @@ p_evaluate_stream_END: dq p_2drop dq p_literal, 1 p_evaluate_stream_BAD: - dq p_Rgt - dq p_drop + dq p_Rgt, p_input, p_put ; restore previous stream dq p_exit WORD p_colon,':' @@ -281,7 +289,7 @@ p_evaluate_stream_BAD: ;; Read next word as a new word into current wordlist, set it ;; to be a doforth word, and set compiling mode. dq p_literal, doforth - dq p_stdin + dq p_input, p_get dq p_read_word dq p_create dq p_tfa2cfa @@ -289,9 +297,49 @@ p_evaluate_stream_BAD: dq p_right_bracket dq p_exit - WORD p_semicolon,';' + 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_literal, p_exit, p_comma, p_left_bracket, p_exit + + WORD p_immediate,'IMMEDIATE',fasm,IMMEDIATE + ;; ( -- ) + ;; Set "immediate flag" of the word being defined + mov rax,qword [p_wordlist_DFA] + mov rax,qword [rax] ; tfa of most recent word + mov qword [rax+16],1 ; set the flags field to 1 + next + + 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,'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_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