;;; ========================================
;;; Dynamic memory management. Allocated with MALLOC and released with
;;; MUNMAP (see below)

	;; ( size -- addr )
	;; Allocates memory (using brk)
	WORD p_malloc,'MALLOC',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 rax		; length of mapping
	push qword 3		; protection mode PROT_READ | PROT_WRITE
	push qword 8226		; flags PRIVATE | ANONYMOUS | LOCKED
	push qword -1		; fd -1
	push qword 0		; offset
	jmp sys_mmap_asm	; exit via sys_mmap

;;; ========================================
;;; 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 (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',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.
	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,qword [rax+16]	; fill

p_read_stream_char.READ:
	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
	push qword [rax]	; size
	mov qword[rax+16],0
	mov qword[rax+24],0
	DOFORTH sys_read
	pop rbx
	mov rax,qword [rsp]
	cmp rbx,0
	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
	mov qword [rsp],0
	mov bl,[rax+rcx]
	mov byte [rsp],bl
	popr rsi
	next

;;; ========================================
;;; Input handling

	WORD p_pad,'PAD',dovariable
	;; A buffer for holding a word
	rb 1024

	WORD p_read_word,'READ-WORD',fasm
	;; ( stream -- char* length )
	;; Read next word from the given stream into the PAD
	pushr rsi
	pop rax
	push qword p_pad_DFA
	push qword 0
	push rax

p_read_word_skipblanks:	
	FORTH
	dq p_dup
	dq p_read_stream_char
	ENDFORTH
	pop rbx
	cmp bl,0
	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
	ENDFORTH
	pop rbx
	cmp bl,0
	jl p_read_word_nomore
	cmp bl,' '
	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
	pushr rsi
	push p_pad_DFA
	push 0
p_double_quote_loop:	
	DOFORTH p_stdin, 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:
	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 10

	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