1 ;;; ========================================
2 ;;; Dynamic memory management. Allocated with MALLOC and released with
5 WORD p_malloc,'MALLOC',fasm
7 ;; Allocates memory (using mmap)
8 pushr rsi ; pretend it's a FORTH word since it
9 ; ends via sys_mmap_asm
11 push qword 0 ; address of mapping (suggestion)
12 push rax ; length of mapping
13 push qword 3 ; protection mode PROT_READ | PROT_WRITE
14 push qword 34 ; flags PRIVATE | ANONYMOUS
17 jmp sys_mmap_asm ; exit via sys_mmap
19 WORD p_realloc,'REALLOC',fasm
20 ;; ( addr old new -- )
21 ;; Try remapping a given MMAP region of old size to a new size
22 ;; mremap(void *old_address, size_t old_size,
23 ;; size_t new_size, int flags, ... /* void *new_address */);
25 push 1 ; MREMAP_MAYMOVE
26 jmp sys_mmap_asm ; exit via sys_mmap
28 ;;; ========================================
29 ;;; Input stream handling.
31 ;;; An input stream for a file descriptor has a stream buffer that is
32 ;;; gradually filled on needs basis. The stream buffer includes a
33 ;;; header portion with:
34 ;;; * size of buffer (excluding the 32 byte head)
35 ;;; * source file descriptor (or -1 for pure in-core data)
37 ;;; * current read position
39 ;;; An input stream for a memory block as a "detached" stream head
44 ;;; * current read position
46 WORD p_stream,'STREAM',fasm
47 ;; ( fd size -- addr ) or ( block -1 -- addr )
48 ;; Allocates a stream buffer of the given size and initializes
49 ;; it to be filled from the given input file descriptor.
55 DOFORTH p_malloc ; ( fd size addr )
57 push qword [rsp+16] ; ( fd size addr addr size )
58 DOFORTH p_erase ; ( fd size addr )
59 pop rax ; addr ( fd size )
61 sub rbx,32 ; reduce by header size
69 push 32 ; size of detached header (wastefull?)
70 DOFORTH p_malloc ; ( block addr )
71 pop rax ; header address
72 pop rbx ; block address
73 mov rcx,[rbx] ; block content size (excludes size field)
74 add rbx,8 ; block content address
75 mov qword [rax],rbx ; save block content address
76 mov qword [rax+8],-1 ; -1 = memblock flag
77 mov qword [rax+16],rcx ; save block content size
78 mov qword [rax+24],0 ; current position
82 WORD p_unstream,'UNSTREAM',fasm
84 ;; Release mmap-ed memory
102 mov rbx,qword [rax+16]
111 WORD p_clear_stream,'CLEAR-STREAM',fasm
113 ;; "Clear" the stream by moving its "current position" to the
116 mov rbx,qword [rax+16] ; copy fill
117 mov qword [rax+24],rbx ; into current
120 WORD p_stream_nchars,'STREAM-NCHARS',fasm
122 ;; Scan over whitespace in the stream buffer (without actually
123 ;; consuming) and tell how much then remains.
126 mov rbx,qword [rcx+16] ; fill
127 sub rbx,qword [rcx+24] ; current
129 je p_stream_nchars_memblock
132 jmp p_stream_nchars_skipblanks
133 p_stream_nchars_memblock:
135 p_stream_nchars_skipblanks:
136 add rsi,qword [rcx+24] ;
138 je p_stream_nchars_done
139 p_stream_nchars_loop:
142 jg p_stream_nchars_done
144 jg p_stream_nchars_loop
145 p_stream_nchars_done:
150 ;;; ========================================
152 ;;; READ-STREAM-CHAR ( stream -- ch )
154 WORD p_read_stream_char,'READ-STREAM-CHAR',fasm
158 mov rbx,qword [rax+16] ; fill
160 p_read_stream_char.READ:
161 mov rcx,qword [rax+24] ; current
163 jg p_read_stream_char.CHAR
165 ;; pull in more from the source, if any
166 cmp qword [rax+8],-1 ; fd == -1 for "no source"
167 je p_read_stream_char.EOF
169 push qword [rax+8] ; fd
172 push qword [rax] ; size
179 jle p_read_stream_char.EOF
180 mov qword[rax+16],rbx
181 jmp p_read_stream_char.READ
183 p_read_stream_char.EOF:
188 p_read_stream_char.CHAR:
197 ;;; ========================================
200 WORD p_pad,'PAD',dovariable
201 ;; A buffer for holding a word
204 WORD p_read_word,'READ-WORD',fasm
205 ;; ( stream -- char* length )
206 ;; Read next word from the given stream into the PAD
209 pushr rax ; the stream
213 p_read_word_skipblanks:
214 DOFORTH p_Rget, p_read_stream_char
217 jl p_read_word_nomore
219 jle p_read_word_skipblanks
221 je p_read_word_skipline
222 p_read_word_readword:
224 mov rax,qword [rsp+8]
228 DOFORTH p_Rget, p_read_stream_char ; ( -- buffer length char )
231 jl p_read_word_nomore
233 jg p_read_word_readword
237 mov rax,qword [rsp+8]
239 mov [rax+rcx],bl ; add NUL ending
247 p_read_word_skipline:
248 DOFORTH p_dup, p_read_stream_char
251 jl p_read_word_nomore
253 je p_read_word_skipblanks
254 jmp p_read_word_skipline
256 WORD p_double_quote,'"',fasm ;; " (fool emacs)
258 ;; Scan to double quote in stream buffer, putting the string
259 ;; on PAD, plus an extra NUL, then copy that into a new temp
260 ;; object, but exclude the NUL from the returned count, n.
265 DOFORTH p_input, p_get, p_read_stream_char
268 jl p_double_quote_endstream
269 cmp rax,'"' ; " (fool emacs)
270 je p_double_quote_endquote
275 jmp p_double_quote_loop
276 p_double_quote_endquote:
277 p_double_quote_endstream:
281 ;; copy PAD string into new temp object
288 WORD p_fdtell,'FDTELL',
289 ;; ( chars* n fd -- )
290 ;; Write n bytes from chars* to fd
291 dq p_rot, p_rot, sys_write, p_drop, p_return
295 ;; Write n bytes from chars* to stdout
296 dq p_literal,1,p_fdtell, p_return
298 WORD p_fdemit,'FDEMIT'
301 dq p_literal,1, p_dsp, p_literal,1, sys_write, p_2drop, p_return
305 ;; Write byte to stdout
306 dq p_literal,1, p_fdemit, p_return
308 WORD p_nl,'NL',dovalue
310 ;; Pushes a newline character on the stack
313 WORD p_sp,'SP',dovalue
315 ;; Pushes a space character on the stack
318 WORD p_digits,'DIGITS',dovariable
319 db '0123456789abcdef'
321 WORD p_dot_temp,'.TEMP',fasm
323 ;; Print TOP value as unsigned BASE integer
329 cmp qword [p_base_DFA],10
342 dec qword [rsp] ; don't count the ending NUL
348 div qword [p_base_DFA] ; rdx:rax / BASE => q=rax, r=rdx
356 mov al,[p_digits_DFA+rdx]
362 ;; Print value to stdout
363 dq p_dot_temp, p_literal,1, p_fdtell, p_return