[Indigo]<AltoSource>FLOATSOURCES.DM!2>Bcpl-Float.mesa

567B,-- 32JMP FLOAT;
405B,-- 33JMP FIX;
555B,-- 34JMP .FMUL;
555B,-- 35JMP .FDIV;
555B,-- 36JMP .FADD;
556B,-- 37JMP .FSUB;
54560B,-- 40FIX: STA 3,saved3;
111000B,-- 41MOV 0,2;
4431B,-- 42JSR EXPLODE1;
35001B,-- 43LDA3,E1,2;GET EXPONENT
20465B,-- 44LDA0,NO32;32 DECIMAL
116400B,-- 45SUB0,3;C(3) = - NUMBER OF SHIFTS
175113B,-- 46MOVL#3,3,SNC;MUST SHIFT AT LEAST 1.
421B,-- 47 JMP FixErr;NOPE
21003B,-- 48LDA0,N1,2;LOW BITS
25002B,-- 49LDA1,M1,2;HIGH
125220B,-- 50MOVZR1,1;SHIFT LOOP
101200B,-- 51MOVR0,0
175404B,-- 52INC3,3,SZR
775B,-- 53 JMP .-3
35000B,-- 54LDA3,S1,2;SIGN
175015B,-- 55MOV#3,3,SNR
404B,-- 56 JMP .+4
100405B,-- 57NEG0,0,SNR;COMPLEMENT DP NUMBER
124401B,-- 58NEG1,1,SKP
124000B,-- 59COM1,1
45001B,-- 60STA1,1,2;LOW ORDER BITS
41000B,-- 61STA0,0,2;HIGH
102400B,-- 62SUB 0,0
2531B,-- 63JMP @saved3;
102520B,-- 64FixErr: SUBZL 0,0
2527B,-- 65JMP @saved3;
0B,-- 67EXPLODEret: 0;
54777B,-- 68EXPLODE1:STA 3,EXPLODEret;
21001B,-- 69LDA0,1,2;HIGH WORD
25000B,-- 70LDA1,0,2;LOW WORD
176400B,-- 71SUB3,3
101113B,-- 72MOVL#0,0,SNC;CHECK SIGN
405B,-- 73 JMP .+5;POSITIVE
174000B,-- 74COM3,3
124405B,-- 75NEG1,1,SNR;DOUBLE PRECISION NEGATE
100401B,-- 76NEG0,0,SKP
100000B,-- 77COM0,0;check here for zero word (-1,-1)
55000B,-- 78STA3,S1,2;SAVE SIGN
101125B,-- 79MOVZL0,0,SNR;HIGH 8 BITS OF AC0 ARE EXPONENT
4423B,-- 80JSR Zero1
34440B,-- 81LDA3,M377
137700B,-- 82ANDS1,3
55003B,-- 83STA3,N1,2;LOW 8 BITS OF MANTISSA
34436B,-- 84LDA3,Q377
167400B,-- 85AND3,1
174000B,-- 86COM3,3
117620B,-- 87andzr 0,3;AND0,3
137300B,-- 88ADDS1,3
175100B,-- 89movl3,3;set up for new high order bit
175240B,-- 90movor3,3;move in high order 1
55002B,-- 91STA3,M1,2;HIGH 16 BITS OF MANTISSA
24426B,-- 92LDA1,Q377
123700B,-- 93ANDS1,0
24425B,-- 94LDA1,BIAS
122400B,-- 95SUB1,0;BIAS THE EXPONENT
41001B,-- 96STA0,E1,2;SAVE EXPONENT
2742B,-- 97JMP@EXPLODEret;RETURN...
40B,-- 98NO32: 40
125014B,-- 99Zero1: mov# 1,1,SZR;check for low order=1
1400B,-- 100jmp0,3;nope, keep processing
45000B,-- 101sta 1,S1,2
45001B,-- 102sta 1,E1,2
45002B,-- 103sta 1,M1,2
45003B,-- 104sta 1,N1,2
2732B,-- 105jmp @EXPLODEret
125224B,-- 106Zero2: movzr 1,1,SZR;check for low order=1
1400B,-- 107jmp0,3;nope, keep processing
45004B,-- 108sta 1,S2,2
45005B,-- 109sta 1,E2,2
45006B,-- 110sta 1,M2,2
45007B,-- 111sta 1,N2,2
2723B,-- 112jmp @EXPLODEret
377B,-- 114M377:377;RIGHT HALF
177400B,-- 115Q377:177400;LEFT HALF
200B,-- 116BIAS:200;EXPONENT BIAS
54717B,-- 118EXPLODE2:STA 3,EXPLODEret;
21003B,-- 119LDA0,3,2;HIGH WORD
25002B,-- 120LDA1,2,2;LOW WORD
176400B,-- 121SUB3,3
101113B,-- 122MOVL#0,0,SNC;CHECK SIGN
405B,-- 123 JMP .+5;POSITIVE
174000B,-- 124COM3,3
124405B,-- 125NEG1,1,SNR;DOUBLE PRECISION NEGATE
100401B,-- 126NEG0,0,SKP
100000B,-- 127COM0,0
55004B,-- 128STA3,S2,2;SAVE SIGN
101125B,-- 129MOVZL0,0,SNR;HIGH 8 BITS OF AC0 ARE EXPONENT
4752B,-- 130jsr Zero2
34760B,-- 131LDA3,M377
137700B,-- 132ANDS1,3
55007B,-- 133STA3,N2,2;LOW 8 BITS OF MANTISSA
34756B,-- 134LDA3,Q377
167400B,-- 135AND3,1
174000B,-- 136COM3,3
117620B,-- 137andzr 0,3;AND0,3
137300B,-- 138ADDS1,3
175100B,-- 139movl3,3;set up for new high order bit
175240B,-- 140movor3,3;move in high order 1
55006B,-- 141STA3,M2,2;HIGH 16 BITS OF MANTISSA
24746B,-- 142LDA1,Q377
123700B,-- 143ANDS1,0
24745B,-- 144LDA1,BIAS
122400B,-- 145SUB1,0;BIAS THE EXPONENT
41005B,-- 146STA0,E2,2;SAVE EXPONENT
2662B,-- 147JMP@EXPLODEret;RETURN...
457B,-- 149.FMUL: JMP FMUL;
540B,-- 150.FDIV: JMP FDIV;
54405B,-- 151.FADD: STA 3,saved3;in case of jump to NORMALIZE
534B,-- 152JMP ..FADD;
54403B,-- 153.FSUB: STA 3,saved3;in case of jump to NORMALIZE
533B,-- 154JMP ..FSUB;
654B,-- 155..EXPLODE1: JMP EXPLODE1
0B,-- 156saved3: 0
54777B,-- 157FLOAT:STA 3,saved3;
111000B,-- 158MOV 0,2;address to store return
25001B,-- 159LDA1,1,2;HIGH ORDER BITS
21000B,-- 160LDA0,0,2;LOW
125113B,-- 161MOVL#1,1,SNC;CHECK SIGN.
405B,-- 162 JMP FLDP1;POSITIVE
100405B,-- 163NEG0,0,SNR;DOUBLE LENGTH NEGATE
124401B,-- 164NEG1,1,SKP
124000B,-- 165COM1,1
176001B,-- 166ADC3,3,SKP;SIGN -1
176400B,-- 167FLDP1:SUB3,3;SIGN 0
55000B,-- 168STA3,S1,2
34674B,-- 169LDA3,NO32;32 DECIMAL
55001B,-- 170STA3,E1,2;EXPONENT
176400B,-- 174SUB3,3;SHIFT COUNT
125005B,-- 175MOV1,1,SNR;IS HIGH ORDER PART ZERO?
407B,-- 176 JMP HIZ;YES
125112B,-- 177NO1:MOVL#1,1,SZC;NORMALIZED?
415B,-- 178 JMP NO2;YES
101120B,-- 179MOVZL0,0;LOW ORDER LEFT
125100B,-- 180MOVL1,1
175400B,-- 181INC3,3;COUNT
773B,-- 182JMPNO1;AND LOOP.
105005B,-- 184HIZ:MOV0,1,SNR;TRY JUST USING LOW BITS
405B,-- 185 JMP ALZ;RESULT ALL ZEROES.
34403B,-- 186LDA3,NO16;16 SHIFTS DONE LIKE WILDFIRE
102400B,-- 187SUB0,0;AND ZERO LOW ORDER
766B,-- 188JMPNO1;REJOIN LOOP
20B,-- 190NO16:16.
41001B,-- 192ALZ:STA0,E1,2;ZERO EXPONENT.
41000B,-- 193STA0,S1,2;POSITIVE SIGN
45002B,-- 194NO2:STA1,M1,2;HIGH ORDER ANSWER
41003B,-- 195STA0,N1,2
25001B,-- 196LDA1,E1,2
166400B,-- 197SUB3,1;ADJUST EXPONENT
45001B,-- 198STA1,E1,2
4572B,-- 199JSR.FST;returns AC0=0
2732B,-- 200JMP@saved3;AND RETURN.
0B,-- 202Msaved3: 0
54777B,-- 203FMUL:STA 3,Msaved3;
111000B,-- 204MOV 0,2;
4661B,-- 205JSR EXPLODE2;order is critical to avoid overwriting params
4724B,-- 206JSR ..EXPLODE1;
21001B,-- 208LDA0,E1,2
25005B,-- 209LDA1,E2,2
123000B,-- 210ADD1,0;ADD EXPONENTS, LIKE IN ANY MULTIPLY
41001B,-- 211STA0,E1,2
21000B,-- 212LDA0,S1,2
25004B,-- 213LDA1,S2,2
125004B,-- 214MOV1,1,SZR;AND XOR SIGNS
100000B,-- 215COM0,0
41000B,-- 216STA0,S1,2
155000B,-- 217MOV2,3;*** PUT BASE REGISTER IN 3 ***
102400B,-- 218SUB0,0;CLEAR AC0
25402B,-- 219LDA1,M1,3
31407B,-- 220LDA2,N2,3
61020B,-- 221MULX;HIGH*LOW
40535B,-- 222STA0,T1;SAVE HIGH ORDER 16 BITS
102400B,-- 223SUB0,0;CLEAR 0
25406B,-- 224LDA1,M2,3
31403B,-- 225LDA2,N1,3
61020B,-- 226MULX;OTHER HIGH*OTHER LOW
24530B,-- 227LDA1,T1
123020B,-- 228ADDZ1,0;ADD RESULTS, SET CARRY IF OVL
25402B,-- 229LDA1,M1,3;HIGH
31406B,-- 230LDA2,M2,3;HIGH
61020B,-- 231MULX;HIGH*HIGH (PLUS STUFF LEFT IN AC0!)
101002B,-- 232MOV0,0,SZC;IF LOW+LOW RESULTED INA CARRY,
101400B,-- 233 INC 0,0;NOW IS THE TIME TO ADD IT IN
101112B,-- 235MOVL#0,0,SZC
405B,-- 236 JMP .+5
125120B,-- 237MOVZL1,1;SHIFT LEFT LOW BITS
101100B,-- 238MOVL0,0;AND HIGH BITS
15401B,-- 239DSZE1,3;DECREMENT EXPONENT TO ACCOUNT
101000B,-- 240 MOV 0,0;IF IT DOES NOT SKIP
101004B,-- 242MOV0,0,SZR;IF HIGH BITS ZERO, TROUBLE.
403B,-- 243 JMP .+3
41401B,-- 244STA0,E1,3
45400B,-- 245STA1,S1,3;THAT IS ZERO.
41402B,-- 247STA0,M1,3
45403B,-- 248STA1,N1,3
171000B,-- 249MOV 3,2
4556B,-- 250JSR FST;Returns aC0=0
2723B,-- 251JMP @Msaved3;AND RETURN.
652B,-- 253.EXPLODE1: JMP ..EXPLODE1;
605B,-- 254.EXPLODE2: JMP EXPLODE2;
670B,-- 255..NORMALIZE: JMP NORMALIZE
511B,-- 256..FADD: JMP FADD
530B,-- 257..FSUB: JMP FSUB
54546B,-- 258FDIV:STA 3,Asaved3;
111000B,-- 259MOV 0,2;
4772B,-- 260JSR .EXPLODE2;order is critical to avoid overwriting params
4770B,-- 261JSR .EXPLODE1;
25006B,-- 263LDA1,M2,2;GET DIVISOR MANTISSA
125005B,-- 264MOV1,1,SNR;CHECK FOR ZERO.
474B,-- 265 JMP DivErr;YES - DIVIDE ERROR.
21005B,-- 266LDA0,E2,2;SUBTRACT EXPONENTS
25001B,-- 267LDA1,E1,2
106400B,-- 268SUB0,1
45001B,-- 269STA1,E1,2;
21000B,-- 270LDA0,S1,2
25004B,-- 271LDA1,S2,2;XOR SIGNS
125004B,-- 272MOV1,1,SZR
100000B,-- 273COM0,0
41000B,-- 274STA0,S1,2
155000B,-- 275MOV2,3;*** PUT BASE REGISTER IN 3 ***
21402B,-- 276LDA0,M1,3
101005B,-- 277MOV0,0,SNR;CHECK FOR DIVIDEND ZERO.
453B,-- 278 JMP DIV0;YUP
25403B,-- 279LDA1,N1,3
31406B,-- 280LDA2,M2,3;HIGH ORDER DIVISOR
112032B,-- 281ADCZ#0,2,SZC;SKIPS IF AC0 GEQ AC2 UNSIGNED
405B,-- 282 JMP D0;IF AC0 < AC2 GO DIVIDE
101220B,-- 283MOVZR0,0
125200B,-- 284MOVR1,1;DIVIDE DIVIDEND BY TWO.
11401B,-- 285ISZE1,3;BUMP EXPONENT BECAUSE OF SHIFT
101010B,-- 286 MOV# 0,0;NOP
61021B,-- 287D0:DIVX;DIVIDEND/ HIGH-ORDER-DIVISOR
101010B,-- 290 MOV# 0,0;ALTO DIVIDE SKIPS
45402B,-- 291STA1,M1,3;SAVE HIGH ORDER RESULTS.
126400B,-- 292SUB1,1;NOW AC0&1 HAVE REMAINDER,0
61021B,-- 293DIVX;REMAINDER/ HIGH-ORDER-DIVISOR
101010B,-- 295 MOV# 0,0;ALTO DIVIDE SKIPS
45403B,-- 296STA1,N1,3;SAVE LOW ORDER RESULT.
102400B,-- 301SUB0,0
25407B,-- 302LDA1,N2,3;LOW ORDER DIVISOR
31402B,-- 303LDA2,M1,3;HIGH ORDER ANSWER SO FAR
61020B,-- 304MULX
31406B,-- 305LDA2,M2,3;HIGH ORDER DIVISOR
112032B,-- 306ADCZ#0,2,SZC;CHECK TO SEE IF DIVIDE WILL OVERFLOW.
403B,-- 308 JMP D2;NO - GO DIVIDE
15402B,-- 309DSZM1,3;YES - DECREMENT HIGH ORDER PART OF
142400B,-- 312SUB2,0;AND SUBTRACT ’ONE’ FROM DIVIDEND
61021B,-- 313D2:DIVX
101010B,-- 314 MOV# 0,0;ALTO DIVIDE SKIPS
21403B,-- 315LDA0,N1,3;UNCORRECTED LOW ORDER RESULT.
122423B,-- 316SUBZ1,0,SNC;SUBTRACT SECOND CORRECTION
15402B,-- 317 DSZ M1,3;DECREASE HIGH ORDER PART TOO - WILL
31402B,-- 319LDA2,M1,3;GET HIGH ORDER PART OF ANSWER
151112B,-- 320D3:MOVL#2,2,SZC;CHECK NORMALIZATION - COULD BECOME
405B,-- 321 JMP D1;UNNORMALIZED BECAUSE OF EITHER ’DSZ’
101120B,-- 322MOVZL0,0;CORRECTION ABOVE
151100B,-- 323MOVL2,2
15401B,-- 324DSZE1,3;DECREMENT EXPONENT
101010B,-- 325 MOV# 0,0
51402B,-- 326D1:STA2,M1,3;STORE ANSWER
41403B,-- 327STA0,N1,3
171000B,-- 328MOV3,2
4454B,-- 329JSR FST;returns ac0=0
2452B,-- 330JMP @Asaved3;AND RETURN.
0B,-- 331T1: 0
41401B,-- 332DIV0:STA0,E1,3;ZERO EXPONENT
41400B,-- 333STA0,S1,3;AND SIGN
111000B,-- 334MOV0,2
767B,-- 335JMPD1;AND EXIT
20404B,-- 337DivErr:LDA 0,p3;
2443B,-- 338JMP @Asaved3
0B,-- 340FSTret: 0
442B,-- 341.FST: JMP FST
3B,-- 342p3: 3;
54437B,-- 352FADD:STA 3,Asaved3;
111000B,-- 353MOV 0,2;
4663B,-- 354JSR .EXPLODE2;order is critical to avoid overwriting params
4661B,-- 355JSR .EXPLODE1;
4516B,-- 357JSRPRESHIFT ;GO SHIFT ARGUMENTS.
21000B,-- 358LDA0,S1,2;ARG 1
25004B,-- 359LDA1,S2,2;ARG 2
101014B,-- 360MOV#0,0,SZR
404B,-- 361 JMP AD1N;FIRST ARG NEGATIVE
125014B,-- 362MOV#1,1,SZR
546B,-- 363 JMP ADD2;SECOND ARG NEGATIVE (+ + -)
566B,-- 364JMPADD1;SECOND ARG POSITIVE (+ + +)
125014B,-- 365AD1N:MOV#1,1,SZR
564B,-- 366 JMP ADD1;SECONG ARG NEGATIVE (- + -)
542B,-- 367JMPADD2;SECOND ARG POSITIVE (- + +)
647B,-- 369.NORMALIZE: JMP ..NORMALIZE
54417B,-- 370FSUB:STA 3,Asaved3;
111000B,-- 371MOV 0,2;
4643B,-- 372JSR .EXPLODE2;order is critical to avoid overwriting params
4641B,-- 373JSR .EXPLODE1;
4476B,-- 375JSRPRESHIFT ;GO SHIFT ARGUMENTS.
21000B,-- 376LDA0,S1,2;ARG 1
25004B,-- 377LDA1,S2,2;ARG 2
101014B,-- 378MOV#0,0,SZR
404B,-- 379 JMP SB1N;FIRST ARG NEGATIVE
125014B,-- 380MOV#1,1,SZR
547B,-- 381 JMP ADD1;SECOND ARG NEGATIVE (+ - -)
525B,-- 382JMPADD2;SECOND ARG POSITIVE (+ - +)
125014B,-- 383SB1N:MOV#1,1,SZR
523B,-- 384 JMP ADD2;SECOND ARG NEGATIVE (- - -)
543B,-- 385JMPADD1;SECOND ARG POSITIVE (- - +)
0B,-- 387Asaved3: 0
54735B,-- 388FST:STA3,FSTret
21003B,-- 389lda 0,N1,2;first, do rounding
24454B,-- 390lda 1,STBIAS;200B
123023B,-- 391addz 1,0,snc
411B,-- 392jmp rounded
25002B,-- 393lda 1,M1,2
125423B,-- 394incz 1,1,snc
405B,-- 395jmp normalized
125200B,-- 396movr 1,1
101200B,-- 397movr 0,0
11001B,-- 398isz E1,2
401B,-- 399jmp .+1
45002B,-- 400normalized: sta 1,M1,2
41003B,-- 401rounded:sta 0,N1,2
25002B,-- 403LDA1,M1,2;MANTISSA
21001B,-- 404LDA0,E1,2;EXPONENT
135005B,-- 405MOV1,3,SNR;IF ZERO, special case
427B,-- 406jmp FSTZeroRet;both AC0 and AC1 are 0
24434B,-- 407LDA1,STBIAS ;GET EXPONENT BIAS
123000B,-- 408ADD1,0
24433B,-- 409LDA1,STL377 ;177400
123414B,-- 410AND#1,0,SZR
426B,-- 411 JMP FstErr;EXPONENT TOO LARGE
137520B,-- 412andzl1,3;used to be:AND1,3
163300B,-- 413ADDS3,0
101220B,-- 414MOVZR0,0;SHIFT INTO POSITION,
40674B,-- 416STA0,T1;SAVE (MAY NEED TO BE COMPLEMENTED)
35003B,-- 417LDA3,N1,2
137400B,-- 418AND1,3
21002B,-- 419LDA0,M1,2
124000B,-- 420COM1,1
123400B,-- 421AND1,0;SECOND 8 BITS OF MANTISSA
163300B,-- 422ADDS3,0
24665B,-- 423LDA1,T1
35000B,-- 424LDA3,S1,2;GET SIGN
175005B,-- 425MOV3,3,SNR
404B,-- 426 JMP .+4
100405B,-- 427NEG0,0,SNR;DOUBLE LENGTH NEGATE
124401B,-- 428NEG1,1,SKP
124000B,-- 429COM1,1
45001B,-- 431STA1,1,2;HIGH WORD
41000B,-- 432STA0,0,2;LOW WORD
102400B,-- 433SUB 0,0
2662B,-- 434JMP @FSTret;AND RETURN...
20404B,-- 436FstErr: LDA 0,p2
2660B,-- 437JMP @FSTret
200B,-- 438STBIAS:200;EXPONDENT BIAS
177400B,-- 439STL377:177400
2B,-- 440p2: 2;
0B,-- 441ArithRet: 0
54777B,-- 443STA3,ArithRet;SAVE RETURN ADDRESS
21002B,-- 444LDA0,M1,2;MANTISSA FOR ZERO CHECK
25006B,-- 445LDA1,M2,2
107415B,-- 446AND#0,1,SNR;IF EITHER ARGUMENT ZERO,
475B,-- 447 JMP NOSHZ;NO SHIFT REQUIRED BECAUSE ZERO
21001B,-- 448LDA0,E1,2
35005B,-- 449LDA3,E2,2
116405B,-- 450SUB0,3,SNR;ARE EXPONENTS THE SAME?
421B,-- 451 JMP NOSH;NO SHIFT
175112B,-- 452MOVL#3,3,SZC;CHECK SIGNS
474B,-- 453JMPSE2; E2 < E1
21005B,-- 455LDA0,E2,2
41001B,-- 456STA0,E1,2;SHIFT UNTIL EXPONENT MATCHES E2
174400B,-- 457NEG3,3;- NUMBER OF SHIFTS
20507B,-- 458LDA0,C31;
117112B,-- 459ADDL#0,3,SZC;SEE IF TOO FAR TO SHIFT.
4502B,-- 460 JSR SE4; YES - FIX - IGNORE NEXT 6 INSTRS.
21002B,-- 461LDA0,M1,2;! GET THE NUMBER
25003B,-- 462LDA1,N1,2;!
101220B,-- 463MOVZR0,0;!
125200B,-- 464MOVR1,1;! SHIFTED
175404B,-- 465INC3,3,SZR;!
775B,-- 466 JMP .-3;! LOOP UNTIL SHIFTS DONE.
41002B,-- 467STA0,M1,2
45003B,-- 468STA1,N1,2
21006B,-- 469NOSH:LDA0,M2,2;COPY SECOND ARGUMENT
40445B,-- 470STA0,AAM
21007B,-- 471LDA0,N2,2
40444B,-- 472STA0,AAN
2742B,-- 473JMP@ArithRet;RETURN
21003B,-- 475ADD2:LDA0,N1,2;LOW ARG 1
24441B,-- 476LDA1,AAN;LOW ARG 2
122420B,-- 477SUBZ1,0;0 HAS LOW ORDER RESULT.
25002B,-- 478LDA1,M1,2;HIGH ORDER
34435B,-- 479LDA3,AAM
101002B,-- 480MOV0,0,SZC;LOOK AT CARRY FROM SUBZ
166421B,-- 481SUBZ3,1,SKP;IF THERE WAS A CARRY,
166020B,-- 483ADCZ3,1;ELSE ONE’S COMPL SUB
101002B,-- 484MOV0,0,SZC;IF NO CARRY, SIGN CHANGED!!!!
626B,-- 485 JMP .NORMALIZE ;CARRY - ALL DONE.
100405B,-- 486NEG0,0,SNR;DOUBLE LENGTH NEGATE
124401B,-- 487NEG1,1,SKP
124000B,-- 488COM1,1
35000B,-- 489LDA3,S1,2;COMPLEMENT SIGN
174000B,-- 490COM3,3
55000B,-- 491STA3,S1,2
617B,-- 492JMP .NORMALIZE
21003B,-- 494ADD1:LDA0,N1,2;LOW ORDER ARG 1
24420B,-- 495LDA1,AAN;LOW ORDER ARG 2
35002B,-- 496LDA3,M1,2;HIGH ORDER ARG 1
123022B,-- 497ADDZ1,0,SZC;ADD LOW PARTS
175420B,-- 498INCZ3,3;BUMP HIGH PART IF CARRY
24413B,-- 499LDA1,AAM;HIGH ORDER ARG 2
167003B,-- 500ADD3,1,SNC;ADD HIGH PARTS
405B,-- 501 JMP .+5;NO CARRY
125200B,-- 502MOVR1,1;POSTSHIFT
101200B,-- 503MOVR0,0
11001B,-- 504ISZE1,2
101000B,-- 505 MOV0,0;NOP
41003B,-- 506STA0,N1,2;STORE RESULTS
45002B,-- 507STA1,M1,2
4621B,-- 508JSR FST;returns AC0=0
2617B,-- 509JMP @Asaved3;AND RETURN.
0B,-- 511AAM: 0
0B,-- 512AAN: 0
101004B,-- 513NOSHZ:MOV0,0,SZR;IF SECOND ARGUMENT ZERO,
727B,-- 514 JMP NOSH;JUST COPY IT TO ITS TEMPS.
21005B,-- 515LDA0,E2,2;ELSE COPY SECOND ARGUMENT’S EXPONENT
41001B,-- 516STA0,E1,2;INTO ARGUMENT 1’S, AND
724B,-- 517JMPNOSH;COPY ARGUMENT 2 TO ITS PLACE
20417B,-- 519SE2:LDA0,C31
117112B,-- 520ADDL#0,3,SZC
4412B,-- 521 JSR SE4;TOO FAR TOOHIFT - IGNORE 6 INSTRS.
21006B,-- 522LDA0,M2,2;! SHIFT ARG2
25007B,-- 523LDA1,N2,2;!
101220B,-- 524MOVZR0,0;!
125200B,-- 525MOVR1,1;!
175404B,-- 526INC3,3,SZR;!
775B,-- 527 JMP .-3;! LOOP SHIFTING
40760B,-- 528STA0,AAM;SAVE IN SPECIAL PLACE
44760B,-- 529STA1,AAN;TO AVOID CLOBBERING NUMBER.
2656B,-- 530JMP@ArithRet
102400B,-- 532SE4:SUB0,0;MAKE BOTH MANTISSAS ZERO
105000B,-- 533MOV0,1
1406B,-- 534JMP6,3;AND BYPASS THE SHIFT LOOP
37B-- 535C31:37
];

CallBcplCode: PROCEDURE [startAddr: CARDINAL, ParamVec: POINTER] =
BEGIN
OPEN NovaOps;
errorFlag: CARDINAL;
errorFlag ← NovaJSR[JSR,@FloatBcplCode+startAddr,ParamVec];
IF errorFlag # 0 THEN
SIGNAL FloatingPointError[LOOPHOLE[errorFlag,RealDefs.FloatingError]];
END;

FloatingPointError: PUBLIC SIGNAL[f: RealDefs.FloatingError] = CODE;

zFloat: PUBLIC PROCEDURE [a: LONG INTEGER] RETURNS [REAL] =
BEGIN
ParamVec: ARRAY [0..2) OF REAL;
ParamVec[0]←LOOPHOLE[a,REAL];
CallBcplCode[0,BASE[ParamVec]];
RETURN [ParamVec[0]];
END;