X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=stdio.asm;h=191e09893e2226146f1ee1d0b92a0650d66ec06d;hb=aa6d10c30115571b859b9e7e3d6e8a9b9ced599b;hp=ae3e08eaa64a5c3b72e1152bce4161da7a8b8f17;hpb=f3bc3b97f37dd7bc012c152374d4185c734b3a7e;p=rrq%2Frrqforth.git

diff --git a/stdio.asm b/stdio.asm
index ae3e08e..191e098 100644
--- a/stdio.asm
+++ b/stdio.asm
@@ -2,74 +2,140 @@
 ;;; 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_clear_stream,'CLEAR-STREAM',fasm
+	;; ( stream -- )
+	;; Clear buffer of input stream
+	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
@@ -83,10 +149,12 @@ p_read_stream_char.READ:
 	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
@@ -96,18 +164,22 @@ p_read_stream_char.CHAR:
 	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
+	push qword p_pad_DFA
 	push qword 0
 	push rax
+
 p_read_word_skipblanks:	
 	FORTH
 	dq p_dup
@@ -118,7 +190,13 @@ p_read_word_skipblanks:
 	jl p_read_word_nomore
 	cmp bl,' '
 	jle p_read_word_skipblanks
+
 p_read_word_readword:
+	;; ( buffer length stream )
+	mov rax,qword [rsp+16]
+	mov rcx,qword [rsp+8]
+	mov [rax+rcx],bl
+	inc qword [rsp+8]
 	FORTH
 	dq p_dup
 	dq p_read_stream_char
@@ -127,14 +205,113 @@ p_read_word_readword:
 	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:
 	pop rax
 	popr rsi
 	next
+
+	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]
+	stosb
+	;; copy PAD string into new temp object
+	inc qword [rsp]
+	DOFORTH p_str2temp
+	dec qword [rsp]
+	add qword [rsp+8],8 	; adjust pointer
+	popr rsi
+	next
+
+	WORD p_tell,'TELL',fasm
+	;; ( chars* n -- )
+	;; Write n bytes from chars* to stdout
+	pushr rsi
+	pop rbx
+	pop rax
+	push 1
+	push rax
+	push rbx
+	DOFORTH sys_write
+	pop rax
+	popr rsi
+	next
+
+	WORD p_emit,'EMIT',fasm
+	;; ( 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
+
+	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,'.',fasm
+	;; ( v -- )
+	;; Print TOP value as unsigned BASE integer
+	pushr rsi
+	mov rax,qword [rsp]
+	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]
+	neg rax
+p_dot_positive:
+	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:
+	pop rdx
+	xor rax,rax
+	mov al,[p_digits_DFA+rdx]
+	push rax
+	DOFORTH p_emit
+	popr rsi
+	next