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)
43 ;; Allocate n bytes on the heap
44 dq p_here, p_put_plus, p_return
48 ;; Find the following word and push its cfa, or 0
49 dq p_input, p_get, p_read_word, p_find
55 WORD p_bracketed_quote,"[']",doforth,IMMEDIATE
56 ;; Compilation ( "word" -- cfa )
57 ;; Compile down " LIT value "
58 dq p_literal, p_literal, p_comma,p_quote, p_comma, p_return
62 ;; Put cell value onto the heap and advance "HERE"
63 dq p_here, p_literal, 8, p_get_n_increment, p_put, p_return
67 ;; Put byte value onto the heap and advance "HERE"
68 dq p_here, p_Cput, p_literal, 1, p_here, p_put_plus, p_return
70 WORD p_does,"DOES>",fasm,IMMEDIATE
72 ;; Change the "DOES offset" of most recent word and assign it
73 ;; the "dodoes" execution semantics that follows.
76 tfa2does rax ; *rax is the DOES offset field
78 mov rcx,qword [p_here_DFA]
80 mov qword [rax],rcx ; save offset from DFA to HERE
81 mov qword [rax+8],dodoes
84 WORD p_literal,'LIT',fasm
86 ;; Push the value of successor cell onto stack, and skip it.
87 ;; not for interactive use!!
92 WORD p_literal_string,'LIT-STRING',fasm
94 ;; Save NUL string length and pointer on heap to make
95 ;; available at interpretation. Not for interactive use!!
105 WORD p_literal_string_compile,'S"',fasm,IMMEDIATE ;; " (fool emacs)
107 ;; Lay out a LIT-STRING and a NUL string with length
109 mov rdi,qword [p_here_DFA]
110 mov qword [rdi],p_literal_string
112 mov qword [p_here_DFA],rdi
113 DOFORTH p_double_quote
116 inc rcx ; include the terminating NUL in count
117 mov rdi,qword [p_here_DFA]
121 p_literal_string_copy:
123 jl p_literal_string_copied
125 jmp p_literal_string_copy
126 p_literal_string_copied:
127 mov qword [p_here_DFA],rdi
131 WORD p_state,'STATE',dovariable
132 ;; Interpretation state (0=interpreting, 1=compiling)
135 WORD p_left_bracket,'[',fasm,IMMEDIATE
137 ;; Change state to interpreting 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
200 cmp rax,qword [p_base_DFA]
209 cmp rax,qword [p_base_DFA]
218 jne p_numper_POSITIVE
226 WORD p_input,'INPUT',dovariable
227 ;; The current input stream for evaluate-stream
230 WORD p_this_word,'THIS-WORD',dovariable
231 dq 0,0 ; ( n chars* )
233 WORD p_evaluate_stream,'EVALUATE-STREAM'
234 ;; ( stream* -- *?* flag )
235 ;; Execute the words from the given stream
236 ;; returns 1 if stream ends and 0 if an unknown word is found
237 dq p_input, p_get, p_gtR ; save old stream on R-stack
239 p_evaluate_stream_PROMPT:
241 BRANCH 0,p_evaluate_stream_LOOP
248 p_evaluate_stream_LOOP:
252 BRANCH 0,p_evaluate_stream_END ; branch if 0 on TOP
253 dq p_2dup, p_this_word, p_2put
256 BRANCH 0,p_evaluate_stream_NOTWORD ; branch if 0 on TOP
259 BRANCH 0,p_evaluate_stream_INTERPRET
262 dq p_literal, 1 ; the immediate bit
264 BRANCH 0,p_evaluate_stream_COMPILE
265 p_evaluate_stream_INTERPRET:
268 BRANCH ,p_evaluate_stream_AFTER
269 p_evaluate_stream_COMPILE:
272 BRANCH ,p_evaluate_stream_AFTER
273 p_evaluate_stream_NOTWORD:
277 BRANCH 0,p_evaluate_stream_BAD ; branch if 0
280 BRANCH 0,p_evaluate_stream_AFTER ; branch if 0
281 dq p_literal, p_literal
283 p_evaluate_stream_AFTER:
286 BRANCH 0,p_evaluate_stream_PROMPT
287 BRANCH ,p_evaluate_stream_LOOP
288 p_evaluate_stream_END:
291 p_evaluate_stream_BAD:
292 dq p_Rgt, p_input, p_put ; restore previous stream
293 dq p_literal,0, p_state, p_put ; set interactive mode
298 ;; Read next word as a new word into current wordlist, set it
299 ;; to be a doforth word, and set compiling mode.
300 dq p_literal, doforth
309 WORD p_semicolon,';',,IMMEDIATE
311 ;; Lay out p_return, and set interpreting mode
312 dq p_literal, p_return, p_comma, p_left_bracket, p_return
314 WORD p_immediate,'IMMEDIATE',fasm,IMMEDIATE
316 ;; Set "immediate flag" of the word being defined
317 mov rax,qword [p_wordlist_DFA]
318 mov rax,qword [rax] ; tfa of most recent word
319 mov qword [rax+16],1 ; set the flags field to 1
322 WORD p_load_buffer_size,'LOAD-BUFFER-SIZE',dovariable
324 ;; The buffer size (in bytes) used by LOAD-FILE
327 WORD p_open_file,'OPEN-FILE',fasm
329 ;; Open the nominated file
331 add rsp,8 ; drop n ... assuming NUL-ended string
338 WORD p_load_file,'LOAD-FILE'
342 BRANCH 1,p_load_file_badfile
343 dq p_load_buffer_size, p_get
344 dq p_stream, p_dup, p_gtR
347 BRANCH ,p_load_file_exit
350 STRING '** open file error: '
351 dq p_tell, p_dot, p_nl, p_emit