diff options
| -rw-r--r-- | readme.md | 9 | ||||
| -rw-r--r-- | sanctuary.fs | 87 | ||||
| -rw-r--r-- | sanctuary.s | 37 |
3 files changed, 114 insertions, 19 deletions
@@ -236,6 +236,9 @@ if a word was found, its link field address is returned along with the true flag. if no word was found or the string is of length zero, abort. +### `?componly? ( -- )` +produce a compile-only error. + ### `?notfound? ( -- )` produce a word not found error. @@ -443,9 +446,6 @@ and skip to `then` if the corresponding `if` was true. ### `emit ( c -- )` print the single character c to output. -### `etype ( a u -- )` -write u characters at a to error output. - ### `executable ( a u -- )` marks the u bytes starting at address a as executable. this is used primarily to mark the program break, @@ -779,6 +779,9 @@ create a variable word, which yields an address that can be written and read. ### `w/o ( -- 1 )` a constant, meaning 'write only', used for file I/O. +### `warn ( a u -- )` +write u characters at a to error output. + ### `while ( ? -- ) IMMEDIAT COMPILE-ONLYE` if given flag is true, continue the current begin-while-repeat loop, otherwise branch to after. diff --git a/sanctuary.fs b/sanctuary.fs index 1acb5ee..9e4d56e 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -180,10 +180,12 @@ false value nonaming : sys-close 3 syscall1 ; : type swap stdout sys-write drop ; -: etype swap stderr sys-write drop ; +: warn swap stderr sys-write drop ; : emit sp 1 type drop ; +: eemit sp 1 warn drop ; \ todo doc : cr 10 emit ; +: ecr 10 eemit ; \ todo doc 0 constant r/o 1 constant w/o @@ -204,15 +206,18 @@ init-source value source-id \ syntax highlighting cannot handle this. oops,, : ." postpone s" postpone type ; immediate compile-only \ " -: e." postpone s" postpone etype ; immediate compile-only \ " -: (abort") ( ? a u -- ) rot 0<> if etype abort else 2drop then ; +: e." postpone s" postpone warn ; immediate compile-only \ " +: (abort") ( ? a u -- ) rot 0<> if warn abort else 2drop then ; : abort" postpone s" postpone (abort") ; immediate compile-only +\ ERROR MESSAGES {{{ \ stk under/overflow ones need to clear the stack first \ feels wrong but i think its correct -:noname e." word not found" cr abort ; is ?notfound? -:noname sp-reset e." stack overflow" cr abort ; is ?overflow? -:noname sp-reset e." stack underflow" cr abort ; is ?underflow? +:noname e." word not found" ecr abort ; is ?notfound? +:noname e." compile-only word used in interpret mode" ecr abort ; is ?componly? +:noname sp-reset e." stack overflow" ecr abort ; is ?overflow? +:noname sp-reset e." stack underflow" ecr abort ; is ?underflow? +\ }}} \ if you need more than 16 layers of included files: go away™ \ todo doc @@ -222,8 +227,74 @@ init-source value source-id 2048 constant /line-buffer \ this bit is so large that i may increase the default brk -create buffers /buffer #buffers * allot -create line-buffers /line-buffer #buffers * allot +create buffers /buffer #buffers * allot +create buffers-used #buffers cells allot +create buffers->in #buffers cells allot +create buffers-fd #buffers cells allot + +create line-buffers /line-buffer #buffers * allot +create line-buffers-used #buffers cells allot +create line-buffers->in #buffers cells allot + +: cbuffer include-depth /buffer * buffers + ; +: cbuffer-used include-depth cells buffers-used + ; +: cbuffer->in include-depth cells buffers->in + ; +: cbuffer-fd include-depth cells buffers-fd + ; + +: cline include-depth /line-buffer * line-buffers + ; +: cline-used include-depth cells line-buffers-used + ; +: cline->in include-depth cells line-buffers->in + ; + +: refill-buffer ( -- u | 0 ) cbuffer /buffer cbuffer-fd @ read-file + 0<> if drop 0 then + 0 cbuffer->in ! dup cbuffer-used ! ; +: cbuffer-empty? cbuffer->in @ cbuffer-used @ >= ; +: bufkey ( -- c | -1 ) + cbuffer-empty? if + refill-buffer 0= if -1 exit then + then + cbuffer cbuffer->in @ + c@ + cbuffer->in @ 1+ cbuffer->in ! ; + +private{ +0 value #read +0 value #read-limit +0 value destination-base +: finish-accept ( -- u ) #read ; +}private +\ uses memory for readability, maybe too slow? +\ need to test to see. +: accept ( a u -- u ) 0 to #read to #read-limit to destination-base + begin + #read #read-limit < + while + bufkey dup 0>= over 10 <> and if + destination-base #read + c! + 1 +to #read + else + drop finish-accept exit + then + repeat + finish-accept ( only reached when buffer limit reached ) ; +privatise + +\ note: these are completely different from ans forth's words of the same name +\ todo check source-id +: save-input #tib @ cline-used ! >in @ cline->in ! ; +: restore-input cline-used @ #tib ! cline->in @ >in ! cline tib ! ; + +: dump-line cline cline-used @ type ; + +: refill ( -- ? ) source-id 0< if false exit then + 0 >in ! cline tib ! + cline /line-buffer accept + dup cline-used ! + dup #tib ! + 0<> if true else false then .s ; + +: quit 0 to source-id postpone [ + begin refill while interpret ( ." ok" cr ) repeat ; +quit \ OLD VERSION I GAVE UP ON BECAUSE IT'S TOO COMPLICATED AND SUCKS SHIT {{{ \ 8192 constant /buffer diff --git a/sanctuary.s b/sanctuary.s index 80b0cbc..b1544a9 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -190,7 +190,7 @@ defcode "parse-name", parse_name, 0 je .wsloop cmp rsi, r10 - jge .empty + jg .empty mov r11, 1 dec rsi ; bring down by one to point to the start push rsi ; will become `a` @@ -204,7 +204,7 @@ defcode "parse-name", parse_name, 0 je .wordloop_e cmp rsi, r10 - jge .wordloop_e + jg .wordloop_e inc r11 lodsb jmp .wordloop @@ -216,6 +216,8 @@ defcode "parse-name", parse_name, 0 pop rsi pspush rsi pspush r11 + ; call twodup + ; call intrpdump ret .empty: @@ -237,7 +239,7 @@ defcode "parse", parse, 0 .wsloop: cmp rsi, r10 - jge .empty + jg .empty lodsb cmp al, bl je .wsloop @@ -245,7 +247,7 @@ defcode "parse", parse, 0 je .wsloop cmp rsi, r10 - jge .empty + jg .empty mov r11, 1 dec rsi ; bring down by one to point to the start push rsi ; will become `a` @@ -257,7 +259,7 @@ defcode "parse", parse, 0 je .wordloop_e cmp rsi, r10 - jge .wordloop_e + jg .wordloop_e inc r11 lodsb jmp .wordloop @@ -323,11 +325,26 @@ defdefer "find", find, 0 pspush r13 ret +; ; tmp dbg +; defcode "INTRPDUMP", intrpdump, 0 +; pspop rdx ; u +; pspop rsi ; a +; mov rdi, 1 +; mov rax, __NR_write +; syscall +; +; mov rdx, 1 +; mov rsi, .spc +; mov rdi, 1 +; mov rax, __NR_write +; syscall +; +; ret +; .spc: db " " + ; interpret {{{ ; r11: word found flag ; r12: state -; TODO respect comp-only flag (do this once error handling is impld) -; TODO it doesnt work right defcode "interpret", interpret, 0 .loop: call parse_name @@ -355,7 +372,7 @@ defcode "interpret", interpret, 0 jmp .loop .componly: - call q_notfound + call q_componly jmp .loop .intrpnum: @@ -1143,6 +1160,10 @@ defdefer "?overflow?", q_overflow, 0 defdefer "?notfound?", q_notfound, 0 call abort ret + +defdefer "?componly?", q_componly, 0 + call abort + ret ; }}} ; these words are called from `create`d words, |