diff options
Diffstat (limited to 'forth.f')
| -rw-r--r-- | forth.f | 110 |
1 files changed, 110 insertions, 0 deletions
@@ -0,0 +1,110 @@ +: -+ - + ; +: / /mod nip ; +: if immediate ' 0branch ,, here 0 , ; +: then immediate ] here swap ! ; + +: find-) key 41 != if find-) ; then ; +: ( immediate find-) ; +( now there's parenthetical comments :) + +: find-cr key 10 != if find-cr ; then ; +: \ immediate find-cr ; +\ and now line comments + +: '@ @ ; \ A tickable @ +: variable here 0 , word create ' lit ,, , exit ; +: constant here swap , word create ' lit ,, , ' '@ ,, exit ; +: array word create ' lit ,, here 0 , exit here swap ! ; + +\ Some stuff for printing/compiling number strings +: cr 10 emit ; +: space 32 emit ; +: tab 9 emit ; + +\ strings +: read-until-" key dup 34 = if 2drop ; then + c, 1 over +! read-until-" ; +: read-str + ' lit ,, here 0 , \ ptr + ' lit ,, here 0 , \ cnt + ' branch ,, here 0 , \ branch + rot here swap ! \ ptr set + swap + read-until-" + 0 c, \ Null terminate strings for syscalls + here swap ! +; +: s" immediate read-str ; +: print dup 0<= if 2drop ; then + 1- swap dup c@ emit 1+ swap print ; +: ." immediate + read-str + ' print ,, +; + +\ Exit back to linux +: bye 0 1 syscall1 ; +: fatal 1 1 syscall1 ; + +\ File IO +0 constant OREAD +1 constant OWRITE +2 constant ORW +100 constant OCREATE +1 constant PROT_READ +2 constant PROT_WRITE +1 constant MAP_SHARED +variable zero 0 zero ! +: ?error -1 = if ." file syscall error" cr fatal ; then ; +: write 4 syscall3 dup ?error ; +: _open 5 syscall3 dup ?error ; +: close 6 syscall1 ?error ; +: lseek 19 syscall3 dup ?error ; +: truncate 92 syscall2 ?error 42 emit ; +: open nip 0 _open ; +: screate nip OCREATE or 420 _open ; +: rswap <r <r swap >r >r ; +: mmap ( path -- ptr ) + ORW open dup dup >r fsize dup <r swap >r >r 0 swap + PROT_READ PROT_WRITE or MAP_SHARED <r 0 192 syscall6 dup ?error + swap close <r ; +: mmap-screate ( path len -- ptr ) ( fl ) + >r ORW screate <r + 2dup 1- 0 lseek drop over zero 1 write drop + swap dup >r >r 0 swap + PROT_READ PROT_WRITE or MAP_SHARED <r 0 192 syscall6 dup ?error + <r close ; + +\ String tokeniser +variable cur +variable len +variable end +array buffer 50 allot +: ?end end @ >= ; +: ?sep 33 < ; +: cnt-word ( cnt ptr -- cnt ) + dup ?end if drop ; then + dup c@ ?sep if drop ; then + swap 1+ swap 1+ cnt-word ; +: find-first-char ( ptr -- ptr ) + dup ?end 0= if + dup c@ ?sep if 1+ find-first-char ; then + then ; +: tokenise ( ptr len -- ) over + end ! cur ! 0 len ! ; +: token ( -- ptr len ) cur @ len @ + find-first-char dup cur ! + 0 over cnt-word dup len ! ; + +\ log math +: lsqrt 0.5 lpow ; +: sq dup l* ; + + +\ High level operators +variable map-fun +variable map-stat +: do-map dup 0<= if drop ; then + 1- @+ map-fun @ execute !+ do-map ; +: map ( pnf -- ) map-fun ! swap dup >a >b do-map ; +: do-sweep dup 0<= if drop ; then + @+ map-stat @ map-fun @ execute !+ 1- do-sweep ; +: sweep ( pnsf -- ) map-fun ! map-stat ! swap dup >a >b do-sweep ; |