113 lines
1.9 KiB
Forth
113 lines
1.9 KiB
Forth
\ ( ." nForth 0.0.1, Copyright (C) 2022 StackSmith" cr )
|
|
|
|
: lit, { \ (val--) compile value as a literal
|
|
' lit , , ; }
|
|
|
|
|
|
: ALLOT { \ ( n -- addr )
|
|
HERE@ swap \ here n
|
|
HERE +! ;
|
|
}
|
|
|
|
: VAR {
|
|
ws HASH skipword CREATE
|
|
dovar,
|
|
,
|
|
HERE@ RUNPTR !
|
|
;
|
|
} IMMEDIATE
|
|
|
|
|
|
: ,fixup, { \ (branch-token -- fixup address)
|
|
, HERE@ zero , ;
|
|
}
|
|
|
|
: begin { HERE@ ;
|
|
} IMMEDIATE
|
|
|
|
: again { ' branch , , ;
|
|
} IMMEDIATE
|
|
|
|
: until { ' 0branch , , ;
|
|
} IMMEDIATE
|
|
|
|
: while { ' nzbranch , , ;
|
|
} IMMEDIATE
|
|
|
|
: if { ' 0branch ,fixup, ;
|
|
} IMMEDIATE
|
|
|
|
: thanx { HERE@ swap ! ;
|
|
} IMMEDIATE
|
|
|
|
: else {
|
|
' branch ,fixup, swap \ new,old
|
|
HERE@ swap ! ;
|
|
} IMMEDIATE
|
|
|
|
: times { \ n times ( ... )
|
|
' push ,
|
|
HERE@ push
|
|
ws COMPILE.ONE
|
|
' dbra ,
|
|
pop , ;
|
|
} IMMEDIATE
|
|
|
|
: case { \ ... n case ( ... ) Execute clause if n matches TOS.
|
|
' over , ' = , ' 0branch ,fixup, \ <over><=><nzbranch>|0...
|
|
ws COMPILE.ONE
|
|
HERE@ swap ! \ fixup
|
|
;
|
|
} IMMEDIATE
|
|
|
|
\ DEBUGGING SUPPORT
|
|
|
|
: sys {
|
|
." DSP RSP HERE READ" cr
|
|
DSP hexd sp RSP hexd sp
|
|
HERE@ hexd sp
|
|
PARSE.PTR @ hexd cr
|
|
_sysp
|
|
hexd sp hexd sp hexd cr
|
|
;
|
|
}
|
|
|
|
: dumpbyte { dup @ hexb sp 1+ ; }
|
|
: dumpascii { dup @ printable emit 1+ ; }
|
|
: dump16 {
|
|
dup hexd sp sp
|
|
dup $10 times dumpbyte sp drop
|
|
$10 times dumpascii cr
|
|
;
|
|
}
|
|
|
|
: hd { dump16 dump16 dump16 dump16 ; }
|
|
|
|
\ LAMBDA SUPPORT
|
|
|
|
\ compiling
|
|
\ lambdas are compiled blocks of code, to be passed around
|
|
\ <lit><lambda-address><branch><over-lambda>...lambda...<NEXT>|<---
|
|
\ (--lambda-address)
|
|
|
|
: {{ { \ (--lambda)
|
|
' lambdaop ,fixup, \ compile <lambdaop><addr> to be fixed up
|
|
$5056A74F COMPILE.UNTIL \ compile to end of lambda
|
|
' ; , \ terminate with <RETURN>
|
|
HERE@ swap ! \ fixup branch
|
|
;
|
|
} IMMEDIATE
|
|
|
|
|
|
: u.r { \ (u width--
|
|
push output pop \ (... n width)
|
|
over - dup 1 < if drop else times ( $30 emit ) thanx
|
|
dotprim ;
|
|
}
|
|
sync
|
|
|
|
\ [ " tstamp.f" included; ]
|
|
( " cgi.f" included; )
|
|
|
|
|