diff options
| -rw-r--r-- | readme.md | 22 | ||||
| -rw-r--r-- | sanctuary.fs | 22 | ||||
| -rw-r--r-- | sanctuary.s | 30 |
3 files changed, 55 insertions, 19 deletions
@@ -200,7 +200,7 @@ duplicate the two topmost values on the stack. call the error handler (the address of which is in the variable `handler`) -### `again ( -- ) IMMEDIATE` +### `again ( -- ) IMMEDIATE COMPILE-ONLY` complete an infinite loop began by the word `begin`. ### `allot ( u -- )` @@ -213,7 +213,7 @@ perform bitwise AND on u1 and u2. a variable containing the current numeric input/output base. by default this is 10. -### `begin ( -- ) IMMEDIATE` +### `begin ( -- ) IMMEDIATE COMPILE-ONLY` mark the beginning of a begin-again, begin-until, or begin-while-repeat loop. @@ -262,6 +262,12 @@ bytes are copied in high memory to low memory order. ### `compile, ( xt -- )` compile a call to xt into user memory. +### `compile-only ( -- )` +mark the most recently defined word as compile-only. + +### `compile-only? ( ht -- ? )` +true if ht is marked compile-only, false otherwise. + ### `constant ( u "name" -- )` create a word that pushes a cell value u to the stack. @@ -298,7 +304,7 @@ remove the value at the top of the stack. ### `dup ( u -- u u )` duplicate the value at the top of the stack. -### `else ( -- ) IMMEDIATE` +### `else ( -- ) IMMEDIATE COMPILE-ONLY` update the current if statement to branch here when the flag is false, and skip to `then` if the corresponding `if` was true. @@ -332,7 +338,7 @@ yields the address of the first available byte in user memory. ### `hex ( -- )` set current base to hexadecimal. -### `if ( ? -- ) IMMEDIATE` +### `if ( ? -- ) IMMEDIATE COMPILE-ONLY` if the flag is true, execute the following if statement, terminated by `else` or `then`. @@ -393,7 +399,7 @@ move a value from the return stack to the working stack. ### `rdrop ( R: u -- )` remove the value at the top of the return stack. -### `repeat ( -- ) IMMEDIATE` +### `repeat ( -- ) IMMEDIATE COMPILE-ONLY` in a begin-while-repeat loop, loop back to the condition. ### `rot ( u1 u2 u3 -- u2 u3 u1 )` @@ -429,7 +435,7 @@ perform the syscall with the id in `rax`, taking three parameters placed in `rdi`, `rsi` and `rdx`, and push the value of the `rax` register to the stack. -### `then ( -- ) IMMEDIATE` +### `then ( -- ) IMMEDIATE COMPILE-ONLY` conclude an if statement. ### `tib ( -- a )` @@ -441,13 +447,13 @@ a cell with all bits set. ### `type ( a u -- )` write u characters at a to output. -### `until ( ? -- ) IMMEDIATE` +### `until ( ? -- ) IMMEDIATE COMPILE-ONLY` if the given flag is true, loop back to `begin`. ### `variable ( "name" -- )` create a variable word, which yields an address that can be written and read. -### `while ( ? -- ) IMMEDIATE` +### `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 d006985..ff4a266 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -11,14 +11,14 @@ : >mark here 0 d, ; : >resolve dup here swap - 4 - swap d! ; -: begin <mark ; immediate -: again branch <resolve ; immediate -: until ?branch <resolve ; immediate -: if ?branch >mark ; immediate -: else branch >mark swap >resolve ; immediate -: then >resolve ; immediate -: while ?branch >mark ; immediate -: repeat branch swap <resolve >resolve ; immediate +: begin <mark ; immediate compile-only +: again branch <resolve ; immediate compile-only +: until ?branch <resolve ; immediate compile-only +: if ?branch >mark ; immediate compile-only +: else branch >mark swap >resolve ; immediate compile-only +: then >resolve ; immediate compile-only +: while ?branch >mark ; immediate compile-only +: repeat branch swap <resolve >resolve ; immediate compile-only : ?dup dup 0<> if dup then ; @@ -27,10 +27,10 @@ : ?find ?dup if find 0= if 2drop abort then else abort then ; : 'h parse-name ?find ; : ' 'h >body ; -: [compile] ' ( word ) compile, ; immediate -: ['] ' ( word ) [compile] literal ; immediate +: [compile] ' ( word ) compile, ; immediate compile-only +: ['] ' ( word ) [compile] literal ; immediate compile-only : postpone 'h ( word ) dup immediate? if >body compile, - else >body [compile] literal ['] compile, compile, then ; immediate + else >body [compile] literal ['] compile, compile, then ; immediate compile-only : cells 8 * ; : cell+ 8 + ; diff --git a/sanctuary.s b/sanctuary.s index a209303..d5e387f 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -315,12 +315,22 @@ defcode "interpret", interpret, 0 cmp r11, false je .intrpnum + call dup + call compile_only_q + pspop r13 + cmp r13, true + je .componly + .callw: ; label here for immed jump call to_body pspop r13 call r13 jmp .loop +.componly: + call dots + call abort + .intrpnum: call number pspop r11 @@ -378,6 +388,17 @@ defcode "immediate?", immediate_q, 0 pspush r13 ret +defcode "compile-only?", compile_only_q, 0 + pspop r11 + add r11, 8 + mov r12b, byte [r11] + xor r13, r13 + test r12b, comp_only_mask + setnz r13b + neg r13 + pspush r13 + ret + defcode ">body", to_body, 0 pspop r11 add r11, 9 @@ -505,6 +526,15 @@ defcode "immediate", immediate, 0 mov byte [r12], r13b ret +defcode "compile-only", compile_only, 0 + mov r12, [latest] + add r12, 8 + mov r13b, [r12] + mov r14b, comp_only_mask + or r13b, r14b + mov byte [r12], r13b + ret + defcode "char", char, 0 call parse_name call drop |