-
Notifications
You must be signed in to change notification settings - Fork 3
/
Copy pathcontrol words blog post.txt
133 lines (90 loc) · 4.31 KB
/
control words blog post.txt
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
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
I’m rewriting the control keywords, **IF THEN ELSE DO ?DO LEAVE ?LEAVE LOOP +LOOP BEGIN WHILE REPEAT UNTIL AGAIN** . Everything was fine, but then one day I was sad because I couldn’t do something in my application code without triggering a compilation error. It might have been putting **LEAVE** inside an **IF** **THEN** block? I don't remember. But I remember feeling that a rewrite was in order.
Originally I lifted the PETTIL control structure code wholesale from Blazin’ Forth. It might have been necessary to change the branches from 16-bit addresses to 8-bit signed offsets, but otherwise I just plugged the Blazin' code in without modification.
I am very happy that the replacement code takes up less space than the old compiler code, from 627 bytes before down to only 585 bytes now! A few cool tricks were used.
* Branching out of **DO **loops is handled by pushing the address following **LOOP** to the return stack. When the **_index _**reaches the _**limit** _a word called **UNLOOP** takes care of unnesting the outer loop, and transfer of control is a simple call to **EXIT**.
* While I was in there, I renamed a byte of zero page storage from **xsave** to **z** . It was being used mostly to save the **X** register data stack pointer so that a primitive could use instructions requiring the **X **register. Calling it **z** makes it seem more like a pseudo-accumulator (the ‘**Z**’** **register)
* I added a **3ERASE** primitive to zero three consecutive bytes of memory.
* Instead of using **?PAIRS** to create and validate control words, I allocated three bytes of memory, one for each _family_** **of words, e.g. **IF THEN ELSE** is in family 2. Opening a structure (**IF**) increments counter 2, **ELSE **will first decrement and then increment counter 2, and **THEN** will decrement it. Nesting is okay, but if the counter ever goes negative, an error condition exists. It also permits things like **IF LEAVE THEN** (which should be abbreviated to its equivalent **?LEAVE**)
*
2)
3)
4)
5)
create pairs 3 allot
: 0pairs ( -- )
pairs 3erase ;
: ?nopairs ( -- )
pairs 3c@ or [ 6 ] ?error ;
: +/-pairs ( family -- |family| )
dup 0<
if
negate pairs + dup -2 +!
then
pairs + dup 1 +!
c@ c->s 0< [ 6 ] ?error ;
: method ( addr -- )
rdrop 2- >r ;
: control
<builds
, c,
does>
?comp @+ swap c@+ +/-pairs swap method ; immediate
: control, ( cfa -- )
[ $fc ] pagemargin , ;
: ?>mark ( cfa family -- addr )
drop control, here 0 c, ;
: ?>resolve ( addr -- )
here 1+ over - swap c! ;
: ?<resolve ( addr cfa family -- )
drop control, dup>r here 2- c, r> ;
' (do) 3 control do
] ?>mark ; immediate
' (?do) 3 control ?do
] ?>mark ; immediate
' (loop) -3 control loop
] ?<resolve ?>resolve ; immediate
' (+loop) -3 control +loop
] ?<resolve ?>resolve ; immediate
' unloop -3 control leave
] +/-pairs xt, ; immediate
' (?leave) -3 control ?leave
] +/-pairs xt, ; immediate
' ?branch 2 control if
] ?>mark ; immediate
' branch -2 control else
] +/-pairs ?>mark swap ?>resolve ; immediate
0 -2 control then
] 2drop ?>resolve ; immediate
0 1 control begin
] 2drop here 1- ; immediate
' ?branch -1 control while
] +/-pairs ?>mark ; immediate
' ?branch -1 control until
] q<resolve drop ; immediate
' branch -1 control again
] ?<resolve drop ; immediate
' ?branch 2 control repeat
] 2>r swap 2r> ?<resolve drop ?>resolve ; immediate
```
Situation:
* An address used by the indirect JMP in NEXT must not span the $(xx)FF..$(xx+1)00 page boundary to do an NMOS hardware bug
Execution:
* There are three situations
1) Page boundary not spanned: NEXT
2) page boundary spanned by PAGE
3) page boundary spanned by PAD
All other ways of page-crossing should be eliminated
Compilation:
XT, ( cfa -- )
inserts a 16-bit pointer to a CFA
1. check HERELSB
$FF - insert a NOP
$FE - insert PAGE
$FD - insert PAGE, NOP
2. insert CFA
CFA, ( addr -- )
populates a CFA with JSR {addr}
pre-inserts PAGE if DP & $00FF is $FD or $FE
XT, is inserting a 2-byte CFA and DP is $xxFD or $xxFE
* Three-byters (e.g. ?BRANCH xx) can go right up to the edge of the page and will flip