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 rdx,qword [p_wordlist_DFA] ; Current word list
12 mov rbx,qword [p_here_DFA]
13 mov rax,qword [rdx] ; set up tfa linking to previous 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],0 ; OFF
32 mov qword [rbx+8],rdi ; pCFA
33 mov qword [rdi],dovariable ; CFA
35 mov qword [p_here_DFA],rdi ; allocate the space
36 mov qword [rdx],rbx ; Install new word (rdx still wordlist ptr)
41 WORD p_allot,'ALLOT',fasm
43 ;; Allocate n bytes on the heap
45 add qword [p_here_DFA],rax
50 ;; Find the following word and push its cfa, or 0
52 DOFORTH p_stdin, p_read_word, p_find
66 WORD p_bracketed_quote,"[']",doforth,IMMEDIATE
67 ;; Compilation ( "word" -- cfa )
68 ;; Find the following word and push its cfa, or 0
78 ;; Put cell value onto the heap and advance "HERE"
79 mov rax,qword [p_here_DFA]
83 mov qword [p_here_DFA],rax
86 WORD p_Ccomma,'C,',fasm
88 ;; Put byte value onto the heap and advance "HERE"
89 mov rax,qword [p_here_DFA]
93 mov qword [p_here_DFA],rax
96 WORD p_does,"DOES>",fasm,IMMEDIATE
98 ;; Change the "DOES offset" of most recent word and assign it
99 ;; the "dodoes" execution semantics that follows.
102 tfa2does rax ; *rax is the DOES offset field
104 mov rcx,qword [p_here_DFA]
106 mov qword [rax],rcx ; save offset from DFA to HERE
107 mov qword [rax+8],dodoes
110 WORD p_literal,'LIT',fasm
112 ;; Push the value of successor cell onto stack, and skip it.
113 ;; not for interactive use!!
118 WORD p_literal_string,'S"',fasm,IMMEDIATE ;; " (fool emacs)
120 ;; Save string on heap to make available at interpretation
121 ;; not for interactive use!!
122 cmp qword [p_state_DFA],0
123 je p_literal_string_executing
125 mov rdi,qword [p_here_DFA]
126 mov qword [rdi],p_literal_string
128 mov qword [p_here_DFA],rdi
129 DOFORTH p_double_quote
132 mov rdi,qword [p_here_DFA]
135 p_literal_string_copy:
137 jl p_literal_string_copied
139 jmp p_literal_string_copy
140 p_literal_string_copied:
141 mov qword [p_here_DFA],rdi
145 p_literal_string_executing:
153 WORD p_state,'STATE',dovariable
154 ;; Interpretation state (0=interpreting, 1=compiling)
157 WORD p_left_bracket,'[',fasm,IMMEDIATE
159 ;; Change state to interpreting state.
160 mov qword[p_state_DFA],0
163 WORD p_right_bracket,']',fasm
165 ;; Change state to compilation state.
166 mov qword[p_state_DFA],1
169 WORD p_base,'BASE',dovariable
172 WORD p_decimal,'DECIMAL',fasm
175 mov qword [p_base_DFA],10
178 WORD p_hex,'HEX',fasm
181 mov qword [p_base_DFA],16
184 WORD p_number,'NUMBER',fasm
185 ;; ( chars* n -- [ 0 ]/[ v 1 ] )
187 pop rcx ; ( -- chars* )
190 mov rbx,1 ; sign (byte 0=0 means negative)
191 cmp qword [p_base_DFA],10
202 xor rax,rax ; clearing
212 mul qword [p_base_DFA] ; uses rdx:rax
236 jne p_numper_POSITIVE
244 WORD p_this_word,'THIS-WORD',dovariable
245 dq 0,0 ; ( n chars* )
247 WORD p_evaluate_stream,'EVALUATE-STREAM'
248 ;; ( stream* -- *?* flag )
249 ;; Execute the words from the given stream
250 ;; returns 1 if stream ends and 0 if an unknown word is found
251 dq p_gtR ; Keep the stream on the return stack.
252 p_evaluate_stream_PROMPT:
255 BRANCH 0,p_evaluate_stream_LOOP
263 p_evaluate_stream_LOOP:
267 BRANCH 0,p_evaluate_stream_END ; branch if 0 on TOP
273 BRANCH 0,p_evaluate_stream_NOTWORD ; branch if 0 on TOP
276 BRANCH 0,p_evaluate_stream_INTERPRET
279 dq p_literal, 1 ; the immediate bit
281 BRANCH 0,p_evaluate_stream_COMPILE
282 p_evaluate_stream_INTERPRET:
285 BRANCH ,p_evaluate_stream_AFTER
286 p_evaluate_stream_COMPILE:
289 BRANCH ,p_evaluate_stream_AFTER
290 p_evaluate_stream_NOTWORD:
294 BRANCH 0,p_evaluate_stream_BAD ; branch if 0
298 BRANCH 0,p_evaluate_stream_AFTER ; branch if 0
299 dq p_literal, p_literal
301 p_evaluate_stream_AFTER:
304 BRANCH 0,p_evaluate_stream_PROMPT
305 BRANCH ,p_evaluate_stream_LOOP
306 p_evaluate_stream_END:
309 p_evaluate_stream_BAD:
316 ;; Read next word as a new word into current wordlist, set it
317 ;; to be a doforth word, and set compiling mode.
318 dq p_literal, doforth
327 WORD p_semicolon,';',,IMMEDIATE
329 ;; Lay out p_exit, and set interpreting mode
336 WORD p_immediate,'IMMEDIATE',fasm,IMMEDIATE
338 ;; Set "immediate flag" of the word being defined
339 mov rax,qword [p_wordlist_DFA]
340 mov rax,qword [rax] ; tfa of most recent word
341 mov qword [rax+16],1 ; set the flags field to 1