Elliott 803 Algol 60 Compiler (reconstructed)

File: strio.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape2/strio.t2
2 0  ;---------------
3 0  ; OutString(a, n)
4 0  ; output string stored in array a, starting at index n (call by name)
5 0  ;
6 0  StringInOut::; 
7 0  =7241 
8 7241 0000000000000 +0; @7241
9 7242 0000000000000 +0; @7242
10 7243 0000000000000 +0; @7243
11 7244 0000000000000.ptrn:+0; @7244
12 7245 0000000000000.work1:+0; @7245
13 7246 0000000000000.array:+0; @7246
14 7247 0000000000000.link1:+0;return address for readchar @7247
15 7248  .wdslft:; 
16 7248 0000000000000 +0;space left in array @7248
17 7249 0000000000000.inflg:+0;inner string flag @7249
18 7250 0000000000000.chcnt:+0;count of chars in pword @7250
19 7251 0000000000000.pword:+0;packed character word @7251
20 7252   ; 
21 7252  =7590 
22 7590  OutString:; 
23 7590 0600016 lod arg1   ; @7590
24 7590+0416116 sto .array   ;array address
25 7591 0000077660000 o00 arg2/lnk 0;call thunk for n @7591
26 7592 1000017 jmp arg2   ; @7592
27 7592+0416114 sto .ptrn   ;store address of n
28 7593 0000072577777 o00 arg1/lod -1;array dope vector address @7593
29 7594 2000022600001 sto 4/lod 1;load lower bound @7594
30 7595 0070462160000 o00 .ptrn/bus 0;subtract from index @7595
31 7596 1120011 jn SubOflo   ;index too low @7596
32 7596+0516116 ads .array   ;add to base
33 7597 0000022120002 o00 4/sub 2;check range @7597
34 7598 1036657 jn .OS1   ;ok, skip @7598
35 7598+1100011 jmp SubOflo   ;index too high
36 7599  ;
37 7599  .OS1:; 
38 7599 0070472600000 o00 .array/lod 0;load first word of string @7599
39 7600 1136662 jn .OS2   ;negative, last word @7600
40 7600+0075163 and W6771   ;=02000000000000
41 7601 1156662 jz .OS2   ;OK, @7601
42 7601+0616574 lod Msg15   ;'STRING ERROR'
43 7602 1016673 jmp .err   ;report error @7602
44 7602+ ;
45 7602+ .OS2:; 
46 7602+0600015 lod Link1   ;save linkage over call to OutStr
47 7603 0416115 sto .work1   ; @7603
48 7603+0616116 lod .array   ;get address of string
49 7604   calln ,   ;output to punch/printer @7604
49+17604 7300005100012 lnk T2Link:jmp OutStr 
50 7605 0616115 lod .work1   ;restore return address @7605
51 7605+0400015 sto Link1   ;
52 7606 0616116 lod .array   ;get string address @7606
53 7606+ .OS3:; 
54 7606+0175121 bus W6737   ;subtract from address of final word+1
55 7607 0070462500000 o00 .ptrn/ads 0;add to index @7607
56 7608 2200136600000 inc stkpt/lod 0;tidy up call by name @7608
57 7609 0415127 sto DLink   ; @7609
58 7609+0540112 cls W6729   ;
59 7610 0540117 cls W6734   ; @7610
60 7610+1016043 jmp RetClr   ;and return
61 7611  ;
62 7611  ; report error
63 7611  ;
64 7611  .err:; 
65 7611  ;L7611:
66 7611 0400004 sto 4   ; @7611
67 7611+0540117 cls W6734   ;
68 7612 2200136600000 inc stkpt/lod 0; @7612
69 7613 0415127 sto DLink   ; @7613
70 7613+0540112 cls W6729   ;
71 7614 0600004 lod 4   ; @7614
72 7614+1016165 jmp outerror0   ;
73 7615  ;--------------------------------------------------------------------
74 7615  ; read char from current input tape and
75 7615  ; convert to 6-bit format
76 7615  ;
77 7615  ReadChar:; 
78 7615 0600127620000 cla indev/inp 0; @7615
79 7616 1056677 jz ReadChar   ;ignore blanks @7616
80 7616+0216115 exa .work1   ;
81 7617 0400004 sto 4   ; @7617
82 7617+0616115 lod .work1   ;
83 7618 0135144 sub W6756   ;=27 [FS] @7618
84 7618+1157002 jz .fs   ; handle figure shift
85 7619 0136223 sub K4   ;=4 =>[LS] @7619
86 7619+1057002 jz .ls   ; handle letter shift
87 7620 0600004 lod 4   ; @7620
88 7620+0216115 exa .work1   ;
89 7621 0116115 add .work1   ; @7621
90 7621+0416116 sto .array   ;
91 7622 0070477000001 o00 .link1/jmp 1; @7622
92 7623  =7682 
93 7682  .ls:; 
94 7682 0115150 add K32a   ;=32 @7682
95 7682+ .fs:; 
96 7682+0416115 sto .work1   ;store shift
97 7683 1016677 jmp ReadChar   ;and get next char @7683
98 7683+ ;
99 7683+0000000 o00 0   ;
100 7684  ;--------------------------------------------------------------------
101 7684  ; PackChar: add character to packed string
102 7684  ; current word in .pword, char count in .chcnt
103 7684  ;
104 7684  =7623 
105 7623  ;PackChar::
106 7623  PackChar:; 
107 7623 0656122 lis .chcnt   ;bump count, test @7623
108 7623+1156712 jz .full   ;zero, word full
109 7624 0616123 lod .pword   ;load word @7624
110 7624+1320006 sll 6   ;shift left
111 7625 0116116 add .array   ;and add character @7625
112 7625+0416123 sto .pword   ;store back
113 7626 1016677 jmp ReadChar   ;and get another word @7626
114 7626+ ;
115 7626+ ; word full, transfer into array
116 7626+ ;
117 7626+ .full:; 
118 7626+0616123 lod .pword   ;get word
119 7627 1056716 jz .skip   ;all zero, skip @7627
120 7627+0656120 lis .wdslft   ;bump words left count
121 7628 1140011 jz SubOflo   ;all gone, error @7628
122 7628+0756123 lzs .pword   ;get word
123 7629 2264506377777 inc W6737/sto -1;bump ptr, and store word @7629
124 7630  .skip:; 
125 7630 0055146 o02 W6758   ;=5+1=>6 @7630
126 7630+0436122 stn .chcnt   ;store char count
127 7631 1016707 jmp PackChar   ; @7631
128 7631+ ;--------------------------------------------------------------------
129 7631+ ; Instring(arr, n)
130 7631+ ; read string into arr at index given by n
131 7631+ ;
132 7631+ ;InString::
133 7631+ InString:; 
134 7631+0556123 cls .pword   ;
135 7632 0000077660000 o00 arg2/lnk 0; @7632
136 7633 1000017 jmp arg2   ;call thunk for n @7633
137 7633+0416114 sto .ptrn   ;store address for n
138 7634 0000072577777 o00 arg1/lod -1;load dope vector address @7634
139 7635 2000022600001 sto 4/lod 1;fetch lowbound(a,1) @7635
140 7636 0070462160000 o00 .ptrn/bus 0;subtract from n @7636
141 7637 1120011 jn SubOflo   ; @7637
142 7637+1016760 jmp .IS9   ;ok, search for start
143 7638  ;
144 7638  .IS1:; 
145 7638  ;L7638:
146 7638 0000022120002 o00 4/sub 2;get upper limit @7638
147 7639 0416120 sto .wdslft   ;save for checking @7639
148 7639+0556122 cls .chcnt   ;
149 7640 1036731 jn .IS2   ;ok, skip @7640
150 7640+1100011 jmp SubOflo   ;
151 7641  ;
152 7641  .IS2:; 
153 7641 0600025 lod indev   ;get reader number @7641
154 7641+1220013 srl 11   ;shift to normal place
155 7642 2000022740100 sto 4/lzs RdBuff;get buffered character @7642
156 7643 1676117 lnk .link1   ;set retn address for readchar @7643
157 7643+1676121 lnk .inflg   ;
158 7644 0416115 sto .work1   ;save character @7644
159 7644+1056677 jz ReadChar   ;zero, buffer empty, read next
160 7645 0075150 and K32a   ;=32 @7645
161 7645+0216115 exa .work1   ;save shift, load char
162 7646 0175152 bus W6762   ;=26 @7646
163 7646+1036677 jn ReadChar   ;ignore layout, letters
164 7647 0136214 sub K13   ;=13 @7647
165 7647+1016762 jmp .IS10   ;
166 7648  ;
167 7648  ; found digit, +,-,.,@
168 7648  ;
169 7648  .ISerr:; 
170 7648 0616575 lod Msg16   ;'READ ERROR' @7648
171 7648+1016673 jmp .err   ;
172 7649  ;
173 7649  ; found the # character
174 7649  ;
175 7649  .IS3:; 
176 7649   calln ,   ; @7649
176+17649 7370475016677 lnk StringInOut.link1:jmp ReadChar 
177 7650 0135152 sub W6762   ;=26 '#' inner string @7650
178 7650+1156744 jz .IS4   ;->note and check
179 7651 0136231 sub N6   ;=-6 '?' end string @7651
180 7651+1156746 jz .IS5   ;->note and check
181 7652 1016707 jmp PackChar   ;pack and continue @7652
182 7652+ ;
183 7652+ ; note inner string
184 7652+ ;
185 7652+ .IS4:; 
186 7652+0756121 lzs .inflg   ;test flag and clear
187 7653 1056740 jz .ISerr   ;already insidr inner string @7653
188 7653+0615140 lod W6752   ;=63 (special inner string mark)
189 7654 1017001 jmp .IS11   ;pack it @7654
190 7654+ ;
191 7654+ ; closing quote, check outer/inner
192 7654+ ;
193 7654+ .IS5:; 
194 7654+0656121 lis .inflg   ;get marker (and set)
195 7655 1056750 jz .IS6   ;inside inner string @7655
196 7655+1016751 jmp .IS7   ;end of outer string
197 7656  ;
198 7656  ; end of inner string
199 7656  ;
200 7656  .IS6:; 
201 7656 0615144 lod W6756   ;=27 end of inner string mark @7656
202 7656+1017001 jmp .IS11   ;pack it in
203 7657  ;
204 7657  ; end of outer string, tidy up and return
205 7657  ;
206 7657  .IS7:; 
207 7657 0656122 lis .chcnt   ;is word full? @7657
208 7657+1056754 jz .IS8   ;yes, skip
209 7658 0616123 lod .pword   ;load current word @7658
210 7658+1320006 sll 6   ;shift up 1 byte
211 7659 0416123 sto .pword   ;save @7659
212 7659+1016751 jmp .IS7   ;and try again
213 7660  ;
214 7660  ; current word now full
215 7660  ;
216 7660  .IS8:; 
217 7660 0656120 lis .wdslft   ;check room for last word @7660
218 7660+1140011 jz SubOflo   ;overflow if over the top
219 7661 0615142 lod TopBit   ;sign bit @7661
220 7661+0116123 add .pword   ;add to final word
221 7662 2264506377777 inc W6737/sto -1;store in array @7662
222 7663 0600016 lod arg1   ;get array address @7663
223 7663+1116666 jmp .OS3   ;join with outstring to update n
224 7664  ;
225 7664  ; initial setup continued
226 7664  ;
227 7664  .IS9:; 
228 7664 0300016 o14 arg1   ;add array base @7664
229 7664+0415121 sto W6737   ;save it
230 7665 0200016 exa arg1   ;swap @7665
231 7665+1016726 jmp .IS1   ;back for string
232 7666  ;
233 7666  ; check for errors prior to string start
234 7666  ;
235 7666  .IS10:; 
236 7666 2000023137001 sto 4/jn .SW+13#; @7666
237 7667 0000023016764 o00 4/jmp .SW; @7667
238 7668  ;
239 7668  .SW:; 
240 7668 4073601016741 jmp .ISerr:jmp .IS3;+13 - +26 # @7668
241 7669 4073375016740 jmp ReadChar:jmp .ISerr;+12 : +25 9 @7669
242 7670 4073601016740 jmp .ISerr:jmp .ISerr;+11 + +24 @ @7670
243 7671 4073375016677 jmp ReadChar:jmp ReadChar;+10 , +23 / @7671
244 7672 4073375016740 jmp ReadChar:jmp .ISerr;+09 ' +22 6 @7672
245 7673 4073601016740 jmp .ISerr:jmp .ISerr;+08 8 +21 5 @7673
246 7674 4073601016677 jmp .ISerr:jmp ReadChar;+07 7 +20 ? @7674
247 7675 4073375016740 jmp ReadChar:jmp .ISerr;+06 = +19 3 @7675
248 7676 4073375016677 jmp ReadChar:jmp ReadChar;+05 $ +18 ) @7676
249 7677 4073601016677 jmp .ISerr:jmp ReadChar;+04 4 +17 ( @7677
250 7678 4073375016740 jmp ReadChar:jmp .ISerr;+03 * +16 0 @7678
251 7679 4073601016677 jmp .ISerr:jmp ReadChar;+02 2 +15 % @7679
252 7680 4073601016740 jmp .ISerr:jmp .ISerr;+01 1 +14 . @7680
253 7681  ;
254 7681  ; store character and pack
255 7681  ;
256 7681  .IS11:; 
257 7681 0416116 sto .array   ; @7681
258 7681+1016707 jmp PackChar   ;
259 7682  ;

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