1 ;;; ========================================
2 ;;; Dynamic memory management. Allocated with MALLOC and released with
6 ;; Allocates memory (using brk)
7 WORD p_malloc,'MALLOC',fasm
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 ;;; ========================================
20 ;;; Input stream handling.
22 ;;; An input stream for a file descriptor has a stream buffer that is
23 ;;; gradually filled on needs basis. The stream buffer includes a
24 ;;; header portion with:
25 ;;; * size of buffer (excluding the 32 byte head)
26 ;;; * source file descriptor (or -1 for pure in-core data)
28 ;;; * current read position
30 ;;; An input stream for a memory block as a "detached" stream head
35 ;;; * current read position
37 WORD p_stream,'STREAM',fasm
38 ;; ( fd size -- addr ) or ( block -1 -- addr )
39 ;; Allocates a stream buffer of the given size and initializes
40 ;; it to be filled from the given input file descriptor.
46 DOFORTH p_malloc ; ( fd size addr )
48 push qword [rsp+16] ; ( fd size addr addr size )
49 DOFORTH p_erase ; ( fd size addr )
50 pop rax ; addr ( fd size )
52 sub rbx,32 ; reduce by header size
60 push 32 ; size of detached header (wastefull?)
61 DOFORTH p_malloc ; ( block addr )
62 pop rax ; header address
63 pop rbx ; block address
64 mov rcx,[rbx] ; block content size (excludes size field)
65 add rbx,8 ; block content address
66 mov qword [rax],rbx ; save block content address
67 mov qword [rax+8],-1 ; -1 = memblock flag
68 mov qword [rax+16],rcx ; save block content size
69 mov qword [rax+24],0 ; current position
73 WORD p_clear_stream,'CLEAR-STREAM',fasm
75 ;; Clear buffer of input stream
77 mov rbx,qword [rax+16] ; copy fill
78 mov qword [rax+24],rbx ; into current
81 WORD p_stream_nchars,'STREAM-NCHARS',fasm
83 ;; Scan over whitespace in the stream buffer (without actually
84 ;; consuming) and tell how much then remains.
87 mov rbx,qword [rcx+16] ; fill
88 sub rbx,qword [rcx+24] ; current
90 je p_stream_nchars_memblock
93 jmp p_stream_nchars_skipblanks
94 p_stream_nchars_memblock:
96 p_stream_nchars_skipblanks:
97 add rsi,qword [rcx+24] ;
99 je p_stream_nchars_done
100 p_stream_nchars_loop:
103 jg p_stream_nchars_done
105 jg p_stream_nchars_loop
106 p_stream_nchars_done:
111 ;;; ========================================
113 ;;; READ-STREAM-CHAR ( stream -- ch )
115 WORD p_read_stream_char,'READ-STREAM-CHAR',fasm
119 mov rbx,qword [rax+16] ; fill
121 p_read_stream_char.READ:
122 mov rcx,qword [rax+24] ; current
124 jg p_read_stream_char.CHAR
126 ;; pull in more from the source, if any
127 cmp qword [rax+8],-1 ; fd == -1 for "no source"
128 je p_read_stream_char.EOF
130 push qword [rax+8] ; fd
133 push qword [rax] ; size
140 jle p_read_stream_char.EOF
141 mov qword[rax+16],rbx
142 jmp p_read_stream_char.READ
144 p_read_stream_char.EOF:
149 p_read_stream_char.CHAR:
158 ;;; ========================================
161 WORD p_pad,'PAD',dovariable
162 ;; A buffer for holding a word
165 WORD p_read_word,'READ-WORD',fasm
166 ;; ( stream -- char* length )
167 ;; Read next word from the given stream into the PAD
174 p_read_word_skipblanks:
177 dq p_read_stream_char
181 jl p_read_word_nomore
183 jle p_read_word_skipblanks
185 p_read_word_readword:
186 ;; ( buffer length stream )
187 mov rax,qword [rsp+16]
188 mov rcx,qword [rsp+8]
193 dq p_read_stream_char
197 jl p_read_word_nomore
199 jg p_read_word_readword
206 WORD p_double_quote,'"',fasm ;; " (fool emacs)
208 ;; Scan to double quote in stream buffer, putting thr string on PAD
213 DOFORTH p_stdin, p_read_stream_char
216 jl p_double_quote_endstream
217 cmp rax,'"' ; " (fool emacs)
218 je p_double_quote_endquote
223 jmp p_double_quote_loop
224 p_double_quote_endquote:
225 p_double_quote_endstream:
229 WORD p_tell,'TELL',fasm
231 ;; Write n bytes from chars* to stdout
243 WORD p_emit,'EMIT',fasm
245 ;; Write byte to stdout
252 pop rax ; ignore return value
253 pop rax ; drop input data
257 WORD p_nl,'NL',dovalue
259 ;; Pushes a newline character on the stack
262 WORD p_sp,'SP',dovalue
264 ;; Pushes a space character on the stack
267 WORD p_digits,'DIGITS',dovariable
268 db '0123456789abcdef'
272 ;; Print TOP value as unsigned BASE integer
277 cmp qword [p_base_DFA],10
285 div qword [p_base_DFA] ; rdx:rax / BASE => q=rax, r=rdx
294 mov al,[p_digits_DFA+rdx]