GSFORTH/MORE at master · perfectconsulting/GSFORTH · GitHub

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
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
   10PROCheader("digit")
   20digit%=P%
   30FORo%=0TO3STEP3
   40P%=digit%
   50[:OPTo%
   60CPX#stkbot%-2
   70BCSunderflow
   80SEC
   90LDAstk%+3,X
  100SBC#ASC("0")
  110BMInondigit
  120CMP#&0A
  130BMIcheckbase
  140SEC
  150SBC#&07
  160CMP#&0A
  170BMInondigit
  180.checkbase
  190CMPstk%+1,X
  200BPLnondigit
  210STAstk%+3,X
  220LDA#&FF
  230STAstk%+1,X
  240STAstk%+2,X
  250RTS
  260.nondigit
  270INX:INX
  280LDA#&00
  290STAstk%+1,X
  300STAstk%+2,X
  310RTS
  320.underflow
  330LDA#estku%
  340JMP(svct%)
  350]:NEXTo%
  360PROCheader("(find)")
  370find%=P%
  380FORo%=0TO3STEP3
  390P%=find%
  400[:OPTo%
  410CPX#stkbot%-2
  420BCSunderflow
  430LDAstk%+1,X
  440STAsc%
  450LDAstk%+2,X
  460STAsc%+1
  470LDAstk%+3,X
  480STAsc%+2
  490LDAstk%+4,X
  500STAsc%+3
  510.findstart
  520LDY#&00
  530LDAsc%
  540BNEfindloop
  550LDAsc%+1
  560BEQnotfound
  570.findloop
  580LDA(sc%),Y
  590AND#&20
  600BNEnextlink
  610LDA(sc%),Y
  620AND#&1F
  630CMP(sc%+2),Y
  640BNEnextlink
  650.nameloop
  660INY
  670LDA(sc%),Y
  680AND#&7F
  690CMP(sc%+2),Y
  700BNEthislink
  710LDA(sc%),Y
  720AND#&80
  730BEQnameloop
  740BNEfound
  750.nextlink
  760INY
  770.thislink
  780LDA(sc%),Y
  790AND#&80
  800BEQnextlink
  810INY
  820LDA(sc%),Y
  830STAsc%+4
  840INY
  850LDA(sc%),Y
  860STAsc%+1
  870LDAsc%+4
  880STAsc%
  890CLC
  900BCCfindstart
  910.underflow
  920LDA#estku%
  930JMP(svct%)
  940.overflow
  950LDA#estko%
  960JMP(svct%)
  970.found
  980CPX#stktop%
  990BEQoverflow
 1000INY:INY:INY
 1010DEX:DEX
 1020TYA
 1030CLC
 1040ADCsc%
 1050STAstk%+5,X
 1060LDAsc%+1
 1070ADC#&00
 1080STAstk%+6,X
 1090LDY#&00
 1100LDA(sc%),Y
 1110STAstk%+3,X
 1120TYA
 1130STAstk%+4,X
 1140LDA#&FF
 1150STAstk%+1,X
 1160STAstk%+2,X
 1170RTS
 1180.notfound
 1190INX:INX
 1200LDA#&00
 1210STAstk%+1,X
 1220STAstk%+2,X
 1230RTS
 1240]:NEXTo%
 1250PROCheader("execute")
 1260exec%=P%
 1270FORo%=0TO3STEP3
 1280P%=exec%
 1290[:OPTo%
 1300CPX#stkbot%
 1310BEQunderflow
 1320LDAstk%+1,X
 1330STAsc%
 1340LDAstk%+2,X
 1350STAsc%+1
 1360INX:INX
 1370JMP(sc%)
 1380.underflow
 1390LDA#estku%
 1400JMP(svct%)
 1410]:NEXTo%
 1420PROCheader("x")
 1430[:PLA:PLA:RTS:]
 1440PROCpoke(&80C1,last%)
 1450OSCLI("EXEC E.MORE")
 1460END
 1470DEFPROCheader(name$)
 1480PRINT:PRINT
 1490PRINT"  *** ";~P%;" nfa '";name$;"'"
 1500LETxhere%=P%
 1510LETspan%=LEN(name$)
 1520?P%=span%
 1530PROCsetbit(7,P%)
 1540LETP%=P%+1
 1550IFspan% > length%THENspan%=length%
 1560FORi%=1TOspan%
 1570?P%=ASC(MID$(name$,i%,1))
 1580LETP%=P%+1
 1590NEXTi%
 1600PRINT"  *** ";~P%;" lfa (";~last%;")"
 1610PROCsetbit(7,P%-1)
 1620PROCpoke(last%,P%)
 1630LETP%=P%+2
 1640LETlast%=xhere%
 1650LETlabel%=label%+1
 1660PRINT:PRINT
 1670ENDPROC
 1680DEFPROCsetbit(bit%,addr%)
 1690?addr%=?addr%OR(2^bit%)
 1700ENDPROC
 1710DEFPROCpoke(val%,addr%)
 1720?addr%=val%MOD256
 1730?(addr%+1)=val%DIV256
 1740ENDPROC
 1750DEFFNliteral(value%):[:OPTo%:JSRlit%:]:PROCpoke(value%,P%):P%=P%+2:=o%