X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=compile.asm;h=f723487f10e21d2db2aade7576dec84e4f65d392;hb=d16950460c966e302f79b7450f50cc21ddc93672;hp=6ddf3a3387b916450ccf72ca5963ca0a75199580;hpb=66382e2941c3b774bb04cd27954258a50b1c402a;p=rrq%2Frrqforth.git diff --git a/compile.asm b/compile.asm index 6ddf3a3..f723487 100644 --- 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 @@ -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,59 +38,59 @@ 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_swap, p_put_plus, p_return - 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_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 - ;; ( v -- ) - ;; Put cell value onto the heap and advance "HERE" + WORD p_Ccomma,'C,',fasm + ;; ( c -- ) + ;; Put byte 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 + mov byte [rax],bl + inc qword [p_here_DFA] next - - WORD p_Ccomma,'C,',fasm + + WORD p_Wcomma,'W,',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 + mov word [rax],bx + add qword [p_here_DFA],2 + next + + WORD p_Dcomma,'D,',fasm + ;; ( d -- ) + ;; Put byte value onto the heap and advance "HERE" + mov rax,qword [p_here_DFA] + pop rbx + mov dword [rax],ebx + add qword [p_here_DFA],4 + next + + WORD p_comma,',',fasm + ;; ( v -- ) + ;; Put byte value onto the heap and advance "HERE" + mov rax,qword [p_here_DFA] + pop rbx + mov qword [rax],rbx + add qword [p_here_DFA],8 next WORD p_does,"DOES>",fasm,IMMEDIATE @@ -108,7 +107,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,17 +115,45 @@ p_quote_end: add rsi,8 next - WORD p_literal_string,'S"',fasm ;; " (fool emacs) + WORD p_literal_string,'LIT-STRING',fasm ;; ( -- char* n ) - ;; Save string on heap to make available at interpretation - ;; not for interactive use!! + ;; Save NUL string length and pointer on heap to make + ;; available at interpretation. Not for interactive use!! mov rax,qword [rsi] add rsi,8 push rsi - push rax add rsi,rax + dec rax + push rax next + + WORD p_literal_string_compile,'S"',fasm,IMMEDIATE ;; " (fool emacs) + ;; ( "..." -- ) + ;; Lay out a LIT-STRING and a NUL string with length + 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 + inc rcx ; include the terminating NUL in count + mov rdi,qword [p_here_DFA] + mov qword [rdi],rcx + add rdi,8 + cld +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 + WORD p_state,'STATE',dovariable ;; Interpretation state (0=interpreting, 1=compiling) dq 0 @@ -196,6 +223,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' @@ -203,6 +232,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 @@ -218,6 +249,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 +260,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 +284,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,26 +315,66 @@ p_evaluate_stream_END: dq p_2drop dq p_literal, 1 p_evaluate_stream_BAD: - dq p_Rgt - dq p_drop - dq p_exit + dq p_Rgt, p_input, p_put ; restore previous stream + dq p_literal,0, p_state, p_put ; set interactive mode + dq p_return WORD p_colon,':' ;; ( -- ) ;; 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 dq p_put dq p_right_bracket - dq p_exit + dq p_return - 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 + ;; 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 + ;; ( -- ) + ;; 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_return