I found out by way of a typo that my zero overhead data stack underflow protection for the Forth words DROP , 2DROP , (DO) , (?DO) and anything that jumps to POP ( DROP ) or POPTWO ( 2DROP ) didn't quite work out. If a code word pops several items off of an empty stack, the error handling can cause problems because WHERE needs a stable stack to work properly and some of the words in WHERE will clip the stack underflow. I meant to type DOPEN which takes no parameters and returns none. It opens the currently selected drive for BLOCK access. I typed OPEN by mistake and it takes five parameters and returns one. This deep of a stack underflow caused problems ( one of my constants used in WHERE got reset to a different value because ! ( store ) stored to the wrong address ). I decided that if my Forth was going to have any data stack underflow protection, instead of clipping the underflow it should ABORT but I needed the stack to be in a good state for the error handling.
Here is the source for ?STACK , the word that aborts when the stack under or overflows.
Code:
HEX
: ?STACK ( -- )
DEPTH 0<
ABORT" STACK EMPTY!"
SP@ SPLIM @ U<
ABORT" STACK FULL!" ;
' ?STACK DO.?STACK !
Depth returns a negative one ( TRUE ) if there was an underflow.
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:
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
I realize that this code looks a little strange with clearing the carry before a subtraction with the operands reversed and then toggling all the bits but the high bit after the roll to the right, but I needed to be able to branch on positive to APUSH and still fall through if the number of items on the stack was less than zero.
After rewriting DEPTH , the error handling was easy.
Here is the new code for 2DROP .
Code:
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
The JSR to zero will be patched when (>FORTH) is defined so it is a JSR to (>FORTH). The zero following is a place holder for ?STACK to be patched in.
Here is the disassembly.
Code:
2DROP
889 INX
88A INX
88B INX
88C INX
88D 843 ^^ BPL NEXT
88F BED JSR
892 1F02 ?STACK
894 FUTURE EXPANSION
B
SEE had a little trouble with this due to the forward JSR. $0BED is the address of the subroutine at (>FORTH) which causes a transition to high level Forth. Since there is an underflow, ?STACK will abort.
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:
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
If (?DO) causes an underflow, it branches to the address labeled RUNG2 and from there branches to the label RUNG1. If (DO) causes a stack underflow, it branches to the address labeled RUNG1. RUNG1 is the address of the transition to high level and the stack check.
Here is a test run to show that the new DEPTH works as expected.
Code:
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