diff options
| -rw-r--r-- | sanctuary.fs | 50 | ||||
| -rw-r--r-- | sanctuary.s | 26 |
2 files changed, 62 insertions, 14 deletions
diff --git a/sanctuary.fs b/sanctuary.fs index f3522c5..80faf6b 100644 --- a/sanctuary.fs +++ b/sanctuary.fs @@ -1,4 +1,4 @@ -: \ 10 parse 2drop ; immediate \ test +: \ 10 parse 2drop ; immediate \ test \ causes issues if there isn't actually any comment following : ( [ char ) ] literal parse 2drop ; immediate ( test ) : binary 2 base ! ; @@ -9,6 +9,8 @@ : nip swap drop ; : tuck swap over ; +: not 0= ; + : <mark here ; : <resolve here 4 + - d, ; : >mark here 0 d, ; @@ -99,6 +101,7 @@ decimal \ privatisation yoinked from pforth : (hide) cell+ dup c@ 1 or swap c! ; +: (unhide) cell+ dup c@ 1 invert and swap c! ; \ todo doc : hide parse-name ?find (hide) ; variable private0 variable private$ @@ -161,6 +164,18 @@ variable hld : #> drop hld @ pad$ over - ; \ }}} +\ NONAME {{{ +\ will maybe(?) be modified later in the vocabulary section. +\ todo doc +false value nonaming + +: :noname here true to nonaming postpone ] ; +: ; [ hex ] c3 c, [ decimal ] + nonaming not if + latest @ (unhide) + then false to nonaming postpone [ ; immediate +\ }}} + \ I/O {{{ 0 constant stdin 1 constant stdout @@ -184,6 +199,7 @@ variable hld : write-file >r swap r> sys-write >errno ; \ all of this is super ugly +\ probably just redo this all and use a static number of buffers -2 constant init-source -1 constant string-source @@ -191,6 +207,7 @@ init-source value source-id 8192 constant /buffer 5 constant /buffer-header +/buffer /buffer-header - constant /buffer-buffer create base-buffer /buffer allot \ stdin input buffer variable latest-buffer @@ -203,6 +220,7 @@ variable latest-buffer 4096 constant /linebuf 2 constant /linebuf-header +/linebuf /linebuf-header - constant /linebuf-buffer create base-linebuffer /linebuf allot \ format >IN USED : linebuf>used cell+ ; @@ -214,9 +232,10 @@ 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-header - r> read-file ( u e ) drop + 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 ! @@ -230,12 +249,14 @@ base-buffer 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 - refill-buffer 0= if -1 exit then + latest-buffer @ refill-buffer 0= if -1 exit then then latest-buffer @ cbuffer->in @ + c@ cbuffer->in @ 1+ cbuffer->in ! ; @@ -261,13 +282,30 @@ private{ 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 ; +quit \ }}} +\ \ VOCABULARY {{{ +\ do this after user input and stuff is Working +\ 32 constant #vocs +\ variable #order +\ create context #vocs cells allot +\ \ }}} + \ PROGRAMMING TOOLS {{{ \ should write top of stack on right -: .s ; +\ : .s ; \ gonna need to be rewritten when/if i add vocabulary/wordlist support -: words ; +\ : words ; \ }}} - bye diff --git a/sanctuary.s b/sanctuary.s index aa52ce3..74b9528 100644 --- a/sanctuary.s +++ b/sanctuary.s @@ -9,7 +9,7 @@ cmp r15, wstk_b jge %%ok - call abort + call q_overflow %%ok: %endmacro @@ -19,7 +19,7 @@ cmp r15, wstk jle %%ok - call abort + call q_underflow %%ok: %endmacro @@ -350,7 +350,7 @@ defcode "interpret", interpret, 0 jmp .loop .componly: - call abort + call q_notfound jmp .loop .intrpnum: @@ -386,7 +386,7 @@ defcode "interpret", interpret, 0 .notfound: ; error handling should go here - call abort + call q_notfound jmp .loop .eof: @@ -1125,6 +1125,16 @@ defcode "abort", abort, 0 mov r11, qword [handler] call r11 ret + +; todo doc? maybe? +defdefer "!underflow", q_underflow, 0 + call abort + +defdefer "!overflow", q_overflow, 0 + call abort + +defdefer "!notfound", q_notfound, 0 + call abort ; }}} ; these words are called from `create`d words, @@ -1205,11 +1215,11 @@ defvar "base", base, 0, 10 defvar "dp", dp, 0, 0 defvar "dp0", dp0, 0, 0 defvar "dp$", dp$, 0, 0 -defvar "tib", tib, 0, initfile -defvar "#tib", n_tib, 0, initlen -defvar ">in", to_in, 0, 0 +defdefervar "tib", tib, 0, initfile +defdefervar "#tib", n_tib, 0, initlen +defdefervar ">in", to_in, 0, 0 defvar "handler", handler, 0, do_0handler -defdefervar "latest", latest, 0, lfa_latest +defvar "latest", latest, 0, lfa_latest initfile: incbin "sanctuary.fs" initlen equ $ - initfile |