X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=compile.asm;h=f723487f10e21d2db2aade7576dec84e4f65d392;hb=7a99f2ed7cfe55f3aa69560b31c055ce45fe1f0c;hp=fc9d3f5416207f48d6f27ec4568ff44c8aa80a81;hpb=d7958ae7b474ef357864237fc40412139e43b117;p=rrq%2Frrqforth.git diff --git a/compile.asm b/compile.asm index fc9d3f5..f723487 100644 --- a/compile.asm +++ b/compile.asm @@ -41,7 +41,7 @@ p_create_COPY: WORD p_allot,'ALLOT' ;; ( n -- ) ;; Allocate n bytes on the heap - dq p_here, p_put_plus, p_return + dq p_here, p_swap, p_put_plus, p_return WORD p_quote,"'" ;; ( "word" -- cfa ) @@ -57,15 +57,41 @@ p_quote_end: ;; Compile down " LIT value " dq p_literal, p_literal, p_comma,p_quote, p_comma, p_return - WORD p_comma,',' - ;; ( v -- ) - ;; Put cell value onto the heap and advance "HERE" - dq p_here, p_literal, 8, p_get_n_increment, p_put, p_return + 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 qword [p_here_DFA] + next - WORD p_Ccomma,'C,' + WORD p_Wcomma,'W,',fasm ;; ( c -- ) ;; Put byte value onto the heap and advance "HERE" - dq p_here, p_Cput, p_literal, 1, p_here, p_put_plus, p_return + mov rax,qword [p_here_DFA] + pop rbx + 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 ;; ( -- ) @@ -89,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 @@ -103,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 @@ -116,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 @@ -286,6 +316,7 @@ p_evaluate_stream_END: dq p_literal, 1 p_evaluate_stream_BAD: 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,':'