Elliott 803 Algol 60 Compiler (reconstructed)

File: outstr.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape2/outstr.t2
2 0  ;----------------
3 0  unpackchar::; 
4 0  unpackchar:; 
5 0 0655122 lis W6738   ;counter @6982
6 0+1040003 jz .1   ;nothing left in AR, get word
7 1 0140000 cla 0   ;clear ACC @6983
8 1+1300006 sla 6   ;shift char into acc
9 2 1040000 jz Return   ;end of string if zero, exit @6984
10 2+1000012 jmp .ret   ;return with next char
11 3  ;
12 3  .1:; 
13 3 0615120 lod W6736   ;was last word flagged? @6985
14 3+1020000 jn Return   ;yes, end of string, exit
15 4 0615142 lod TopBit   ;=04000000000000 (sign bit) @6986
16 4+0415120 sto W6736   ;end of string indicator
17 5 2264506577777 inc W6737/lod -1;load next word @6987
18 6 0475120 ans W6736   ;test with sign bit @6988
19 6+1200044 sra 36   ;shift into AR
20 7 0055146 o02 W6758   ;=5+1=>6 @6989
21 7+0435122 stn W6738   ;count := -6
22 8 1000000 jmp unpackchar   ;back to try again @6990
23 8+ ;--------------------------------------------------------------------
24 8+ ; output a char to printer or punch
25 8+ ; device address in 6718
26 8+ ;
27 8+ outchar:; 
28 8+0100077 add outdev   ;add device number
29 9 1664517700000 stc W6739/otp 0;print/punch it @6991
30 10  .ret:; 
31 10 0000023000001 o00 4/jmp 1;return to caller @6992
32 11  ;--------------------------------------------------------------------
33 11  ; output string to teleprinter
34 11  ;
35 11  OutStr::; 
36 11  outstr:; 
37 11 1060013 jo IntOflo   ;report overflow if set @6993
38 11+0540016 cls arg1   ;
39 12 0555120 cls W6736   ;end of string flag @6994
40 12+0415121 sto W6737   ;address of first wd of string
41 13 0555122 cls W6738   ;number of chars in AR @6995
42 13+0555126 cls W6742   ;
43 14 0000000 o00 0   ; @6996
44 14+0615144 lod W6756   ;=27 figure shift
45 15   calln ,   ;output FS @6997
45+115 7300021100010 lnk 4:jmp outchar 
46 16  .1:; 
47 16   calln ,   ;get next char from string @6998
47+116 7300021000000 lnk 4:jmp unpackchar 
48 17 0400015 sto Link1   ;save it @6999
49 17+0135140 sub W6752   ;=63 [escape character]
50 18 1140032 jz .4   ;check inner string @7000
51 18+0600015 lod Link1   ;reload character
52 19 0075150 and K32a   ;=32 @7001
53 19+0200016 exa arg1   ;store new shift, get old shift
54 20 0120016 sub arg1   ;compare the two @7002
55 20+1140030 jz .3   ;same, shift OK
56 21 0600016 lod arg1   ;get new shift @7003
57 21+1140026 jz .2   ;figs->
58 22 0616223 lod K4   ;=4 @7004
59 22+ .2:; 
60 22+0115144 add W6756   ;=27 => 27/31
61 23   calln ,   ;output shift char @7005
61+123 7300021100010 lnk 4:jmp outchar 
62 24 0000000 o00 0   ;padding @7006
63 24+ .3:; 
64 24+0600015 lod Link1   ;get current char
65 25   calln ,   ;output to printer/punch @7007
65+125 7300021100010 lnk 4:jmp outchar 
66 26 1000020 jmp .1   ;loop back for more @7008
67 26+ ;
68 26+ ; char= 63 (escape for inner strings)
69 26+ .4:; 
70 26+0555124 cls W6740   ;
71 27  .5:; 
72 27   calln ,   ;get next char from string @7009
72+127 7300021000000 lnk 4:jmp unpackchar 
73 28 0400015 sto Link1   ;save it @7010
74 28+0135150 sub K32a   ;=32 check for end of inner string
75 29 1000125 jmp .24   ;->check for letter @7011
76 29+ ;
77 29+ .6:; 
78 29+1660020 lnk arg3   ;
79 30   calln ,   ; @7012
79+130 7300075100066 lnk arg2:jmp OutStr.16 
80 31 0600015 lod Link1   ; @7013
81 31+0135157 sub W6767   ;=49 'Q'
82 32 1040046 jz .8   ; @7014
83 32+0116210 add N1   ;=-1 'P'
84 33 1040047 jz .9   ; @7015
85 33+0116210 add N1   ;=-1 'R'
86 34 1040050 jz .10   ; @7016
87 34+0135141 sub W6753   ;
88 35 1040051 jz .11   ; @7017
89 35+0115160 add W6768   ;
90 36 1040045 jz .7   ; @7018
91 36+1000120 jmp .21   ;
92 37  ;
93 37  .7:; 
94 37 0055145 o02 W6757   ;=29+1=>30 @7019
95 37+1100051 jmp .12   ;
96 38  ;
97 38  .8:; 
98 38 0615152 lod W6762   ; @7020
99 38+1100051 jmp .12   ;
100 39  ;
101 39  .9:; 
102 39 0140000 cla 0   ; @7021
103 39+1100051 jmp .12   ;
104 40  ;
105 40  .10:; 
106 40 0055144 o02 W6756   ;=27 @7022
107 40+1100051 jmp .12   ;
108 41  ;
109 41  .11:; 
110 41 0615161 lod W6769   ; @7023
111 41+ .12:; 
112 41+0415125 sto W6741   ;
113 42 1000033 jmp .5   ; @7024
114 42+ ;
115 42+ .13:; 
116 42+0176241 bus Ptab2+0   ;=-5
117 43 1040122 jz .22   ; @7025
118 43+1020033 jn .5   ;
119 44 0615124 lod W6740   ; @7026
120 44+1040120 jz .21   ;
121 45 0056220 o02 K15a   ;=15+1=>16 @7027
122 45+0160015 bus Link1   ;
123 46 2000023020120 sto 4/jn .SW+15; @7028
124 47 0000023100101 o00 4/jmp .SW#; @7029
125 48  ;
126 48  .14:; 
127 48 0616220 lod K15a   ;=15 @7030
128 48+0460015 ans Link1   ;
129 49 0740020 lzs arg3   ; @7031
130 49+1140062 jz .15   ;
131 50 0555126 cls W6742   ; @7032
132 50+ .15:; 
133 50+1360000 ara 0   ;
134 51 0215126 exa W6742   ; @7033
135 51+1255153 mul W6763   ;
136 52 1360000 ara 0   ; @7034
137 52+0100015 add Link1   ;
138 53 0215126 exa W6742   ; @7035
139 53+1200046 sra 38   ;
140 54 1000033 jmp .5   ; @7036
141 54+ ;--------------------------------
142 54+ .16:; 
143 54+0635126 lcs W6742   ;test and clear flag
144 55 1040076 jz .20   ; @7037
145 55+0055145 o02 W6757   ;=29+1=>30
146 56 0175125 bus W6741   ; @7038
147 56+1020072 jn .17   ;
148 57 0615145 lod W6757   ; @7039
149 57+1000075 jmp .19   ;
150 58  ;
151 58  .17:; 
152 58 0115153 add W6763   ; @7040
153 58+1040124 jz .23   ;
154 59 0116231 add N6   ;=-6 @7041
155 59+1040124 jz .23   ;
156 60 1000076 jmp .20   ; @7042
157 60+ ;
158 60+ .18:; 
159 60+0615144 lod W6756   ;=27
160 61  .19:; 
161 61   calln ,   ; @7043
161+161 7300021100010 lnk 4:jmp outchar 
162 62  .20:; 
163 62 1675124 lnk W6740   ; @7044
164 62+0655126 lis W6742   ;
165 63 0000077040001 o00 arg2/jz 1;return if flag zero @7045
166 64 0615125 lod W6741   ; @7046
167 64+1000075 jmp .19   ;
168 65  ;
169 65 4000301000060.SW:jmp .14:jmp .14;~ O @7047
170 66 4000301000120 jmp .14:jmp .21;A P @7048
171 67 4000501000120 jmp .21:jmp .21;B Q @7049
172 68 4000301000060 jmp .14:jmp .14;C R @7050
173 69 4000501000120 jmp .21:jmp .21;D S @7051
174 70 4000501000060 jmp .21:jmp .14;E T @7052
175 71 4000301000060 jmp .14:jmp .14;F U @7053
176 72 4000301000120 jmp .14:jmp .21;G V @7054
177 73 4000501000120 jmp .21:jmp .21;H W @7055
178 74 4000501000060 jmp .21:jmp .14;I X @7056
179 75 4000501000120 jmp .21:jmp .21;J Y @7057
180 76 4000501000122 jmp .21:jmp .22;K Z @7058
181 77 4000501000033 jmp .21:jmp .5;L @7059
182 78 4000501000033 jmp .21:jmp .5;M @7060
183 79 4000501000033 jmp .21:jmp .5;N @7061
184 80  ;
185 80  .21:; 
186 80 0600001 lod T2Link   ; @7062
187 80+0400015 sto Link1   ;
188 81 0616574 lod Msg15   ;'STRING ERROR' @7063
189 81+1016165 jmp outerror0   ;
190 82  ;
191 82  .22:; 
192 82   calln ,   ; @7064
192+182 7300075100066 lnk arg2:jmp OutStr.16 
193 83 0555126 cls W6742   ; @7065
194 83+1000020 jmp .1   ;
195 84  ;
196 84  .23:; 
197 84 0540016 cls arg1   ; @7066
198 84+1140074 jz .18   ;
199 85  .24:; 
200 85 1120052 jn .13   ;non-letter character @7067
201 85+0175144 bus W6756   ;=27 check for FS
202 86 1020033 jn .5   ;non-letter, ignore @7068
203 86+1100035 jmp .6   ;letter check for specials
204 87  ;--------------------------------------------------------------------

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