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-LINE ( stream -- n )
154 WORD p_read_stream_line,'READ-STREAM-LINE'
156 ;; Read stream until next newline
158 p_read_stream_line_loop:
159 dq p_Rget, p_read_stream_char
161 BRANCH 1,p_read_stream_line_done
162 dq p_dup, p_nl, p_equal
163 BRANCH 1,p_read_stream_line_done
164 dq p_over, p_Cput, p_literal,1, p_plus
165 BRANCH ,p_read_stream_line_loop
166 p_read_stream_line_done:
167 dq p_drop, p_literal,0, p_over, p_Cput
168 dq p_pad, p_minus, p_Rgt, p_drop, p_return
171 ;;; ========================================
173 ;;; READ-STREAM-CHAR ( stream -- ch )
175 WORD p_read_stream_char,'READ-STREAM-CHAR',fasm
179 mov rbx,qword [rax+16] ; fill
181 p_read_stream_char.READ:
182 mov rcx,qword [rax+24] ; current
184 jg p_read_stream_char.CHAR
186 ;; pull in more from the source, if any
187 cmp qword [rax+8],-1 ; fd == -1 for "no source"
188 je p_read_stream_char.EOF
190 push qword [rax+8] ; fd
193 push qword [rax] ; size
200 jle p_read_stream_char.EOF
201 mov qword[rax+16],rbx
202 jmp p_read_stream_char.READ
204 p_read_stream_char.EOF:
209 p_read_stream_char.CHAR:
218 ;;; ========================================
221 WORD p_pad,'PAD',dovariable
222 ;; A buffer for holding a word
225 WORD p_read_word,'READ-WORD',fasm
226 ;; ( stream -- char* length )
227 ;; Read next word from the given stream into the PAD
230 pushr rax ; the stream
234 p_read_word_skipblanks:
235 DOFORTH p_Rget, p_read_stream_char
238 jl p_read_word_nomore
240 jle p_read_word_skipblanks
242 je p_read_word_skipline
243 p_read_word_readword:
245 mov rax,qword [rsp+8]
249 DOFORTH p_Rget, p_read_stream_char ; ( -- buffer length char )
252 jl p_read_word_nomore
254 jg p_read_word_readword
258 mov rax,qword [rsp+8]
260 mov [rax+rcx],bl ; add NUL ending
268 p_read_word_skipline:
269 DOFORTH p_Rget, p_read_stream_char
272 jl p_read_word_nomore
274 je p_read_word_skipblanks
275 jmp p_read_word_skipline
277 WORD p_double_quote,'"',fasm ;; " (fool emacs)
279 ;; Scan to double quote in stream buffer, putting the string
280 ;; on PAD, plus an extra NUL, then copy that into a new temp
281 ;; object, but exclude the NUL from the returned count, n.
286 DOFORTH p_input, p_get, p_read_stream_char
289 jl p_double_quote_endstream
290 cmp rax,'"' ; " (fool emacs)
291 je p_double_quote_endquote
296 jmp p_double_quote_loop
297 p_double_quote_endquote:
298 p_double_quote_endstream:
302 ;; copy PAD string + NUL into new temp object
309 WORD p_fdtell,'FDTELL',
310 ;; ( chars* n fd -- )
311 ;; Write n bytes from chars* to fd
312 dq p_rot, p_rot, sys_write, p_drop, p_return
316 ;; Write n bytes from chars* to stdout
317 dq p_literal,1,p_fdtell, p_return
319 WORD p_fdemit,'FDEMIT'
322 dq p_literal,1, p_dsp, p_literal,1, sys_write, p_2drop, p_return
326 ;; Write byte to stdout
327 dq p_literal,1, p_fdemit, p_return
329 WORD p_nl,'NL',dovalue
331 ;; Pushes a newline character on the stack
334 WORD p_sp,'SP',dovalue
336 ;; Pushes a space character on the stack
339 WORD p_digits,'DIGITS',dovariable
340 db '0123456789abcdef'
342 WORD p_dot_temp,'.TEMP',fasm
344 ;; Print TOP value as unsigned BASE integer
350 cmp qword [p_base_DFA],10
363 dec qword [rsp] ; don't count the ending NUL
369 div qword [p_base_DFA] ; rdx:rax / BASE => q=rax, r=rdx
377 mov al,[p_digits_DFA+rdx]
383 ;; Print value to stdout
384 dq p_dot_temp, p_literal,1, p_fdtell, p_return