diff --git a/blk/046 b/blk/046 index a1b5226..efc468f 100644 --- a/blk/046 +++ b/blk/046 @@ -9,8 +9,8 @@ SWAP a b -- b a 2DUP a b -- a b a b 2OVER a b c d -- a b c d a b 2SWAP a b c d -- c d a b - - +PICK Pick nth item from stack. "0 PICK" = DUP, + "1 PICK" = OVER. diff --git a/emul/forth/z80c.bin b/emul/forth/z80c.bin index 323a382..6cd8124 100644 Binary files a/emul/forth/z80c.bin and b/emul/forth/z80c.bin differ diff --git a/forth/boot.fs b/forth/boot.fs index 672f385..95e8c85 100644 --- a/forth/boot.fs +++ b/forth/boot.fs @@ -243,7 +243,7 @@ PC ORG @ 0x15 + ! ( popRS ) RET, '(' A, 'u' A, 'f' A, 'l' A, 'w' A, ')' A, 0 A, -L1 BSET ( abortUnderflow ) +L2 BSET ( abortUnderflow ) HL PC 7 - LDddnn, DE RAMSTART 0x02 + LDdd(nn), ( RAM+02 == CURRENT ) 0x03 CALLnn, ( find ) @@ -262,7 +262,7 @@ PC ORG @ 0x1e + ! ( chkPS ) SP SUBHLss, HL POPqq, CNC RETcc, ( INITIAL_SP >= SP? good ) - JR, L1 BWR ( abortUnderflow ) + JR, L2 BWR ( abortUnderflow ) PC ORG @ 0x1b + ! ( next ) ( This routine is jumped to at the end of every word. In it, @@ -274,7 +274,7 @@ PC ORG @ 0x1b + ! ( next ) IX PUSHqq, HL POPqq, DE RS_ADDR LDddnn, DE SUBHLss, - JRC, L1 BWR ( IX < RS_ADDR? abortUnderflow ) + JRC, L2 BWR ( IX < RS_ADDR? abortUnderflow ) E 0 IY+ LDrIXY, D 1 IY+ LDrIXY, IY INCss, diff --git a/forth/z80c.fs b/forth/z80c.fs index 4da5d45..e58f4cd 100644 --- a/forth/z80c.fs +++ b/forth/z80c.fs @@ -62,6 +62,24 @@ CODE OVER DE PUSHqq, ( A ) ;CODE +CODE PICK + HL POPqq, + chkPS, + ( x2 ) + L SLAr, + H RLr, + SP ADDHLss, + C (HL) LDrr, + HL INCss, + B (HL) LDrr, + ( check PS range before returning ) + EXDEHL, + RAMSTART LDHL(nn), ( RAM+00 == INITIAL_SP ) + DE SUBHLss, + CC L2 @ JPccnn, ( abortUnderflow ) + BC PUSHqq, +;CODE + ( a b -- a b a b ) CODE 2DUP HL POPqq, ( B ) @@ -77,6 +95,7 @@ CODE 2DUP CODE 2DROP HL POPqq, HL POPqq, + chkPS, ;CODE ( a b c d -- a b c d a b )