diff options
| -rw-r--r-- | readme.md | 3 | ||||
| -rw-r--r-- | sanctuary.fs | 118 | ||||
| -rw-r--r-- | sanctuary.s | 2 |
3 files changed, 30 insertions, 93 deletions
@@ -632,6 +632,9 @@ yield the address of the return pointer. note that the address points to the return stack *before* this word was called. +### `rp0 ( -- a )` +a variable containing the value of the return stack at the beginning of the program. + ### `s" ( "string" -- , COMPILES: -- a u ) IMMEDIATE COMPILE-ONLY` compile into the definition code to push the given string, terminated by a double quote. diff --git a/sanctuary.fs b/sanctuary.fs index 72dd439..6342227 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -10,6 +10,11 @@ : tuck swap over ; : not 0= ; +\ todo doc +: / /mod nip ; +: mod /mod drop ; +: */ */mod nip ; +: negate 0 swap - ; : <mark here ; : <resolve here 4 + - d, ; @@ -28,6 +33,9 @@ : ?dup dup 0<> if dup then ; : exit [ hex ] c3 c, [ decimal ] ; immediate compile-only +\ todo doc +: abs dup 0< if negate then ; + : allot dp +! ; : ?find ?dup if find 0= if 2drop abort then else abort then ; @@ -219,6 +227,21 @@ init-source value source-id :noname sp-reset e." stack underflow" ecr abort ; is ?underflow? \ }}} +32 constant bl +: space bl emit ; +: spaces begin dup 0> while space 1- repeat drop ; + +\ NUMERIC OUTPUT {{{ +\ todo doc +: (u.) <# #s #> ; +: u. (u.) type space ; +: u.r >r (u.) r> over - spaces type ; + +: (.) dup abs <# #s swap sign #> ; +: . (.) type space ; +: .r >r (.) r> over - spaces type ; +\ }}} + \ if you need more than 16 layers of included files: go away™ \ todo doc 16 constant #buffers @@ -291,98 +314,7 @@ privatise 0<> if true else false then ; : 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 -\ 5 constant /buffer-header -\ /buffer /buffer-header - constant /buffer-buffer -\ create base-buffer /buffer allot \ stdin input buffer -\ variable latest-buffer -\ -\ \ format: LINK LINEBUF-PTR >IN USED FD [BUFFER (8152B)] -\ : buf>line cell+ ; -\ : buf>in 2 cells + ; -\ : buf>used 3 cells + ; -\ : buf>fd 4 cells + ; -\ : buf>buf 5 cells + ; -\ -\ 4096 constant /linebuf -\ 2 constant /linebuf-header -\ /linebuf /linebuf-header - constant /linebuf-buffer -\ create base-linebuffer /linebuf allot -\ \ format >IN USED -\ : linebuf>used cell+ ; -\ : linebuf>buf 2 cells + ; -\ -\ base-linebuffer base-buffer buf>line ! -\ base-buffer latest-buffer ! -\ -\ \ todo doc -\ : create-linebuffer ( buf-a -- ) dup /linebuf ?allocate swap buf>line ! ; -\ -\ \ SEGFAULT HERE -\ : refill-buffer ( a -- u | 0 ) dup >r dup buf>fd @ swap ( fd a ) -\ dup buf>in 0 swap ! dup buf>used 0 swap ! -\ buf>buf swap >r /buffer-buffer r> read-file ( u e ) drop -\ r> ( u a ) buf>used ! ; -\ : create-buffer ( fd -- something? ) /buffer ?allocate ( fd a ) -\ dup latest-buffer @ swap ! dup buf>fd rot swap ! -\ dup refill-buffer 0= if abort then -\ dup create-linebuffer -\ latest-buffer ! ; -\ : free-buffer ( a -- ) dup @ >r -\ dup buf>line @ free free -\ r> latest-buffer ! ; -\ -\ : cbuffer->in latest-buffer @ buf>in ; -\ : cbuffer-used latest-buffer @ buf>used ; -\ : cbuffer-fd latest-buffer @ buf>fd ; -\ : cbuffer-line latest-buffer @ buf>line ; -\ : cbuffer-linebuf latest-buffer @ buf>line @ linebuf>buf ; -\ -\ : cbuffer-empty? cbuffer->in @ cbuffer-used @ >= ; -\ -\ : bufkey ( -- c | -1 ) -\ cbuffer-empty? if -\ latest-buffer @ refill-buffer 0= if -1 exit then -\ then -\ latest-buffer @ 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 <> or if -\ destination-base #read + c! -\ 1 +to #read -\ else -\ drop finish-accept exit -\ then -\ repeat -\ finish-accept ( only reached when buffer limit reached ) ; -\ privatise -\ -\ \ : _ s" stack underflow" type abort ; ' _ is !underflow -\ \ : _ s" stack overflow" type abort ; ' _ is !overflow -\ \ : _ s" word not found" type abort ; ' _ is !notfound -\ -\ : refill source-id 0< if false exit then -\ 0 >in ! cbuffer-linebuf tib ! cbuffer-linebuf /linebuf-buffer accept -\ dup #tib ! dup 0= if true else false then ; -\ -\ : quit 0 to source-id [compile] [ begin refill while interpret repeat ; -\ }}} + begin refill while interpret ." ok" cr repeat ; \ }}} \ \ VOCABULARY {{{ @@ -398,4 +330,4 @@ quit \ gonna need to be rewritten when/if i add vocabulary/wordlist support \ : words ; \ }}} -bye +quit bye diff --git a/sanctuary.s b/sanctuary.s index 6d70016..1182e1e 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -96,6 +96,7 @@ section .text global _start _start: lea r15, [wstk] + mov [rp0], rsp call brk@ pspop r11 @@ -1222,6 +1223,7 @@ defcode "HEREDUMP", heredump, 0 defvar "state", state, 0, INTERPRET defvar "base", base, 0, 10 +defvar "rp0", rp0, 0, 0 defvar "dp", dp, 0, 0 defvar "dp0", dp0, 0, 0 defvar "dp$", dp$, 0, 0 |