;;; Dynamic memory management. Allocated with MALLOC and released with
;;; MUNMAP (see below)
- ;; ( size -- addr )
- ;; Allocates memory (using brk)
WORD p_malloc,'MALLOC',fasm
+ ;; ( size -- addr )
+ ;; Allocates memory (using mmap)
pushr rsi ; pretend it's a FORTH word since it
; ends via sys_mmap_asm
pop rax
push qword 0 ; address of mapping (suggestion)
push rax ; length of mapping
push qword 3 ; protection mode PROT_READ | PROT_WRITE
- push qword 8226 ; flags PRIVATE | ANONYMOUS | LOCKED
+ push qword 34 ; flags PRIVATE | ANONYMOUS
push qword -1 ; fd -1
push qword 0 ; offset
jmp sys_mmap_asm ; exit via sys_mmap
-;;; ========================================
-;;; Mapping files
-
- ;; ( fd -- address )
- ;; Request memory mapping of a file
- WORD p_mmap,'MMAP',fasm
- pushr rsi ; pretend it's a FORTH word since it
- ; ends via sys_mmap_asm
- pop rax
- push qword 0 ; address of mapping (suggestion)
- push qword 10240 ; length of mapping
- push qword 1 ; protection mode PROT_READ
- push qword 2 ; flags MAP_PRIVATE
- push rax ; fd
- push qword 0 ; offset
- jmp sys_mmap_asm ; exit via sys_mmap
+ WORD p_realloc,'REALLOC',fasm
+ ;; ( addr old new -- )
+ ;; Try remapping a given MMAP region of old size to a new size
+ ;; mremap(void *old_address, size_t old_size,
+ ;; size_t new_size, int flags, ... /* void *new_address */);
+ pushr rsi
+ push 1 ; MREMAP_MAYMOVE
+ jmp sys_mmap_asm ; exit via sys_mmap
;;; ========================================
-;;; Input stream handling. An input stream has a stream buffer that is
+;;; Input stream handling.
+;;;
+;;; An input stream for a file descriptor has a stream buffer that is
;;; gradually filled on needs basis. The stream buffer includes a
;;; header portion with:
;;; * size of buffer (excluding the 32 byte head)
-;;; * source file descriptor
+;;; * source file descriptor (or -1 for pure in-core data)
;;; * current fill
+;;; * current read position
+;;;
+;;; An input stream for a memory block as a "detached" stream head
+;;; with:
+;;; * block address
+;;; * -1
+;;; * size of block
;;; * current read position
- WORD p_stream,'STREAM',
- ;; ( fd size -- addr )
+ WORD p_stream,'STREAM',fasm
+ ;; ( fd size -- addr ) or ( block -1 -- addr )
;; Allocates a stream buffer of the given size and initializes
;; it to be filled from the given input file descriptor.
- dq p_dup ; ( fd size size )
- dq p_malloc ; ( fd size addr )
- dq p_2dup ; ( fd size addr size addr )
- dq p_swap ; ( fd size addr addr size )
- dq p_erase ; ( fd size addr )
- ENDFORTH
- pop rax ; ( fd size )
- pop rbx ; ( fd )
- sub rbx,32
+ pushr rsi
+ mov rax,[rsp]
+ cmp rax,-1
+ je p_stream_MEM
+ push rax
+ DOFORTH p_malloc ; ( fd size addr )
+ push qword [rsp]
+ push qword [rsp+16] ; ( fd size addr addr size )
+ DOFORTH p_erase ; ( fd size addr )
+ pop rax ; addr ( fd size )
+ pop rbx ; size ( fd )
+ sub rbx,32 ; reduce by header size
mov [rax],rbx
pop rbx
mov [rax+8],rbx
push rax
jmp exit
+p_stream_MEM:
+ push 32 ; size of detached header (wastefull?)
+ DOFORTH p_malloc ; ( block addr )
+ pop rax ; header address
+ pop rbx ; block address
+ mov rcx,[rbx] ; block content size (excludes size field)
+ add rbx,8 ; block content address
+ mov qword [rax],rbx ; save block content address
+ mov qword [rax+8],-1 ; -1 = memblock flag
+ mov qword [rax+16],rcx ; save block content size
+ mov qword [rax+24],0 ; current position
+ push rax
+ jmp exit
+
+ WORD p_unstream,'UNSTREAM',fasm
+ ;; ( stream -- )
+ ;; Release mmap-ed memory
+ pushr rsi
+ mov rax,qword [rsp]
+ mov rbx,qword [rax+8]
+ cmp rbx,0
+ jl p_unstream_incore
+ ;; unstream fd stream
+ push rbx
+ DOFORTH sys_close
+ pop rax
+ mov rax,qword [rsp]
+ push qword [rax+16]
+ add qword [rax+16],32
+ DOFORTH sys_munmap
+ pop rax
+ popr rsi
+ next
+p_unstream_incore:
+ mov rbx,qword [rax+16]
+ mov rax,qword [rax]
+ mov qword [rsp],rax
+ push rbx
+ DOFORTH sys_munmap
+ pop rax
+ popr rsi
+ next
+
+ WORD p_clear_stream,'CLEAR-STREAM',fasm
+ ;; ( stream -- )
+ ;; "Clear" the stream by moving its "current position" to the
+ ;; "fill position".
+ pop rax
+ mov rbx,qword [rax+16] ; copy fill
+ mov qword [rax+24],rbx ; into current
+ next
+
+ WORD p_stream_nchars,'STREAM-NCHARS',fasm
+ ;; ( stream -- n )
+ ;; Scan over whitespace in the stream buffer (without actually
+ ;; consuming) and tell how much then remains.
+ pushr rsi
+ mov rcx,qword [rsp]
+ mov rbx,qword [rcx+16] ; fill
+ sub rbx,qword [rcx+24] ; current
+ cmp qword [rcx+8],-1
+ je p_stream_nchars_memblock
+ mov rsi,rcx
+ add rsi,32
+ jmp p_stream_nchars_skipblanks
+p_stream_nchars_memblock:
+ mov rsi,qword [rcx]
+p_stream_nchars_skipblanks:
+ add rsi,qword [rcx+24] ;
+ cmp rbx,0
+ je p_stream_nchars_done
+p_stream_nchars_loop:
+ lodsb
+ cmp al,32
+ jg p_stream_nchars_done
+ dec rbx
+ jg p_stream_nchars_loop
+p_stream_nchars_done:
+ mov qword [rsp],rbx
+ popr rsi
+ next
+
+;;; ========================================
+;;; Stream reading
+;;; READ-STREAM-CHAR ( stream -- ch )
+
WORD p_read_stream_char,'READ-STREAM-CHAR',fasm
;; ( stream -- ch )
pushr rsi
mov rax,qword [rsp]
- mov rbx,[rax+16] ; fill
+ mov rbx,qword [rax+16] ; fill
+
p_read_stream_char.READ:
- mov rcx,[rax+24] ; current
+ mov rcx,qword [rax+24] ; current
cmp rbx,rcx
jg p_read_stream_char.CHAR
+
+ ;; pull in more from the source, if any
+ cmp qword [rax+8],-1 ; fd == -1 for "no source"
+ je p_read_stream_char.EOF
+
push qword [rax+8] ; fd
lea rbx,[rax+32]
push rbx ; buffer
jle p_read_stream_char.EOF
mov qword[rax+16],rbx
jmp p_read_stream_char.READ
+
p_read_stream_char.EOF:
mov qword [rsp],-1
popr rsi
next
+
p_read_stream_char.CHAR:
inc qword [rax+24]
add rcx,32
popr rsi
next
- WORD p_line_buffer,'LINE-BUFFER',dovariable
- ;; A buffer for holding a text line
+;;; ========================================
+;;; Input handling
+
+ WORD p_pad,'PAD',dovariable
+ ;; A buffer for holding a word
rb 1024
WORD p_read_word,'READ-WORD',fasm
- ;; ( stream -- addr length )
- ;; Read a text line from the stream into the line buffer
+ ;; ( stream -- char* length )
+ ;; Read next word from the given stream into the PAD
pushr rsi
pop rax
- push qword p_line_buffer_DFA
+ pushr rax ; the stream
+ push qword p_pad_DFA
push qword 0
- push rax
+
p_read_word_skipblanks:
- FORTH
- dq p_dup
- dq p_read_stream_char
- ENDFORTH
+ DOFORTH p_Rget, p_read_stream_char
pop rbx
cmp bl,0
jl p_read_word_nomore
cmp bl,' '
jle p_read_word_skipblanks
+ cmp bl,'#'
+ je p_read_word_skipline
p_read_word_readword:
- FORTH
- dq p_dup
- dq p_read_stream_char
- ENDFORTH
+ ;; ( buffer length )
+ mov rax,qword [rsp+8]
+ mov rcx,qword [rsp]
+ mov [rax+rcx],bl
+ inc qword [rsp]
+ DOFORTH p_Rget, p_read_stream_char ; ( -- buffer length char )
pop rbx
cmp bl,0
jl p_read_word_nomore
cmp bl,' '
- jle p_read_word_nomore
- ;; ( buffer length stream )
- mov rax,qword [rsp+16]
- mov rcx,qword [rsp+8]
- mov [rax+rcx],bl
- inc qword [rsp+8]
- jmp p_read_word_readword
+ jg p_read_word_readword
+
p_read_word_nomore:
+ xor rbx,rbx
+ mov rax,qword [rsp+8]
+ mov rcx,qword [rsp]
+ mov [rax+rcx],bl ; add NUL ending
+ inc qword [rsp]
+ DOFORTH p_str2temp
+ dec qword [rsp]
+ popr rax
+ popr rsi
+ next
+
+p_read_word_skipline:
+ DOFORTH p_Rget, p_read_stream_char
+ pop rbx
+ cmp bl,0
+ jl p_read_word_nomore
+ cmp bl,10 ; newline
+ je p_read_word_skipblanks
+ jmp p_read_word_skipline
+
+ WORD p_double_quote,'"',fasm ;; " (fool emacs)
+ ;; ( -- char* n )
+ ;; Scan to double quote in stream buffer, putting the string
+ ;; on PAD, plus an extra NUL, then copy that into a new temp
+ ;; object, but exclude the NUL from the returned count, n.
+ pushr rsi
+ push p_pad_DFA
+ push 0
+p_double_quote_loop:
+ DOFORTH p_input, p_get, p_read_stream_char
+ pop rax
+ cmp rax,0
+ jl p_double_quote_endstream
+ cmp rax,'"' ; " (fool emacs)
+ je p_double_quote_endquote
+ lea rdi,[p_pad_DFA]
+ add rdi,qword [rsp]
+ stosb
+ inc qword [rsp]
+ jmp p_double_quote_loop
+p_double_quote_endquote:
+p_double_quote_endstream:
+ lea rdi,[p_pad_DFA]
+ add rdi,qword [rsp]
+ mov byte [rdi],0
+ ;; copy PAD string + NUL into new temp object
+ inc qword [rsp]
+ DOFORTH p_str2temp
+ dec qword [rsp]
+ popr rsi
+ next
+
+ WORD p_fdtell,'FDTELL',
+ ;; ( chars* n fd -- )
+ ;; Write n bytes from chars* to fd
+ dq p_rot, p_rot, sys_write, p_drop, p_return
+
+ WORD p_tell,'TELL'
+ ;; ( chars* n -- )
+ ;; Write n bytes from chars* to stdout
+ dq p_literal,1,p_fdtell, p_return
+
+ WORD p_fdemit,'FDEMIT'
+ ;; ( c fd -- )
+ ;; Write byte to fd
+ dq p_literal,1, p_dsp, p_literal,1, sys_write, p_2drop, p_return
+
+ WORD p_emit,'EMIT'
+ ;; ( c -- )
+ ;; Write byte to stdout
+ dq p_literal,1, p_fdemit, p_return
+
+ WORD p_nl,'NL',dovalue
+ ;; ( -- c )
+ ;; Pushes a newline character on the stack
+ dq 10
+
+ WORD p_sp,'SP',dovalue
+ ;; ( -- c )
+ ;; Pushes a space character on the stack
+ dq 32
+
+ WORD p_digits,'DIGITS',dovariable
+ db '0123456789abcdef'
+
+ WORD p_dot_temp,'.TEMP',fasm
+ ;; ( v -- )
+ ;; Print TOP value as unsigned BASE integer
+ pushr rsi
+ mov rdi,p_pad_DFA
pop rax
+ cmp rax,0
+ jge p_dot_positive
+ cmp qword [p_base_DFA],10
+ jne p_dot_positive
+ mov byte[rdi],'-'
+ inc rdi
+ neg rax
+p_dot_positive:
+ call p_dot_pad_subr
+ xor rax,rax
+ stosb
+ push p_pad_DFA
+ sub rdi,p_pad_DFA
+ push rdi
+ DOFORTH p_str2temp
+ dec qword [rsp] ; don't count the ending NUL
popr rsi
next
+
+p_dot_pad_subr: ;
+ xor rdx,rdx
+ div qword [p_base_DFA] ; rdx:rax / BASE => q=rax, r=rdx
+ cmp rax,0
+ je p_dot_remainder
+ push rdx
+ call p_dot_pad_subr
+ pop rdx
+p_dot_remainder:
+ xor rax,rax
+ mov al,[p_digits_DFA+rdx]
+ stosb
+ ret
+
+ WORD p_dot,'.'
+ ;; ( v -- )
+ ;; Print value to stdout
+ dq p_dot_temp, p_literal,1, p_fdtell, p_return
projects / rrq / rrqforth.git / blobdiff