Elliott 803 Algol 60 Compiler (reconstructed)

File: lookup.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape1.d/lookup.t2
2 0  ;------------------
3 0  ;
4 0  =504 
5 504  lookupkw::; 
6 504  ;
7 504  ; data for lookup routine
8 504 0000000000000.work1:+0; @504
9 505 0000000000002.work2:+2; @505
10 506 0000000000000.work3:+0; @506
11 507 0000000001234.kwtab:+kwtable-2; @507
12 508  .kwtabendp:; 
13 508 0000000001406 +kwtabend;774 ;kwtabend @508
14 509  ; list of negative increments for binary search
15 509  ; assume start address = 0
16 509  ; values must be even as entries are two words long
17 509  ;
18 509  .kwtabptrs:; 
19 509 7777777776456 -kwtable-52;starting point in table @509
20 510 7777777777746 -26;increments to above
21 511 7777777777762 -14 
22 512 7777777777772 -6 
23 513 7777777777774 -4 
24 514 7777777777776 -2 
25 515 0000000000000 +0; @515
26 516 0000000000000 +0; @516
27 517 0000000000000 +0; @517
28 518 0000000000000 +0; @518
29 519 0000000000000 +0; @519
30 520 0000000000000 +0; @520
31 521 0000000000000 +0; @521
32 522 0000000000000 +0; @522
33 523 0000000001242.ptr2:+674; @523
34 524 0000000000006.ptr1:+6; @524
35 525 0000000000576.work:+382; @525
36 526 0000000000000W526:+0; @526
37 527 0000000000001W527:+1; @527
38 528 0000000000000W528:+0; @528
39 529 0000000000011.word:+9; @529
40 530  ;
41 530  =469 
42 469 4004110000000dfltid:+04004110000000; default type @469
43 470  ;-------------------------------------------------------------------
44 470  ;
45 470  =470 
46 470  .ent:; 
47 470 0003522600001 o00 .lnk/lod 1; get parameter @470
48 471 2004066600000 sto .work/lod 0; get word to look up @471
49 472 0401021 sto .word   ; store word
50 472+1060731 jo .0   ; clr oflo
51 473  .0:; 
52 473 0541014 cls .ptr1   ; .ptr1=0
53 473+0541013 cls .ptr2   ; .ptr2=0
54 474  .3:; 
55 474 2204062600774 inc .ptr1/lod .kwtabptrs-1; fetch kwtabendp[++.ptr1] @474
56 475 1020740 jn .1   ; if < skip to 480
57 475+0601013 lod .ptr2   ;
58 476 0120774 sub .kwtabendp   ; table end pointer
59 476+1040737 jz .2   ; return +2
60 477  .5:; 
61 477 0600771 lod .work2   ;=2 @477
62 477+ .6:; 
63 477+0100725 add dfltid   ;=04004110000000 @477+
64 478  .10:; 
65 478 0101013 add .ptr2   ; table pointer @478
66 478+0120770 sub .work1    
67 479  .2:; 
68 479 0003523000002 o00 .lnk/jmp 2;return bypassing param @479
69 480  ;
70 480  .1:; 
71 480 2704056600000 o27 .ptr2/lod 0; subtract and fetch @480
72 481 0121021 sub .word   ; compare with word
73 481+1060755 jo .7   ; overflow?
74 482 1020732 jn .3   ; less than - move down
75 482+1040756 jz .8   ; equal got it
76 483  .9:; 
77 483 2204062600774 inc .ptr1/lod .kwtabptrs-1; try next pointer @483
78 484 1020747 jn .4   ; still negative? OK
79 484+0601013 lod .ptr2   ; table pointer
80 485 0120773 sub .kwtab   ; table start
81 485+1040735 jz .5   ;
82 486 0140000 cla 0   ; =0
83 486+1100735 jmp .6   ;
84 487  ;
85 487  .4:; 
86 487 2404056600000 ads .ptr2/lod 0; add to pointer and fetch @487
87 488 0121021 sub .word   ; compare with word
88 488+1060755 jo .7   ; oflo?
89 489 1020732 jn .3   ; back to earlier bit
90 489+1040756 jz .8   ; match - return
91 490 1000743 jmp .9   ; back for another go
92 490+ ;
93 490+ .11:; 
94 490+0601013 lod .ptr2   ; get table pointer @490+
95 491 0120773 sub .kwtab   ; less table start
96 491+1040735 jz .5   ; at start of table
97 492 0140000 cla 0   ; zero
98 492+1000736 jmp .10   ; finish
99 493  ;
100 493  .7:; 
101 493 1020743 jn .9   ; overflow - invert sign test @493
102 493+1000732 jmp .3   ; back into loop
103 494  ;
104 494  .8:; 
105 494 0600772 lod .work3   ; ? @494
106 494+1140752 jz .11   ; back if zero
107 495 0401020 sto W528   ;indicate continue not possible
108 495+0441020 inc W528   ;(assuming .work3 != -1)
109 496 0601013 lod .ptr2   ;
110 496+0401017 sto W527   ;
111 497 0601015 lod .work   ;
112 497+0401016 sto W526   ;
113 498  .13:; 
114 498 2204076600000 inc W527/lod 0; @498
115 499 2204072120000 inc W526/sub 0;
116 500 1060755 jo .7   ;
117 500+1020732 jn .3   ;
118 501 1040766 jz .12   ;
119 501+1000743 jmp .9   ;
120 502  ;
121 502  .12:; 
122 502 0641020 lis W528   ; @502
123 502+1020762 jn .13   ;
124 503 1100752 jmp .11   ;
125 503+ ;
126 503+0000000 o00 0   ; @503+
127 504  ;
128 504  =530 
129 530  ; no refs?
130 530  ;
131 530 0003522600001 o00 .lnk/lod 1; @530
132 531 2004066600003 sto .work/lod 3;
133 532 0420772 stn .work3   ;
134 532+0440772 inc .work3   ;
135 533 0004066600004 o00 .work/lod 4; @533
136 534 0400770 sto .work1   ;
137 534+0541014 cls .ptr1   ;
138 535 0004066600002 o00 .work/lod 2; @535
139 536 0400771 sto .work2   ;
140 536+0540774 cls .kwtabendp   ;
141 537 0004066600000 o00 .work/lod 0;
142 538  .538:; 
143 538 0401013 sto .ptr2   ; @538
144 538+ .538P:; 
145 538+0601013 lod .ptr2   ; @538+
146 539 1200001 sra 1   ;
147 539+0361013 o17 .ptr2   ;
148 540 1240771 mul .work2   ; @540
149 540+1360000 ara 0   ;
150 541 2204062420774 inc .ptr1/stn .kwtabendp;
151 542 0500774 ads .kwtabendp   ; @542
152 542+1141037 jz .543   ;
153 543 1101032 jmp .538P   ;
154 543+ ;
155 543+ .543:; 
156 543+0600770 lod .work1   ; @543+
157 544 0004066100001 o00 .work/add 1;
158 545 0120771 sub .work2   ;
159 545+0400773 sto .kwtab   ;
160 546 0500774 ads .kwtabendp   ; @546
161 546+0560775 o27 .kwtabptrs   ;
162 547 0003523000002 o00 .lnk/jmp 2;return, bypassing param
163 548  ;---------------------------------------------------------------

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