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 8226 ; flags PRIVATE | ANONYMOUS | LOCKED
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_clear_stream,'CLEAR-STREAM',fasm
84 ;; Clear buffer of input stream
86 mov rbx,qword [rax+16] ; copy fill
87 mov qword [rax+24],rbx ; into current
90 WORD p_stream_nchars,'STREAM-NCHARS',fasm
92 ;; Scan over whitespace in the stream buffer (without actually
93 ;; consuming) and tell how much then remains.
96 mov rbx,qword [rcx+16] ; fill
97 sub rbx,qword [rcx+24] ; current
99 je p_stream_nchars_memblock
102 jmp p_stream_nchars_skipblanks
103 p_stream_nchars_memblock:
105 p_stream_nchars_skipblanks:
106 add rsi,qword [rcx+24] ;
108 je p_stream_nchars_done
109 p_stream_nchars_loop:
112 jg p_stream_nchars_done
114 jg p_stream_nchars_loop
115 p_stream_nchars_done:
120 ;;; ========================================
122 ;;; READ-STREAM-CHAR ( stream -- ch )
124 WORD p_read_stream_char,'READ-STREAM-CHAR',fasm
128 mov rbx,qword [rax+16] ; fill
130 p_read_stream_char.READ:
131 mov rcx,qword [rax+24] ; current
133 jg p_read_stream_char.CHAR
135 ;; pull in more from the source, if any
136 cmp qword [rax+8],-1 ; fd == -1 for "no source"
137 je p_read_stream_char.EOF
139 push qword [rax+8] ; fd
142 push qword [rax] ; size
149 jle p_read_stream_char.EOF
150 mov qword[rax+16],rbx
151 jmp p_read_stream_char.READ
153 p_read_stream_char.EOF:
158 p_read_stream_char.CHAR:
167 ;;; ========================================
170 WORD p_pad,'PAD',dovariable
171 ;; A buffer for holding a word
174 WORD p_read_word,'READ-WORD',fasm
175 ;; ( stream -- char* length )
176 ;; Read next word from the given stream into the PAD
183 p_read_word_skipblanks:
186 dq p_read_stream_char
190 jl p_read_word_nomore
192 jle p_read_word_skipblanks
194 p_read_word_readword:
195 ;; ( buffer length stream )
196 mov rax,qword [rsp+16]
197 mov rcx,qword [rsp+8]
202 dq p_read_stream_char
206 jl p_read_word_nomore
208 jg p_read_word_readword
215 WORD p_double_quote,'"',fasm ;; " (fool emacs)
217 ;; Scan to double quote in stream buffer, putting the string
218 ;; on PAD, plus an extra NUL, then copy that into a new temp
219 ;; object, but exclude the NUL from the returned count, n.
224 DOFORTH p_input, p_get, p_read_stream_char
227 jl p_double_quote_endstream
228 cmp rax,'"' ; " (fool emacs)
229 je p_double_quote_endquote
234 jmp p_double_quote_loop
235 p_double_quote_endquote:
236 p_double_quote_endstream:
240 ;; copy PAD string into new temp object
244 add qword [rsp+8],8 ; adjust pointer
248 WORD p_tell,'TELL',fasm
250 ;; Write n bytes from chars* to stdout
262 WORD p_emit,'EMIT',fasm
264 ;; Write byte to stdout
271 pop rax ; ignore return value
272 pop rax ; drop input data
276 WORD p_nl,'NL',dovalue
278 ;; Pushes a newline character on the stack
281 WORD p_sp,'SP',dovalue
283 ;; Pushes a space character on the stack
286 WORD p_digits,'DIGITS',dovariable
287 db '0123456789abcdef'
291 ;; Print TOP value as unsigned BASE integer
296 cmp qword [p_base_DFA],10
304 div qword [p_base_DFA] ; rdx:rax / BASE => q=rax, r=rdx
313 mov al,[p_digits_DFA+rdx]