mirror of
https://github.com/hsoft/collapseos.git
synced 2024-11-17 07:08:05 +11:00
Support nested LOAD
This commit is contained in:
parent
aec19e5c87
commit
415bd7a169
1
blk/044
1
blk/044
@ -1,3 +1,4 @@
|
||||
(cont.)
|
||||
UNTIL f -- *I* Jump backwards to BEGIN if f is
|
||||
false.
|
||||
EXIT! -- Exit current INTERPRET loop.
|
||||
|
34
forth/blk.fs
34
forth/blk.fs
@ -7,14 +7,12 @@
|
||||
: BLK!* 2 BLKMEM+ ;
|
||||
( Current blk pointer in ( )
|
||||
: BLK> 4 BLKMEM+ ;
|
||||
( backup for CINPTR when LOADing )
|
||||
: BLKC<* 6 BLKMEM+ ;
|
||||
: BLK( 8 BLKMEM+ ;
|
||||
: BLK( 6 BLKMEM+ ;
|
||||
|
||||
: BLK$
|
||||
H@ 0x57 RAM+ !
|
||||
( 1024 for the block, 8 for variables )
|
||||
1032 ALLOT
|
||||
( 1024 for the block, 6 for variables )
|
||||
1030 ALLOT
|
||||
( LOAD detects end of block with ASCII EOT. This is why
|
||||
we write it there. EOT == 0x04 )
|
||||
4 C,
|
||||
@ -42,17 +40,33 @@
|
||||
DUP 4 = IF
|
||||
DROP
|
||||
( We're finished interpreting )
|
||||
BLKC<* @ 0x0c RAM+ !
|
||||
C<
|
||||
EXIT!
|
||||
THEN
|
||||
;
|
||||
|
||||
: LOAD
|
||||
( save BLK>, CINPTR and boot< ptr to RSP )
|
||||
BLK> @ >R
|
||||
0x0c RAM+ @ >R
|
||||
0x2e RAM+ @ >R
|
||||
BLK@
|
||||
( 2e == BOOT C< PTR )
|
||||
( Point to beginning of BLK )
|
||||
BLK( 0x2e RAM+ !
|
||||
( Save current C< ptr )
|
||||
0x0c RAM+ @ BLKC<* !
|
||||
( 0c == CINPTR )
|
||||
['] _ 0x0c RAM+ !
|
||||
INTERPRET
|
||||
R> 0x2e RAM+ !
|
||||
( Before we restore CINPTR, are we restoring it to "_"?
|
||||
if yes, it means we're in a nested LOAD which means we
|
||||
should also load back the saved BLK>. Otherwise, we can
|
||||
ignore the BLK> from RSP. )
|
||||
I 0x0c RAM+ @ = IF
|
||||
( nested load )
|
||||
R> DROP ( CINPTR )
|
||||
R> BLK@
|
||||
ELSE
|
||||
( not nested )
|
||||
R> 0x0c RAM+ !
|
||||
R> DROP ( BLK> )
|
||||
THEN
|
||||
;
|
||||
|
@ -149,3 +149,12 @@
|
||||
LIT< _sys (find) NOT IF ABORT THEN
|
||||
DUP HERE ! CURRENT !
|
||||
;
|
||||
|
||||
( Drop RSP until I-2 == INTERPRET. )
|
||||
: EXIT!
|
||||
['] INTERPRET ( I )
|
||||
BEGIN ( I )
|
||||
DUP ( I I )
|
||||
R> DROP I 2 - @ ( I I a )
|
||||
= UNTIL
|
||||
;
|
||||
|
Loading…
Reference in New Issue
Block a user