X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=compile.asm;h=f723487f10e21d2db2aade7576dec84e4f65d392;hb=433a6cc4e7fccb418345a78de099a4e15891abcf;hp=bcffaef4f02fda5c44ffd3cc0b48e2f281a1f636;hpb=97a4e5ecb1623dbe0fbd7b6eeb96e966c6c5b1d3;p=rrq%2Frrqforth.git diff --git a/compile.asm b/compile.asm index bcffaef..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 @@ -38,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 + 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 - ;; ( 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 @@ -115,12 +115,22 @@ p_quote_end: add rsi,8 next - WORD p_literal_string,'S"',fasm,IMMEDIATE ;; " (fool emacs) + WORD p_literal_string,'LIT-STRING',fasm ;; ( -- 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 + ;; 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 + 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 @@ -129,9 +139,11 @@ p_quote_end: 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 @@ -142,14 +154,6 @@ p_literal_string_copied: popr rsi next -p_literal_string_executing: - mov rax,qword [rsi] - add rsi,8 - push rsi - push rax - add rsi,rax - next - WORD p_state,'STATE',dovariable ;; Interpretation state (0=interpreting, 1=compiling) dq 0 @@ -219,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' @@ -226,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 @@ -308,7 +316,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 +330,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 +345,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