Elliott 803 Algol 60 Compiler (reconstructed)

File: loader.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape1.d/loader.t2
2 0  ;------------------
3 0  ;
4 0  ; data for loader
5 0  ;
6 0  =21 
7 21 0000000000000bitsheld:+0; number of bits in held @21
8 22 0000000000000held:+0; contains held bits @22
9 23 0000000000000opcd:+0; o-code operator @23
10 24 0000000000000ocdwk:+0; temp work space @24
11 25 0000000000000sumck:+0; sumcheck for ocode @25
12 26 0000000000000PatchLP:+0; patch list pointer @26
13 27 0000000000000Link1a:+0; return address @27
14 28 0000000000000CodePtr:+0; object code address (loader) @28
15 29 0000000000000LodWk2:+0; general work (loader) @29
16 30 0000000000000contop:+0; top of final constant area @30
17 31 0000000000000conlim:+0; bottom of final constant area @31
18 32  =34 
19 34 0000000000000DispBase:+0; display base address @34
20 35 0000000000000LodWk3:+0; general work (loader) @35
21 36 0000000000000LodWk1:+0; general work (loader) @36
22 37 0000000000000LodWk4:+0; general work (loader) @37
23 38 0000000000000OcdRdP:+0; Ocode read pointer @38
24 39  =40 
25 40 0000000000000TConTop:+0; top of current constant area @40
26 41 0000000000000TConLim:+0; bottom of current constant area @41
27 42 0000000000000fbptr:+0; pointer into film buffer @42
28 43 0000000000000FilmFlg:+0; nonzero if using film for ocode @43
29 44 0000000000000W44:+0; @44
30 45 0000000000000W45:+0; @45
31 46 0000000000005K5c:+5; @46
32 47 0000000000001K1a:+1; @47
33 48 0000000000003K3b:+3; @48
34 49 0000000000005 +5; no refs? @49
35 50 0000000000017K15b:+15; @50
36 51 0000000000047K39a:+39; @51
37 52 0000000000010K8:+8; @52
38 53 4000000000000TopBit:+04000000000000; @53
39 54 3777777700001W54:+03777777700001;used to adjust PC in loader @54
40 55 0000002000000BBit:+00000002000000; @55
41 56 0000000000014K12a:+12; @56
42 57 0000000010000 +4096; no refs @57
43 58 0000000000000LoMeM:+0; @58
44 59 0000000000023K19a:+19; @59
45 60 0000000017777K8191a:+8191; @60
46 61 4000041000000EP6SK:jmp _TAPE2+8:jmp 0; modified by tape2 base @61
47 62 0000000000013K11a:+11 
48 63 0000000000037K31a:+31 
49 64 4000001100000JmpJmp:jmp 0:jmp 0#;
50 65 0000000000102fsmsgp:+fsmsg 
51 66  ;
52 66 0757646624545fsmsg:'\r\nFREE'; @66
53 67 4746364576245 '\74STORE'!; @67
54 68  ;
55 68 0000000000600FBuffP:+384; @68
56 69 0000000000077K63a:+63; @69
57 70 0000000000022K18a:+18; @70
58 71  ;
59 71 0000001100061EP8SK:00 0:44 _TAPE2+49; @71
60 72 4701475000014W72:+04701475000014;47 207 : 40 12 @72
61 73  ; table of 2**n - 1
62 73  masks:; 
63 73 0000000000001 +1;0000000000001 @73
64 74 0000000000003 +3;0000000000003 @74
65 75 0000000000007 +7;0000000000007
66 76 0000000000017 +15;0000000000017 @76
67 77 0000000000037 +31;0000000000037
68 78 0000000000077 +63;0000000000077 @78
69 79 0000000000177 +127;0000000000177
70 80 0000000000377 +255;0000000000377 @80
71 81 0000000000777 +511;0000000000777
72 82 0000000001777 +1023;0000000001777 @82
73 83 0000000003777 +2047;0000000003777
74 84 0000000007777 +4095;0000000007777 @84
75 85 0000000017777 +8191;0000000017777
76 86 0000000037777 +16383;0000000037777 @86
77 87 0000000077777 +32767;0000000077777
78 88 0000000177777 +65535;0000000177777 @88
79 89 0000000377777 +131071;0000000377777
80 90 0000000777777 +262143;0000000777777 @90
81 91 0000001777777 +524287;0000001777777
82 92 0000003777777 +1048575;0000003777777 @92
83 93 0000007777777 +2097151;0000007777777
84 94 0000017777777 +4194303;0000017777777 @94
85 95 0000037777777 +8388607;0000037777777
86 96 0000077777777 +16777215;0000077777777 @96
87 97 0000177777777 +33554431;0000177777777
88 98 0000377777777 +67108863;0000377777777 @98
89 99 0000777777777 +134217727;0000777777777
90 100 0001777777777 +268435455;0001777777777 @100
91 101 0003777777777 +536870911;0003777777777
92 102 0007777777777 +1073741823;0007777777777 @102
93 103 0017777777777 +2147483647;0017777777777
94 104 0037777777777 +4294967295;0037777777777 @104
95 105 0077777777777 +8589934591;0077777777777
96 106 0177777777777 +17179869183;0177777777777 @106
97 107 0377777777777 +34359738367;0377777777777
98 108 0777777777777 +68719476735;0777777777777 @108
99 109 1777777777777 +137438953471;1777777777777
100 110 3777777777777 +274877906943;3777777777777 @110
101 111 7777777777777 +549755813887;7777777777777
102 112  ;----------------------------------------------------
103 112  ; return address in 33
104 112  ; extract 'acc' bits from ocode stream
105 112  ;
106 112  getchunk::; 
107 112  .ent:; 
108 112 0560025 o27 bitsheld   ; @112
109 112+0600025 lod bitsheld   ; 'n'
110 113 1040167 jz .1   ; @113
111 113+1020170 jn .2   ;->
112 114 1000163 jmp .0   ;no-op @114
113 114+0000000 o00 0   ;padding
114 115  ;
115 115  ; more than enough bits held, extract needed bits
116 115  ;
117 115 0000126600110.0:o00 bitsheld/lod masks-1;get bottom 'n' bits @115
118 116   nop      
118+1116 1100164 jmp .1    
118+2116+ .1:; 
119 116+0660026 lns held   ;load data, clear fetched bits
120 117 0000127220000 o00 bitsheld/srl 0;shift right 'n' bits @117
121 118  .ret:; 
122 118   ret     ;and return
122+1118 0000207000001 o00 getchunk.lnk/jmp 1 
123 119  ;
124 119  ; exact fit, return held info
125 119  ;
126 119 0740026.1:lzs held   ;get held bits @119
127 119+1000166 jmp .ret   ;return
128 120  ;
129 120  ; not enough bits held, get more and extract as needed
130 120  ;
131 120  .2:call     ;get next ocode word @120
131+1120 7300235000204 lnk getowd.lnk:jmp getowd.ent 
132 121 0560031 o27 sumck   ;do sumcheck arithmetic
133 121+0400030 sto ocdwk   ;save complete word
134 122 0600063 lod K39a   ;=39 @122
135 122+0500025 ads bitsheld   ;add number of new bits to old
136 123 0600025 lod bitsheld   ;load new number
137 123+1040203 jz .3   ;no bits left over, must be 39
138 124 0420044 stn LodWk1   ;store negated for shift @124
139 124+  nop      
139+1124+1000175 jmp .1    
139+2125  .1:; 
140 125 0000126600110 o00 bitsheld/lod masks-1;mask for bits leftover
141 126   nop     ; @126
141+1126 1100176 jmp .1    
141+2126+ .1:; 
142 126+0660030 lns ocdwk   ;and with data
143 127 0000127220000 o00 bitsheld/srl 0;shift rest right
144 128 0200030 exa ocdwk   ;put rest back, get masked bit @128
145 128+0200026 exa held   ;exch with part-word
146 129 0000223320047 o00 LodWk1/sll 39;make room for new bit
147 130 0100030 add ocdwk   ;add into part-word @130
148 130+1000166 jmp .ret   ;return
149 131  ;
150 131  ; from 123+
151 131 0600030.3:lod ocdwk   ; @131
152 131+1000166 jmp .ret   ;return
153 132  ;--------------------------------------------------------
154 132  ; ep=379 alt entry to getchunk
155 132  =379 
156 379  .alt:; 
157 379  ;
158 379  getchunka.ent:; 
159 379 0440032 inc PatchLP   ;bump patch list pointer @379
160 379+1000160 jmp .ent   ;then do getchunk
161 380  =132 
162 132  ;-----------------------------------------------------------
163 132  ; read next word from ocode stream
164 132  getowd::; 
165 132  .ent:; 
166 132 0600053 lod FilmFlg   ; @132
167 132+1140210 o46 .2   ;load from memory
168 133 0040000 o02 0   ;=1
169 133+0760052 o37 fbptr   ;adjust pointer
170 134 0120104 sub FBuffP   ;buffer exhausted?
171 134+1040213 jz .4   ;yes, ->read next block
172 135  ;
173 135  .1:; 
174 135 0000252600000 o00 fbptr/lod 0;get word from film buffer @135
175 136 1000212 jmp .3   ;and return
176 136+ ;
177 136+ ; reading from memory
178 136+ .2:; 
179 136+0040000 o02 0   ;=1 @136+
180 137 2700232600001 o27 OcdRdP/lod 1;get next ocode word
181 138  ;
182 138  .3:; 
183 138   ret     ;return @138
183+1138 0000237000001 o00 getowd.lnk/jmp 1 
184 139  ;-------------------------
185 139  ; read block of ocode from film
186 139  .4:; 
187 139 0000267742000 o00 W45/o76 1024;prepare read @139
188 140 0000423760000 o00 FBuffP/o77 0; read block @140
189 141 0000267742002 o00 W45/o76 1026; prepare search (to get status)
190 142 0060106 and K18a   ;=022 check error flags @142
191 142+1040221 jz .5   ;read OK
192 143 0000263760000 o00 W44/o77 0; do search
193 144 1700013 otp 11   ;punch warning char @144
194 144+1000213 jmp .4   ;try again
195 145  ;
196 145  ; block read from film, set pointers to read from buffer
197 145  .5:; 
198 145 0440054 inc W44   ; @145
199 145+0600105 lod K63a   ;=63
200 146 0100104 add FBuffP   ;add film buffer base address
201 146+0400052 sto fbptr   ;store pointer to last word of buffer
202 147 1000207 jmp .1   ;->back to do it again
203 147+ ;
204 147+0000000 o00 0   ;
205 148  ;--------------------------------------------------------
206 148  ; consolidate compiled code for execution
207 148  ;
208 148  loadit::; 
209 148  .ent:; 
210 148 0540025 cls bitsheld   ; @148
211 148+0540026 cls held   ;
212 149   call     ; discard trailing null
212+1149 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
213 150   nop     ; @150
213+1150 1100226 jmp .1    
213+2150+ .1:; 
214 150+ ; from 171+
215 150+0600056.1:lod K5c   ;=5
216 151   call     ; get opcode
216+1151 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
217 152 0400027 sto opcd   ; @152
218 152+0060062 and K15b   ;=15
219 153 1700137040233 o17 opcd/jz .sw;switch if zero
220 154 0600137100233 cla opcd/jmp .sw#;switch otherwise @154
221 155  ;
222 155  .sw:; 
223 155 4002455000253 jmp .err:jmp .sw16;0 16 @155
224 156 4402151000542 jmp .sw1:jmp .sw17;1 17 @156
225 157 4402005100270 jmp .sw2:jmp .sw18;2 18 @157
226 158 4402111000411 jmp .sw3:jmp .sw19;3 19 @158
227 159 4402101000513 jmp .sw4:jmp .err;4 20 @159
228 160 4402275000513 jmp .sw5:jmp .err;5 21 @160
229 161 4402251100510 jmp .sw6:jmp .sw22;6 22 @161
230 162 4002245100475 jmp .sw7:jmp .sw23;7 23 @162
231 163 4002041100437 jmp .sw8:jmp .sw24;8 24 @163
232 164 4001771000412 jmp .sw9:jmp .sw25;9 25 @164
233 165 4002135000503 jmp .sw10:jmp .sw26;10 26 @165
234 166 4402335000513 jmp .sw11:jmp .err;11 27 @166
235 167 4002055000513 jmp .sw12:jmp .err;12 28 @167
236 168 4002461000513 jmp .sw13:jmp .err;13 29 @168
237 169 4002455000513 jmp .err:jmp .err;14 30 @169
238 170 4002471000513 jmp .sw15:jmp .err;15 31 @170
239 171  ;
240 171  ; type 16 entry, set code load address
241 171  ;
242 171  .sw16:; 
243 171   calln ,   ;recursive call @171
243+1171 7300155100226 lnk Link1a:jmp loadit.1 
244 172  .172:; 
245 172 1000513 jmp .err   ;modified by 4471+ @172
246 172+1010562 jmp .4466   ;-->>
247 173  =4466 
248 4466  ;W4466:
249 4466  .4466:; 
250 4466 0400034 sto CodePtr   ; @4466
251 4466+0160050 bus TConTop   ; @4466+
252 4467  ;W4467:
253 4467  ;.4467:
254 4467 1020255 jn loadit.2   ; @4467
255 4467+0600262 lod W178   ;=< ***:00 W172> @4467+
256 4468  ;W4468:
257 4468  ;.4468:
258 4468 0400040 sto Link1   ; @4468
259 4468+1100317 jmp L207P   ; @4468+
260 4469  =173 
261 173  ;
262 173  ; from 190, 272, 328, 4467
263 173  .2:; 
264 173   calln ,   ;recursive call @173
264+1173 7300155100226 lnk Link1a:jmp loadit.1 
265 174 1100266 jmp .182P   ;direct return, set B-mod @174
266 174+ ; ;skip return
267 174+ ; from 257, 296+, 303
268 174+ .3:; 
269 174+0400035 sto LodWk2   ;save instruction temp @174+
270 175 0600065 lod TopBit   ;=04000000000000
271 175+0700034 las CodePtr   ;bump load address
272 176 1020263 jn .4   ;-> @176
273 176+1000277 jmp .5   ;->jump to patch
274 177  =191 
275 191  .5:;patch moved in-line 
276 191 0160050 bus TConTop   ;check for overlap @191
277 191+1000356 jmp .238   ;secondary patch?
278 192  =238 
279 238  .238:; 
280 238   clo     ;clr oflo @238
280+1238 1160356 jo .1    
280+2238+ .1:; 
281 238+1020360 jn .240   ;belated test, skip if no overlap
282 239   call     ;relocate constant area
282+1239 7300201000321 lnk MvCons.lnk:jmp MvCons.ent 
283 240  .240:; 
284 240 0600035 lod LodWk2   ;re-load instruction @240
285 240+1000261 jmp .177   ;re-join main line
286 241  ;
287 241  =177 
288 177  .177:; 
289 177 0000162400000 o00 CodePtr/sto 0;store in program @177
290 178 1000255W178:jmp .2   ;->
291 178+0000254 o00 .172   ; in-line constant
292 179  ;
293 179  ; from 176
294 179  .4:; 
295 179 0040000 o02 0   ;=1
296 179+0560034 o27 CodePtr   ;next full word
297 180 0600035 lod LodWk2   ;reload instruction @180
298 180+1320024 sll 20   ;
299 181 0000162500001 o00 CodePtr/ads 1;add to program
300 182 1000255 jmp .2   ;-> @182
301 182+ ;
302 182+ ;
303 182+0600067.182P:lod BBit   ;00 0/00 0 - B-modifier bit
304 183 0000162500000 o00 CodePtr/ads 0;add to program
305 184 1000255 jmp .2   ;-> @184
306 184+ ;
307 184+ ; type 18 entry, set base address in display
308 184+ .sw18:; 
309 184+0600064 lod K8   ;
310 185   call     ;get 8-bit data, base id
310+1185 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
311 186 0100042 add DispBase   ;display base @186
312 186+0400043 sto LodWk3   ;temp display ptr
313 187   calln ,   ;recursive call
313+1187 7300155100226 lnk Link1a:jmp loadit.1 
314 188 1000513 jmp .err   ; @188
315 188+  nop     ;
315+1188+1000275 jmp .1    
315+2189  .1:; 
316 189 0000216400000 o00 LodWk3/sto 0;store in display area
317 190 1000255 jmp .2   ; @190
318 190+ ;
319 190+0000000 o00 0   ;
320 191  ;
321 191  =254 
322 254  ; type 9 entry
323 254  .sw9:; 
324 254 0600034 lod CodePtr   ; @254
325 254+1120377 jn L255P   ;
326 255 0100066 add W54   ;=03777777700001
327 255+ L255P:; 
328 255+0100100 add JmpJmp   ;=
329 256 0000152177777 o00 PatchLP/exa -1;swap with patch list entry
330 257 1100256 jmp .3   ;
331 257+ ;
332 257+ ; type 2 entry
333 257+ .sw2:; 
334 257+0600060 lod K3b   ; @257+
335 258  ; from 265+
336 258  .6:; 
337 258 0400045 sto LodWk4   ;save reloc id size @258
338 258+0600073 lod K19a   ;=19
339 259   call     ; @259
339+1259 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
340 260 0200045 exa LodWk4   ;save instn, get reloc id size
341 260+  nop     ;
341+1260+1000405 jmp .1    
341+2261  .1:; 
342 261  ; from 287
343 261  .7:; 
344 261   call     ;get reloc id @261
344+1261 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
345 262 0100042 add DispBase   ;add display base address
346 262+0200045 exa LodWk4   ;store reloc base, load instn
347 263 0000226100000 o00 LodWk4/add 0;add reloc to instn
348 264  ;
349 264  ;; type 8 entry, exit recursive call with skip
350 264  ;
351 264  .sw8:; 
352 264 0000157100001 o00 Link1a/jmp 1#;return+half @264
353 265  ;
354 265  ; type 19 entry
355 265  ;
356 265  .sw19:; 
357 265 0600064 lod K8   ; @265
358 265+1000402 jmp .6   ;->
359 266  ;
360 266  ; type 25 entry, exit recursive call without skip
361 266  ;
362 266  .sw25:; 
363 266 0000157000001 o00 Link1a/jmp 1;return direct @266
364 267  ;
365 267  ; type 12 entry, add a jump to the switch list, sequence to define address
366 267  ; for jump to *
367 267  ;
368 267  .sw12:; 
369 267   calln ,   ;recursive call @267
369+1267 7300155100226 lnk Link1a:jmp loadit.1 
370 268 1000513 jmp .err   ;direct return @268
371 268+0400027 sto opcd   ;skip return, store address
372 269 0600034 lod CodePtr   ;get current code address
373 269+1120416 jn .sw12a   ;
374 270 0100066 add W54   ;=03777777700001 @270
375 270+ .270P:; 
376 270+ .sw12a:; 
377 270+0100100 add JmpJmp   ;= convert to jump
378 271 0000136400000 o00 opcd/sto 0;store at address
379 272 1000255 jmp .2   ;back for next @272
380 272+ ;
381 272+ ; type 4 entry, large absolute instruction (6+13) bits
382 272+ ;
383 272+ .sw4:; 
384 272+0600073 lod K19a   ;=19
385 273   call     ;read instruction (19 bits)
385+1273 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
386 274 1000410 jmp .sw8   ;and store it. @274
387 274+ ;
388 274+ ; type 3 entry, small absolute instruction (6+5) bits
389 274+ ;
390 274+ .sw3:; 
391 274+0600076 lod K11a   ;=11, size of instn
392 275   call     ;
392+1275 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
393 276 0400045 sto LodWk4   ;save combined instn/address @276
394 276+0060077 and K31a   ;=31, mask off address
395 277 0360045 o17 LodWk4   ;store address, load opcode
396 277+1320010 sll 8   ;align
397 278 0100045 add LodWk4   ;add address @278
398 278+1000410 jmp .sw8   ;->return instn
399 279  ;
400 279  ; type 10 entry, build jump to *, push onto patch list
401 279  ;
402 279  .sw10:; 
403 279 0600034 lod CodePtr   ; @279
404 279+1120430 jn .8   ;
405 280 0100066 add W54   ;=03777777700001 @280
406 280+ .8:; 
407 280+0100100 add JmpJmp   ;=
408 281 2200152377777 inc PatchLP/sto -1;add to patch list
409 282 1100226 jmp .1   ; @282
410 282+ ;
411 282+ ; type 1 entry, small instruction, 6 bits opcode, 5 bits address, 3 bit reloc
412 282+ ;
413 282+ .sw1:; 
414 282+0600076 lod K11a   ;=11 @282+
415 283   call     ;get combined opcode/address
415+1283 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
416 284 0400045 sto LodWk4   ;temp save
417 284+0060077 and K31a   ;=31, mask out address
418 285 0360045 o17 LodWk4   ;store address, load opcode
419 285+1320010 sll 8   ;align
420 286 0500045 ads LodWk4   ;add to address
421 286+0600060 lod K3b   ;size of reloc
422 287 1000405 jmp .7   ;->join with type 19
423 287+ ;
424 287+ ; type 24 entry, instruction ref, 6-bit opcode, two (or 3 if B-mod)
425 287+ ; sequences for the instuctions, store full word in const table
426 287+ ;
427 287+ .sw24:; 
428 287+0040056 o02 K5c   ;=5+1=>6 @287+
429 288   call     ;get opcode bits
429+1288 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
430 289 1320015 sll 13   ;align
431 289+0400035 sto LodWk2   ;temp save opcode
432 290   calln ,   ; recursive call, read F2N2 @290
432+1290 7300155100226 lnk Link1a:jmp loadit.1 
433 291 1000466 jmp .310   ;direct return
434 291+0400043 sto LodWk3   ;skip return, temp save F2N2
435 292  .292:; 
436 292   calln ,   ;recursive call, read F1N1 @292
436+1292 7300155100226 lnk Link1a:jmp loadit.1 
437 293 1000466 jmp .310   ;direct return
438 293+1320024 sll 20   ;skip return
439 294 0100043 add LodWk3   ;add in F2N2 @294
440 294+0000000 o00 0   ;
441 295   call     ;add to constant table
441+1295 7300205000301 lnk StoreConst.lnk:jmp StoreConst.ent 
442 296 0100035 add LodWk2   ;add opcode @296
443 296+1100256 jmp .3   ;store in program
444 297  ;
445 297  ; type 7 entry, cond jump, dont pop patch list. 2-bit modifier
446 297  ;
447 297  .sw7:; 
448 297 0000152577777 o00 PatchLP/lod -1;get current patch list entry
449 298 1000454 jmp .9   ;then join with type 6 @298
450 298+ ;
451 298+ ; type 6 entry, cond jump, pop patch list. 2-bit modifier.
452 298+ ;
453 298+ .sw6:; 
454 298+0040000 o02 0   ;=1
455 299 2700152600000 o27 PatchLP/lod 0;pop patch list
456 300  .9:; 
457 300 0400045 sto LodWk4   ;save jump @300
458 300+0040057 o02 K1a   ;=1+1=>2
459 301   call     ;get two bit modifier
459+1301 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
460 302 1320015 sll 13   ;shift to place @302
461 302+0100045 add LodWk4   ;and modify the jump
462 303 1100256 jmp .3   ;store jump in program
463 303+ ;
464 303+ ; type 5 entry, constant ref, 6 bits opcode, 39 bits constant
465 303+ .sw5:; 
466 303+0040056 o02 K5c   ;=5+1=>6 bits opcode
467 304   call     ;get opcode @304
467+1304 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
468 305 1320015 sll 13   ;align
469 305+0400045 sto LodWk4   ;temp save
470 306 0600063 lod K39a   ;=39, full word size @306
471 306+  nop     ;
471+1306+1000463 jmp .1    
471+2307  .1:; 
472 307   call     ;get the constant value
472+1307 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
473 308   call     ;store in constant area @308
473+1308 7300205000301 lnk StoreConst.lnk:jmp StoreConst.ent 
474 309 0100045 add LodWk4   ;add returned address to opcode
475 309+1000410 jmp .sw8   ;and store instruction
476 310  ;
477 310  ; B-modifier from Instruction ref
478 310  ;
479 310  .310:; 
480 310 0600067 lod BBit   ;00 0/00 0 @310
481 310+0500043 ads LodWk3   ;add B-bit to saved F2N2
482 311 1000444 jmp .292   ;and rejoin code
483 311+ ;
484 311+ ; type 11 entry, list of fullword constants (array dope vectors)
485 311+ ;
486 311+ .sw11:; 
487 311+0600064 lod K8   ;=8, size for count
488 312   call     ;get count @312
488+1312 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
489 313 0420045 stn LodWk4   ;save counter (negated)
490 313+ .10:; 
491 313+0640045 lis LodWk4   ;load and increment counter @313+
492 314 1140226 jz .1   ;finished->
493 314+0600063 lod K39a   ;=39
494 315   call     ;get next constant (39 bits)
494+1315 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
495 316   call     ;store in constant table (ignore dups)
495+1316 7300205000300 lnk StoreConstF.lnk:jmp StoreConstF.ent 
496 317 1100471 jmp .10   ;and loop
497 317+ ;
498 317+ ; type 23 entry, table reference, 6-bit opcode argument
499 317+ ;
500 317+ .sw23:; 
501 317+0040056 o02 K5c   ;=5+1=>6 @317+
502 318   call     ;get 6-bit opcode
502+1318 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
503 319 1320015 sll 13   ;align
504 319+0400045 sto LodWk4   ;save it
505 320 0040037 o02 conlim   ;get current constant pointer
506 320+0000000 o00 0   ;
507 321   call     ;store in constant table
507+1321 7300205000301 lnk StoreConst.lnk:jmp StoreConst.ent 
508 322 0100045 add LodWk4   ;add returned address to opcode
509 322+1000410 jmp .sw8   ; and store it
510 323  ;
511 323  ; type 26 entry, patch a full word, followed by address and value sequences
512 323  ;
513 323  .sw26:; 
514 323   calln ,   ;recursive call, get address @323
514+1323 7300155100226 lnk Link1a:jmp loadit.1 
515 324 1000513 jmp .err   ;direct return, error @324
516 324+0400035 sto LodWk2   ;skip return, save address
517 325   calln ,   ;recursive call, get value
517+1325 7300155100226 lnk Link1a:jmp loadit.1 
518 326 1000513 jmp .err   ;direct return, error @326
519 326+  nop     ;skip return,
519+1326+1000507 jmp .1    
519+2327  .1:; 
520 327 0000166400000 o00 LodWk2/sto 0;save value at address @327
521 328 1000255 jmp .2   ;back for next entry
522 328+ ;
523 328+ ; type 22 entry, sumcheck value for following segment
524 328+ .sw22:; 
525 328+0600063 lod K39a   ;=39 @328+
526 329   call     ; get value
526+1329 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
527 330 0400031 sto sumck   ; store sumcheck value
528 330+1100226 jmp .1   ;back for more
529 331  ;
530 331  ; error, invalid opcode in ocode
531 331  ;
532 331 1700001.err:otp 1   ;loop outputting 1 @331
533 331+1000513 jmp .err    
534 332  ;
535 332  ; type 13 entry, test sumcheck (should be zero)
536 332  ;
537 332 0600031.sw13:lod sumck   ;test sumcheck @332
538 332+1140226 jz .1   ;OK, continue
539 333  ;
540 333  ; error loading ocode, sumcheck failure
541 333 1700002._err2:otp 2   ;loop outputting 2 @333
542 333+1000515 jmp ._err2   ;
543 334  ;
544 334  ; type 15 entry, end of program, set up for program entry
545 334  .sw15:; 
546 334 0040036 o02 contop   ;program starts here @334
547 334+0100075 add EP6SK   ;=<40 _TAPE2+8:40 0>
548 335 0400006 sto EP6   ; ep for program restart @335
549 335+0040060 o02 K3b   ;=3+1=>4
550 336 0400075W336:sto _TAPE2+61   ; modified by 4054 @336
551 336+1060521 jo .11   ;clear oflo
552 337 1100535.11:jmp .18   ;jump to patch @337
553 337+ ; patch moved in-line
554 337+ =349+ 
555 349+ .18:; 
556 349+0600541 lod W353   ;set up print device @349+
557 350 0400077W350:sto _TAPE2+63   ; @350
558 350+0600540 lod W352   ;and print format
559 351 0400076W351:sto _TAPE2+62   ; @351
560 351+1100521 jmp .12   ;resume original sequence
561 352  ;
562 352 0000004000000W352:00 1:00 0; @352
563 353 0000000014000W353:00 0:00 TP; @353
564 354  ;
565 354  =337+ 
566 337+ .12:; 
567 337+0600101 lod fsmsgp   ;'free store ' @337+
568 338 7300005100012W338:lnk _TAPE2+1:jmp _TAPE2+10#;modified by L4057 to...@338
569 339  ; ;..call OutStr in tape2
570 339 1714033 otp TP+FS   ; @339
571 339+1714006 otp TP+'='   ;
572 340 0600072W340:lod LoMeM   ;
573 340+0400031 sto _TAPE2+25   ; arg1, tape2 base + 25
574 341 7300005100022W341:lnk _TAPE2+1:o44 _TAPE2+18;modified by tape2 base @341
575 342  ; ;call OutInt in tape2
576 342  ; no refs
577 342 1714015 otp TP+'-'   ; @342
578 342+0600037 lod conlim   ;
579 343 0400033W343:sto _TAPE2+27   ;arg1, modified by tape2 base @343
580 343+0000000 o00 0   ;
581 344 7300005100022W344:lnk _TAPE2+1:o44 _TAPE2+18;modified for tape2 @344
582 345  ; ;call OutInt in tape2
583 345  ;
584 345  ; now output some linefeeds
585 345  ;
586 345 0600070 lod K12a   ;=12
587 345+0420033 stn Link1a   ;
588 346  .13:; 
589 346 1714036 otp TP+LF   ;output 12 LF's in loop @346
590 346+0640033 lis Link1a   ;
591 347 1020532 jn .13   ;
592 347+ ;
593 347+1714035 otp TP+CR   ;6K+CR
594 348  ;
595 348 7300005000035W348:lnk _TAPE2+1:jmp _TAPE2+29;modified for tape2 @348
596 349  ; ;call DWait in tape2
597 349 1000006 jmp EP6   ;enter program
598 349+ ;
599 349+ =354 
600 354  ;
601 354  ; type 17 entry, two 12-bit data: code size, data size,
602 354  ; 2 8-bit data: display size, patch list size
603 354  ; the compiler loader uses the same area for variables and
604 354  ; the display/patch list area to avoid overwriting compiler
605 354  ; (although the program can do so while running).
606 354  ; The Tape2 loader (only used when loading ocode tapes)
607 354  ; keeps the areas separate, putting the display/patch list
608 354  ; in low memory
609 354  ;
610 354  .sw17:; 
611 354 0000000 o00 0   ; @354
612 354+0040070 o02 K12a   ;=12
613 355   call     ;get code size
613+1355 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
614 356 0400043 sto LodWk3   ;temp save @356
615 356+0040070 o02 K12a   ;=12
616 357   call     ;get vars size
616+1357 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
617 358 0400045 sto LodWk4   ;temp save @358
618 358+0600064 lod K8   ;=8
619 359   call     ;get display size
619+1359 7300205000160 lnk getchunk.lnk:jmp getchunk.ent 
620 360 0400032 sto PatchLP   ;start of patch list @360
621 360+0600064 lod K8   ;=8
622 361   call     ;patch list size
622+1361 7300205000573 lnk getchunka.lnk:jmp getchunka.ent 
623 362 0100032 add PatchLP   ;add display size @362
624 362+0120045 sub LodWk4   ;compare with variables size
625 363 1120554 jn .14   ;less, use variable size
626 363+0100045 add LodWk4   ;restore combined size
627 364 1000555 jmp .15   ;and use that @364
628 364+ ;
629 364+ ; from 363
630 364+ .14:; 
631 364+0600045 lod LodWk4   ;load vars size
632 365  ; from 364
633 365  .15:; 
634 365 0160013 bus Memtop   ;subtract from top of memory @365
635 365+0500032 ads PatchLP   ;add base address in to patch list base
636 366 0400042 sto DispBase   ;store as display base address
637 366+0040000 o02 0   ;=1
638 367 3700212400002 o37 DispBase/sto 2;store vars base in display[2]
639 368 0120043 sub LodWk3   ;(temp) code size @368
640 368+  nop     ;
640+1368+1000561 jmp .1    
640+2369  .1:; 
641 369 0000212400001 o00 DispBase/sto 1;store code base in display[1]
642 370 0120057 sub K1a   ;=1 @370
643 370+0400036 sto contop   ;top of constant area
644 371 0400037 sto conlim   ;bottom of constant area
645 371+0600012 lod T2VEC   ;address of tape2 relocation base
646 372 0000212400004 o00 DispBase/sto 4;store in display[4] @372
647 373 0040036 o02 contop   ;
648 373+0160046 bus OcdRdP   ;
649 374 0100060 add K3b   ;=3
650 374+1020572 jn .17   ;->
651 375 0040046 o02 OcdRdP   ; @375
652 375+0100060 add K3b   ;
653 376  ; from 378+
654 376  .16:; 
655 376 2000242540000 sto TConTop/cls 0; @376
656 377 0400051 sto TConLim   ;
657 377+1100226 jmp .1   ;loop back to 150
658 378  ;
659 378  ; from 374+
660 378  .17:; 
661 378 0600036 lod contop   ; @378
662 378+1000570 jmp .16   ;->
663 379  ;---------------------------------------------------------
664 379  =192 
665 192  ;-----------------------------------------------------------
666 192  ;
667 192  StoreConst::; 
668 192  ;
669 192  ; StoreConstF: add full-word constant to constant table. With this
670 192  ; entry, the search is bypassed as the values must
671 192  ; be in order stored
672 192  ;
673 192  StoreConstF.ent:; 
674 192 0400027 sto opcd   ;temp save value @192
675 192+1000307 jmp .2   ;
676 193  ;
677 193  ; StoreConst: add full-word constant to constant table. With normal
678 193  ; entry, search table for duplicates to save space
679 193  ;
680 193  StoreConst.ent:; 
681 193 0400027 sto opcd   ;temp save value @193
682 193+0600050 lod TConTop   ;present top of constant area
683 194 0120057 sub K1a   ;=1
684 194+0400030 sto ocdwk   ;set search pointer
685 195  ; from 198+
686 195  .1:; 
687 195 0000142600001 o00 ocdwk/lod 1;get entry from table @195
688 196 0120027 sub opcd   ;compare to new value @196
689 196+1040314 jz .4   ;->equal, return this address
690 197 0040000 o02 0   ;=1
691 197+0760030 o37 ocdwk   ;decrement pointer
692 198 0160051 bus TConLim   ;check for lower limit @198
693 198+1020303 jn .1   ;->continue if not finished
694 199  ;
695 199  ; entry not found (or not looked for), add to table
696 199  ;
697 199  .2:; 
698 199 0040000 o02 0   ;=1 @199
699 199+0560037 o27 conlim   ;decrement table limit
700 200 0760051 o37 TConLim   ;fetch and decrement TConLim
701 200+0160046 bus OcdRdP   ;overlap with Ocode area
702 201 1040340 jz L224   ;->see if we can move things @201
703 201+ L201P:; 
704 201+ .3:; 
705 201+0600027 lod opcd   ;get value to be stored
706 202 0000246400001 o00 TConLim/sto 1;store in table @202
707 203 0040037 o02 conlim   ;load pointer for...
708 203+1000316 jmp .ret   ;...return to caller
709 204  ;
710 204  ; from 196+
711 204  .4:; 
712 204 0040030 o02 ocdwk   ;get pointer
713 204+0160050 bus TConTop   ;relative to current area
714 205 0160036 bus contop   ;make relative to final area
715 205+  nop     ;and then...
715+1205+1000316 jmp .1    
715+2206  .1:; 
716 206  .ret:; 
717 206   ret     ;... return to caller @206
717+1206 0000207000001 o00 StoreConst.lnk/jmp 1 
718 207  ;-------------------------------------------------------------------
719 207  ;
720 207  ; complicated fiddle here:
721 207  ; call L241, then jump in to store result (without lookup)
722 207  ;
723 207  =207 
724 207  L207:; 
725 207  .207:; 
726 207 1660040 lnk Link1   ; @207
727 207+ L207P:; 
728 207+ .207P:; 
729 207+1000361 jmp L241   ;
730 208 1100311 jmp StoreConst.3   ; @208
731 208+ ;
732 208+  pad     ; @208+
732+1208+0000000 00 0    
733 209  ;-------------------------------------------------------------------

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