X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=compile.asm;h=bcffaef4f02fda5c44ffd3cc0b48e2f281a1f636;hb=92ed95a59cba9c0685150503196877c3d81fedbc;hp=1e76aeea96c355beec402cc9f59d3667526cbbad;hpb=c7bd2072c9a131bff7f03f36fefd65f7b6f60f02;p=rrq%2Frrqforth.git diff --git a/compile.asm b/compile.asm index 1e76aee..bcffaef 100644 --- a/compile.asm +++ b/compile.asm @@ -4,18 +4,14 @@ ;; The heap dq heap_start - ;; CREATE ( "[ \t\0]*([^ \t\0]+)" -- tfa ) - ;; Skip leading whitespace and scan following non-whitespace - ;; as being a "word" to add into the current vocabulary. Add - ;; that word header, which consisits of: WORD p_create,'CREATE',fasm + ;; CREATE ( chars* n -- tfa ) + ;; Add the pstring as a new word in the current wordlist. pushr rsi - push p_stdin_DFA ; ( -- stream ) - DOFORTH p_read_word ; ( -- chars* n ) read next word - mov rax,qword [p_wordlist_DFA] ; Current word list - mov rax,[rax] ; last word of current wordlist + mov rdx,qword [p_wordlist_DFA] ; Current word list mov rbx,qword [p_here_DFA] - mov [rbx],rax ; TFA of new word + mov rax,qword [rdx] ; set up tfa linking to previous word + mov qword [rbx],rax ; mov qword [rbx+16],0 ; flags field ;; copy pname pop rcx ; n @@ -26,19 +22,18 @@ p_create_COPY: movsb dec rcx - jge p_create_COPY + jg p_create_COPY mov byte [rdi],0 ; extra NUL inc rdi mov qword [rdi],rbx ; pTFA add rdi,8 - mov qword [rdi],rbx ; OFF + mov qword [rdi],0 ; OFF add rdi,8 mov qword [rbx+8],rdi ; pCFA + mov qword [rdi],dovariable ; CFA add rdi,8 - mov qword [rdi],dovalue ;CFA - add rdi,8 - mov qword [rax],rbx ; Install new word mov qword [p_here_DFA],rdi ; allocate the space + mov qword [rdx],rbx ; Install new word (rdx still wordlist ptr) push rbx popr rsi next @@ -47,30 +42,322 @@ p_create_COPY: ;; ( n -- ) ;; Allocate n bytes on the heap pop rax - add rax,qword [p_here_DFA] - mov qword [p_here_DFA],rax + add qword [p_here_DFA],rax next - ;; DOES> ( -- ) - ;; Change DOES offset of latest compilation word to current - ;; compilation address. - ;; LATEST @ TFA>DOES HERE @ OVER - SWAP ! - WORD p_does,'DOES>',fasm - mov rax,qword [p_wordlist_DFA] - mov rax,[rax] ; last word of current wordlist - add rax,8 - ;add rax,byte [rax] - add rax,1 - mov rbx,[p_here_DFA] + WORD p_quote,"'",fasm + ;; ( "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 +p_quote_end: + popr rsi + next + + 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 + + WORD p_comma,',',fasm + ;; ( 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 + ;; ( 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 + + WORD p_does,"DOES>",fasm,IMMEDIATE + ;; ( -- ) + ;; Change the "DOES offset" of most recent word and assign it + ;; the "dodoes" execution semantics that follows. + mov rax,qword [rsp] + mov rbx,rax + tfa2does rax ; *rax is the DOES offset field + tfa2dfa rbx + mov rcx,qword [p_here_DFA] + sub rcx,rbx + mov qword [rax],rcx ; save offset from DFA to HERE mov qword [rax+8],dodoes next + + WORD p_literal,'LIT',fasm + ;; ( -- v ) + ;; Push the value of successor cell onto stack, and skip it. + ;; not for interactive use!! + push qword [rsi] + add rsi,8 + next + + 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 - WORD p_literal,'LIT',IMMEDIATE - dq p_create - dq p_does +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 + + WORD p_left_bracket,'[',fasm,IMMEDIATE + ;; ( -- ) + ;; Change state to interpreting state. + mov qword[p_state_DFA],0 + next + + WORD p_right_bracket,']',fasm + ;; ( -- ) + ;; Change state to compilation state. + mov qword[p_state_DFA],1 + next + + WORD p_base,'BASE',dovariable + dq 10 + + WORD p_decimal,'DECIMAL',fasm + ;; ( -- ) + ;; Set BASE to 10 + mov qword [p_base_DFA],10 + next + + WORD p_hex,'HEX',fasm + ;; ( -- ) + ;; Set BASE to 16 + mov qword [p_base_DFA],16 + next + + WORD p_number,'NUMBER',fasm + ;; ( chars* n -- [ 0 ]/[ v 1 ] ) + pushr rsi + pop rcx ; ( -- chars* ) + pop rsi ; ( -- ) + xor rdi,rdi ; value + mov rbx,1 ; sign (byte 0=0 means negative) + cmp qword [p_base_DFA],10 + jne p_number_LOOP + cmp byte [rsi],'-' + jne p_number_LOOP + mov rbx,0 + inc rsi + dec rcx + jle p_number_BAD +p_number_LOOP: + dec rcx + jl p_number_DONE + xor rax,rax ; clearing + lodsb + cmp al,'0' + jl p_number_BAD + cmp al,'9' + jg p_number_ALPHA + sub al,'0' +p_number_CONSUME: + mov r8,rax + mov rax,rdi + mul qword [p_base_DFA] ; uses rdx:rax + add rax,r8 + mov rdi,rax + jmp p_number_LOOP +p_number_ALPHA: + cmp al,'A' + jl p_number_BAD + cmp al,'Z' + jg p_number_alpha + sub al,'A'-10 + jmp p_number_CONSUME +p_number_alpha: + cmp al,'a' + jl p_number_BAD + cmp al,'z' + jg p_number_BAD + sub al,'a'-10 + jmp p_number_CONSUME +p_number_BAD: + push qword 0 + popr rsi + next +p_number_DONE: + cmp rbx,0 + jne p_numper_POSITIVE + neg rdi +p_numper_POSITIVE: + push rdi + push qword 1 + 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* ) + + WORD p_evaluate_stream,'EVALUATE-STREAM' + ;; ( stream* -- *?* flag ) + ;; Execute the words from the given stream + ;; returns 1 if stream ends and 0 if an unknown word is found + 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, p_get + BRANCH 0,p_evaluate_stream_LOOP + dq p_depth, p_dot + dq p_literal_string + STRING '> ' + dq p_tell + dq p_input, p_get + dq p_clear_stream +p_evaluate_stream_LOOP: + 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, p_this_word, p_2put + dq p_find + dq p_dup + BRANCH 0,p_evaluate_stream_NOTWORD ; branch if 0 on TOP + dq p_state dq p_get + BRANCH 0,p_evaluate_stream_INTERPRET + dq p_dup + dq p_tfa2flags_get + dq p_literal, 1 ; the immediate bit + dq p_and + 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_input, p_get + dq p_stream_nchars + BRANCH 0,p_evaluate_stream_PROMPT + BRANCH ,p_evaluate_stream_LOOP +p_evaluate_stream_END: + dq p_2drop + dq p_literal, 1 +p_evaluate_stream_BAD: + dq p_Rgt, p_input, p_put ; restore previous stream dq p_exit - - WORD p_execute,'EXECUTE' + 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_input, p_get + dq p_read_word + dq p_create + dq p_tfa2cfa + dq p_put + dq p_right_bracket + dq p_exit + + 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 + + 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_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_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 + dq p_evaluate_stream + dq p_exit