Elliott 803 Algol 60 Compiler (reconstructed)

File: loader.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape2/loader.t2
2 0  ;
3 0  ; working storage for loader
4 0  numbits:; 
5 0 0000000000000 +0;0000000000000 @17
6 1  bitsheld:; 
7 1 0000000000000 +0;0000000000000 @18
8 2  ocdop:; 
9 2 0000000000000 +0;0000000000000 @19
10 3  newchar:; 
11 3 0000000000000 +0;0000000000000 @20
12 4  sumchk:; 
13 4 0000000000000 +0;0000000000000 @21
14 5 0000000000000W22:+0;0000000000000 @22
15 6 0000000000000lnk2:+0;0000000000000 @23
16 7 0000000000000codept:+0;0000000000000 @24
17 8 0000000000000W25:+0;0000000000000 @25
18 9 0000000000000contop:+0;0000000000000 @26
19 10 0000000000000conlim:+0;0000000000000 @27
20 11 0000000000000W28:+0;0000000000000 @28
21 12 0000000000000lnk1:+0;0000000000000 @29
22 13 0000000000000W30:+0;0000000000000 @30
23 14 0000000000000W31:+0;0000000000000 @31
24 15 0000000000000tmp1:+0;0000000000000 @32
25 16 0000000000000W33:+0;0000000000000 @33
26 17 0000000000005N5:+5;0000000000005 @34
27 18 0000000000001K1:+1;0000000000001 @35
28 19 0000000000003K3:+3;0000000000003 @36
29 20 0000000000005K5:+5;0000000000005 @37
30 21 0000000000017K15:+15;0000000000017 @38
31 22 0000000000047K39:+39;0000000000047 @39
32 23 0000000000010K8:+8;0000000000010 @40
33 24  signbit:; 
34 24 4000000000000 +04000000000000; @41
35 25 3777777700001W42:+03777777700001; @42
36 26 0000002000000Bbit:+00000002000000; @43
37 27 0000000000014K12:+12;0000000000014 @44
38 28 0000000010000K4K:+4096;0000000010000 @45
39 29 0000000000416lowmem:+Lomem;0000000000416 @46
40 30 0000000000023K19:+19;0000000000023 @47
41 31  ;W48:
42 31 0000000000000 +0;0000000000000 @48
43 32  ep6skel:; 
44 32 4000041000000 jmp ResetEnt:jmp 0;4064035000000 @49
45 33 0000000000013K11:+11;0000000000013 @50
46 34 0000000000037K31:+31;0000000000037 @51
47 35 4000001100000W52:jmp 0:jmp 0#;4000001100000 @52
48 36 0000000000045fsmsgp:+fsmsg;0000000000066 @53
49 37 0757646624545fsmsg:'\75\76FREE';0757646624545 @54
50 38 4746364576245 +SIGN+'\74STORE';4746364576245 @55
51 39  ;------------------------------------------------------------------
52 39  ; owncode loader
53 39  ;
54 39  ; getchunk: extract N bits (where N is in ACC at call) and return
55 39  ; return address in 29
56 39  ;
57 39  getchunk::; 
58 39  getchunk:; 
59 39 0560000 o27 numbits   ;subtract N from numbits @56
60 39+0600000 lod numbits   ;get numbits
61 40 1040056 jz .1   ;zero, just right @57
62 40+1020057 jn .2   ;negative, not enough
63 41  ;
64 41  ; there are more than N bits available, remove N from bitsheld
65 41 0040000 o02 0   ;=1 @58
66 41+  nop     ;
66+141+1000052 jmp .1    
66+242  .1:; 
67 42 0000003320000 o00 numbits/sll 0;shift left n places @59
68 43 0120022 sub K1   ;=1, less one to give mask @60
69 43+0660001 lns bitsheld   ;exchange, mask with store
70 44 0000003220000 o00 numbits/srl 0;shift into place @61
71 45  .ret:; 
72 45 0000063000001 o00 lnk1/jmp 1;and return @62
73 46  ; exactly N bits left, return them
74 46  .1:; 
75 46 0740001 lzs bitsheld   ;get bitsheld, and zero @63
76 46+1000055 jmp .ret   ;and return
77 47  ;
78 47  ; less than N bits, need to get more
79 47  ;
80 47  .2:; 
81 47 0140000 cla 0   ; @64
82 47+1620000 inp 0   ;get next character
83 48 0560004 o27 sumchk   ;subtract from sumcheck @65
84 48+0400003 sto newchar   ;store new character
85 49 0600024 lod K5   ;=5 (number of bits in char) @66
86 49+0500000 ads numbits   ;bump numbits
87 50 0600000 lod numbits   ;see if this is enough @67
88 50+1040073 jz .3   ;just right
89 51 1020075 jn .4   ;not enough @68
90 51+ ;
91 51+ ; more than enough
92 51+0420017 stn tmp1   ;save = -m
93 52 0040000 o02 0   ;=1 @69
94 52+  nop     ;padding
94+152+1000065 jmp .1    
94+253  .1:; 
95 53 0000003320000 o00 numbits/sll 0;shift left @70
96 54 0120022 sub K1   ;less one for mask @71
97 54+0660003 lns newchar   ;new character
98 55 0000003220000 o00 numbits/srl 0;align with bitsheld @72
99 56 0200003 exa newchar   ;exchange @73
100 56+0200001 exa bitsheld   ;likewise
101 57 0000077320005 o00 tmp1/sll 5;re-align bitsheld @74
102 58 0100003 add newchar   ;and add the new bits @75
103 58+1000055 jmp .ret   ;and return
104 59  ;
105 59  ; just enough combine with bitsheld and return
106 59  ;
107 59  .3:; 
108 59 0740001 lzs bitsheld   ;get held bits @76
109 59+1320005 sll 5   ;re-align
110 60 0100003 add newchar   ;add new bits @77
111 60+1000055 jmp .ret   ;and return
112 61  ;
113 61  ; not enough still, pack with bitsheld and repeat
114 61  ;
115 61  .4:; 
116 61 0600001 lod bitsheld   ;held bits @78
117 61+1320005 sll 5   ;shift left
118 62 0100003 add newchar   ;add new bits @79
119 62+0400001 sto bitsheld   ;store result
120 63 1000057 jmp .2   ;back for more @80
121 63+ ;
122 63+0000000 o00 0   ;
123 64  ;------------------------------------------------------------------
124 64  ; come here after skipping tape headers etc.
125 64  ;
126 64  Loader::; 
127 64  Loader:; 
128 64 0540000 cls numbits   ; @81
129 64+0540001 cls bitsheld   ;
130 65   calln ,   ; @82
130+165 7300061000047 lnk lnk1:jmp getchunk 
131 66   nop     ; @83
131+166 1100102 jmp .1    
131+266+ .1:; 
132 66+ .a:; 
133 66+0600021 lod N5   ;=5
134 67   calln ,   ; @84
134+167 7300061000047 lnk lnk1:jmp getchunk 
135 68 0400002 sto ocdop   ; @85
136 68+0060025 and K15   ;=15
137 69 1700013040107 o17 ocdop/jz .SW88;switch with 0-15 @86
138 70 0600013100107 cla ocdop/jmp .SW88#;switch with 16-31 @87
139 71  .SW88:; 
140 71 1000330 jmp .lderr   ;+0 @88
141 71+1000127 jmp .lod16   ;+16
142 72 1100247 jmp .lod01   ;+1 @89
143 72+1000357 jmp .lod17   ;+17
144 73 1100216 jmp .lod02   ;+2 @90
145 73+1100165 jmp .lod18   ;+18
146 74 1100237 jmp .lod03   ;+3 @91
147 74+1000226 jmp .lod19   ;+19
148 75 1100235 jmp .lod04   ;+4 @92
149 75+1000330 jmp .lderr   ;+20
150 76 1100274 jmp .lod05   ;+5 @93
151 76+1000330 jmp .lderr   ;+21
152 77 1100267 jmp .lod06   ;+6 @94
153 77+1100325 jmp .lod22   ;+22
154 78 1000266 jmp .lod07   ;+7 @95
155 78+1100312 jmp .lod23   ;+23
156 79 1000225 jmp .lod08   ;+8 @96
157 79+1100254 jmp .lod24   ;+24
158 80 1000213 jmp .lod09   ;+9 @97
159 80+1000227 jmp .lod25   ;+25
160 81 1000244 jmp .lod10   ;+10 @98
161 81+1000320 jmp .lod26   ;+26
162 82 1100304 jmp .lod11   ;+11 @99
163 82+1000330 jmp .lderr   ;+27
164 83 1000230 jmp .lod12   ;+12 @100
165 83+1000330 jmp .lderr   ;+28
166 84 1000331 jmp .lod13   ;+13 @101
167 84+1000330 jmp .lderr   ;+29
168 85 1000330 jmp .lderr   ;+14 @102
169 85+1000330 jmp .lderr   ;+30
170 86 1000333 jmp .lod15   ;+15 @103
171 86+1000330 jmp .lderr   ;+31
172 87  ;
173 87  ; type 16 entry, set load point, then loop storing instructions
174 87  ;
175 87  .lod16:; 
176 87   calln ,   ;recursive call @104
176+187 7300031100102 lnk lnk2:jmp Loader.a 
177 88 1000330 jmp .lderr   ;direct return - illegal @105
178 88+0400007 sto codept   ;skip return, save code address
179 89  .l16a:; 
180 89   calln ,   ;recursive call @106
180+189 7300031100102 lnk lnk2:jmp Loader.a 
181 90 1100163 jmp .l16e   ;direct return - add B-bit @107
182 90+ .l16b:;skip return, normal instn 
183 90+0400010 sto W25   ;save result
184 91 0600030 lod signbit   ;=04000000000000 @108
185 91+0700007 las codept   ;add to codept, get prev value
186 92 1020160 jn .l16d   ;odd address - top half @109
187 92+1000174 jmp .l16f   ;even address
188 93  ; patch moved in-line
189 93  =124 
190 124  .l16f:; 
191 124 0600010 lod W25   ;reload half-word @124
192 124+1000156 jmp .l16c   ;end of patch
193 125  ;
194 125  =110 
195 110  .l16c:; 
196 110 0000036400000 o00 codept/sto 0;store in bottom half @110
197 111 1000131 jmp .l16a   ;continue @111
198 111+ ;
199 111+0000000 o00 0   ;
200 112  .l16d:; 
201 112 0040000 o02 0   ;=1 @112
202 112+0560007 o27 codept   ;decrement code pointer
203 113 0600010 lod W25   ;reload half-word @113
204 113+1320024 sll 20   ;shift to top end
205 114 0000036500001 o00 codept/ads 1;and add to current word @114
206 115 1000131 jmp .l16a   ;continue @115
207 115+ ;
208 115+ .l16e:; 
209 115+0600032 lod Bbit   ;00 0/00 0
210 116 0000036500000 o00 codept/ads 0;add in B bit @116
211 117 1000131 jmp .l16a   ;continue @117
212 117+ ;
213 117+ ; type 18 entry, set base address, 8 bits of data, plus arbitrary value
214 117+ ;
215 117+ .lod18:; 
216 117+0600027 lod K8   ;=8
217 118   calln ,   ;get base number @118
217+1118 7300061000047 lnk lnk1:jmp getchunk 
218 119 0100015 add W30   ;display base @119
219 119+0400016 sto W31   ;save while reading value
220 120   calln ,   ;recursive call @120
220+1120 7300031100102 lnk lnk2:jmp Loader.a 
221 121 1000330 jmp .lderr   ;error return @121
222 121+  nop     ;base address now in acc
222+1121+1000172 jmp .1    
222+2122  .1:; 
223 122 0000072400000 o00 W31/sto 0;store display address for block@122
224 123 1000131 jmp .l16a   ;continue loading @123
225 123+ ;
226 123+0000000 o00 0   ;padding
227 124  ;-------------------------------------------------------------------
228 124  =139 
229 139  ;
230 139  ; type 9 entry, else jump?, swap patch to current address, store previous value
231 139  ;
232 139  .lod09:; 
233 139 0600007 lod codept   ;code pointer @139
234 139+1120214 jn .l9a   ;
235 140 0100031 add W42   ;=03777777700001 @140
236 140+ .l9a:; 
237 140+0100043 add W52   ;=04000001100000
238 141 0000026177777 o00 W22/exa -1;exchange with patch list top @141
239 142 1100132 jmp .l16b   ;store as normal instn @142
240 142+ ;
241 142+ ; type 2 entry, large relocatable instruction,
242 142+ ; 6 bits op + 13 bits address + 3 bits relocation
243 142+ ;
244 142+ .lod02:; 
245 142+0600023 lod K3   ;=3 set relocation size
246 143  .l2a:; 
247 143 0400020 sto W33   ;save temporarily @143
248 143+0600036 lod K19   ;=19
249 144   calln ,   ;get fn+address @144
249+1144 7300061000047 lnk lnk1:jmp getchunk 
250 145 0200020 exa W33   ;save instruction @145
251 145+  nop     ;
251+1145+1000222 jmp .1    
251+2146  .1:; 
252 146  .l2b:; 
253 146   calln ,   ;get reloc number @146
253+1146 7300061000047 lnk lnk1:jmp getchunk 
254 147 0100015 add W30   ;add base address @147
255 147+0200020 exa W33   ;exchange instn
256 148 0000102100000 o00 W33/add 0;add relocation term @148
257 149  ;
258 149  ; type 8 entry, return NULL instruction (acc=0) to outer sequence
259 149  ;
260 149  .lod08:; 
261 149 0000033100001 o00 lnk2/jmp 1#;skip return, skipping one inst @149
262 150  ;
263 150  ; type 19 entry, extra large instruction, 6 bits opcode + 13 bits address
264 150  ; plus 8 bits relocation.
265 150  ;
266 150  .lod19:; 
267 150 0600027 lod K8   ;=8 @150
268 150+1000217 jmp .l2a   ;
269 151  ;
270 151  ; type 25 entry, give direct return to indicate B-bit modification
271 151  ;
272 151  .lod25:; 
273 151 0000033000001 o00 lnk2/jmp 1;direct return, @151
274 152  ;
275 152  ; type 12 entry, patch jump instruction into switch list
276 152  ;
277 152  .lod12:; 
278 152   calln ,   ;recursive call @152
278+1152 7300031100102 lnk lnk2:jmp Loader.a 
279 153 1000330 jmp .lderr   ; @153
280 153+0400002 sto ocdop   ;address where to patch
281 154 0600007 lod codept   ;test code pointer @154
282 154+1120233 jn .l12a   ;adjust for alignment
283 155 0100031 add W42   ;=03777777700001 @155
284 155+ .l12a:; 
285 155+0100043 add W52   ;=04000001100000 jump instn
286 156 0000012400000 o00 ocdop/sto 0;patch jump into sw list @156
287 157 1000131 jmp .l16a   ;continue @157
288 157+ ;
289 157+ ; type 4 entry, 19 bit value to be returned
290 157+ ; as for type 2, but no relocation
291 157+ ;
292 157+ .lod04:; 
293 157+0600036 lod K19   ;=19
294 158   calln ,   ;get the data @158
294+1158 7300061000047 lnk lnk1:jmp getchunk 
295 159 1000225 jmp .lod08   ;and return it @159
296 159+ ;
297 159+ ; type 3 entry, 11 bit entry, fiddle with it and return
298 159+ ; as for type 1, but no relocation
299 159+ ;
300 159+ .lod03:; 
301 159+0600041 lod K11   ;=11
302 160   calln ,   ;get all 11 bits in one go @160
302+1160 7300061000047 lnk lnk1:jmp getchunk 
303 161 0400020 sto W33   ;temp save @161
304 161+0060042 and K31   ;=31 mask address part
305 162 0360020 o17 W33   ;store address, load fn @162
306 162+1320010 sll 8   ;shift up to right place
307 163 0100020 add W33   ;add address @163
308 163+1000225 jmp .lod08   ;normal return
309 164  ;
310 164  ; type 10 entry
311 164  ; plant jump to codept in patchup list
312 164  ;
313 164  .lod10:; 
314 164 0600007 lod codept   ;get code pointer @164
315 164+1120245 jn .l10a   ;adjust alignment
316 165 0100031 add W42   ;=03777777700001 @165
317 165+ .l10a:; 
318 165+0100043 add W52   ;=04000001100000
319 166 2200026377777 inc W22/sto -1;plant in patchup list @166
320 167 1100102 jmp Loader.a   ;and continue @167
321 167+ ;
322 167+ ; type 1 entry, 6 bits fn, 5 bits address, 3 bits relocation
323 167+ ;
324 167+ .lod01:; 
325 167+0600041 lod K11   ;=11 size of fn+address
326 168   calln ,   ;get fn+address in one go @168
326+1168 7300061000047 lnk lnk1:jmp getchunk 
327 169 0400020 sto W33   ;temp save @169
328 169+0060042 and K31   ;=31, mask off address part (5 bits)
329 170 0360020 o17 W33   ;subtract from original @170
330 170+1320010 sll 8   ;shift op-code into F2 position
331 171 0500020 ads W33   ;add address part @171
332 171+0600023 lod K3   ;=3
333 172 1000222 jmp .l2b   ;join up with type 2 @172
334 172+ ;
335 172+ ; type 24 entry, instruction ref, 6 bits opcode, followed by two recursive
336 172+ ; sequences which are combined into an instruction pair.
337 172+ ; store in constant table, combine address of constant with opcode
338 172+ ; and store that as normal instruction
339 172+ ;
340 172+ .lod24:; 
341 172+0040021 o02 N5   ;=5+1=>6 bits needed
342 173   calln ,   ;get opcode @173
342+1173 7300061000047 lnk lnk1:jmp getchunk 
343 174 1320015 sll 13   ;shift left 13 @174
344 174+0400010 sto W25   ;save it
345 175   calln ,   ;recursive call - F2N2 @175
345+1175 7300031100102 lnk lnk2:jmp Loader.a 
346 176 1000303 jmp .l24b   ;direct return set B-bit? @176
347 176+0400016 sto W31   ;skip, save result
348 177  .l24a:; 
349 177   calln ,   ;recursive calln - F1N1 part @177
349+1177 7300031100102 lnk lnk2:jmp Loader.a 
350 178 1000303 jmp .l24b   ;direct return, add B-bit @178
351 178+1320024 sll 20   ;skip return, align top half
352 179 0100016 add W31   ;and add F2N2 @179
353 179+0000000 o00 0   ;
354 180   calln ,   ;put result into constant table @180
354+1180 7300061000176 lnk lnk1:jmp storeconst 
355 181 0100010 add W25   ;and add opcode to for instn @181
356 181+1100132 jmp .l16b   ;store as normal instn
357 182  ;
358 182  ; type 7 entry, cond jump, 2-bit modifier to change jump type,
359 182  ; get jump instruction from patch list, modify and store as
360 182  ; normal instruction. Don't pop patch list!
361 182  ;
362 182  .lod07:; 
363 182 0000026577777 o00 W22/lod -1;load instruction from list @182
364 183 1000271 jmp .l6a   ;and joint type 6 code @183
365 183+ ;
366 183+ ; type 6 entry, unstack most recent patch, add condition, and add to code.
367 183+ ; As for type 7, except we pop the list.
368 183+ ;
369 183+ .lod06:; 
370 183+0040000 o02 0   ;=1
371 184 2700026600000 o27 W22/lod 0;decrement ptr and fetch @184
372 185  .l6a:; 
373 185 0400020 sto W33   ;save the jump @185
374 185+0040022 o02 K1   ;=1+1=>2 bits modifier
375 186   calln ,   ;get jump modifier 0-3 @186
375+1186 7300061000047 lnk lnk1:jmp getchunk 
376 187 1320015 sll 13   ;shift up appropriately @187
377 187+0100020 add W33   ;and add to jump
378 188 1100132 jmp .l16b   ;continue as normal instn @188
379 188+ ;
380 188+ ; type 5 entry, 6 bit opcode + 39 bit constant, store constant
381 188+ ; and combine address with opcode to return instruction
382 188+ ;
383 188+ .lod05:; 
384 188+0040021 o02 N5   ;=5+1=>6
385 189   calln ,   ;get 6 bits of data @189
385+1189 7300061000047 lnk lnk1:jmp getchunk 
386 190 1320015 sll 13   ;shift up for opcode @190
387 190+0400020 sto W33   ;and save temporarily
388 191 0600026 lod K39   ;=39, full word @191
389 191+  nop     ;
389+1191+1000300 jmp .1    
389+2192  .1:; 
390 192   calln ,   ;get data word @192
390+1192 7300061000047 lnk lnk1:jmp getchunk 
391 193   calln ,   ;add to constant area if needed @193
391+1193 7300061000176 lnk lnk1:jmp storeconst 
392 194 0100020 add W33   ;plus opcode @194
393 194+1000225 jmp .lod08   ;return completed instruction
394 195  ;
395 195  .l24b:; 
396 195 0600032 lod Bbit   ;00 0/00 0 @195
397 195+0500016 ads W31   ;
398 196 1000261 jmp .l24a   ; @196
399 196+ ;
400 196+ ; type 11 entry, 8-bit data (N), followed by N 39-bit constants
401 196+ ; to be stored in constant table.
402 196+ ;
403 196+ .lod11:; 
404 196+0600027 lod K8   ;=8
405 197   calln ,   ;get the number of consts @197
405+1197 7300061000047 lnk lnk1:jmp getchunk 
406 198 0420020 stn W33   ;save it (negated) @198
407 198+ .l11a:; 
408 198+0640020 lis W33   ;load and increment count
409 199 1140102 jz Loader.a   ;continue loading if finished @199
410 199+0600026 lod K39   ;=39
411 200   calln ,   ;get full-word constant @200
411+1200 7300061000047 lnk lnk1:jmp getchunk 
412 201   calln ,   ;put it into constant area @201
412+1201 7300061000175 lnk lnk1:jmp addconst 
413 202 1100306 jmp .l11a   ;and repeat until done @202
414 202+ ;
415 202+ ; type 23 entry, 6-bit opcode, address from table loaded by type 11
416 202+ ;
417 202+ .lod23:; 
418 202+0040021 o02 N5   ;=5+1=>6
419 203   calln ,   ;get opcode @203
419+1203 7300061000047 lnk lnk1:jmp getchunk 
420 204 1320015 sll 13   ;shift into place @204
421 204+0400020 sto W33   ;save temporarily
422 205 0040012 o02 conlim   ;address of last entry stored @205
423 205+0000000 o00 0   ;
424 206   calln ,   ;add that to table @206
424+1206 7300061000176 lnk lnk1:jmp storeconst 
425 207 0100020 add W33   ;add address to opcode @207
426 207+1000225 jmp .lod08   ;and return that
427 208  ;
428 208  ; type 26 entry, two recursive items: address and fullword value
429 208  ; patch address with value
430 208  ;
431 208  .lod26:; 
432 208   calln ,   ;recursive call, get address @208
432+1208 7300031100102 lnk lnk2:jmp Loader.a 
433 209 1000330 jmp .lderr   ;error, crash @209
434 209+0400010 sto W25   ;save address
435 210   calln ,   ;recursive call, get value @210
435+1210 7300031100102 lnk lnk2:jmp Loader.a 
436 211 1000330 jmp .lderr   ;error, crash @211
437 211+  nop     ;
437+1211+1000324 jmp .1    
437+2212  .1:; 
438 212 0000042400000 o00 W25/sto 0;store in previous address @212
439 213 1000131 jmp .l16a   ;and continue @213
440 213+ ;
441 213+ ; type 22 entry, set sumchk value (39 bits)
442 213+ ;
443 213+ .lod22:; 
444 213+0600026 lod K39   ;=39
445 214   calln ,   ;get 39 bit value @214
445+1214 7300061000047 lnk lnk1:jmp getchunk 
446 215 0400004 sto sumchk   ;save as sumcheck @215
447 215+1100102 jmp Loader.a   ;back for more entries
448 216  ;
449 216  ; error in owncode, invalid opcode or other item
450 216  ;
451 216  .lderr:; 
452 216 1700001 otp 1   ;error indicator @216
453 216+1000330 jmp .lderr   ;loop, punching 1's
454 217  ;
455 217  ; type 13 entry, test sumcheck
456 217  ;
457 217  .lod13:; 
458 217 0600004 lod sumchk   ;test sumcheck, should be zero @217
459 217+1140102 jz Loader.a   ;OK< continue loading
460 218  .lderr2:; 
461 218 1700002 otp 2   ;error indicator @218
462 218+1000332 jmp .lderr2   ;loop, punching 2's
463 219  ;
464 219  ; type 15 entry, end of program, tidy up and quit.
465 219  ;
466 219  .lod15:; 
467 219 0040011 o02 contop   ;start of program @219
468 219+0100040 add ep6skel   ;=
469 220 0400006 sto ep6   ;set entry point jump @220
470 220+0040023 o02 K3   ;=3+1=>4
471 221 0400075 sto Ndigits   ;digits(4) @221
472 221+  clo     ;reset overflow (just in case)
472+1221+1060336 jo .1    
472+2222  .1:; 
473 222 1100352 jmp L234P   ;jump to patch @222
474 222+ =234+ 
475 234+ L234P:;patch moved in-line 
476 234+0600356 lod .TPdev   ;
477 235 0400077 sto outdev   ;set output device=printer @235
478 235+0600355 lod W237   ;
479 236 0400076 sto prtfmt   ;set format for printing @236
480 236+1100336 jmp L222P   ;end of patch
481 237  ;
482 237  =222+ 
483 222+ L222P:;resume normal flow 
484 222+0600044 lod fsmsgp   ; 'free store '
485 223   calln ,   ;output string @223
485+1223 7300005100012 lnk T2Link:jmp OutStr 
486 224 1714033 otp TP+FS   ; @224
487 224+1714006 otp TP+'='   ;
488 225 0600035 lod lowmem   ;=Lomem @225
489 225+0400031 sto lomem   ;
490 226   calln ,   ;print integer @226
490+1226 7300005100022 lnk T2Link:jmp OutInt 
491 227 1714015 otp TP+'-'   ; @227
492 227+0600012 lod conlim   ;
493 228 0400033 sto himem   ;2064150000000 @228
494 228+0000000 o00 0   ;
495 229   calln ,   ;print integer @229
495+1229 7300005100022 lnk T2Link:jmp OutInt 
496 230 0600033 lod K12   ;=12 @230
497 230+0420006 stn lnk2   ;
498 231  L231:; 
499 231 1714036 otp TP+LF   ;output 12 line feeds @231
500 231+0640006 lis lnk2   ;
501 232 1020347 jn L231   ; @232
502 232+1714035 otp TP+CR   ; add carriage return
503 233   calln ,   ;warbling pause @233
503+1233 7300005000035 lnk T2Link:jmp DWaitEnt 
504 234 1000006 jmp ep6   ;run program? @234
505 234+ ;
506 234+ =237 
507 237 0000004000000W237:+0000004000000;00 1:00 0 print format @237
508 238 0000000014000.TPdev:+TP; @238
509 239  ;
510 239  ; type 17 entry, define dimensions of program and tables
511 239  ;
512 239  .lod17:; 
513 239 0600035 lod lowmem   ;=Lomem @239
514 239+0120022 sub K1   ;=1
515 240 0400015 sto W30   ;base pointer @240
516 240+0040033 o02 K12   ;=12+1=>13
517 241   calln ,   ;getchunk(13) -> code size @241
517+1241 7300061000047 lnk lnk1:jmp getchunk 
518 242 0400016 sto W31   ;store code size @242
519 242+0040033 o02 K12   ;=12+1=>13
520 243   calln ,   ;getchunk(13) -> vars size @243
520+1243 7300061000047 lnk lnk1:jmp getchunk 
521 244 0400020 sto W33   ;store vars size @244
522 244+0600034 lod K4K   ;=4096
523 245 0430000 stn ExtMem   ;1st word of extended memory @245
524 245+0610000 lod ExtMem   ;for 4K m/c, 0; for 8K m/c -4K
525 246 1000414 jmp .268   ;patch, @246
526 246+ ;
527 246+ ; patch moved in-line
528 246+ ExtMem= ëÿ¿P/@hëÿ¿hX@Ø ôÿ¿ÿ4096; start of extended memory 
529 246+ =268 
530 268  .268:; 
531 268 0100034 add K4K   ;get adjustment, 0K / 4K @268
532 268+0160013 bus Memtop   ;=memtop : top of free area - adjustment
533 269 1100366 jmp .246P   ;return from patch @269
534 269+ ;
535 269+ ; resume original code
536 269+ =246+ 
537 246+ .246P:; 
538 246+0120020 sub W33   ;less vars size
539 247 0000066400002 o00 W30/sto 2;variables base @247
540 248 0120016 sub W31   ;less code size @248
541 248+  nop     ;
541+1248+1000371 jmp .1    
541+2249  .1:; 
542 249 0000066400001 o00 W30/sto 1;code base address @249
543 250 0120022 sub K1   ;code base - 1 @250
544 250+0400011 sto contop   ;top of constant table
545 251 2000052540000 sto conlim/cls 0;constant pointer, set entry zero @251
546 252 0600012 lod T2BASE   ;tape2 base address @252
547 252+0000000 o00 0   ;
548 253 0000066400004 o00 W30/sto 4;run-time support base @253
549 254   nop     ; @254
549+1254 1100376 jmp .1    
549+2254+ .1:; 
550 254+0600027 lod K8   ;=8
551 255   calln ,   ;getchunk(8) size of display area @255
551+1255 7300061000047 lnk lnk1:jmp getchunk 
552 256 0100035 add lowmem   ;=Lomem bottom of free memory @256
553 256+0400005 sto W22   ;address of 1st base area
554 257 0440005 inc W22   ;+1 @257
555 257+0600027 lod K8   ;=8
556 258   calln ,   ;getchunk(8) size of second base area @258
556+1258 7300061000047 lnk lnk1:jmp getchunk 
557 259 0100005 add W22   ;+first base address @259
558 259+0400013 sto W28   ;address of second base area
559 260 0120012 sub conlim   ;check against top-down area @260
560 260+1120102 jn Loader.a   ;ok, continue
561 261 1000014 jmp SpaceOflo   ;space oflo? @261
562 261+ ;
563 261+0000000 o00 0   ;
564 262  ;
565 262  ; loader entry point
566 262  ;
567 262  Loadit::; 
568 262  Loadit:; 
569 262 1620000 inp 0   ; read tape @262
570 262+1040406 jz Loadit   ; skip leading blanks
571 263  .1:; 
572 263 1600023714000 stc 4/otp TP; copy heading @263
573 264 1620000 inp 0   ; get next char @264
574 264+  jnz     ; repeat loop until null
574+1264+1140411 jz .1    
574+2265 1000407 jmp Loadit.1    
574+3265+ .1:; 
575 265+ ;
576 265+ ; heading copied, skip more blanks
577 265+ .2:; 
578 265+1620000 inp 0   ; read tape
579 266 1140411 jz .2   ; skip more blanks @266
580 266+0140000 cla 0   ; clear acc
581 267 1620000 inp 0   ; read next char @267
582 267+1000100 jmp Loader   ;->
583 268  ;-------------------------------------------------------------------
584 268  ; addconst
585 268  ; add item to constant area, regardless
586 268  ;
587 268  =125 
588 125  addconst:; 
589 125 0400002 sto ocdop   ;store item @125
590 125+1000204 jmp storeconst.2   ;branch into storeconst after scan
591 126  ;-------------------------------------------------------------------
592 126  ; storeconst
593 126  ; see if const (in ACC) is already in table, if so return address,
594 126  ; otherwise add to table, checking for space oflo. return address
595 126  ; of new item.
596 126  ;
597 126  storeconst::; 
598 126  storeconst:; 
599 126 0400002 sto ocdop   ;temp store for value @126
600 126+0040000 o02 0   ;=1
601 127 0160011 bus contop   ;top of constant area @127
602 127+0400003 sto newchar   ;working pointer
603 128  .1:; 
604 128 0000016600001 o00 newchar/lod 1;check existing entries @128
605 129 0120002 sub ocdop   ;matching entry? @129
606 129+1140211 jz .3   ;yes, ->return address of match
607 130 0040000 o02 0   ;=1 @130
608 130+0760003 o37 newchar   ;decrement ptr
609 131 0160012 bus conlim   ;start of table @131
610 131+1020200 jn .1   ;no, continue loop
611 132  .2:; 
612 132 0040000 o02 0   ;=1 @132
613 132+0760012 o37 conlim   ;extend table down
614 133 0120013 sub W28   ;check for overlap @133
615 133+1020014 jn SpaceOflo   ;space oflo?
616 134 0600002 lod ocdop   ;get new item @134
617 134+0000000 o00 0    
618 135 0000052400001 o00 conlim/sto 1;store in table @135
619 136 0040012 o02 conlim   ;table address+1 @136
620 136+1000212 jmp .4   ;return
621 137  ;
622 137 0000000 o00 0   ; @137
623 137+ ;
624 137+ .3:; 
625 137+0040003 o02 newchar   ;table pointer+1
626 138  .4:; 
627 138 0000063000001 o00 lnk1/jmp 1;and return @138
628 139  ;-------------------------------------------------------------------
629 139  ; end of loader, define bottom of free area:
630 139  ;
631 139  Lomem= ëÿ¿P/@hëÿ¿hX@Ø ôÿ¿ÿ270; 

Page created by Bill Purvis, last updated: January 09 2004