Elliott 803 Algol 60 Compiler (reconstructed)

File: packword.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape1.d/packword.t2
2 0  ;--------------------
3 0  =380 
4 380  ; get next char, multiple return via 387
5 380  ;
6 380  getchar::; 
7 380 0000000000000currchar:+0; @380
8 381 0000000000000ipshift:+0; 0/32 depending on shift
9 382 0000000000011ident:+9; @382
10 383 0000000000000decscale:+0;
11 384 0000000000010token:+8; @384
12 385 0000000000000 +0;
13 386 0000000000000incomment:+0; @386
14 387  =388 
15 388  ;
16 388  .ent:; 
17 388 0140000 cla 0   ;clear acc @388
18 388+ .0:; 
19 388+1620000 inp 0   ;input next character
20 389  getchara.ent:; 
21 389 2002763000615 sto currchar/jmp .sw;switch (modified below) @389
22 390  ;
23 390  ; letter shift, set modifier and switch
24 390  ;
25 390 0600614.ls:lod K32   ;=32 @390
26 390+0400575 sto ipshift   ;store modifier
27 391 0600613 lod .lsw   ;letters switch @391
28 391+ .1:; 
29 391+0400605 sto getchara.ent   ;modify switch instn
30 392 1000604 jmp .ent   ;back for next char @392
31 392+ ;
32 392+ ; figure shift, clear modifer, reset switch
33 392+ ;
34 392+0540575.fs:cls ipshift   ;modifier = 0
35 393 0600612 lod .fsw   ;figures switch @393
36 393+1100607 jmp .1   ;
37 394  ;
38 394  ; switch instructions for above
39 394  ;W394:
40 394 2002763000615.fsw:sto currchar/jmp .sw;for figures @394
41 395 2002763100615.lsw:sto currchar/jmp .sw#;for letters
42 396 0000000000040K32:+32;modifier for letters @396
43 397  ;
44 397  ; jump table - 32 entries, one per character
45 397  .sw:; 
46 397 4403021100604 jmp .0:jmp .0;null - back for more @397
47 398 4003275000655 jmp .d:jmp .l; 1 A
48 399 4003275000655 jmp .d:jmp .l; 2 B
49 400 4003271000655 jmp .p1:jmp .l; * C
50 401 4003275000655 jmp .d:jmp .l; 4 D
51 402 4042545000655 jmp .dol:jmp .l; $ E
52 403 4003271000655 jmp .p1:jmp .l; = F
53 404 4003275000655 jmp .d:jmp .l; 7 G
54 405 4003275000655 jmp .d:jmp .l; 8 H
55 406 4003305000655 jmp .p2:jmp .l; ' I
56 407 4003271000655 jmp .p1:jmp .l; , J
57 408 4003305000655 jmp .p2:jmp .l; + K
58 409 4003271000655 jmp .p1:jmp .l; : L
59 410 4003305000655 jmp .p2:jmp .l; - M
60 411 4403321000655 jmp .np:jmp .l; . N
61 412 4003271000655 jmp .p1:jmp .l; % O
62 413 4003275000655 jmp .d:jmp .l; 0 P
63 414 4003305000655 jmp .p2:jmp .l; ( Q
64 415 4003305000655 jmp .p2:jmp .l; ) R
65 416 4003275000655 jmp .d:jmp .l; 3 S
66 417 4003271000655 jmp .p1:jmp .l; ? T
67 418 4003275000655 jmp .d:jmp .l; 5 U
68 419 4003275000655 jmp .d:jmp .l; 6 V
69 420 4003271000655 jmp .p1:jmp .l; / W
70 421 4403321000655 jmp .np:jmp .l; @ X
71 422 4003275000655 jmp .d:jmp .l; 9 Y
72 423 4003305000655 jmp .p2:jmp .l; # Z
73 424 4403041100610 jmp .fs:jmp .fs; FS
74 425 4003311000662 jmp .lay:jmp .lay; SP
75 426 4003311000662 jmp .lay:jmp .lay; CR
76 427 4003311000662 jmp .lay:jmp .lay; LF
77 428 4003031000606 jmp .ls:jmp .ls; LS
78 429  ;
79 429  ; 387 contains return address
80 429  ;
81 429 0003017000001.l:o00 .lnk/jmp 1;letters ret1 @429
82 430 0003017100001.p1:o00 .lnk/jmp 1#; ; = , : % ? / ret1a @430
83 431 0003017000002.d:o00 .lnk/jmp 2;digits ret2 @431
84 432 0003017100002.nr:o00 .lnk/jmp 2#; @. ret2a @432
85 433 0003017000003.p2:o00 .lnk/jmp 3; ' + - ( ) £ ret3 @433
86 434 0003017100003.lay:o00 .lnk/jmp 3#; SP, CR, LF ret3a @434
87 435  ;-----patch moved inline
88 435  =4441 
89 4441  ; from switch 397[5] ; '$'
90 4441  .dol:; 
91 4441 0600603 lod .lnk   ; return address @4441
92 4441+0130533 sub .addr   ; check against call
93 4442 0062222 and K8191   ;=8191 ignore top end rubbish @4442
94 4442+1040655 jz .l   ; treat as for letters
95 4443 1000663 jmp .cont   ; pseudo-no-op @4443
96 4443+ ;
97 4443+0006771.addr:00 W3577   ; address used above
98 4444  ;
99 4444  =435 
100 435  ; from 4443 ($ patch)
101 435  .cont:; 
102 435   call     ; @435
102+1435 7304221001107 lnk L583.lnk:jmp L583.ent 
103 436 1000604 jmp .ent   ;re-enter get next char @436
104 436+ ;
105 436+ .np:; 
106 436+0600602 lod incomment   ; @ . scanning comment @436+
107 437 1040660 jz .nr   ;yes, -> @437
108 437+1000604 jmp .ent   ; @437+
109 438  ;
110 438  ;
111 438  =4465 
112 4465  getchar2.ent:; 
113 4465 0600574 lod currchar   ;get previous character @4465
114 4465+1000605 jmp getchara.ent   ;re-process character type
115 4466  ;--------------------------------------------------------------------
116 4466  =4525 
117 4525  .ipnorm:; 
118 4525 0600001620000 cla 0:inp 0; planted in getchar @4525
119 4526  .iptrace:; 
120 4526 0600001110657 cla 0:jmp .tracer; also planted in getchar @4526
121 4527   pad     ; above jumps to following:
121+14527 0000000 00 0    
122 4527+ ;
123 4527+ .tracer:; 
124 4527+1620000 inp 0   ; input next character
125 4528 2002763714000 sto currchar/otp TP; punch to tty @4528
126 4529 1000605 jmp getchara.ent   ; and back to getchar
127 4529+ ;
128 4529+ ;----------------------------------------------------------------------
129 4529+ ; ep=439 lnk=438 mult return?
130 4529+ ; pack up to 6 chars into word
131 4529+ ;
132 4529+ =439 
133 439  packword::; 
134 439  ;
135 439  .ent:; 
136 439 1100671 jmp .2   ;-> @439
137 439+ ;
138 439+ ; from 458+
139 439+ =441+ 
140 441+ .2:; 
141 441+0600574 lod currchar   ;get held char
142 442   call     ; @442
142+1442 7303015000605 lnk getchara.lnk:jmp getchara.ent 
143 443 1000712 jmp .id1   ; letters
144 443+1000700 jmp .pn1   ; ; = , : % ? /
145 444 1001110 jmp .number   ; digits @444
146 444+1001161 jmp .fpp   ; @. punctuation in reals
147 445 1000676 jmp .pn2   ; ' + - ( ) £
148 445+1000604 jmp getchar.ent   ;getchar: SP, CR, LF
149 446  ;
150 446  ; ; punct 2
151 446  .pn2:; 
152 446 0540574 cls currchar   ;clear curr char @446
153 446+0400576 sto ident   ;store in ident
154 447 0003333000003 00 .lnk/jmp 3; return+3 @447
155 448  ;
156 448  ; ; punct 1
157 448  .pn1:; 
158 448 0400576 sto ident   ;store in ident @448
159 448+  clo     ;clear oflo
159+1448+1060701 jo .1    
159+2449  .1:; 
160 449   call     ; @449
160+1449 7303015000604 lnk getchar.lnk:jmp getchar.ent 
161 450 1000710 jmp .op1   ;letter @450
162 450+1000705 jmp .op2   ;punct1
163 451 1000710 jmp .op1   ;digit @451
164 451+1000710 jmp .op1   ;@.
165 452 1000710 jmp .op1   ;punct2 @452
166 452+1000604 jmp getchar.ent   ;getchar: layout
167 453  ;
168 453  ; multi-char operator, pack up into ident
169 453  .op2:; 
170 453 0600576 lod ident   ;punct1+punct1, get ident @453
171 453+1320006 sll 6   ; shift left
172 454   clo     ;clear oflo @454
172+1454 1160706 jo .1    
172+2454+ .1:; 
173 454+0100574 add currchar   ;add new char
174 455 0400576 sto ident   ;store ident @455
175 455+1000604 jmp getchar.ent    
176 456  ;
177 456  ; multi-char followed by something else, return
178 456  .op1:; 
179 456 0600576 lod ident   ;letter,digit,???,punct2 @456
180 456+  pad     ; no-op
180+1456+0000000 00 0    
181 457 0003333100001 00 .lnk/jmp 1#; return +1+
182 458  ;
183 458  ; starting letter, pack identifier/keyword
184 458  .id1:; 
185 458 0100614 add K32   ;=32 - convert to 6-bit form @458
186 458+1100667 jmp .id2   ;-> store ident, clr oflo...
187 459  =439+ 
188 439+ .id2:; 
189 439+0400576 sto ident   ; store ident @439+
190 440 1060713 jo .id3   ;clear overflow
191 440+1000713 jmp .id3   ;->
192 441   pad     ; @441
192+1441 0000000 00 0    
193 441+ =459 
194 459  .id3:; 
195 459   call     ;get subsequent chars of ident @459
195+1459 7303015000604 lnk getchar.lnk:jmp getchar.ent 
196 460 1000717 jmp .id4   ;letter @460
197 460+1100722 o44 .id5   ;punct1
198 461 1000717 jmp .id4   ;digit @461
199 461+1100722 o44 .id5   ;@.
200 462 1100722 o44 .id5   ;punct2 @462
201 462+1100722 o44 .id5   ;layout
202 463  ;
203 463  ; letters or digits following letter - pack identifier/keyword
204 463  .id4:; 
205 463 0600576 lod ident   ;ident @463
206 463+1320006 sll 6   ;shift left for packing
207 464 1060604 jo getchar.ent   ; oflo -> getchar
208 464+0100574 add currchar   ;currchar
209 465 0100575 add ipshift   ;add shift
210 465+0400576 sto ident   ;store updated word
211 466 1000604 jmp getchar.ent   ;continue
212 466+ ;
213 466+ ; anything else terminates identifier
214 466+ .id5:; 
215 466+0600576 lod ident   ;pass packed word @466+
216 467 0003333000001 00 .lnk/jmp 1;return+1
217 468  =584 
218 584  ;
219 584  ; get digit in packword
220 584  ;
221 584  .number:; 
222 584 0541206 cls num   ;clear working variables @584
223 584+0541207 cls decptf   ;
224 585 0541210 cls expsign   ;
225 585+0541213 cls SPflg   ;
226 586 0540577 cls decscale   ;reset real scale @586
227 586+0041215 o02 K10   ;=10+1=>11
228 587 0421212 stn dct2   ;digitcount=-11
229 587+0601120 lod .big   ;large negative number
230 588 0401211 sto dct1   ;? @588
231 588+  clo     ;clr oflo
231+1588+1061115 jo .1    
231+2589  .1:; 
232 589 0600574 lod currchar   ;currchar
233 589+  pad     ;
233+1589+0000000 00 0    
234 590   call     ;re-classify current char
234+1590 7303015000605 lnk getchara.lnk:jmp getchara.ent 
235 591 1101122 jmp .term   ;letters @591
236 591+1101122 jmp .term   ;punct1
237 592 1001146.big:jmp .dig   ;digit @592
238 592+1101166 jmp .fpp2   ;@. modify to FP
239 593 1101122 jmp .term   ;punct2
240 593+0641213 lis SPflg   ;layout
241 594 1040604 jz getchar.ent   ;getchar not terminator @594
242 594+ ;
243 594+ ; terminate number
244 594+ ;
245 594+0601211.term:lod dct1   ; @594+
246 595 1021144 jn .fixpt   ;->no decimal point
247 595+1041205 jz _err01   ;->no digits after point
248 596  .term2:; 
249 596 0601212 lod dct2   ;digitct @596
250 596+1021145 jn .fltpt   ;->OK
251 597 0121211 sub dct1   ;digits after point
252 597+ .term3:; 
253 597+0500577 ads decscale   ;add to scale factor
254 598 0741206 lzs num   ;fetch num, and zero it @598
255 598+0400576 sto ident   ;store in ident
256 599 0601207 lod decptf   ;was there an '@'? @599
257 599+  jnn     ;no, finished
257+1599+1121130 jn .1    
257+2600 1001200 jmp packword.finish    
257+3600+ .1:; 
258 600+ .getexp:; 
259 600+0041216 o02 K2   ;=2+1=>3 @600+
260 601 0421212 stn dct2   ;-3=>digitct
261 601+0601120 lod .big   ;big negative number?
262 602 0401211 sto dct1   ;otherct @602
263 602+0541213 cls SPflg   ;
264 603   call     ;
264+1603 7303015000604 lnk getchar.lnk:jmp getchar.ent 
265 604 1101137 jmp .expt   ;letters @604
266 604+1101137 jmp .expt   ;punct1
267 605 1001146 jmp .dig   ;digit
268 605+1001205 jmp _err01   ;@.->error
269 606 1101172 jmp .expp   ;punct2 - may be + or -
270 606+0641213 lis SPflg   ;layout
271 607 1040604 jz getchar.ent   ; @607
272 607+ ;
273 607+ ; end of exponent
274 607+ .expt:; 
275 607+0601120 lod .big   ;big negative number
276 608 0121211 sub dct1   ;otherct @608
277 608+1041205 jz _err01   ;->error: no digits in exponent
278 609 0601210 lod expsign   ;expsign
279 609+1141142 jz .exp1   ;zero, positive exponent
280 610 0621206 lcs num   ;negate num @610
281 610+ .exp1:; 
282 610+0601206 lod num   ;fetch num
283 611 0500577 ads decscale   ;add to scale factor
284 611+1001201 jmp .ret2   ;
285 612  ;
286 612  ;integer number
287 612  ;
288 612  .fixpt:; 
289 612 0541211 cls dct1   ; @612
290 612+1001124 jmp .term2   ;
291 613  ;
292 613  ; real number
293 613  ;
294 613  .fltpt:; 
295 613 0221211 o11 dct1   ;
296 613+1101125 jmp .term3   ;
297 614  ;
298 614  ; digits come here
299 614 0441211.dig:inc dct1   ;increment ?? @614
300 614+0601206 lod num   ;num
301 615 1141157 jz .numz   ;->bypass if first digit
302 615+0641212 lis dct2   ;increment digitct
303 616 1021151 jn .digOK   ;->still negative, OK @616
304 616+1101155 jmp .dignext   ;too many digits, ignore
305 617  ;
306 617  .digOK:; 
307 617 0601217 lod K15   ;=15
308 617+0460574 ans currchar   ;currchar
309 618 0601206 lod num   ;num
310 618+0500574 ads currchar   ;\
311 619 0500574 ads currchar   ; \ @619
312 619+1320003 sll 3   ; \
313 620 0100574 add currchar   ; num;10+currchar @620
314 620+1161156 jo .oflow   ;test for overflow
315 621  ;
316 621  .numOK:; 
317 621 0401206 sto num   ;ok, store num
318 621+ .dignext:; 
319 621+0541213 cls SPflg   ;clear flag
320 622 1000604 jmp getchar.ent   ;getchar (previous return) @622
321 622+ ;
322 622+ .oflow:; 
323 622+0440577 inc decscale   ;set indicator
324 623 1101155 jmp .dignext   ;continue
325 623+ ;
326 623+ ; first non-zero digit (optimisation)
327 623+ ;
328 623+0600574.numz:lod currchar   ;currchar
329 624 0061217 and K15   ;=15 @624
330 624+1001155 jmp .numOK   ;-> store num
331 625  ;
332 625  ; @ or . read before digits
333 625  .fpp:; 
334 625 0040574 o02 currchar   ;currchar+1
335 625+0121217 sub K15   ;=15 ('.'+1)
336 626 1041110 jz .number   ;-> decimal point enter readnum @626
337 626+ ; @ before digits
338 626+0040000 o02 0   ;=1 @626+
339 627 0400576 sto ident   ;set exponent flag
340 627+0540577 cls decscale   ;clear scale factor
341 628 0421207 stn decptf   ;-1=>647 @628
342 628+0541206 cls num   ;0=>num
343 629 0541210 cls expsign   ;0=>expsign @629
344 629+  clo     ;clr oflo
344+1629+1061166 jo .1    
344+2630  .1:; 
345 630 1101130 jmp .getexp   ;-> @630
346 630+ ;
347 630+ ; @ or . in number
348 630+ ;
349 630+0040574.fpp2:o02 currchar   ;currchar+1
350 631 0121217 sub K15   ;=15 ('.'+1)
351 631+1041204 jz .decpt   ;-> decimal point
352 632 0421207 stn decptf   ;(should be 10: '@'-'.') @632
353 632+1101122 jmp .term   ;->back to process exponent
354 633  ;
355 633  .decpt1:; 
356 633 0201211 exa dct1   ;check for previous '.'
357 633+1121155 jn .dignext   ;->OK
358 634 1001205 jmp _err01   ;-> report error in number @634
359 634+ ;
360 634+ ; punct2 in exponent, possible sign
361 634+0601206.expp:lod num   ;digits in exponent?
362 635   jnz     ;yes, treat as terminator
362+1635 1041174 jz .1    
362+2635+1101137 jmp packword.expt    
362+3636  .1:; 
363 636 0600574 lod currchar   ;currchar @636
364 636+0121220 sub K13   ;=13 '-'
365 637 1041177 jz .expneg   ;negative exponent
366 637+0101216 add K2   ;=2 '+'
367 638 1141155 jz .dignext   ;positive @638
368 638+1101137 jmp .expt   ;otherwise terminator
369 639  ;
370 639  .expneg:; 
371 639 1661210 lnk expsign   ;set expsign non-zero
372 639+1101155 jmp .dignext   ;continue
373 640  ;
374 640  .finish:; 
375 640 0600577 lod decscale   ;get scale factor @640
376 640+1041202 jz .ret1   ;none set, check decptf
377 641  .ret2:; 
378 641 0003333100002 o00 .lnk/jmp 2#;return +2+, flpt number
379 642  ;-----------------
380 642  ;
381 642  .ret1:; 
382 642 0221207 o11 decptf   ;clear decptf, load prev value @642
383 642+1021201 jn .ret2   ;exponent seen, ret 2#
384 643 0003333000002 o00 .lnk/jmp 2;return +2, fixed pt number
385 644  ;-----------------
386 644  ;
387 644  ; decimal point in number
388 644  .decpt:; 
389 644 0441207 inc decptf   ;increment decpt flag @644
390 644+1001171 jmp .decpt1   ;->
391 645  ;-----------------
392 645  ; error in number, call error recovery
393 645  _err01:; 
394 645 1661044 lnk errlnk   ;error 1: number of impremissable form
395 645+1004772 jmp error2   ;
396 646  ;
397 646 0000000000000num:+0;number being produced @646
398 647 0000000000000decptf:+0;'.' count, <0 if exponent @647
399 648  expsign:; 
400 648 0000000000000 +0;expsign @648
401 649 7777777777765dct1:-11;otherct @649
402 650 7777777777765dct2:-11;digitct @650
403 651 0000000000000SPflg:+0;used to ignore single spaces @651
404 652 0000000000000 +0;no refs @652
405 653 0000000000012K10:+10 
406 654 0000000000002K2:+2 
407 655 0000000000017K15:+15 
408 656 0000000000015K13:+13 
409 657  ;
410 657  ;-------------------------------------------------------------------

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