;;; ========================================
;;; 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 (starts at 8 = after block size)

	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

;;; ========================================
;;; 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

p_read_stream_char.READ:
	mov rcx,[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_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

p_emit_buffer:	dq 0
	
	WORD p_emit,'EMIT',fasm
	;; ( c -- )
	;; Write byte to stdout
	pushr rsi
	pop rax
	mov [p_emit_buffer],al
	push 1
	push p_emit_buffer
	push 1
	DOFORTH sys_write
	pop rax
        popr rsi
	next