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
popr rsi
next
+;;; ========================================
+;;; Copy line to PAD
+;;; READ-STREAM-LINE ( stream -- n )
+
+ WORD p_read_stream_line,'READ-STREAM-LINE'
+ ;; ( stream -- n )
+ ;; Read stream until next newline
+ dq p_gtR, p_pad
+p_read_stream_line_loop:
+ dq p_Rget, p_read_stream_char
+ dq p_dup, p_0less
+ BRANCH 1,p_read_stream_line_done
+ dq p_dup, p_nl, p_equal
+ BRANCH 1,p_read_stream_line_done
+ dq p_over, p_Cput, p_literal,1, p_plus
+ BRANCH ,p_read_stream_line_loop
+p_read_stream_line_done:
+ dq p_drop, p_literal,0, p_over, p_Cput
+ dq p_pad, p_minus, p_Rgt, p_drop, p_return
+
+
;;; ========================================
;;; Stream reading
;;; READ-STREAM-CHAR ( stream -- ch )
;; 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
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
+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
jmp p_double_quote_loop
p_double_quote_endquote:
p_double_quote_endstream:
- mov qword [rdi],0
lea rdi,[p_pad_DFA]
add rdi,qword [rsp]
- ;; copy PAD string into new temp object
+ mov byte [rdi],0
+ ;; copy PAD string + NUL 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
+ 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
- pushr rsi
- pop rbx
- pop rax
- push 1
- push rax
- push rbx
- DOFORTH sys_write
- pop rax
- popr rsi
- next
+ dq p_literal,1,p_fdtell, p_return
- WORD p_emit,'EMIT',fasm
+ 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 )
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