1 ;;; Words for adding words
3 WORD p_here,'HERE',dovariable
7 WORD p_create,'CREATE',fasm
8 ;; CREATE ( chars* n -- tfa )
9 ;; Add the pstring as a new word in the current wordlist.
11 mov rax,qword [p_wordlist_DFA] ; Current word list
12 mov rax,[rax] ; last word of current wordlist
13 mov rbx,qword [p_here_DFA]
14 mov [rbx],rax ; TFA of new word
15 mov qword [rbx+16],0 ; flags field
18 mov qword [rbx+24],rcx ; PFA (length)
19 pop rsi ; chars* (source)
20 lea rdi,[rbx+32] ; (dest)
26 mov byte [rdi],0 ; extra NUL
28 mov qword [rdi],rbx ; pTFA
30 mov qword [rdi],rbx ; OFF
32 mov qword [rbx+8],rdi ; pCFA
34 mov qword [rdi],dovalue ;CFA
36 mov qword [rax],rbx ; Install new word
37 mov qword [p_here_DFA],rdi ; allocate the space
42 WORD p_allot,'ALLOT',fasm
44 ;; Allocate n bytes on the heap
46 add rax,qword [p_here_DFA]
47 mov qword [p_here_DFA],rax
52 ;; Put cell value onto the heap and advance "HERE"
53 mov rax,qword [p_here_DFA]
57 mov qword [p_here_DFA],rax
60 WORD p_Ccomma,'C,',fasm
62 ;; Put byte value onto the heap and advance "HERE"
63 mov rax,qword [p_here_DFA]
67 mov qword [p_here_DFA],rax
70 WORD p_does,'DOES>',fasm,IMMEDIATE
72 ;; Change the "DOES offset" of latest compilation and assign
73 ;; it the "dodoes" execution semantics,
74 mov rax,qword [p_wordlist_DFA]
75 mov rax,[rax] ; last word of current wordlist
76 tfa2does rax ; *rax is the DOES offset field
77 ;; offset = qword [p_here_DFA]) - (rax+2*8)
78 mov rbx,qword [p_here_DFA]
82 mov qword [rax+8],dodoes
85 WORD p_literal,'LIT',fasm
87 ;; Push the value of successor cell onto stack, and skip it
92 WORD p_literal_string,'S"',fasm ;; " (fool emacs)
93 ;; Compilation: ( "..." -- )
94 ;; Interpretation: ( -- char* n )
95 ;; Save string on heap to make available at interpretation
96 cmp qword [p_state_DFA],0
97 je p_literal_string_interpret
98 ;; compilation mode: read stream until \" onto the heap
101 lea rbx,[p_literal_string_CFA]
108 je p_literal_string_end
110 p_literal_string_copy:
114 jg p_literal_string_copy
115 p_literal_string_end:
116 mov qword [p_here_DFA],rdi
120 p_literal_string_interpret:
128 ;;; ========================================
129 ;;; The text interpreter
131 WORD p_state,'STATE',dovariable
132 ;; Interpretation state (0=interpreting, 1=compiling)
135 WORD p_left_bracket,'[',fasm,IMMEDIATE
137 ;; Change state to interpretation state.
138 mov qword[p_state_DFA],0
141 WORD p_right_bracket,']',fasm
143 ;; Change state to compilation state.
144 mov qword[p_state_DFA],1
147 WORD p_base,'BASE',dovariable
150 WORD p_decimal,'DECIMAL',fasm
153 mov qword [p_base_DFA],10
156 WORD p_hex,'HEX',fasm
159 mov qword [p_base_DFA],16
162 WORD p_number,'NUMBER',fasm
163 ;; ( chars* n -- [ 0 ]/[ v 1 ] )
165 pop rcx ; ( -- chars* )
168 mov rbx,1 ; sign (byte 0=0 means negative)
169 cmp qword [p_base_DFA],10
180 xor rax,rax ; clearing
190 mul qword [p_base_DFA] ; uses rdx:rax
214 jne p_numper_POSITIVE
222 WORD p_this_word,'THIS-WORD',dovariable
223 dq 0,0 ; ( n chars* )
225 WORD p_evaluate_stream,'EVALUATE-STREAM'
226 ;; ( stream* -- *?* flag )
227 ;; Execute the words from the given stream
228 ;; returns 1 if stream ends and 0 if an unknown word is found
229 dq p_ltR ; Keep the stream on the return stack.
230 p_evaluate_stream_PROMPT:
231 dq p_depth, p_dot, p_literal_string
233 dq p_tell, p_Rget, p_clear_stream
234 p_evaluate_stream_LOOP:
235 dq p_Rget, p_read_word, p_dup
236 BRANCH 0,p_evaluate_stream_END ; branch if 0 on TOP
237 dq p_2dup, p_this_word, p_2put, p_find, p_dup
238 BRANCH 0,p_evaluate_stream_NOTWORD ; branch if 0 on TOP
240 BRANCH 0,p_evaluate_stream_INTERPRET
242 BRANCH ,p_evaluate_stream_AFTER
243 p_evaluate_stream_INTERPRET:
245 BRANCH ,p_evaluate_stream_AFTER
246 p_evaluate_stream_NOTWORD:
248 BRANCH 0,p_evaluate_stream_BAD ; branch if 0
249 p_evaluate_stream_AFTER:
250 dq p_Rget,p_stream_nchars
251 BRANCH 0,p_evaluate_stream_PROMPT
252 BRANCH ,p_evaluate_stream_LOOP
253 p_evaluate_stream_END:
254 dq p_2drop, p_literal, 1
255 p_evaluate_stream_BAD:
256 dq p_Rgt, p_drop, p_exit