X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=stdio.asm;h=e07e809d8bba5deda2d599f73c9660a1cfd04f2d;hb=c39ff90d7e44da4984c0b04370eb41d839779d3b;hp=a6cf5128683ce1f121855560ec4e181ed837f2c9;hpb=5e1475bc1afeecd3bd9388cac34d937ea67c2a68;p=rrq%2Frrqforth.git

diff --git a/stdio.asm b/stdio.asm
index a6cf512..e07e809 100644
--- a/stdio.asm
+++ b/stdio.asm
@@ -2,20 +2,29 @@
 ;;; 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
 
+	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.
 ;;;
@@ -70,14 +79,74 @@ p_stream_MEM:
 	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 buffer of input 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 )
@@ -86,10 +155,10 @@ p_stream_MEM:
 	;; ( 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
 
@@ -137,31 +206,26 @@ p_read_stream_char.CHAR:
 	;; Read next word from the given stream into the PAD
 	pushr rsi
 	pop rax
+	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:
-	;; ( buffer length stream )
-	mov rax,qword [rsp+16]
-	mov rcx,qword [rsp+8]
+	;; ( buffer length )
+	mov rax,qword [rsp+8]
+	mov rcx,qword [rsp]
 	mov [rax+rcx],bl
-	inc qword [rsp+8]
-	FORTH
-	dq p_dup
-	dq p_read_stream_char
-	ENDFORTH
+	inc qword [rsp]
+	DOFORTH p_Rget, p_read_stream_char ; ( -- buffer length char )
 	pop rbx
 	cmp bl,0
 	jl p_read_word_nomore
@@ -169,37 +233,77 @@ p_read_word_readword:
 	jg p_read_word_readword
 
 p_read_word_nomore:
-	pop rax
+	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
 
-	WORD p_tell,'TELL',fasm
-	;; ( chars* n -- )
-	;; Write n bytes from chars* to stdout
-	pushr rsi
+p_read_word_skipline:
+	DOFORTH p_dup, 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
-	push 1
-	push rax
-	push rbx
-	DOFORTH sys_write
-	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 into new temp object
+	inc qword [rsp]
+	DOFORTH p_str2temp
+	dec qword [rsp]
 	popr rsi
 	next
 
-	WORD p_emit,'EMIT',fasm
+	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
-	pushr rsi
-	mov rax,rsp
-	push 1
-	push rax
-	push 1
-	DOFORTH sys_write
-	pop rax			; ignore return value
-	pop rax			; drop input data
-        popr rsi
-	next
+	dq p_literal,1, p_fdemit, p_return
 
 	WORD p_nl,'NL',dovalue
 	;; ( -- c )
@@ -209,37 +313,51 @@ p_read_word_nomore:
 	WORD p_sp,'SP',dovalue
 	;; ( -- c )
 	;; Pushes a space character on the stack
-	dq 10
+	dq 32
 
 	WORD p_digits,'DIGITS',dovariable
 	db '0123456789abcdef'
 
-	WORD p_dot,'.',fasm
+	WORD p_dot_temp,'.TEMP',fasm
 	;; ( v -- )
 	;; Print TOP value as unsigned BASE integer
 	pushr rsi
-	mov rax,qword [rsp]
+	mov rdi,p_pad_DFA
+	pop rax
 	cmp rax,0
 	jge p_dot_positive
 	cmp qword [p_base_DFA],10
 	jne p_dot_positive
-	push '-'
-	DOFORTH p_emit
-	mov rax,qword [rsp]
+	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
-	mov qword [rsp],rdx 
 	cmp rax,0
 	je p_dot_remainder
-	push rax
-	DOFORTH p_dot
-p_dot_remainder:
+	push rdx
+	call p_dot_pad_subr
 	pop rdx
+p_dot_remainder:
 	xor rax,rax
 	mov al,[p_digits_DFA+rdx]
-	push rax
-	DOFORTH p_emit
-	popr rsi
-	next
+	stosb
+	ret
+
+	WORD p_dot,'.'
+	;; ( v -- )
+	;; Print value to stdout
+	dq p_dot_temp, p_literal,1, p_fdtell, p_return