From 60057839785134cd60545fa503c31ab50d4056d2 Mon Sep 17 00:00:00 2001 From: Ralph Ronnquist Date: Sat, 5 Jun 2021 18:26:21 +1000 Subject: [PATCH] various improvements --- adoc/p_fdemit.adoc | 14 +++++ adoc/p_fdtell.adoc | 11 ++++ adoc/p_load_buffer_size.adoc | 12 ++++ adoc/p_load_file.adoc | 18 ++++++ adoc/p_load_file_quote.adoc | 15 ----- adoc/p_open_file.adoc | 13 ++++ adoc/p_rbp.adoc | 12 ++++ adoc/{p_rsp.adoc => p_rbpn.adoc} | 11 +++- adoc/p_read_word.adoc | 14 +++++ adoc/p_stream.adoc | 1 + adoc/p_tell.adoc | 2 +- adoc/p_unstream.adoc | 24 +++++++ compile.asm | 105 +++++++++++++------------------ debug.sh | 2 +- machine.asm | 2 + reference.adoc | 18 ++++-- stack.asm | 16 ++++- stdio.asm | 92 +++++++++++++++++---------- wordindex.adoc | 12 +++- 19 files changed, 272 insertions(+), 122 deletions(-) create mode 100644 adoc/p_fdemit.adoc create mode 100644 adoc/p_fdtell.adoc create mode 100644 adoc/p_load_buffer_size.adoc create mode 100644 adoc/p_load_file.adoc delete mode 100644 adoc/p_load_file_quote.adoc create mode 100644 adoc/p_open_file.adoc create mode 100644 adoc/p_rbp.adoc rename adoc/{p_rsp.adoc => p_rbpn.adoc} (56%) create mode 100644 adoc/p_unstream.adoc diff --git a/adoc/p_fdemit.adoc b/adoc/p_fdemit.adoc new file mode 100644 index 0000000..49932fc --- /dev/null +++ b/adoc/p_fdemit.adoc @@ -0,0 +1,14 @@ +// stdio.asm: WORD p_fdemit,'FDEMIT' + +anchor:p_fdemit[] + +=== Word: FDEMIT + +.... +Data stack: ( c fd -- ) +.... + +"FDEMIT" is a function word that puts the given character code to the +given file descriptor. The character is the least significant byte of +the data stack cell. + diff --git a/adoc/p_fdtell.adoc b/adoc/p_fdtell.adoc new file mode 100644 index 0000000..9d61d1a --- /dev/null +++ b/adoc/p_fdtell.adoc @@ -0,0 +1,11 @@ +// stdio.asm: WORD p_fdtell,'FDTELL' + +anchor:p_fdtell[] + +=== Word: FDTELL +.... +Data stack: ( char* n fd -- ) +.... + +"FDTELL" is a function word that prints a string to the given file +descriptor. diff --git a/adoc/p_load_buffer_size.adoc b/adoc/p_load_buffer_size.adoc new file mode 100644 index 0000000..f5e81ce --- /dev/null +++ b/adoc/p_load_buffer_size.adoc @@ -0,0 +1,12 @@ +// compile.asm: WORD p_load_buffer_size,'LOAD-BUFFER-SIZE',dovariable + +anchor:p_load_buffer_size[] + +=== Word: LOAD-BUFFER-SIZE + +.... +data stack: ( -- a ) +.... + +"LOAD-BUFFER-SIZE" is a variable word telling the buffer size in bytes +that <> should use. diff --git a/adoc/p_load_file.adoc b/adoc/p_load_file.adoc new file mode 100644 index 0000000..a6e3eb8 --- /dev/null +++ b/adoc/p_load_file.adoc @@ -0,0 +1,18 @@ +// compile.asm: WORD p_load_file,'LOAD-FILE' + +anchor:p_load_file[] + +=== Word: LOAD-FILE + +.... +data stack: ( chaz* -- * 0/1 ) +.... + +"LOAD-FILE" is a function word that evaluates a text file. It opens a +file via xref:p_open_file[OPEN-FILE] and sets up a stream with a +buffer of <> bytes for +reading it. The stream is passed to +<> for processing its words. Upon +its return the file is closed and the stream memory is reclaimed, and +then the function returns whatever +<> returns. diff --git a/adoc/p_load_file_quote.adoc b/adoc/p_load_file_quote.adoc deleted file mode 100644 index 8e0b4b3..0000000 --- a/adoc/p_load_file_quote.adoc +++ /dev/null @@ -1,15 +0,0 @@ -// compile.asm: WORD p_load_file_quote,'LOAD-FILE"' - -anchor:p_load_file_quote[] - -=== Word: LOAD-FILE" - -.... -data stack: ( "name" -- ) -.... - -"LOAD-FILE"" is a function word that opens a file via -xref:p_open_file_quote[OPEN-FILE"], allocates a stream buffer of 15000 -bytes for reading it, saves the stream pointer as value for the newly -created filename variable, and then it invokes -xref:p_evaluate_stream[EVALUATE-STREAM] for processing the file. diff --git a/adoc/p_open_file.adoc b/adoc/p_open_file.adoc new file mode 100644 index 0000000..5281ffb --- /dev/null +++ b/adoc/p_open_file.adoc @@ -0,0 +1,13 @@ +// compile.asm: WORD p_open_file,'OPEN-FILE' + +anchor:p_open_file[] + +=== Word: OPEN-FILE + +.... +Data stack: ( chaz* -- fd ) +.... + +"OPEN-FILE" is a function word that opens the file named by the zero +terminated character string and returns the file descriptor, or if +less than 0, the system call error code. diff --git a/adoc/p_rbp.adoc b/adoc/p_rbp.adoc new file mode 100644 index 0000000..077d724 --- /dev/null +++ b/adoc/p_rbp.adoc @@ -0,0 +1,12 @@ +// stack.asm: WORD p_rbp, 'RSP',fasm + +anchor:p_rbp[] + +=== Word: RSP + +.... +Data stack: ( -- a ) +.... + +"RSP" is a function word that pushes the return stack pointer value +onto the data stack. diff --git a/adoc/p_rsp.adoc b/adoc/p_rbpn.adoc similarity index 56% rename from adoc/p_rsp.adoc rename to adoc/p_rbpn.adoc index 9b757da..55071e2 100644 --- a/adoc/p_rsp.adoc +++ b/adoc/p_rbpn.adoc @@ -1,6 +1,6 @@ -// stack.asm: WORD p_rsp, 'R[n]',fasm +// stack.asm: WORD p_rbpn, 'R[n]',fasm -anchor:p_rsp[] +anchor:p_rbpn[] === Word: R[n] @@ -10,3 +10,10 @@ Data stack: ( n -- a ) "R[n]" is a function word that pushes the address for the n:th cell on the top return stack value onto the data stack. + +==== +.Defintion concept for R[n] +**** +( n -- a ) : R[n] 8 * RSP + ; +**** +==== diff --git a/adoc/p_read_word.adoc b/adoc/p_read_word.adoc index 76bb0e6..95baa76 100644 --- a/adoc/p_read_word.adoc +++ b/adoc/p_read_word.adoc @@ -13,3 +13,17 @@ cell pointer for it. The characters of the word are copied to <>, and there is a limit of 1024 characters. At the end of the stream READ-WORD returns 0 length. + +.Whitespace +[caption='Special syntax {counter:syntax}: '] +==== +All character codes less or equal to 32 are regarded as "whitespace". +==== + +.Rest-of-line comment +[caption='Special syntax {counter:syntax}: '] +==== +The "#" character following whitespace starts a line comment and the +rest of the line is ignored. Note that this is also recognised with +<>. +==== diff --git a/adoc/p_stream.adoc b/adoc/p_stream.adoc index 6143ef0..16f6d9c 100644 --- a/adoc/p_stream.adoc +++ b/adoc/p_stream.adoc @@ -12,6 +12,7 @@ descriptor or for a memory block (of size+data). ==== File descriptor backed STREAM + A file descriptor backed STREAM gains a buffer of the given size prefixed by a 32 byte STREAM header of the following layout: diff --git a/adoc/p_tell.adoc b/adoc/p_tell.adoc index a84fb1a..736db57 100644 --- a/adoc/p_tell.adoc +++ b/adoc/p_tell.adoc @@ -1,4 +1,4 @@ -// stdio.asm: WORD p_tell,'TELL',fasm +// stdio.asm: WORD p_tell,'TELL' anchor:p_tell[] diff --git a/adoc/p_unstream.adoc b/adoc/p_unstream.adoc new file mode 100644 index 0000000..7ccb6cb --- /dev/null +++ b/adoc/p_unstream.adoc @@ -0,0 +1,24 @@ +// stdio.asm: WORD p_unstream,'UNSTREAM',fasm + +anchor:p_unstream[] + +=== Word: UNSTREAM +.... +Data stack: ( stream* -- ) +.... + +"UNSTREAM" is a function word that releases the memory allocated for a +stream, and closes the associated file if it's a file stream. + +==== File descriptor backed stream + +This kind of stream has the stream header as a prefix within the +allocated memory. Thus, stream* is the base address for the memory to +reclaim, and the size of this is determined from the cell at (stream* ++ 16) plus the 32 bytes head itself. + +==== Memory block backed STREAM + +This kind of stream has a separate header which points at the memory +area to reclaim. The cell at stream* is the base address, and the cell +at (stream* + 16) is its size. diff --git a/compile.asm b/compile.asm index bcffaef..53dbaec 100644 --- a/compile.asm +++ b/compile.asm @@ -38,60 +38,34 @@ p_create_COPY: popr rsi next - WORD p_allot,'ALLOT',fasm + WORD p_allot,'ALLOT' ;; ( n -- ) ;; Allocate n bytes on the heap - pop rax - add qword [p_here_DFA],rax - next + dq p_here, p_put_plus, p_exit - WORD p_quote,"'",fasm + WORD p_quote,"'" ;; ( "word" -- cfa ) ;; Find the following word and push its cfa, or 0 - pushr rsi - DOFORTH p_input, p_get, p_read_word, p_find - cmp qword[rsp],0 - jne p_quote_tfa - add rsp,16 - mov qword[rsp],0 - jmp p_quote_end -p_quote_tfa: - mov rax,qword [rsp] - tfa2cfa rax - mov qword [rsp],rax + dq p_input, p_get, p_read_word, p_find + BRANCH 0,p_quote_end + dq p_tfa2cfa p_quote_end: - popr rsi - next + dq p_exit WORD p_bracketed_quote,"[']",doforth,IMMEDIATE ;; Compilation ( "word" -- cfa ) - ;; Find the following word and push its cfa, or 0 - dq p_literal - dq p_literal - dq p_comma - dq p_quote - dq p_comma - dq p_exit + ;; Compile down " LIT value " + dq p_literal, p_literal, p_comma,p_quote, p_comma, p_exit - WORD p_comma,',',fasm + WORD p_comma,',' ;; ( v -- ) ;; Put cell value onto the heap and advance "HERE" - mov rax,qword [p_here_DFA] - pop rbx - mov qword [rax],rbx - add rax,8 - mov qword [p_here_DFA],rax - next + dq p_here, p_put, p_literal, 8, p_here, p_put_plus, p_exit - WORD p_Ccomma,'C,',fasm + WORD p_Ccomma,'C,' ;; ( c -- ) ;; Put byte value onto the heap and advance "HERE" - mov rax,qword [p_here_DFA] - pop rbx - mov byte [rax],bl - inc rax - mov qword [p_here_DFA],rax - next + dq p_here, p_Cput, p_literal, 1, p_here, p_put_plus, p_exit WORD p_does,"DOES>",fasm,IMMEDIATE ;; ( -- ) @@ -326,11 +300,7 @@ p_evaluate_stream_BAD: WORD p_semicolon,';',,IMMEDIATE ;; ( -- ) ;; Lay out p_exit, and set interpreting mode - dq p_left_bracket - dq p_literal, p_exit - dq p_comma - dq p_left_bracket - dq p_exit + dq p_literal, p_exit, p_comma, p_left_bracket, p_exit WORD p_immediate,'IMMEDIATE',fasm,IMMEDIATE ;; ( -- ) @@ -340,24 +310,35 @@ p_evaluate_stream_BAD: mov qword [rax+16],1 ; set the flags field to 1 next - WORD p_open_file_quote,'OPEN-FILE"' - ;; ( "name" -- fd ) - dq p_double_quote - dq p_create - dq p_tfa2namez - dq p_literal,0 - dq p_literal,0 - dq sys_open - dq p_exit + WORD p_load_buffer_size,'LOAD-BUFFER-SIZE',dovariable + ;; ( -- a ) + ;; The buffer size (in bytes) used by LOAD-FILE + dq 15000 + + WORD p_open_file,'OPEN-FILE',fasm + ;; ( chaz* -- fd ) + ;; Open the nominated file + pushr rsi + push qword 0 + push qword 0 + DOFORTH sys_open + popr rsi + next - WORD p_load_file_quote,'LOAD-FILE"' - ;; ( "name" -- ) - ;; Create a word for the nominated file for a stream to, - ;; and store that stream pointer, then invoke evaluate-stream - dq p_open_file_quote ; fd - dq p_literal, 15000 ; buffer size - dq p_stream - dq p_dup - dq p_comma + WORD p_load_file,'LOAD-FILE' + ;; ( chaz* -- ) + dq p_open_file + dq p_dup, p_0less + BRANCH 1,p_load_file_badfile + dq p_load_buffer_size, p_get + dq p_stream, p_dup, p_gtR dq p_evaluate_stream + dq p_Rgt, p_unstream + BRANCH ,p_load_file_exit +p_load_file_badfile: + dq p_literal_string + STRING '** open file error: ' + dq p_tell, p_dot, p_nl, p_emit + dq p_literal,1 +p_load_file_exit: dq p_exit diff --git a/debug.sh b/debug.sh index 9b64b49..4c4f4fd 100755 --- a/debug.sh +++ b/debug.sh @@ -19,8 +19,8 @@ echo "break *${RET[0]}" >> gdbinit cat <> gdbinit commands $((NBR+1)) print (void*) \$rsp -print (((char*)(*(((void**)\$rax)-2)))+32) print (void*) \$rsi +print (char*)((*((void**)(*((void**)\$rsi)-16)))+32) end EOF diff --git a/machine.asm b/machine.asm index f1fb51c..31db9ce 100644 --- a/machine.asm +++ b/machine.asm @@ -233,6 +233,8 @@ dataend: macro BRANCH zero,label { if zero in <0> dq p_zero_branch + else if zero in <1> + dq p_true_branch else dq p_branch end if diff --git a/reference.adoc b/reference.adoc index 7bf6815..35455e5 100644 --- a/reference.adoc +++ b/reference.adoc @@ -127,6 +127,10 @@ include::adoc/p_exit.adoc[] include::separator.adoc[] include::adoc/p_false.adoc[] include::separator.adoc[] +include::adoc/p_fdemit.adoc[] +include::separator.adoc[] +include::adoc/p_fdtell.adoc[] +include::separator.adoc[] include::adoc/p_find.adoc[] include::separator.adoc[] include::adoc/p_forth.adoc[] @@ -167,7 +171,9 @@ include::adoc/p_literal.adoc[] include::separator.adoc[] include::adoc/p_literal_string.adoc[] include::separator.adoc[] -include::adoc/p_load_file_quote.adoc[] +include::adoc/p_load_buffer_size.adoc[] +include::separator.adoc[] +include::adoc/p_load_file.adoc[] include::separator.adoc[] include::adoc/p_lparen.adoc[] include::separator.adoc[] @@ -187,7 +193,7 @@ include::adoc/p_not.adoc[] include::separator.adoc[] include::adoc/p_number.adoc[] include::separator.adoc[] -include::adoc/p_open_file_quote.adoc[] +include::adoc/p_open_file.adoc[] include::separator.adoc[] include::adoc/p_or.adoc[] include::separator.adoc[] @@ -209,6 +215,10 @@ include::adoc/p_quit.adoc[] include::separator.adoc[] include::adoc/p_quote.adoc[] include::separator.adoc[] +include::adoc/p_rbp.adoc[] +include::separator.adoc[] +include::adoc/p_rbpn.adoc[] +include::separator.adoc[] include::adoc/p_read_stream_char.adoc[] include::separator.adoc[] include::adoc/p_read_word.adoc[] @@ -221,8 +231,6 @@ include::adoc/p_roll.adoc[] include::separator.adoc[] include::adoc/p_rot.adoc[] include::separator.adoc[] -include::adoc/p_rsp.adoc[] -include::separator.adoc[] include::adoc/p_semicolon.adoc[] include::separator.adoc[] include::adoc/p_setup_signals.adoc[] @@ -275,6 +283,8 @@ include::adoc/p_tuck.adoc[] include::separator.adoc[] include::adoc/p_unequal.adoc[] include::separator.adoc[] +include::adoc/p_unstream.adoc[] +include::separator.adoc[] include::adoc/p_verboseQ.adoc[] include::separator.adoc[] include::adoc/p_within.adoc[] diff --git a/stack.asm b/stack.asm index 5b6910b..637d8ac 100644 --- a/stack.asm +++ b/stack.asm @@ -1,5 +1,14 @@ ;;; Words for stack manipulations + WORD p_dsp,'D[n]',fasm + ;; ( n -- a ) + ;; Push the address of the n:th cell below n onto the stack + pop rax + shl rax,3 + add rax,rsp + push rax + next + WORD p_depth,'DEPTH',fasm ;; ( -- v ) ;; Push stack depth (before push) @@ -152,7 +161,12 @@ p_roll_eq: push qword [rbp] next - WORD p_rsp,'R[n]',fasm + WORD p_rbp,'RSP',fasm + ;; Push the return stack pointer to the data stack + push rbp + next + + WORD p_rbpn,'R[n]',fasm ;; ( n -- a ) ;; push the address of the n:th cell on the return stack mov rax,qword [rsp] diff --git a/stdio.asm b/stdio.asm index 3f69cd3..dd559c6 100644 --- a/stdio.asm +++ b/stdio.asm @@ -79,9 +79,39 @@ p_stream_MEM: 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 @@ -181,26 +211,21 @@ p_read_stream_char.CHAR: push rax p_read_word_skipblanks: - FORTH - dq p_dup - dq p_read_stream_char - ENDFORTH + DOFORTH p_dup, 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] mov [rax+rcx],bl inc qword [rsp+8] - FORTH - dq p_dup - dq p_read_stream_char - ENDFORTH + DOFORTH p_dup, p_read_stream_char pop rbx cmp bl,0 jl p_read_word_nomore @@ -212,6 +237,15 @@ p_read_word_nomore: popr rsi next +p_read_word_skipline: + DOFORTH p_dup, 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 @@ -234,9 +268,9 @@ p_double_quote_loop: 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] + mov byte [rdi],0 ;; copy PAD string into new temp object inc qword [rsp] DOFORTH p_str2temp @@ -245,33 +279,25 @@ p_double_quote_endstream: 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_exit + + 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_exit - 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_exit + + 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_exit WORD p_nl,'NL',dovalue ;; ( -- c ) diff --git a/wordindex.adoc b/wordindex.adoc index 2ffe08e..24e98fe 100644 --- a/wordindex.adoc +++ b/wordindex.adoc @@ -43,7 +43,7 @@ xref:p_literal_string[S"] {nbsp} xref:p_gtR[>R] {nbsp} xref:p_Rget[R@] {nbsp} xref:p_Rgt[R>] {nbsp} -<> {nbsp} +<> {nbsp} xref:data_stack[DATA-STACK] {nbsp} xref:return_stack[RETURN-STACK] {nbsp} @@ -96,6 +96,8 @@ xref:p_execute[EXECUTE] {nbsp} xref:p_exit[EXIT] {nbsp} xref:p_false[FALSE] {nbsp} +xref:p_fdemit[FDEMIT] {nbsp} +xref:p_fdtell[FDTELL] {nbsp} xref:p_find[FIND] {nbsp} xref:p_forth[FORTH] {nbsp} @@ -109,7 +111,8 @@ xref:p_immediate[IMMEDIATE] {nbsp} xref:p_input[INPUT] {nbsp} xref:p_literal[LIT] {nbsp} -xref:p_load_file_quote[LOAD-FILE"] {nbsp} +xref:p_load_buffer_size[LOAD-BUFFER-SIZE] {nbsp} +xref:p_load_file[LOAD-FILE] {nbsp} xref:p_args[MAIN-ARGS] {nbsp} xref:p_malloc[MALLOC] {nbsp} @@ -120,7 +123,7 @@ xref:p_nl[NL] {nbsp} xref:p_not[NOT] {nbsp} xref:p_number[NUMBER] {nbsp} -xref:p_open_file_quote[OPEN-FILE"] {nbsp} +xref:p_open_file[OPEN-FILE] {nbsp} xref:p_or[OR] {nbsp} xref:p_over[OVER] {nbsp} @@ -135,6 +138,7 @@ xref:p_read_word[READ-WORD] {nbsp} xref:p_realloc[REALLOC] {nbsp} xref:p_roll[ROLL] {nbsp} xref:p_rot[ROT] {nbsp} +xref:p_rbp[RSP] {nbsp} xref:p_sp[SP] {nbsp} xref:p_state[STATE] {nbsp} @@ -158,6 +162,8 @@ xref:p_this_word[THIS-WORD] {nbsp} xref:p_true[TRUE] {nbsp} xref:p_tuck[TUCK] {nbsp} +xref:p_unstream[UNSTREAM] {nbsp} + xref:p_verboseQ[VERBOSE?] {nbsp} xref:p_within[WITHIN] {nbsp} -- 2.39.2