X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=compile.asm;h=defb1acaa5dcfc25e59eac9acbe315c216b5c450;hb=a0aa0a5825ce306120666fd5425308a8ec9314f8;hp=fe19b203620ee3dab25f407657704c588641fe20;hpb=bfb48545dd4310c422007dfc1dc3b9eb2897d125;p=rrq%2Frrqforth.git diff --git a/compile.asm b/compile.asm index fe19b20..defb1ac 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,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_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 - - WORD p_Ccomma,'C,',fasm + dq p_here, p_literal, 8, p_get_n_increment, p_put, p_exit + + 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 ;; ( -- ) @@ -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 @@ -241,6 +219,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* ) @@ -248,26 +230,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_gtR ; 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_verboseQ - dq p_get + dq p_verboseQ, p_get BRANCH 0,p_evaluate_stream_LOOP - dq p_depth - dq p_dot + 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 @@ -293,13 +272,12 @@ p_evaluate_stream_NOTWORD: dq p_dup BRANCH 0,p_evaluate_stream_BAD ; branch if 0 dq p_drop - dq p_state - dq p_get + 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 @@ -307,8 +285,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,':' @@ -316,7 +293,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 @@ -327,11 +304,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 ;; ( -- ) @@ -341,24 +314,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_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