Here is the source for ?STACK , the word that aborts when the stack under or overflows.
Code: Select all
HEX
: ?STACK ( -- )
DEPTH 0<
ABORT" STACK EMPTY!"
SP@ SPLIM @ U<
ABORT" STACK FULL!" ;
' ?STACK DO.?STACK !
My solution to that problem was to redefine DEPTH . DEPTH is a code word so it doesn't access the data stack until it places a result on it. The new DEPTH reports the number of items on the stack as before, so long as the stack hasn't had an underflow. If there is an underflow, DEPTH clears the stack then places a negative one ( TRUE ) on the stack.
Here is the code:
Code: Select all
HEX
CODE DEPTH ( NX -- NX N )
TXA,
' SP0 >BODY C@ # LDY,
CLC, UP )Y SBC,
.A ROR, 7F # EOR,
APUSH 0< NOT BRAN,
UP )Y LDA, TAX,
PUSH.TRUE 0< NOT BRAN,
END-CODE
After rewriting DEPTH , the error handling was easy.
Here is the new code for 2DROP .
Code: Select all
HEX
CODE 2DROP ( N1 N2 -- )
HERE TIS POPTWO
INX, INX,
HERE TIS POP
INX, INX,
NEXT 0< NOT BRAN,
LABEL RUNG1
// WILL BE PATCHED
0 JSR, // >FORTH
LABEL DO.?STACK
0 , // ?STACK
END-CODE
Here is the disassembly.
Code: Select all
2DROP
889 INX
88A INX
88B INX
88C INX
88D 843 ^^ BPL NEXT
88F BED JSR
892 1F02 ?STACK
894 FUTURE EXPANSION
B
Neither (>FORTH) nor do.colon affect or are affected by the data stack. The new DEPTH doesn't pop anything from the data stack. It doesn't push anything on a data stack that had an underflow before fixing the underflow.
(DO) and (?DO) were modified to branch to the address of (>FORTH) JSR, ( JSR (>FORTH) ) if the branch elsewhere falls through.
Code: Select all
HEX
CODE (DO) ( N1 N2 -- )
INY,
IP )Y LDA, PHA, DEY,
IP )Y LDA, PHA, CLC,
3 ,X LDA, 80 # ADC, PHA,
3 ,X STA, 2 ,X LDA, PHA, SEC,
0 ,X LDA, 2 ,X SBC, TAY,
1 ,X LDA, 3 ,X SBC, PHA,
TYA, PHA,
INX, INX, INX, INX,
IP.INC2 0< NOT BRAN,
LABEL RUNG2
RUNG1 0< BRAN,
END-CODE
CODE (?DO)
0 ,X LDA, 2 ,X CMP,
' (DO) @ 0= NOT BRAN,
1 ,X LDA, 3 ,X CMP,
' (DO) @ 0= NOT BRAN,
INX, INX, INX, INX,
XBRANCH 2+ 0< NOT BRAN,
RUNG2 0< BRAN,
END-CODE
Here is a test run to show that the new DEPTH works as expected.
Code: Select all
OK
CR DEPTH .S >IN OFF
0
0 1
0 1 2
0 1 2 3
0 1 2 3 4
0 1 2 3 4 5
0 1 2 3 4 5 6
0 1 2 3 4 5 6 7
0 1 2 3 4 5 6 7 8
0 1 2 3 4 5 6 7 8 9
0 1 2 3 4 5 6 7 8 9 10
0 1 2 3 4 5 6 7 8 9 10
11
0 1 2 3 4 5 6 7 8 9 10
11 12
0 1 2 3 4 5 6 7 8 9 10
11 12 13
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40 41
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40 41 42
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40 41 42 43
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40 41 42 43
44
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40 41 42 43
44 45
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40 41 42 43
44 45 46
0 1 2 3 4 5 6 7 8 9 10
11 12 13 14 15 16 17 18 19 20 21
22 23 24 25 26 27 28 29 30 31 32
33 34 35 36 37 38 39 40 41 42 43
44 45 46 47
CR DEPTH .S >IN OFF
^^^
STACK FULL!
CODE TEST OK
INX, INX, >FORTH DEPTH ; OK
CODE TEST2 OK
INX, INX, INX, INX, >FORTH DEPTH ; OK
CODE TEST3 OK
INX, INX, INX, INX, INX, INX, OK
>FORTH DEPTH ; OK
TEST OK
.S 65535 OK
TEST2 OK
.S 65535 OK
SP! OK
TEST2 OK
.S 65535 OK
SP! OK
TEST3 OK
.S 65535 OK
CONSOLE