67 lines
1.6 KiB
Plaintext
67 lines
1.6 KiB
Plaintext
|
0 const 0
|
||
|
1 const 1
|
||
|
2 const cell
|
||
|
: cells cell * ;
|
||
|
|
||
|
10 const '\n'
|
||
|
13 const '\r'
|
||
|
key const sp
|
||
|
|
||
|
128 const F_IMMEDIATE
|
||
|
0x100 const F_USERWORD
|
||
|
|
||
|
: cr '\n' emit ;
|
||
|
: bl sp emit ;
|
||
|
|
||
|
: if ' BZ_ , here 0 , ; immediate
|
||
|
: else ' GOTO_ , 0 , here swap ! here cell - ; immediate
|
||
|
: then here swap ! ; immediate
|
||
|
|
||
|
: begin here ; immediate
|
||
|
: while ' BZ_ , here 0 , ; immediate
|
||
|
: repeat ' GOTO_ , swap , here swap ! ; immediate
|
||
|
: again ' GOTO_ , , ; immediate
|
||
|
: until ' BZ_ , , ; immediate
|
||
|
|
||
|
: lit ' LIT_ , , ;
|
||
|
: ( begin key [ key ) lit ] = until ; immediate
|
||
|
|
||
|
: inline| ' INLINEDATA_ , here 0 , ;
|
||
|
: |inline [ ' then , ] ;
|
||
|
|
||
|
' cells @ const $DOCOLON ( get the colon execution token )
|
||
|
: :| inline| $DOCOLON , ; immediate
|
||
|
: |; ' ret , |inline ; immediate
|
||
|
|
||
|
: s" state if inline| else here then
|
||
|
begin key dup [ key " lit ] != over 0 != and while b, repeat drop 0 b,
|
||
|
state if |inline else dup here! then ; immediate
|
||
|
|
||
|
: interpretword F_IMMEDIATE & state not or if execute else , then ;
|
||
|
: interpretnumber state if lit then ;
|
||
|
: interpretunknown type s" ?" type cr ;
|
||
|
: compileword lookup dup
|
||
|
if interpretword
|
||
|
else drop number
|
||
|
if interpretnumber
|
||
|
else interpretunknown
|
||
|
then
|
||
|
then ;
|
||
|
: interpreter
|
||
|
begin word dup b@ while compileword repeat drop ;
|
||
|
: loadfp ( -- )
|
||
|
infile @ >r
|
||
|
fdeactivate infile !
|
||
|
interpreter
|
||
|
infile @ factivate
|
||
|
<r infile ! ;
|
||
|
: loadfile ( filename -- ) fdeactivate >r open loadfp close <r factivate ;
|
||
|
|
||
|
( image loading )
|
||
|
: noop ;
|
||
|
|
||
|
: defer word new-word $DODEFERRED , ' noop , ;
|
||
|
: redefine ( cp cpdeferred ) cell + ! ;
|
||
|
: definition ( cpdeferred ) cell + @ ;
|
||
|
|