Elliott 803 Algol 60 Compiler (reconstructed)

File: read.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape2/read.t2
2 0  ;--------------
3 0  ; readreal - read real number, return value in Acc
4 0  ;
5 0  Read::; 
6 0  ;
7 0  ; local scratch variables, these locations are also used by other
8 0  ; routines
9 0  ;
10 0  =7241 
11 7241 0000000000000.temp:+0; used briefly as a temp @7241
12 7242 0000000000000.num:+0; number being assembled @7242
13 7243 0000000000000.work1:+0; @7243
14 7244  .numflg:; 
15 7244 0000000000000 +0; flag - number started @7244
16 7245  .expflg:; 
17 7245 0000000000000 +0; flag - exponent present @7245
18 7246  .negflg:; 
19 7246 0000000000000 +0; flag - negative sign read @7246
20 7247  .sigflg:; 
21 7247 0000000000000 +0; flag - set if sign or digit @7247
22 7248  .decptflg:; 
23 7248 0000000000000 +0; flag - set if dec pt read @7248
24 7249  .fracct:; count of fractional digits  @7249
25 7249 0000000000000.powlnk:+0; also used as link to Pow10
26 7250 0000000000000.type:+0; 0 = real, 1 = integer @7250
27 7251 0000000000000.work2:+0; @7251
28 7252 0000000000000.rdrno:+0; reader number (derived from indev)
29 7253  .work3:; alternative for ... 
30 7253 0000000000000.char:+0; holds current char or deriv @7253
31 7254 0000000000000.pwk1:+0; work used by Pow10 @7254
32 7255 0000000000000.pwk2:+0; ditto @7255
33 7256 0000000000000.digct:+0; digit count @7256
34 7257  =7716 
35 7716  ReadReal:; 
36 7716 0556122 cls .type   ;flag=0 @7716
37 7716+1017046 jmp .1   ;
38 7717  ;--------------------------------------------------------------------
39 7717  ; readint
40 7717  ReadInt:; 
41 7717 0556122 cls .type   ;flag=1 @7717
42 7717+0456122 inc .type   ;
43 7718  ;
44 7718  ; common read item code
45 7718  ;
46 7718  .1:; 
47 7718 0056213 o02 N8   ;=-8+1=>-7 @7718
48 7718+0416125 sto .work3   ;set count
49 7719  .2:; 
50 7719 3270526556120 lis .work3/cls .decptflg;clear 8 words 7241-48 @7719
51 7720 1037047 jn .2   ; @7720
52 7720+1117063 jmp .8   ;-->>
53 7721  =7731+ 
54 7731+ .8:;moved in-line 
55 7731+1060013 jo IntOflo   ;just in case?
56 7732 0600025 lod indev   ;get reader id @7732
57 7732+1220013 srl 11   ;shift right to index
58 7733 0416124 sto .rdrno   ;save for later @7733
59 7733+1117072 jmp .12   ;-->>
60 7734  =7738+ 
61 7738+ .12:; 
62 7738+0056211 o02 K10a   ;=10+1=>11
63 7739 0436130 stn .digct   ; @7739
64 7739+0617223 lod .SW   ;large negative number
65 7740 0416121 sto .fracct   ; @7740
66 7740+1017055 jmp .5   ;join loop
67 7741  ;
68 7741  =7721 
69 7721  ; read next char from tape
70 7721  .lp:; 
71 7721 0600127620000 cla indev/inp 0;read char @7721
72 7722 1057051 jz .lp   ;repeat while blanks @7722
73 7722+1017246 jmp .48   ;-->>
74 7723  =7846 
75 7846  .48:; 
76 7846 0070522200100 o00 .rdrno/exa RdBuff;swap with char in buffer @7846
77 7847 1017053 jmp .4   ;-->> @7847
78 7847+ =7723 
79 7723  .4:; 
80 7723 0076225 and K32   ;=32 mask shift bit @7723
81 7723+  nop     ;
81+17723+1017054 jmp .1    
81+27724  .1:; 
82 7724 0070522500100 o00 .rdrno/ads RdBuff;add shift to new char @7724
83 7725  .5:; 
84 7725 0070522600100 o00 .rdrno/lod RdBuff;load buffer(n) @7725
85 7726 0416125 sto .char   ;current char @7726
86 7726+0076225 and K32   ;=32 get shift
87 7727 1057066 jz .9   ;figure shift @7727
88 7727+0176125 bus .char   ;subtract shift from char
89 7728 0416125 sto .char   ;store amended char @7728
90 7728+0176215 bus K27   ;=27 - char'
91 7729 0116210 add N1   ;=-1 @7729
92 7729+1037067 jn .10   ;ok, do switch
93 7730  .ig:; 
94 7730   ; ignorable character, 
95 7730 0616114 lod .numflg   ;see if digits read in @7730
96 7730+ .7:; 
97 7730+1057051 jz .lp   ;back to get next char
98 7731 1017136 jmp .term   ;treat as terminator @7731
99 7731+ ;
100 7731+ =7734 
101 7734  .9:; 
102 7734 0616125 lod .char   ;char @7734
103 7734+0176220 bus K15a   ;=15-char
104 7735  .10:; 
105 7735 0070527137203 o00 .char/jn .SW#-16;switch on char @7735
106 7736 0670527017223 cla .char/jmp .SW; @7736
107 7737  ;
108 7737  ; figure shift comes here
109 7737  .fs:; 
110 7737 0070522540100 o00 .rdrno/cls RdBuff;clear shift in buffer @7737
111 7738 1017051 jmp .lp   ; @7738
112 7738+ ;
113 7738+ =7741 
114 7741  ; minus sign comes here
115 7741  .neg:; 
116 7741 0236117 o11 .sigflg   ; @7741
117 7741+1037136 jn .term   ;
118 7742 0456116 inc .negflg   ;set sign flag @7742
119 7742+ ; plus sign comes here
120 7742+ .pl:; 
121 7742+0456114 inc .numflg   ;
122 7743 0656117 lis .sigflg   ; @7743
123 7743+1117062 jmp .7   ;
124 7744  ;
125 7744  ; digits come here
126 7744  ;
127 7744  .dig:; 
128 7744 0456114 inc .numflg   ; @7744
129 7744+0456117 inc .sigflg   ;
130 7745 0456121 inc .fracct   ; @7745
131 7745+0616220 lod K15a   ;=15
132 7746 0476125 ans .char   ; @7746
133 7746+0616112 lod .num   ;
134 7747 1057112 jz .19   ; @7747
135 7747+0656130 lis .digct   ;
136 7748 1037105 jn .16   ; @7748
137 7748+1017051 jmp .lp   ;
138 7749  ;
139 7749  .16:; 
140 7749 0616112 lod .num   ;\ @7749
141 7749+0536125 sbs .char   ; \
142 7750 0516125 ads .char   ; >n:=10*n-c @7750
143 7750+1320003 sll 3   ; /
144 7751 0116125 add .char   ;/ @7751
145 7751+1077111 jo .18   ;check for overflow
146 7752  .17:; 
147 7752 0416112 sto .num   ;store result @7752
148 7752+1017051 jmp .lp   ;and continue scanning
149 7753  ;
150 7753  .18:; 
151 7753 0456130 inc .digct   ; @7753
152 7753+1017051 jmp .lp   ;
153 7754  ;
154 7754  .19:; 
155 7754 0236125 o11 .char   ;n:= -char @7754
156 7754+1017110 jmp .17   ;back to store and continue
157 7755  ;
158 7755  ; decimal point comes here
159 7755  .dot:; 
160 7755 0556121 cls .fracct   ; @7755
161 7755+0656120 lis .decptflg   ;test+set dec pt flg
162 7756 0116115 add .expflg   ; @7756
163 7756+1057051 jz .lp   ;
164 7757 1017171 jmp .error   ; @7757
165 7757+ ;
166 7757+ ; @ power-of-ten character comes here
167 7757+ .ten:; 
168 7757+0656115 lis .expflg   ;test+set exponent flag
169 7758 1057117 jz .22   ;OK @7758
170 7758+1017171 jmp .error   ;
171 7759  ;
172 7759  .22:; 
173 7759 0556117 cls .sigflg   ; @7759
174 7759+0756120 lzs .decptflg   ;load & clr dec pt flg
175 7760 1157131 jz .27   ;no decimal pt read @7760
176 7760+0616121 lod .fracct   ;check exponent flag
177 7761 1057171 jz .error   ; @7761
178 7761+ .23:; 
179 7761+0616130 lod .digct   ;
180 7762 1137130 jn .26   ; @7762
181 7762+0176121 bus .fracct   ;
182 7763  .24:; 
183 7763 0356123 stc .work2   ; @7763
184 7763+0236116 o11 .negflg   ;
185 7764 1037125 jn .25   ; @7764
186 7764+0636112 lcs .num   ;
187 7765  .25:; 
188 7765 0756112 lzs .num   ; @7765
189 7765+0416113 sto .work1   ;
190 7766 0056211 o02 K10a   ;=10+1=>11 @7766
191 7766+0436130 stn .digct   ;
192 7767 0617223 lod .SW   ;large negative number @7767
193 7767+0416121 sto .fracct   ;
194 7768 1017051 jmp .lp   ; @7768
195 7768+ ;
196 7768+ .26:; 
197 7768+0616121 lod .fracct   ;
198 7769 1017123 jmp .24   ; @7769
199 7769+ ;
200 7769+ .27:; 
201 7769+0616121 lod .fracct   ;
202 7770 0137223 sub .SW   ;large negative number @7770
203 7770+1057134 jz .29   ;
204 7771  .28:; 
205 7771 0556121 cls .fracct   ; @7771
206 7771+1117121 jmp .23   ;
207 7772  ;
208 7772  .29:; 
209 7772 0040000 o02 0   ; @7772
210 7772+0436112 stn .num   ;
211 7773 1017133 jmp .28   ; @7773
212 7773+ ;
213 7773+0000000 o00 0   ;
214 7774  ;--------------------------------------------------------------------
215 7774  ; finished reading number, now assemble into number
216 7774  ;
217 7774  .term:; 
218 7774 0616121 lod .fracct   ; @7774
219 7774+1057171 jz .error   ;
220 7775 0137223 sub .SW   ;large negative number @7775
221 7775+1057171 jz .error   ;
222 7776 0236116 o11 .negflg   ; @7776
223 7776+1137141 jn .31   ;
224 7777 0636112 lcs .num   ; @7777
225 7777+ .31:; 
226 7777+0616115 lod .expflg   ;
227 7778 1157156 jz .40   ; @7778
228 7778+0616123 lod .work2   ;
229 7779 0576112 o27 .num   ; @7779
230 7779+0616122 lod .type   ;
231 7780 1057145 jz .32   ; @7780
232 7780+1017171 jmp .error   ;
233 7781  ;
234 7781  .32:; 
235 7781 1077155 jo .39   ; @7781
236 7781+0616113 lod .work1   ;
237 7782  .33:; 
238 7782 1540000 flt 4096   ; @7782
239 7782+ .34:; 
240 7782+0416113 sto .work1   ;
241 7783 0756112 lzs .num   ; @7783
242 7783+1157167 jz .45   ;
243 7784 0176217 bus N76   ;=-76 @7784
244 7784+1137151 jn .35   ;
245 7785 0776112 o37 .num   ; @7785
246 7785+ .35:; 
247 7785+0176217 bus N76   ;=-76
248 7786 0400004 sto 4   ; @7786
249 7786+0077153 and .con   ;
250 7787 0200004.con:exa 4   ;=01000010020000 @7787
251 7787+ .36:; 
252 7787+0020000 neg 0   ;
253 7788 1137153 jn .36   ; @7788
254 7788+1016024 jmp .37   ;
255 7789  =7188 
256 7188  ;
257 7188  .37:; 
258 7188   calln ,   ; @7188
258+17188 7370505017177 lnk Read.powlnk:jmp Pow10 
259 7189 0216113 exa .work1   ; @7189
260 7189+1016005 jmp .38   ;
261 7190  ;
262 7190  =7173 
263 7173  .38:; 
264 7173 0000023476113 o00 4/fmu .work1; @7173
265 7174 1117146 jmp .34   ; @7174
266 7174+ ;
267 7174+ =7789 
268 7789  .39:; 
269 7789 0456112 inc .num   ; @7789
270 7789+0616356 lod Math.Magic   ;=0x0666666666
271 7790 1017146 jmp .33   ; @7790
272 7790+ ;
273 7790+ .40:; 
274 7790+0136121 sub .fracct   ;
275 7791 1037160 jn .41   ; @7791
276 7791+0556121 cls .fracct   ;
277 7792  .41:; 
278 7792 0616130 lod .digct   ; @7792
279 7792+1137161 jn .42   ;
280 7793 1017162 jmp .43   ; @7793
281 7793+ ;
282 7793+ .42:; 
283 7793+0140000 cla 0   ;
284 7794  .43:; 
285 7794 0136121 sub .fracct   ; @7794
286 7794+0216112 exa .num   ;
287 7795 0416113 sto .work1   ; @7795
288 7795+0616122 lod .type   ;
289 7796 1057145 jz .32   ; @7796
290 7796+0616112 lod .num   ;
291 7797 1057166 jz .44   ; @7797
292 7797+1017171 jmp .error   ;
293 7798  ;
294 7798  .44:; 
295 7798 0236120 o11 .decptflg   ; @7798
296 7798+1037171 jn .error   ;
297 7799 1077171 jo .error   ; @7799
298 7799+ .45:; 
299 7799+0616113 lod .work1   ;
300 7800 1000000 jmp Return   ; @7800
301 7800+ ;
302 7800+0000000 o00 0   ;
303 7801  ;--------------------------------------------------------------------
304 7801  .error:; 
305 7801 0600001 lod T2Link   ; @7801
306 7801+0416123 sto .work2   ;
307 7802 0070522540100 o00 .rdrno/cls RdBuff; @7802
308 7803 0616575 lod Msg16   ;'READ ERROR' @7803
309 7803+0000000 o00 0   ;
310 7804   calln ,   ; @7804
310+17804 7300065016165 lnk Link1:jmp outerror0 
311 7805 0616123 lod .work2   ; @7805
312 7805+0400001 sto T2Link   ;
313 7806 1017046 jmp .1   ; @7806
314 7806+ ;
315 7806+0000000 o00 0   ;
316 7807  ;--------------------------------------------------------------------
317 7807  =7827 
318 7827  .SW:; 
319 7827 4074311017100 jmp .ig:jmp .dig;00 bl 16 0 @7827
320 7828 4074401017062 jmp .dig:jmp .ig;01 1 17 ( @7828
321 7829 4074401017062 jmp .dig:jmp .ig;02 2 18 ) @7829
322 7830 4074311017100 jmp .ig:jmp .dig;03 * 19 3 @7830
323 7831 4074401017062 jmp .dig:jmp .ig;04 4 20 ? @7831
324 7832 4075245017100 jmp .dol:jmp .dig;05 $ 21 5 @7832
325 7833 4074311017100 jmp .ig:jmp .dig;06 = 22 6 @7833
326 7834 4074401017062 jmp .dig:jmp .ig;07 7 23 / @7834
327 7835 4074401117115 jmp .dig:jmp .ten;08 8 24 @ @7835
328 7836 4074311017100 jmp .ig:jmp .dig;09 ' 25 9 @7836
329 7837 4074311117247 jmp .ig:jmp .qt;10 , 26 # @7837
330 7838 4474371017071 jmp .pl:jmp .fs;11 + 27 FS @7838
331 7839 4074311117244 jmp .ig:jmp .sp;12 : 28 SP @7839
332 7840 4074365017062 jmp .neg:jmp .ig;13 - 29 CR @7840
333 7841 4074455017062 jmp .dot:jmp .ig;14 . 30 LF @7841
334 7842 4074310616225 jmp .ig:lod K32;15 % 31 LS @7842
335 7843 0070522400100 o00 .rdrno/sto RdBuff;store letter shift @7843
336 7844 1017051 jmp .lp   ; @7844
337 7844+ ;
338 7844+ ; spaces come here
339 7844+ .sp:; 
340 7844+0600025 lod indev   ;is special bit set?
341 7845 1037051 jn .lp   ;yes, ignore it @7845
342 7845+1017062 jmp .ig   ;treat as possible delimiter
343 7846  ;
344 7846  ; opening string quote comes here
345 7846  ;
346 7846  =7847+ 
347 7847+ .qt:; 
348 7847+0616114 lod .numflg   ;number read?
349 7848 1057171 jz .error   ;no, error @7848
350 7848+1017136 jmp .term   ;yes, treat as terminator
351 7849  ;
352 7849  .dol:; 
353 7849 0600001 lod T2Link   ; @7849
354 7849+0416111 sto .temp   ;
355 7850  ;W7850: ; Dump copies this into EP13
356 7850  .calldwt:; 
357 7850   calln ,   ;warbling wait @7850
357+17850 7300005000035 lnk T2Link:jmp DWaitEnt 
358 7851 0616111 lod .temp   ; @7851
359 7851+0400001 sto T2Link   ;
360 7852 1017051 jmp .lp   ;then continue @7852
361 7852+ ;
362 7852+0000000 o00 0   ;
363 7853  ;--------------------------------------------------------------------
364 7853  =7807 
365 7807  ;
366 7807  Pow10:; 
367 7807 0436125 stn .work3   ;save original exponent @7807
368 7807+ .7807P:; 
369 7807+0020000 neg 0   ;abs(ACC)
370 7808 1137177 jn .7807P   ; @7808
371 7808+0176210 bus N1   ;=-1
372 7809 1320040 sll 32   ; @7809
373 7809+0416127 sto .pwk2   ;
374 7810 0616206 lod FP1   ;=1.0 @7810
375 7810+0416126 sto .pwk1   ;working result=1.0
376 7811 0056213 o02 N8   ;=-8+1=>-7 loop counter @7811
377 7811+ .7811P:; 
378 7811+0216127 exa .pwk2   ;store count/load bits
379 7812 1137206 jn .7814P   ;bit set, skip @7812
380 7812+0216126 exa .pwk1   ;save bits, reload working result
381 7813 0070537477223 o00 .pwk2/fmu T7820+7;;10;;n @7813
382 7814 0216126 exa .pwk1   ;save result, reload bits @7814
383 7814+ .7814P:; 
384 7814+1320001 sll 1   ;shift bits left 1
385 7815 0256127 exc .pwk2   ;store bits,load count @7815
386 7815+1137203 jn .7811P   ;repeat if not all done
387 7816 0616125 lod .work3   ;load original exponent @7816
388 7816+1037213 jn .7819   ;skip if negative
389 7817 0616206 lod FP1   ;=1.0 @7817
390 7817+1516126 fdv .pwk1   ;generate inverse result 1.0/N
391 7818  .7818:; 
392 7818 0070507000001 o00 .powlnk/jmp 1;return @7818
393 7819  ;
394 7819  .7819:; 
395 7819 0616126 lod .pwk1   ;load result and... @7819
396 7819+1017212 jmp .7818   ; ... return it.
397 7820  ;
398 7820  T7820:; 
399 7820 3023601745725 +03023601745725;1E+64 @7820
400 7821 2356132663553 +02356132663553;1E+32 @7821
401 7822 2160674467466 +02160674467466;1E+16 @7822
402 7823 2765702000433 +02765702000433;1E+8 @7823
403 7824 2342000000416 +02342000000416;1E+4 @7824
404 7825 3100000000407 +03100000000407;1E+2 @7825
405 7826 2400000000404 +02400000000404;1E+1 @7826
406 7827  ;--------------------------------------------------------------------

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