X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=stdio.asm;h=99bac9eb290532001312dcf7fb3db975de493c49;hb=6abdd618f54acab8cb2d04f3c3ee2d0aab36eb22;hp=fed8eda38df2fffa598e11bb4f8d7c8d4a26b19e;hpb=135bac77e9403714670d582b59255f2588ec83fb;p=rrq%2Frrqforth.git diff --git a/stdio.asm b/stdio.asm index fed8eda..99bac9e 100644 --- a/stdio.asm +++ b/stdio.asm @@ -2,74 +2,170 @@ ;;; 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_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" 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 ) + 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 +179,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,40 +194,38 @@ 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 + 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 @@ -137,6 +233,131 @@ p_read_word_readword: jg p_read_word_readword p_read_word_nomore: + 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 + ;; 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] + mov byte [rdi],0 + ;; copy PAD string + NUL into new temp object + inc qword [rsp] + DOFORTH p_str2temp + dec qword [rsp] popr rsi next + + 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 + dq p_literal,1, p_fdemit, p_return + + 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_temp,'.TEMP',fasm + ;; ( v -- ) + ;; Print TOP value as unsigned BASE integer + pushr rsi + mov rdi,p_pad_DFA + pop rax + cmp rax,0 + jge p_dot_positive + cmp qword [p_base_DFA],10 + jne p_dot_positive + 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 + cmp rax,0 + je p_dot_remainder + push rdx + call p_dot_pad_subr + pop rdx +p_dot_remainder: + xor rax,rax + mov al,[p_digits_DFA+rdx] + stosb + ret + + WORD p_dot,'.' + ;; ( v -- ) + ;; Print value to stdout + dq p_dot_temp, p_literal,1, p_fdtell, p_return