diff options
Diffstat (limited to 'jefs.fs')
| -rw-r--r-- | jefs.fs | 34 |
1 files changed, 19 insertions, 15 deletions
@@ -159,19 +159,21 @@ decimal : exit ret, ; immediate -\ DO LOOP {{{ -: do ( RT: lim idx -- ) ( ? ) ' swap compile, ' >r compile, ' >r compile, <mark ; immediate -\ TODO rework to avoid address of the word. maybe a rnip word? -\ compiling: rover r> 1+ rnip rover rnip r> rnip 2dup >= -\ swap >r rswap swap >r rswap [ ?branch <resolve ] rnip rnip -: loop ( -- ) ' rover compile, ' r> compile, ' 1+ compile, ' rnip compile, - ' rover compile, ' rnip compile, ' r> compile, ' rnip compile, - ' 2dup compile, ' >= compile, ' swap compile, ' >r compile, - ' rswap compile, ' swap compile, ' >r compile, ' rswap compile, - ?branch <resolve ' rnip compile, ' rnip compile, ; -: i r> r> dup >r swap >r ; \ todo fix to skip addr of `i` -\ todo j -\ }}} +\ \ DO LOOP {{{ +\ : do ( RT: lim idx -- ) ( ? ) ' swap compile, ' >r compile, ' >r compile, <mark ; immediate +\ \ TODO rework to avoid address of the word. maybe a rnip word? +\ \ compiling: rover r> 1+ rnip rover rnip r> rnip 2dup >= +\ \ swap >r rswap swap >r rswap [ ?branch <resolve ] rnip rnip +\ \ seems to be leaking a value when compiled +\ \ pointing to one of the r>s +\ : loop ( -- ) ' rover compile, ' r> compile, ' 1+ compile, ' rnip compile, +\ ' rover compile, ' rnip compile, ' r> compile, ' rnip compile, +\ ' 2dup compile, ' >= compile, ' swap compile, ' >r compile, +\ ' rswap compile, ' swap compile, ' >r compile, ' rswap compile, +\ ?branch <resolve ' rnip compile, ' rnip compile, ; +\ : i r> r> dup >r swap >r ; \ todo fix to skip addr of `i` +\ \ todo j +\ \ }}} : ?comp state @ 0<> if 3 error ! handler execute then ; : ?intr state @ if 4 error ! handler execute then ; @@ -280,7 +282,6 @@ make error-msgs #error-msgs cells allot :> ." includes too recursed" ; 5 set-error \ awful description : #bye ( code -- ) 60 syscall1 ; -\ maybe this would be more elegant as a table? :> >s0 error @ dup write-error cr #bye ; to handler : fuck ( n -- ) error ! handler execute ; @@ -386,6 +387,9 @@ make line-buffer line-buffer-length allot : argc rs0 @ @ ; : argv ( n -- a u ) 1+ cells rs0 @ + @ dup strlen ; \ segfaults if n>=argc : environ argc 2 + cells rs0 @ + ; + +: ->= ( zstr -- a u ) dup begin dup c@ [ char = ] literal <> while 1+ repeat dup >r swap - r> swap ; \ i dont think the stack wrngling at the end is right +: (env) ( envptr -- name-a name-u val-a val-u ) ; \ }}} \ TERMINAL CONTROL {{{ @@ -517,7 +521,7 @@ decimal : (dumphex) ( a -- ) (dw+) (dw+) (dw+) (dw+) (dw+) (dw+) (dw+) (dw+) drop ; : (dump) ( a -- ) dup (dumploc) bold dup (dumphex) 2 spaces (dumpascii) normal cr ; \ dump cell of memory at a -: dump ( n a -- ) swap begin ?dup 0> while swap dup (dump) 16 + swap 1- repeat drop ; \ dump n lines (of 16 bytes each) of memory starting at a +: dump ( a n -- ) begin ?dup 0> while swap dup (dump) 16 + swap 1- repeat drop ; \ dump n lines (of 16 bytes each) of memory starting at a \ }}} 0 constant version |