diff --git a/blk/367 b/blk/367 new file mode 100644 index 0000000..e1f7ae4 --- /dev/null +++ b/blk/367 @@ -0,0 +1,10 @@ +: IMMEDIATE + CURRENT @ 1- + DUP C@ 128 OR SWAP C! ; +: IMMED? 1- C@ 0x80 AND ; +: +! TUCK @ + SWAP ! ; +: -^ SWAP - ; +: / /MOD NIP ; +: MOD /MOD DROP ; +: ALLOT HERE +! ; +: LEAVE R> R> DROP I 1- >R >R ; diff --git a/blk/368 b/blk/368 deleted file mode 100644 index 6121c98..0000000 --- a/blk/368 +++ /dev/null @@ -1,12 +0,0 @@ -: +! TUCK @ + SWAP ! ; -: [entry] ( w -- ) - H@ SWAP - BEGIN C@+ ( w+1 c ) ?DUP IF C, 0 ELSE 1 THEN UNTIL DROP - H@ SWAP - ( sz ) - ( write prev value ) - H@ CURRENT @ - , - C, ( write size ) - H@ CURRENT ! -; - -: (entry) WORD [entry] ; diff --git a/blk/369 b/blk/369 index 35f6b3f..2aad0d2 100644 --- a/blk/369 +++ b/blk/369 @@ -1,11 +1,12 @@ -: IMMEDIATE - CURRENT @ 1- - DUP C@ 128 OR SWAP C! ; -: IMMED? 1- C@ 0x80 AND ; -: -^ SWAP - ; -: / /MOD NIP ; -: MOD /MOD DROP ; -: ALLOT HERE +! ; -: CREATE (entry) 11 ( 11 == cellWord ) C, ; -: VARIABLE CREATE 2 ALLOT ; -: LEAVE R> R> DROP I 1- >R >R ; +: '? WORD FIND ; +: ' + '? (?br) [ 4 , ] EXIT + LIT< (wnf) FIND DROP EXECUTE +; +: ROLL + ?DUP NOT IF EXIT THEN + 1+ DUP PICK ( n val ) + SWAP 2 * (roll) ( val ) + NIP ; +: 2OVER 3 PICK 3 PICK ; +: 2SWAP 3 ROLL 3 ROLL ; diff --git a/blk/370 b/blk/370 index 2aad0d2..b488aa3 100644 --- a/blk/370 +++ b/blk/370 @@ -1,12 +1,14 @@ -: '? WORD FIND ; -: ' - '? (?br) [ 4 , ] EXIT - LIT< (wnf) FIND DROP EXECUTE -; -: ROLL - ?DUP NOT IF EXIT THEN - 1+ DUP PICK ( n val ) - SWAP 2 * (roll) ( val ) - NIP ; -: 2OVER 3 PICK 3 PICK ; -: 2SWAP 3 ROLL 3 ROLL ; +: MOVE ( a1 a2 u -- ) + ( u ) 0 DO ( a1 a2 ) + SWAP C@+ ( a2 a1+1 x ) + ROT C!+ ( a1+1 a2+1 ) + LOOP 2DROP ; +: MOVE- ( a1 a2 u -- ) + TUCK + 1- ( a1 u a2+u-1 ) + ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 ) + ROT ( u ) 0 DO ( a2 a1 ) + C@- ( a2 a1-1 x ) + ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 ) + LOOP 2DROP ; +: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ; +: PREV 3 - DUP @ - ; diff --git a/blk/371 b/blk/371 index b488aa3..1af79e1 100644 --- a/blk/371 +++ b/blk/371 @@ -1,14 +1,10 @@ -: MOVE ( a1 a2 u -- ) - ( u ) 0 DO ( a1 a2 ) - SWAP C@+ ( a2 a1+1 x ) - ROT C!+ ( a1+1 a2+1 ) - LOOP 2DROP ; -: MOVE- ( a1 a2 u -- ) - TUCK + 1- ( a1 u a2+u-1 ) - ROT 2 PICK + 1- ( u a2+u-1 a1+u-1 ) - ROT ( u ) 0 DO ( a2 a1 ) - C@- ( a2 a1-1 x ) - ROT C!- ( a1-1 a2-1 ) SWAP ( a2 a1 ) - LOOP 2DROP ; -: MOVE, ( a u -- ) H@ OVER ALLOT SWAP MOVE ; -: PREV 3 - DUP @ - ; +: [entry] ( w -- ) + 1- C@+ ( w+1 len ) TUCK MOVE, ( len ) + ( write prev value ) + H@ CURRENT @ - , + C, ( write size ) + H@ CURRENT ! +; +: (entry) WORD [entry] ; +: CREATE (entry) 11 ( 11 == cellWord ) C, ; +: VARIABLE CREATE 2 ALLOT ; diff --git a/emul/forth.bin b/emul/forth.bin index e9f80d4..efb3a2d 100644 Binary files a/emul/forth.bin and b/emul/forth.bin differ diff --git a/emul/stage.c b/emul/stage.c index fe00dea..c0f3af4 100644 --- a/emul/stage.c +++ b/emul/stage.c @@ -42,7 +42,8 @@ static uint8_t iord_stdio() static void iowr_stdio(uint8_t val) { - // we don't output stdout in stage0 + // uncomment when you need to debug staging + // putc(val, stderr); } static void iowr_here(uint8_t val)