GSFORTH/O.ASTACK 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
   10PROCheader(">a")
   20toa%=P%
   30FORo%=0TO3STEP3
   40P%=toa%
   50[:OPTo%
   60CPX#stkbot%
   70BEQunderflow
   80LDYasp%
   90CPY#astktop%
  100BEQoverflow
  110LDAstk%+1,X
  120STAsc%
  130LDAstk%+2,X
  140STAsc%+1
  150INX:INX
  160STXsc%+2
  170TYA:TAX
  180DEX:DEX
  190LDAsc%
  200STAastk%+1,X
  210LDAsc%+1
  220STAastk%+2,X
  230STXasp%
  240LDXsc%+2
  250RTS
  260.underflow
  270LDA#estku%
  280JMP(svct%)
  290.overflow
  300LDA#eastko%
  310JMP(svct%)
  320]:NEXTo%
  330PROCheader("a>")
  340afrom%=P%
  350FORo%=0TO3STEP3
  360P%=afrom%
  370[:OPTo%
  380CPX#stktop%
  390BEQoverflow
  400LDYasp%
  410CPY#astkbot%
  420BEQunderflow
  430STXsc%+1
  440TYA:TAX
  450LDAastk%+1,X
  460STAsc%
  470LDAastk%+2,X
  480INX:INX
  490STXasp%
  500LDXsc%+1
  510DEX:DEX
  520STAstk%+2,X
  530LDAsc%
  540STAstk%+1,X
  550RTS
  560.underflow
  570LDA#eastku%
  580JMP(svct%)
  590.overflow
  600LDA#estko%
  610JMP(svct%)
  620]:NEXTo%
  630PROCheader("a")
  640a%=P%
  650FORo%=0TO3STEP3
  660P%=a%
  670[:OPTo%
  680CPX#stktop%
  690BEQoverflow
  700LDYasp%
  710CPY#astkbot%
  720BEQunderflow
  730STXsc%+1
  740TYA:TAX
  750LDAastk%+1,X
  760STAsc%
  770LDAastk%+2,X
  780LDXsc%+1
  790DEX:DEX
  800STAstk%+2,X
  810LDAsc%
  820STAstk%+1,X
  830RTS
  840.underflow
  850LDA#eastku%
  860JMP(svct%)
  870.overflow
  880LDA#estko%
  890JMP(svct%)
  900]:NEXTo%
  910PROCheader("adrop")
  920adrop%=P%
  930FORo%=0TO3STEP3
  940P%=adrop%
  950[:OPTo%
  960TXA:TAY
  970LDXasp%
  980CPX#astktop%
  990BEQunderflow
 1000INX:INX
 1010STXasp%
 1020TYA:TAX
 1030RTS
 1040.underflow
 1050LDA#eastku%
 1060JMP(svct%)
 1070]:NEXTo%
 1080OSCLI("EXEC E.ASTACK")
 1090END
 1100DEFPROCheader(name$)
 1110PRINT:PRINT
 1120PRINT"  *** ";~P%;" nfa '";name$;"'"
 1130LETxhere%=P%
 1140LETspan%=LEN(name$)
 1150?P%=span%
 1160PROCsetbit(7,P%)
 1170LETP%=P%+1
 1180IFspan% > length%THENspan%=length%
 1190FORi%=1TOspan%
 1200?P%=ASC(MID$(name$,i%,1))
 1210LETP%=P%+1
 1220NEXTi%
 1230PRINT"  *** ";~P%;" lfa (";~last%;")"
 1240PROCsetbit(7,P%-1)
 1250PROCpoke(last%,P%)
 1260LETP%=P%+2
 1270LETlast%=xhere%
 1280LETlabel%=label%+1
 1290PRINT:PRINT
 1300ENDPROC
 1310DEFPROCsetbit(bit%,addr%)
 1320?addr%=?addr%OR(2^bit%)
 1330ENDPROC
 1340DEFPROCpoke(val%,addr%)
 1350?addr%=val%MOD256
 1360?(addr%+1)=val%DIV256
 1370ENDPROC
 1380DEFFNliteral(value%):[:OPTo%:JSRlit%:]:PROCpoke(value%,P%):P%=P%+2:=o%