File: print.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape2/print.t2
2 0  ;---------------
3 0  ;
4 0  Print::; 
5 0  ;
6 0  ; local variables: overlay on Scratch area. This space is used
7 0  ; by other routines in independent ways
8 0  ;
9 0  =7241 
10 7241  .digits1:; 
11 7241 0000000000000 +0; @7241
12 7242  .digits2:; 
13 7242 0000000000000 +0; @7242
14 7243 0000000000000.wk1:+0; @7243
15 7244 0000000000000.wk2:+0; @7244
16 7245 0000000000000.wk3:+0; @7245
17 7246 0000000000000.wk4:+0; @7246
18 7247 0000000000000.wk5:+0; @7247
19 7248 0000000000000.wk6:+0; @7248
20 7249  .powlnk:; 
21 7249 0000000000000 +0; @7249
22 7250 0000000000000 +0; @7250
23 7251 0000000000000.wk7:+0; @7251
24 7252 0000000000000.wk8:+0; @7252
25 7253 0000000000000 +0; @7253
26 7254 0000000000000 +0; @7254
27 7255 0000000000000.wk9:+0; @7255
28 7256 0000000000000.Pbuff:+0; @7256
29 7257 0000000000000 +0; @7257
30 7258 0000000000000 +0; @7258
31 7259 0000000000000 +0; @7259
32 7260 0000000000000 +0; @7260
33 7261 0000000000000 +0; @7261
34 7262 0000000000000 +0; @7262
35 7263 0000000000000 +0; @7263
36 7264 0000000000000 +0; @7264
37 7265 0000000000000 +0; @7265
38 7266 0000000000000 +0; @7266
39 7267 0000000000000 +0; @7267
40 7268 0000000000000 +0; @7268
41 7269 0000000000000 +0; @7269
42 7270 0000000000000 +0; @7270
43 7271  ;--------------------------------------------------------------------
44 7271  ; print a real number (in Acc)
45 7271  ;
46 7271  =7853 
47 7853  .real:; 
48 7853 0556114 cls .wk2   ;indicate real @7853
49 7853+1117274 jmp .r0   ;
50 7854  =7868+ 
51 7868+ .r0:; 
52 7868+0556124 cls .wk8   ;
53 7869 1157301 jz .r1   ;value == 0? @7869
54 7869+1117264 jmp .r3   ;
55 7870  =7873+ 
56 7873+ .r1:; 
57 7873+0600074 lod Rfmt   ;
58 7874 0076545 and W7525   ;=01000000000000 @7874
59 7874+1157264 jz .r3   ;
60 7875 0615132 lod FP0.5   ; @7875
61 7875+0135150 sub K32a   ;=32
62 7876 1117264 jmp .r3   ;--> @7876
63 7876+ ;
64 7876+  pad     ;
64+17876+0000000 00 0    
65 7877  =7860+ 
66 7860+ .r3:; 
67 7860+0556115 cls .wk3   ;
68 7861 0556130 cls .Pbuff   ; @7861
69 7861+1137267 jn .r4   ;
70 7862 0456130 inc .Pbuff   ; @7862
71 7862+0456130 inc .Pbuff   ;indicate '-' sign not needed
72 7863 1017270 jmp .r5   ; @7863
73 7863+ ;
74 7863+ .r4:; 
75 7863+1440000 fna 0   ;make number positive
76 7864  .r5:; 
77 7864 0416116 sto .wk4   ;save actual number @7864
78 7864+0600074 lod Rfmt   ;get real format info
79 7865 0416113 sto .wk1   ;save it @7865
80 7865+1200024 sra 20   ;get total digits
81 7866 0076202 and K8191   ;=N1 bits, mask off top bits @7866
82 7866+0356111 stc .digits1   ;save it
83 7867 1300024 sla 20   ;get digits after @7867
84 7867+0356112 stc .digits2   ;save that too
85 7868 1014661 jmp .r6   ;-->> @7868
86 7868+ =6577 
87 6577  .r6:; 
88 6577 0616113 lod .wk1   ;reload format info @6577
89 6577+0116113 add .wk1   ;double it
90 6578 1134663 jn .r8   ;test bit 38 - aligned @6578
91 6578+ .r7:; 
92 6578+0140000 cla 0   ;
93 6579 1017305 jmp .c1   ;join with printint @6579
94 6579+ ;
95 6579+ ; set up for aligned output
96 6579+ ;
97 6579+ .r8:; 
98 6579+0616111 lod .digits1   ;digits before point
99 6580 0136112 sub .digits2   ;total digits @6580
100 6580+  nop     ;
100+16580+1014665 jmp .1    
100+26581  .1:; 
101 6581   calln ,   ;get 10**(-digits after point) @6581
101+16581 7370505017177 lnk Print.powlnk:jmp Pow10 
102 6582 0116210 add N1   ;=-1 crafty / 2.0 @6582
103 6582+1456116 fna .wk4   ;subtract from num
104 6583 1034670 jn .r9   ;num less than epsilon @6583
105 6583+1114662 jmp .r7   ;ok
106 6584  ; number less than minimum representable, use zero instead
107 6584  ;
108 6584  .r9:; 
109 6584 0556116 cls .wk4   ;set num = 0 @6584
110 6584+1114662 jmp .r7   ;and join with other formats
111 6585  ;--------------------------------------------------------------------
112 6585  ;
113 6585  ; print integer value
114 6585  ; value in Acc
115 6585  ;
116 6585  =7854 
117 7854  ;
118 7854  .int:; 
119 7854 1015756 jmp .i1   ; @7854
120 7854+ =7150 
121 7150  .i1:; 
122 7150 0556114 cls .wk2   ; @7150
123 7150+0556130 cls .Pbuff   ;sign=0 (-)
124 7151 1137256 jn .i2   ;-> @7151
125 7151+0456130 inc .Pbuff   ;value is positive
126 7152 0456130 inc .Pbuff   ;sign=2 (+) @7152
127 7152+1117256 jmp .i2   ;-->>
128 7153  =7854+ 
129 7854+ .i2:; 
130 7854+0456114 inc .wk2   ;indicate integer
131 7855 0416115 sto .wk3   ;store number @7855
132 7855+0556117 cls .wk5   ;
133 7856 0600075 lod Ndigits   ;number of digits to print @7856
134 7856+0076220 and K15a   ;=15
135 7857 0416111 sto .digits1   ; @7857
136 7857+0416112 sto .digits2   ;
137 7858 0116213 add N8   ;=-8 @7858
138 7858+0136223 sub K4   ;=4
139 7859 0356120 stc .wk6   ; @7859
140 7859+0556113 cls .wk1   ;
141 7860 1017305 jmp .c1   ; @7860
142 7860+ ;
143 7860+ ; in common with printreal, Acc always 0 at this point??
144 7860+ ;
145 7860+ =7877 
146 7877  .c1:; 
147 7877 0136130 sub .Pbuff   ;0/-2 @7877
148 7877+1137312 jn .c3   ;'+'
149 7878 0600076 lod prtfmt   ;load format info @7878
150 7878+1137307 jn .c2   ;special(1)? ->
151 7879 1117312 jmp .c3   ;not special(1) @7879
152 7879+ ;
153 7879+ ; setup for special(1) - suppress leading blank
154 7879+ ;
155 7879+ .c2:; 
156 7879+0616210 lod N1   ;=-1
157 7880 0516112 ads .digits2   ;decrement total digit @7880
158 7880+0616111 lod .digits1   ;see if digits before
159 7881 1157312 jz .c3   ; is = 0 -> @7881
160 7881+0616210 lod N1   ;=-1 no, decrement digits before
161 7882 0516111 ads .digits1   ; @7882
162 7882+ .c3:; 
163 7882+0236114 o11 .wk2   ;load real/integer flag, wk2 = -2
164 7883   ; if sign = '-', -1 if digits before >0, 
165 7883   ; or 0 if digits before was zero ??? 
166 7883 1037400 jn .g2   ;->integer @7883
167 7883+ .c4:; 
168 7883+0556117 cls .wk5   ;
169 7884 0616116 lod .wk4   ;get number to be printed @7884
170 7884+1157366 jz .f4   ;easy case->
171 7885 0076203 and K511   ;extract exponent @7885
172 7885+0556124 cls .wk8   ;
173 7886 1017317 jmp .c5   ;-->> @7886
174 7886+  pad     ;
174+17886+0000000 00 0    
175 7887  ;--------------------------------------------------------------------
176 7887  .c5:; 
177 7887 0136204 sub K256   ;=256 convert to signed form @7887
178 7887+1256205 mul W7301   ;=0.3 (fixed pt frac)
179 7888 0416120 sto .wk6   ;approx decimal exponent @7888
180 7888+1137321 jn .c6   ;skip if < 0
181 7889 0020000 neg 0   ;negate value @7889
182 7889+ .c6:; 
183 7889+0136217 sub N76   ;=-76 limit
184 7890 1037356 jn .c9   ;too big/small @7890
185 7890+ .c7:; 
186 7890+0236120 o11 .wk6   ;exchange&negate
187 7891  .c8:; 
188 7891 0576115 o27 .wk3   ;subtract from wk3 (real:0/int:num) @7891
189 7891+1017352 jmp .d1   ;re-scale number to 0.1-1.0
190 7892  =7918 
191 7918  ;
192 7918  .c9:; 
193 7918 0616217 lod N76   ;=-76 @7918
194 7918+0216120 exa .wk6   ;use -76/reload scaled exponent
195 7919 1137322 jn .c7   ; @7919
196 7919+0616217 lod N76   ;=-76 use -76 as exponentn
197 7920 1017323 jmp .c8   ; @7920
198 7920+  pad     ;
198+17920+0000000 00 0    
199 7921  ; rescale number to range 0.1-1.0, try approx exponent first, then
200 7921  ; adjust by +/- 1 until it's right
201 7921  ;
202 7921  =7914 
203 7914  .d1:; 
204 7914   calln ,   ;convert to power of 10 @7914
204+17914 7370505017177 lnk Print.powlnk:jmp Pow10 
205 7915 1476116 fmu .wk4   ;scale argument @7915
206 7915+0416116 sto .wk4   ;and save it
207 7916 1456207 fna Point1   ;=0.1 @7916
208 7916+1036022 jn .d2   ;>=0.1, OK so far
209 7917 0040000 o02 0   ;<0.1, scale up by 10 @7917
210 7917+1017323 jmp .c8   ;back to try again
211 7918  ;
212 7918  =7186 
213 7186  .d2:; 
214 7186 0616116 lod .wk4   ;load argument @7186
215 7186+1436206 fsb FP1   ;=1.0
216 7187 1037324 jn .d3   ;<1.0 in range @7187
217 7187+1117342 jmp .d9   ;scale down by 10
218 7188  ;.d9: lod N1 ;=-1 copy of code below
219 7188  ; jmp .c9 ;loop back
220 7188  ;
221 7188  =7892 
222 7892  ; gets to here with argument (.wk4) in range 0.1 - 1.0
223 7892  ; check to see if there are sufficient spaces before point for
224 7892  ; digits needed.
225 7892  .d3:; 
226 7892 0616113 lod .wk1   ;load format info @7892
227 7892+1037336 jn .d8   ;scaled format->
228 7893 0616111 lod .digits1   ;freepoint/aligned, space before@7893
229 7893+0136115 sub .wk3   ;less actual digits before point
230 7894 1037406 jn .h4   ;won't fit, change fmt @7894
231 7894+0040000 o02 0   ;=1
232 7895 0776117 o37 .wk5   ;load .wk5, sub 1 from .wk5 @7895
233 7895+1137343 jn .e1   ;prev value < 0
234 7896 0616113 lod .wk1   ;reload fmt info @7896
235 7896+0116113 add .wk1   ;double to test Bit38
236 7897 1037333 jn .d4   ;->aligned format @7897
237 7897+0616115 lod .wk3   ;actual digits before point
238 7898 1037334 jn .d7   ;<0 pure fraction @7898
239 7898+1017336 jmp .d8   ;->
240 7899  ;
241 7899  .d4:; 
242 7899 0616115 lod .wk3   ;actual digits before point @7899
243 7899+1016012 jmp .d5   ;-->>
244 7900  ;
245 7900  =7178 
246 7178  .d5:; 
247 7178 0136111 sub .digits1   ;space before point @7178
248 7178+0400004 sto 4   ;number of leading zeros
249 7179   nop     ; @7179
249+17179 1116013 jmp .1    
249+27179+ .1:; 
250 7179+ .d6:; 
251 7179+0640004 lis 4   ;count zeros
252 7180 1057336 jz .d8   ;done @7180
253 7180+0056220 o02 K15a   ;=15+1=>16 [0]
254 7181 2270522416130 inc .wk8/sto .Pbuff;store zero in print buffer @7181
255 7182 1116013 jmp .d6   ;and repeat @7182
256 7182+ ;
257 7182+ =7900 
258 7900  .d7:; 
259 7900   calln ,   ; @7900
259+17900 7370505017177 lnk Print.powlnk:jmp Pow10 
260 7901 1476116 fmu .wk4   ; @7901
261 7901+0416116 sto .wk4   ;
262 7902  .d8:; 
263 7902 0616112 lod .digits2   ;total digits space @7902
264 7902+0176124 bus .wk8   ;less spaces filled with zeros
265 7903   calln ,   ;get least sig digit @7903
265+17903 7370505017177 lnk Print.powlnk:jmp Pow10 
266 7904 0116210 add N1   ;=-1 halve it @7904
267 7904+1416116 fad .wk4   ;add to number (rounding)
268 7905 0416116 sto .wk4   ;store rounded number @7905
269 7905+1436206 fsb FP1   ;=1.0
270 7906 1137343 jn .e1   ;not rounded up over limit @7906
271 7906+ .d9:; 
272 7906+0616210 lod N1   ;=-1 scale down by another 10.0
273 7907 1017323 jmp .c8   ;and do it all again @7907
274 7907+ ;
275 7907+ .e1:; 
276 7907+0616113 lod .wk1   ;reload format info
277 7908 1137350 jn .e4   ;->scaled @7908
278 7908+0116113 add .wk1   ;double to check bit38
279 7909 1036020 jn .e2   ;->aligned @7909
280 7909+0616115 lod .wk3   ;load scale factor (freepoint)
281 7910 1137347 jn .e3   ; @7910
282 7910+0416111 sto .digits1   ;
283 7911 1017361 jmp .f1   ; @7911
284 7911+ ;
285 7911+ =7184 
286 7184  .e2:; 
287 7184 0616115 lod .wk3   ; @7184
288 7184+0176111 bus .digits1   ;
289 7185 0416124 sto .wk8   ; @7185
290 7185+1017361 jmp .f1   ;
291 7186  ;
292 7186  =7911+ 
293 7911+ .e3:; 
294 7911+0556111 cls .digits1   ;
295 7912 1017361 jmp .f1   ; @7912
296 7912+ ;
297 7912+ .e4:; 
298 7912+0616111 lod .digits1   ;
299 7913 0576115 o27 .wk3   ; @7913
300 7913+1017361 jmp .f1   ;
301 7914  ;
302 7914  =7921 
303 7921  ;--------------------------------------------------------------------
304 7921  .f1:; 
305 7921 0616116 lod .wk4   ;load number @7921
306 7921+0076203 and K511   ;=0777 mask exponent
307 7922 0136204 sub K256   ;=256 convert to zero-base @7922
308 7922+0116212 add K63   ;=63
309 7923 1137365 jn .f2   ;insignificant @7923
310 7923+0020000 neg 0   ;make shift factor negative
311 7924 1070473200077 exa .wk4/sra 63;shift mantissa into AR @7924
312 7925 1017366 jmp .f3   ; @7925
313 7925+ ;
314 7925+ .f2:; 
315 7925+0140000 cla 0   ;
316 7926  .f3:; 
317 7926 0356116 stc .wk4   ;store what's left @7926
318 7926+ .f4:; 
319 7926+0616124 lod .wk8   ;
320 7927 0416117 sto .wk5   ; @7927
321 7927+1116016 jmp .f5   ;-->>
322 7928  ;
323 7928  =7182+ 
324 7182+ .f5:; 
325 7182+0136112 sub .digits2   ;number of digits needed
326 7183 0216116 exa .wk4   ;swap with number @7183
327 7183+1017370 jmp .f6   ;-->>
328 7184  ;
329 7184  =7928 
330 7928  .f6:; 
331 7928 1200046 sra 38   ;shift bits into AR @7928
332 7928+1017374 jmp .f8   ;jump into loop
333 7929  ;
334 7929  ; loop, extracting digits
335 7929  ;
336 7929  .f7:; 
337 7929 1360000 ara 0   ;get bits from AR @7929
338 7929+1256211 mul K10a   ;=10 multiply by 10
339 7930 2070516617550 sto .wk7/lod digits;convert 0..9 to digit char @7930
340 7931 2270476416130 inc .wk5/sto .Pbuff;bump index, store char @7931
341 7932  .f8:; 
342 7932 0656116 lis .wk4   ;load&increment digit count @7932
343 7932+1037371 jn .f7   ;still negative, do more digits
344 7933 0616113 lod .wk1   ;reload format info @7933
345 7933+1137376 jn .g1   ;scaled format->
346 7934 1017454 jmp .l1   ;others-> @7934
347 7934+ ;
348 7934+ ; scaled format
349 7934+ ;
350 7934+ .g1:; 
351 7934+0456117 inc .wk5   ;
352 7935 0616211 lod K10a   ;=10 @7935
353 7935+0436120 stn .wk6   ;
354 7936  .g2:; 
355 7936 0617464 lod .W7988   ;=.p6 @7936
356 7936+0416121 sto .powlnk   ;
357 7937 0616115 lod .wk3   ;get value @7937
358 7937+1017421 jmp .g3   ;
359 7938  ;--------------------------------------------------------------------
360 7938  =7953 
361 7953  .g3:; 
362 7953 2270476556127 inc .wk5/cls .wk9; @7953
363 7954 1037425 jn .g4   ; @7954
364 7954+0020000 neg 0   ;
365 7955 0070476456127 o00 .wk5/inc .wk9; @7955
366 7956 0070476456127 o00 .wk5/inc .wk9; @7956
367 7957  .g4:; 
368 7957 1256216 mul W7310   ; @7957
369 7957+1200044 sra 36   ;
370 7958 0416116 sto .wk4   ; @7958
371 7958+0056211 o02 K10a   ;=10+1=>11
372 7959 0020000 neg 0   ; @7959
373 7959+0216116 exa .wk4   ;
374 7960 1017432 jmp .g6   ;jump into loop @7960
375 7960+ ;
376 7960+ .g5:; 
377 7960+1360000 ara 0   ;
378 7961 0136210 sub N1   ;=-1 @7961
379 7961+1256211 mul K10a   ;=10
380 7962  .g6:; 
381 7962 2070516617550 sto .wk7/lod digits;convert to printable form @7962
382 7963 0070476416130 o00 .wk5/sto .Pbuff;store in buffer @7963
383 7964 0076220 and K15a   ;=15 @7964
384 7964+1057436 jz .g7   ;zero?
385 7965 0616120 lod .wk6   ; @7965
386 7965+1037402 jn .h1   ;out of room
387 7966  .g7:; 
388 7966 0656120 lis .wk6   ; @7966
389 7966+1137437 jn .g8   ;
390 7967 0456117 inc .wk5   ; @7967
391 7967+ .g8:; 
392 7967+0656116 lis .wk4   ;
393 7968 1137430 jn .g5   ; @7968
394 7968+0456117 inc .wk5   ;
395 7969 0070507000001 o00 .powlnk/jmp 1; @7969
396 7970  ;--------------------------------------------------------------------
397 7970  =7938 
398 7938  ; recovery when insufficient space to print number
399 7938  ;
400 7938  .h1:; 
401 7938 0040000 o02 0   ;decrement digits2 @7938
402 7938+0576112 o27 .digits2   ;
403 7939 0756115 lzs .wk3   ;reload value @7939
404 7939+1540000 flt 4096   ;convert to float
405 7940 1037405 jn .h2   ;check sign, negative-> @7940
406 7940+1117405 jmp .h3   ;positive->
407 7941  ;
408 7941  .h2:; 
409 7941 1440000 fna 0   ;make it positive @7941
410 7941+ .h3:; 
411 7941+0416116 sto .wk4   ;save value
412 7942  .h4:; 
413 7942 0056223 o02 K4   ;=4+1=>5 space needed for exp @7942
414 7942+0176112 bus .digits2   ;deduct from digits2
415 7943 1037413 jn .h5   ;<0, isn't room even for scaled @7943
416 7943+0416112 sto .digits2   ;store reduced digits
417 7944 0616213 lod N8   ;=-8 @7944
418 7944+0416113 sto .wk1   ;reset count to -8
419 7945 0556111 cls .digits1   ;clear digits1 for scaled @7945
420 7945+0456112 inc .digits2   ;add one to digits2
421 7946 0456111 inc .digits1   ;and also to digits1 @7946
422 7946+1117313 jmp .c4   ;restart conversion using scaled format
423 7947  ;
424 7947  ; number won't fit in space allowed, print ' $' error indicator
425 7947  .h5:; 
426 7947 0556113 cls .wk1   ; @7947
427 7947+0056215 o02 K27   ;=27
428 7948 0416131 sto .Pbuff+1   ; @7948
429 7948+0416132 sto .Pbuff+2   ;
430 7949 0416133 sto .Pbuff+3   ; @7949
431 7949+0416134 sto .Pbuff+4   ;
432 7950 0056227 o02 Signbit   ;=04000000000001 @7950
433 7950+0116223 add K4   ;=4=>04000000000005 '$'
434 7951 0070452416131 o00 .digits2/sto .Pbuff+1; @7951
435 7952 0556112 cls .digits2   ; @7952
436 7952+1017454 jmp .l1   ;-->>
437 7953  ;--------------------------------------------------------------------
438 7953  ; basic digits assembled, apply formatting
439 7953  ; first sort out prefix string
440 7953  ;
441 7953  =7980 
442 7980  .l1:; 
443 7980 0600001 lod T2Link   ; @7980
444 7980+0416120 sto .wk6   ;save return address
445 7981 0600076 lod prtfmt   ;get format info @7981
446 7981+0416114 sto .wk2   ;save it
447 7982 1220024 srl 20   ;shift N1 down @7982
448 7982+0076202 and K8191   ;mask N1 bits
449 7983 1057460 jz .l2   ;no prefix, use CRLF @7983
450 7983+1117460 jmp .l3   ;use specified string
451 7984  ;
452 7984  .l2:; 
453 7984 0617472 lod .PCRLF   ;=SCRLF @7984
454 7984+ .l3:; 
455 7984+  clo     ;make sure overflow clear
455+17984+1077461 jo .1    
455+27985  .1:; 
456 7985   calln ,   ;output prefix string @7985
456+17985 7300005100012 lnk T2Link:jmp OutStr 
457 7986 0616120 lod .wk6   ; @7986
458 7986+0400001 sto T2Link   ;restore return address
459 7987  ;
460 7987 0616113 lod .wk1   ;reload format info @7987
461 7987+1137466 jn .l4   ;scaled format->
462 7988 0616227.W7988:lod Signbit   ;=04000000000000 @7988
463 7988+0017453 o00 .p6   ;
464 7989 0070452516130 o00 .digits2/ads .Pbuff; @7989
465 7990 1017474 jmp .l5   ; @7990
466 7990+ ;
467 7990+ .l4:; 
468 7990+0616214 lod K13   ;=13 '-'
469 7991 0070452136131 o00 .digits2/sub .Pbuff+1; @7991
470 7992 1320006 sll 6   ; @7992
471 7992+0116224 add K24   ;=24 '@'
472 7993 0070452416131 o00 .digits2/sto .Pbuff+1; @7993
473 7994 0616227.PCRLF:lod Signbit   ;=04000000000000 @7994
474 7994+0000116 o00 SCRLF   ;in-line constant
475 7995 0070452516133 o00 .digits2/ads .Pbuff+3; @7995
476 7996  .l5:; 
477 7996 0616130 lod .Pbuff   ;sign marker @7996
478 7996+1057500 jz .l6   ;negative sign needed
479 7997 0616114 lod .wk2   ; @7997
480 7997+1137501 jn .l7   ;
481 7998 0116114 add .wk2   ; @7998
482 7998+1037500 jn .l6   ;
483 7999 0056215 o02 K27   ;=27+1=>28 [SP] @7999
484 7999+1017502 jmp .l8   ;sign=' '
485 8000  ;
486 8000  .l6:; 
487 8000 0616214 lod K13   ;=13 [-] @8000
488 8000+0536130 sbs .Pbuff   ;
489 8001 1017503 jmp .l9   ; @8001
490 8001+ ;
491 8001+ .l7:; 
492 8001+0140000 cla 0   ;
493 8002  .l8:; 
494 8002 0416130 sto .Pbuff   ;store sign here @8002
495 8002+0000000 o00 0   ;
496 8003  .l9:; 
497 8003 0616113 lod .wk1   ;reload format info @8003
498 8003+1057513 jz .m4   ;->no format?
499 8004 0616111 lod .digits1   ; @8004
500 8004+0136112 sub .digits2   ;less frac digits
501 8005 1057510 jz .m1   ;no int digits @8005
502 8005+0616114 lod .wk2   ;
503 8006 1320003 sll 3   ;*8 @8006
504 8006+1037511 jn .m2   ;test bit 36->
505 8007 0056214 o02 K13   ;=13+1=14 [.] @8007
506 8007+1117511 jmp .m3   ;->
507 8008  .m1:; 
508 8008 0056215 o02 K27   ;=27+1=>28 [SP] @8008
509 8008+1117511 jmp .m3   ;->
510 8009  ;
511 8009  .m2:; 
512 8009 0616211 lod K10a   ;=10 @8009
513 8009+ .m3:; 
514 8009+1320006 sll 6   ;shift decimal pt (or space)
515 8010 0070446516130 o00 .digits1/ads .Pbuff;add to last int digit @8010
516 8011  .m4:; 
517 8011 0616114 lod .wk2   ;load format info @8011
518 8011+0076212 and K63   ;=077, mask out leadzero char
519 8012 1115763 jmp .m5   ;-->> @8012
520 8012+ =7155+ 
521 7155+ .m5:; 
522 7155+0556121 cls .powlnk   ;
523 7156 1157523 jz .n5   ;leadzero char=null, use space @7156
524 7156+0416115 sto .wk3   ;save leadzero char
525 7157 0076225 and K32   ;=32, letter shift mask @7157
526 7157+0456121 inc .powlnk   ;bump flag
527 7158 1057515 jz .n2   ;not letters @7158
528 7158+0436121 stn .powlnk   ;set flag=-32
529 7159 0176115 bus .wk3   ;subtract from char @7159
530 7159+1320006 sll 6   ;shift left
531 7160 0115771 add W7161   ;and add letter shift @7160
532 7160+1117514 jmp .n1   ;join loop
533 7161  ;
534 7161 0000000000037W7161:+31; @7161
535 7162  ;
536 7162  =8012+ 
537 8012+ ;
538 8012+ .n1:; 
539 8012+0416115 sto .wk3   ;save leadzero character
540 8013  .n2:; 
541 8013 0556116 cls .wk4   ;set index=0 @8013
542 8013+ .n3:; 
543 8013+0616220 lod K15a   ;=15, digit mask
544 8014 2270472076130 inc .wk4/and .Pbuff;get next digit @8014
545 8015 1057520 jz .n4   ;leading zero? -> @8015
546 8015+1117524 jmp .n6   ;non-zero->
547 8016  ;
548 8016  .n4:; 
549 8016 0056116 o02 .wk4   ; @8016
550 8016+0176111 bus .digits1   ;
551 8017 1137524 jn .n6   ; @8017
552 8017+0616115 lod .wk3   ;replacement character
553 8018 0070472416130 o00 .wk4/sto .Pbuff;store over zero @8018
554 8019 1117515 jmp .n3   ;and repeat for next @8019
555 8019+ ;
556 8019+ .n5:; 
557 8019+0056215 o02 K27   ;=FS+1=>SP, default leadzero char
558 8020 1117514 jmp .n1   ;back to remove leading zero @8020
559 8020+ ;
560 8020+ .n6:; 
561 8020+1015772 jmp .n7   ;-->>
562 8021  =7162 
563 7162  .n7:; 
564 7162 0236121 o11 .powlnk   ;check flag @7162
565 7162+1155775 jz .n8   ;
566 7163 1037530 jn .o2   ; @7163
567 7163+0615163 lod W6771   ;=02000000000000
568 7164 0070472516127 o00 .wk4/ads .wk9;set marker for FS needed @7164
569 7165 1017442 jmp .p1   ;output digits etc. @7165
570 7165+ ;
571 7165+ .n8:; 
572 7165+0616114 lod .wk2   ;
573 7166 1017525 jmp .o1   ;-->> @7166
574 7166+ ;
575 7166+ =8021 
576 8021  .o1:; 
577 8021 1320002 sll 2   ; @8021
578 8021+1037530 jn .o2   ;->
579 8022 0616115 lod .wk3   ;leadzero char @8022
580 8022+0216130 exa .Pbuff   ;swap with sign
581 8023 0070472416127 o00 .wk4/sto .wk9;put sign into place @8023
582 8024  .o2:; 
583 8024 0616114 lod .wk2   ; @8024
584 8024+1220015 srl 13   ;
585 8025 0076212 and K63   ;=077 @8025
586 8025+1057442 jz .p1   ;output digits etc.
587 8026 0416114 sto .wk2   ; @8026
588 8026+0176111 bus .digits1   ;
589 8027  .o3:; 
590 8027 0416115 sto .wk3   ; @8027
591 8027+0116210 add N1   ;=-1
592 8028 1137537 jn .o4   ; @8028
593 8028+0616226 lod SP.00   ;=03400
594 8029 0070466516130 o00 .wk3/ads .Pbuff; @8029
595 8030 0616115 lod .wk3   ; @8030
596 8030+0136114 sub .wk2   ;
597 8031 1017533 jmp .o3   ; @8031
598 8031+ ;
599 8031+ .o4:; 
600 8031+0616111 lod .digits1   ;
601 8032  .o5:; 
602 8032 0116114 add .wk2   ; @8032
603 8032+0416115 sto .wk3   ;
604 8033 0176112 bus .digits2   ; @8033
605 8033+1037442 jn .p1   ;output digits etc.
606 8034 1057442 jz .p1   ;ditto. @8034
607 8034+0616226 lod SP.00   ;=03400
608 8035 0070466516130 o00 .wk3/ads .Pbuff; @8035
609 8036 0616115 lod .wk3   ; @8036
610 8036+1017540 jmp .o5   ;
611 8037  ;--------------------------------------------------------------------
612 8037  ;
613 8037  ; output the formatted sign,digits,exponent, etc.
614 8037  ;
615 8037  =7970 
616 7970  .p1:; 
617 7970 0600377700033 cla outdev/otp FS;clear acc, o/p fig shift @7970
618 7971  .p2:; 
619 7971 2070476616130 sto .wk5/lod .Pbuff; @7971
620 7972 0416116 sto .wk4   ; @7972
621 7972+0100077 add outdev   ;
622 7973 1070473700000 exa .wk4/otp 0; @7973
623 7974 1200006 sra 6   ; @7974
624 7974+0076212 and K63   ;=077
625 7975 1057451 jz .p3   ; @7975
626 7975+0100077 add outdev   ;
627 7976 2070473700000 sto .wk4/otp 0; @7976
628 7977  .p3:; 
629 7977 2270476616127 inc .wk5/lod .wk9; @7977
630 7978 0400004 sto 4   ; @7978
631 7978+1115776 jmp .p4   ;-->>
632 7979  ;
633 7979  =7166+ 
634 7166+ .p4:; 
635 7166+0075163 and W6771   ;=02000000000000
636 7167 1056001 jz .p5   ;not set, skip FS @7167
637 7167+  nop      
637+17167+1016000 jmp .1    
637+27168  .1:; 
638 7168 0000377700033 o00 outdev/otp FS;output figure shift @7168
639 7169  .p5:; 
640 7169 0600004 lod 4   ; @7169
641 7169+1020000 jn Return   ;
642 7170 1017453 jmp .p6   ;-->> @7170
643 7170+ ;
644 7170+ =7979 
645 7979  ;
646 7979  .p6:; 
647 7979 0616117 lod .wk5   ; @7979
648 7979+1017443 jmp .p2   ; repeat until add done
649 7980  ;--------------------------------------------------------------------
650 7980  =8037 
651 8037  .nr3:; 
652 8037 0600001 lod T2Link   ; @8037
653 8037+0400015 sto Link1   ;
654 8038 0616576 lod Msg17   ;'PRINT ERROR' @8038
655 8038+1016165 jmp outerror0   ;
656 8039  ; no refs
657 8039  .nr4:; 
658 8039 1000000 jmp Return   ; @8039
659 8039+ ;
660 8039+0000000 o00 0   ;
661 8040  digits:; 
662 8040 0000000000004 '0','1','2','3','4';digits reverse lookup @8040
663 8045 0000000000031 '5','6','7','8','9' 
664 8050 0400001000010W8050:+00400001000010; @8050
665 8051  ;
666 8051  =7870 
667 7870  ;
668 7870  ; no refs
669 7870  .nr1:; 
670 7870   clo     ; @7870
670+17870 1177276 jo .1    
670+27870+ .1:; 
671 7870+1320001 sll 1   ;
672 7871 1077300 jo .nr2   ; @7871
673 7871+1017545 jmp .nr3   ;
674 7872  ;
675 7872  .nr2:; 
676 7872 0600004 lod 4   ; @7872
677 7872+1117264 jmp .r3   ;
678 7873  ; no refs
679 7873 1117264 jmp .r3   ; @7873
680 7873+ ;
681 7873+  ;