Elliott 803 Algol 60 Compiler (reconstructed)

File: math.t2

For general comments see here
LineAddressObject Code LabelF1N1BF2N2CommentsCheck
1 0  ; tape2/math1.t2
2 0  ;---------------
3 0  ; RPower, raise number to real power, using exp(ln(Link1) * arg1)
4 0  ;
5 0  Math::; 
6 0  ;
7 0  ; scratch data area : these words may be used by other
8 0  ; routines, unrelated to what goes on here
9 0  ;
10 0  =7241 
11 7241 0000000000000.SLink:+0; return address for Series subroutine
12 7242 0000000000000.work1:+0; used by Series and Sqrt as temp
13 7243 0000000000000.work2:+0; used by Exp, Series and Sqrt as temp
14 7244 0000000000000.work3:+0; used by Series & Sqrt as temp
15 7245 0000000000000.work4:+0; used by Series & ArcSin as temp
16 7246  .coeffp:; 
17 7246 0000000000000 +0; used by Series to reference table
18 7247 0000000000000.arg:+0; used by most rtnes as main argument
19 7248 0000000000000 +0; not knowingly referenced!
20 7249 0000000000000.work5:+0; used by most rtnes as temp
21 7250  ;
22 7250  =7104 
23 7104  ;
24 7104  RPower:; 
25 7104 0600015 lod Link1   ; @7104
26 7104+1156006 jz L7174P   ;
27 7105   calln ,   ; @7105
27+17105 7300065116002 lnk Link1:jmp LogSub 
28 7106 1460016 fmu arg1   ; @7106
29 7106+0000000 o00 0   ;
30 7107   calln ,   ; @7107
30+17107 7300065000041 lnk Link1:jmp ExpEnt 
31 7108 1000000 jmp Return   ; @7108
32 7108+ ;
33 7108+0000000 o00 0   ;
34 7109  =7170+ 
35 7170+ ;
36 7170+ LogSub:; 
37 7170+1136003 jn .LSerr   ;negative value->error
38 7171 1000042 jmp LogEnt   ;call real log @7171
39 7171+ ;
40 7171+ .LSerr:; 
41 7171+0600001 lod T2Link   ;restore return address
42 7172 0340015 stc Link1   ; @7172
43 7172+1016321 jmp .LnErr   ;then report error
44 7173  ;
45 7173  =7174+ 
46 7174+ L7174P:; 
47 7174+0120016 sub arg1   ;
48 7175 1135370 jn Round.1   ; @7175
49 7175+1116003 jmp .LSerr   ;report error
50 7176  ;
51 7176  =7190 
52 7190  ; exp(x)
53 7190  ;
54 7190  ;Exp::
55 7190  .ExpErr:; 
56 7190 0616567 lod Msg10   ;'Exp error' @7190
57 7190+1016165 jmp outerror0   ;
58 7191  Exp:; 
59 7191 0416117 sto .arg   ; @7191
60 7191+1456151 fna FP176.06   ;=176.06 (ish)
61 7192 1036026 jn .ExpErr   ; @7192
62 7192+0616117 lod .arg   ;
63 7193 1416151 fad FP176.06   ;=176.06 (ish) @7193
64 7193+1036044 jn .ExpZero   ;
65 7194 0616117 lod .arg   ; @7194
66 7194+1476153 fmu FP1.4427   ;=1.4427 (ish)
67 7195 0416113 sto .work2   ; @7195
68 7195+1416154 fad FP257.0   ;=257.0 (just under)
69 7196 0416121 sto .work5   ; @7196
70 7196+0076155 and MantBits   ;=07777777777000
71 7197 2570507200446 sbs .work5/sra 294; @7197
72 7198 0136204 sub K256   ;=256 @7198
73 7198+0416121 sto .work5   ;
74 7199 1540000 flt 4096   ; @7199
75 7199+1436113 fsb .work2   ;
76 7200 0416117 sto .arg   ; @7200
77 7200+0616042 lod .ExpCon   ;
78 7201   calln ,   ; @7201
78+17201 7370445016074 lnk Math.SLink:jmp Series.1 
79 7202  .ExpCon:; 
80 7202 0116121 add .work5   ; @7202
81 7202+0016231 o00 Ptab1   ;in-line param?
82 7203  RetClr:; 
83 7203 1060052 jo retlnk1   ; @7203
84 7203+1000052 jmp retlnk1   ;
85 7204  ;
86 7204  .ExpZero:; 
87 7204 0140000 cla 0   ; @7204
88 7204+1016043 jmp RetClr   ;
89 7205  ;--------------------------------------------------------------------
90 7205  ;Sin::
91 7205  .SinErr:; 
92 7205 0616570 lod Msg11   ;'Sine Error' @7205
93 7205+1016165 jmp outerror0   ;
94 7206  ;
95 7206  ; sin(x)
96 7206  ;
97 7206  Sin:; 
98 7206 1476070 fmu FP0.6366   ;=0.6366 (ish) @7206
99 7206+0416117 sto .arg   ;
100 7207 0556121 cls .work5   ; @7207
101 7207+0076203 and K511   ;=0777
102 7208 0176160 bus K286   ;exponent=+30 @7208
103 7208+1036045 jn .SinErr   ;
104 7209 0176161 bus K30   ;=30 @7209
105 7209+1136061 jn .S2   ;
106 7210 0216117 exa .arg   ; @7210
107 7210+0076155 and MantBits   ;=07777777777000
108 7211 1200001.Scon:sra 1   ; @7211
109 7211+0016241 o00 Ptab2   ;=-5
110 7212 0070477320000 o00 .arg/sll 0; @7212
111 7213   clo     ; @7213
111+17213 1176055 jo .1    
111+27213+ .1:; 
112 7213+1320001 sll 1   ;
113 7214 0456121 inc .work5   ; @7214
114 7214+1176057 jo .S1   ;
115 7215 0556121 cls .work5   ; @7215
116 7215+ .S1:; 
117 7215+0116204 add K256   ;=256
118 7216 1400000 fad 0   ; @7216
119 7216+1056043 jz RetClr   ;
120 7217 0416117 sto .arg   ; @7217
121 7217+ .S2:; 
122 7217+0616053 lod .Scon   ;
123 7218   calln ,   ; @7218
123+17218 7370445016071 lnk Math.SLink:jmp Series 
124 7219 1476117 fmu .arg   ; @7219
125 7219+0216121 exa .work5   ;
126 7220 1056066 jz .S3   ; @7220
127 7220+0140000 cla 0   ;
128 7221 1436121 fsb .work5   ; @7221
129 7221+1016043 jmp RetClr   ;
130 7222  ;
131 7222  .S3:; 
132 7222 0616121 lod .work5   ; @7222
133 7222+1016043 jmp RetClr   ;
134 7223  ;--------------------------------------------------------------------
135 7223  ; cos(x)
136 7223  ; =sin(x+pi/2)
137 7223  ;
138 7223  Cos:; 
139 7223 1456156 fna PIby2   ;=1.570796326 (pi/2) @7223
140 7223+1016046 jmp Sin   ;
141 7224  ;--------------------------------------------------------------------
142 7224  ; Series: approximate function using polynomial? series
143 7224  ;
144 7224  ;Series::
145 7224  ; table of co-efficients in Acc,
146 7224  ; main argument in .arg
147 7224  ;
148 7224  FP0.6366:; 
149 7224 2427630156400 +02427630156400;0.6366197728 = 2.0/PI @7224
150 7225  ;
151 7225  Series:; 
152 7225 2070472600001 sto .coeffp/lod 1;save coeff ptr, load coeff[1] @7225
153 7226 0416115 sto .work4   ;save it @7226
154 7226+0616117 lod .arg   ;load argument
155 7227 1476117 fmu .arg   ;square argument @7227
156 7227+1016076 jmp .P2   ;skip alternate entry
157 7228  ;
158 7228  ; alternate entry
159 7228  Series.1:; 
160 7228 2070472600001 sto .coeffp/lod 1;save coeff ptr, load coeff[1] @7228
161 7229 0416115 sto .work4   ;save it @7229
162 7229+0616117 lod .arg   ;load argument
163 7230  .P2:; 
164 7230 1476157 fmu FP4.0   ;=4.0 @7230
165 7230+1436162 fsb FP2.0   ;=2.0
166 7231 0416114 sto .work3   ; @7231
167 7231+0556113 cls .work2   ;
168 7232 0070472600000 o00 .coeffp/lod 0; @7232
169 7233  .P3:; 
170 7233 0216115 exa .work4   ; @7233
171 7233+0216113 exa .work2   ;
172 7234 0416112 sto .work1   ; @7234
173 7234+0616113 lod .work2   ;
174 7235 1476114 fmu .work3   ; @7235
175 7235+1436112 fsb .work1   ;
176 7236 2270473400001 inc .coeffp/fad 1; @7236
177 7237 0256115 exc .work4   ; @7237
178 7237+1036101 jn .P3   ;
179 7238 0616115 lod .work4   ; @7238
180 7238+1436112 fsb .work1   ;
181 7239 1056110 jz .P4   ; @7239
182 7239+0116210 add N1   ;=-1
183 7240  .P4:; 
184 7240 0070447000001 o00 .SLink/jmp 1; @7240
185 7241  ;--------------------------------------------------------------------
186 7241  ; tape2/math2.t2
187 7241  ;---------------
188 7241  ; ln(x)
189 7241  ;
190 7241  =7377 
191 7377  ;Ln::
192 7377  .LnErr:; 
193 7377 0616571 lod Msg12   ;'log error' @7377
194 7377+1016165 jmp outerror0   ;
195 7378  ;
196 7378  Ln:; 
197 7378 1036321 jn .LnErr   ; @7378
198 7378+1056321 jz .LnErr   ;
199 7379 0416117 sto .arg   ; @7379
200 7379+0076203 and K511   ;=511
201 7380 0136204 sub K256   ;=256 @7380
202 7380+0116210 add N1   ;=-1
203 7381 0376117 o17 .arg   ; @7381
204 7381+1436206 fsb FP1   ;=1.0
205 7382 0216117 exa .arg   ; @7382
206 7382+1540000 flt 4096   ;
207 7383 1476164 fmu FP0.6931   ;=0.6931 @7383
208 7383+0416121 sto .work5   ;
209 7384 0616330.Lcon:lod .Lcon   ; @7384
210 7384+0016250 o00 Ptab3   ;
211 7385   calln ,   ; @7385
211+17385 7370445016074 lnk Math.SLink:jmp Series.1 
212 7386 1416121 fad .work5   ; @7386
213 7386+1016043 jmp RetClr   ;
214 7387  ;--------------------------------------------------------------------
215 7387  ;Tan::
216 7387  .TErr:; 
217 7387 0616572 lod Msg13   ;'TAN ERROR' @7387
218 7387+1016165 jmp outerror0   ;
219 7388  ;
220 7388  ; tan(x)
221 7388  ;
222 7388  Tan:; 
223 7388 1476070 fmu FP0.6366   ;=0.6366 (ish) @7388
224 7388+1476162 fmu FP2.0   ;=2.0
225 7389 0416117 sto .arg   ; @7389
226 7389+0076203 and K511   ;=0777
227 7390 0176160 bus K286   ;exponent=+30 @7390
228 7390+1036333 jn .TErr   ;
229 7391 0556121 cls .work5   ; @7391
230 7391+0176221 bus K29   ;=29
231 7392 1136345 jn .T1   ; @7392
232 7392+0116204 add K256   ;=256
233 7393 0376117 o17 .arg   ; @7393
234 7393+1200001 sra 1   ;
235 7394 0070477317401 o00 .arg/sla 7937; @7394
236 7395   clo     ; @7395
236+17395 1176343 jo .1    
236+27395+ .1:; 
237 7395+1320001 sll 1   ;
238 7396 0116204 add K256   ;=256 @7396
239 7396+0416117 sto .arg   ;
240 7397 1076353 jo .T2   ; @7397
241 7397+ .T1:; 
242 7397+0616352 lod .Tcon   ;
243 7398   calln ,   ; @7398
243+17398 7370445016071 lnk Math.SLink:jmp Series 
244 7399 1476117 fmu .arg   ; @7399
245 7399+0216121 exa .work5   ;
246 7400 1056066 jz .S3   ; @7400
247 7400+0140000 cla 0   ;
248 7401 1436206 fsb FP1   ;=1.0 @7401
249 7401+1516121 fdv .work5   ;
250 7402 1016043.Tcon:jmp RetClr   ; @7402
251 7402+0016263 o00 Ptab4    
252 7403  ;
253 7403  .T2:; 
254 7403 0076155 and MantBits   ;=07777777777000 @7403
255 7403+1056355 jz .T3   ;
256 7404 0456121 inc .work5   ; @7404
257 7404+1116345 jmp .T1   ;
258 7405  ;
259 7405  .T3:; 
260 7405 0616230 lod MaxInt   ;=03777777777777 @7405
261 7405+1016043 jmp RetClr   ;
262 7406  ;--------------------------------------------------------------------
263 7406  ;
264 7406  .Magic:; 
265 7406 0314631463146 +0314631463146;0x0666666666 @7406
266 7407  ;
267 7407  ; arctan(x)
268 7407  ;
269 7407  ArcTan:; 
270 7407 0416117 sto .arg   ; @7407
271 7407+ .AT1:; 
272 7407+1440000 fna 0   ;
273 7408 1136357 jn .AT1   ;abs(x) @7408
274 7408+0556121 cls .work5   ;
275 7409 1436206 fsb FP1   ;=1.0 @7409
276 7409+1036367 jn .AT4   ;
277 7410 0616206 lod FP1   ;=1.0 @7410
278 7410+1516117 fdv .arg   ;
279 7411 1440000 fna 0   ; @7411
280 7411+0416117 sto .arg   ;
281 7412 1036366 jn .AT2   ; @7412
282 7412+0616156 lod PIby2   ;=1.570796326 (pi/2)
283 7413 1440000 fna 0   ; @7413
284 7413+1116366 jmp .AT3   ;
285 7414  ;
286 7414  .AT2:; 
287 7414 0616156 lod PIby2   ;=1.570796326 (pi/2) @7414
288 7414+ .AT3:; 
289 7414+0416121 sto .work5   ;
290 7415  .AT4:; 
291 7415 0616367 lod .AT4   ; @7415
292 7415+0016274 o00 Ptab5   ;
293 7416   calln ,   ; @7416
293+17416 7370445016071 lnk Math.SLink:jmp Series 
294 7417 1476117 fmu .arg   ; @7417
295 7417+1416121 fad .work5   ;
296 7418 1016043 jmp RetClr   ; @7418
297 7418+ ;
298 7418+0000000 o00 0   ;
299 7419  ;--------------------------------------------------------------------
300 7419  ; sqrt(a) - extract square root of real number
301 7419  ;
302 7419  ;Sqrt::
303 7419  Sqrt:; 
304 7419 1036414 jn .SQerr   ;sqrt error if < 0.0 @7419
305 7419+1056043 jz RetClr   ;return if = 0.0
306 7420 0416113 sto .work2   ; @7420
307 7420+0076203 and K511   ;=0777 mask off exponent
308 7421 0136412 sub .255   ; @7421
309 7421+1200001 sra 1   ;
310 7422 0416114 sto .work3   ; @7422
311 7422+1320001 sll 1   ;
312 7423 0176113 bus .work2   ; @7423
313 7423+0416113 sto .work2   ;
314 7424 0116210 add N1   ;=-1, divide by 2 @7424
315 7424+1416413 fad .4368   ;
316 7425 0416112 sto .work1   ; @7425
317 7425+0616113 lod .work2   ;
318 7426 1516112 fdv .work1   ; @7426
319 7426+1416112 fad .work1   ;
320 7427 0116210 add N1   ;=-1, divide by 2 @7427
321 7427+0416112 sto .work1   ;
322 7428 0616113 lod .work2   ; @7428
323 7428+1516112 fdv .work1   ;
324 7429 1416112 fad .work1   ; @7429
325 7429+0116210 add N1   ;=-1, divide by 2
326 7430 0416112 sto .work1   ; @7430
327 7430+0616113 lod .work2   ;
328 7431 1516112 fdv .work1   ; @7431
329 7431+1416112 fad .work1   ;
330 7432 0116210 add N1   ;=-1, divide by 2 @7432
331 7432+0116114 add .work3   ;
332 7433 1016043 jmp RetClr   ;return answer @7433
333 7433+ ;
334 7433+0000000 o00 0   ;
335 7434  ;
336 7434 0000000000377.255:+255; @7434
337 7435 3375103775377.4368:+03375103775377;0.4368000003 @7435
338 7436  ;
339 7436  .SQerr:; 
340 7436 0616566 lod Msg9   ;'SQRT ERROR' @7436
341 7436+1016165 jmp outerror0   ;
342 7437  ;--------------------------------------------------------------------
343 7437  ; arcsin(x)
344 7437  ;
345 7437  ;ArcSin::
346 7437  ArcSin:; 
347 7437 0556121 cls .work5   ; @7437
348 7437+1440000 fna 0   ;
349 7438  .AS1:; 
350 7438 0416117 sto .arg   ; @7438
351 7438+1476163 fmu Root2   ;=1.414213561
352 7439 0216117 exa .arg   ; @7439
353 7439+1136420 jn .AS2   ;
354 7440 1440000 fna 0   ; @7440
355 7440+ .AS2:; 
356 7440+1416206 fad FP1   ;=1.0
357 7441 1036445 jn .ASerr   ; @7441
358 7441+0616117 lod .arg   ;
359 7442 1476117 fmu .arg   ; @7442
360 7442+1436206 fsb FP1   ;=1.0
361 7443 1036436 jn .AS8   ; @7443
362 7443+1016010 jmp .AS3   ;
363 7444  =7176 
364 7176  .AS3:; 
365 7176 0600016 lod arg1   ; @7176
366 7176+1460016 fmu arg1   ;
367 7177 0136210 sub N1   ;=-1 @7177
368 7177+1116441 jmp .AS4   ;
369 7178  ;
370 7178  =7457+ 
371 7457+ .AS4:; 
372 7457+1456162 fna FP2.0   ;=2.0
373 7458 0416115 sto .work4   ; @7458
374 7458+1016424 jmp .AS5   ;
375 7459  =7444 
376 7444  .AS5:; 
377 7444 0600015 lod Link1   ; @7444
378 7444+0216115 exa .work4   ;
379 7445   calln ,   ; @7445
379+17445 7300065016373 lnk Link1:jmp Sqrt 
380 7446 0216117 exa .arg   ; @7446
381 7446+1136430 jn .AS6   ;
382 7447 0140000 cla 0   ; @7447
383 7447+1436117 fsb .arg   ;
384 7448 0416117 sto .arg   ; @7448
385 7448+ .AS6:; 
386 7448+0616115 lod .work4   ;
387 7449 0400015 sto Link1   ; @7449
388 7449+0616436 lod .AS8   ;
389 7450   calln ,   ; @7450
389+17450 7370445016071 lnk Math.SLink:jmp Series 
390 7451 1476117 fmu .arg   ; @7451
391 7451+1036435 jn .AS7   ;
392 7452 1436156 fsb PIby2   ;=1.570796326 (pi/2) @7452
393 7452+1116440 jmp .AS9   ;
394 7453  ;
395 7453  .AS7:; 
396 7453 1416156 fad PIby2   ;=1.570796326 (pi/2) @7453
397 7453+1116440 jmp .AS9   ;
398 7454  ;
399 7454  .AS8:; 
400 7454 0616436 lod .AS8   ; @7454
401 7454+0016307 o00 Ptab6   ;
402 7455   calln ,   ; @7455
402+17455 7370445016071 lnk Math.SLink:jmp Series 
403 7456 1476117 fmu .arg   ; @7456
404 7456+ .AS9:; 
405 7456+1456121 fna .work5   ;
406 7457 1016043 jmp RetClr   ; @7457
407 7457+ ;
408 7457+ =7459 
409 7459  ;--------------------------------------------------------------------
410 7459  ; arccos(x)
411 7459  ;
412 7459  ArcCos:; 
413 7459 0416121 sto .work5   ; @7459
414 7459+0616156 lod PIby2   ;=1.570796326 (pi/2)
415 7460 0216121 exa .work5   ; @7460
416 7460+1016416 jmp .AS1   ;
417 7461  ;
418 7461  .ASerr:; 
419 7461 0616573 lod Msg14   ;'ARCSIN ERROR' @7461
420 7461+1016165 jmp outerror0   ;
421 7462  ;--------------------------------------------------------------------
422 7462   ; 

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