1 FIXMRI FADD=1000 2 FIXMRI FSUB=2000 3 FIXMRI FMPY=3000 4 FIXMRI FDIV=4000 5 FIXMRI FGET=5000 6 FIXMRI FPUT=6000 7 FNOR=7000 8 FEXT=0000 9 FIXTAB 10 /27-BIT EXTENDED FUNCTIONS 11 12 /5-23-72 R BEAN 13 14 /COPYRIGHT 1972 DIGITAL EQUIPMENT CORPORATION,MAYNARD, MASS. 01754 15 16 /DEC-08-NFPEA-A VERSION 1 17 18 EXP=44 19 HORD=45 20 LORD=46 21 22 FIXFLT=5500 23 *FIXFLT 24 25 /******FIX****** 26 /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO 27 /A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44) 28 29 005500 0000 FFIX, 0 30 005501 4772 JMS I SPLITA /SPLIT UP FAC (UNPACK IT) 31 005502 3771 DCA I SPLTFK /CLEAR SPLIT FLAG!! 32 005503 1044 TAD EXP /FETCH EXPONENT 33 005504 1307 TAD FTRPRT /SUBTRACT THE BIAS 34 005505 7540 SZA SMA /IS NUMBER <1? 35 005506 5311 JMP .+3 /NO-CONTINUE ON 36 005507 7600 FTRPRT, 7600 /CLA=-200 37 005510 5327 JMP FIXDNE /YES-FIX IT TO ZERO 38 005511 1332 TAD M13 /SET BINARY POINT AT 11 PLACES TO 39 005512 7540 SMA SZA /RIGHT OF CURRENT POINT IS # TOO BIG? 40 005513 5751 JMP I OTRAPA /YES-TAKE OVERFLOW TRAP 41 005514 1331 TAD M4 /NO-ADD 4 SINCE AC1 HAS SOME BITS 42 005515 3044 DCA EXP /SET SCALE COUNT 43 005516 4773 FIXLP, JMS I AR1A /SHIFT FAC RIGHT 1 PLACE 44 005517 3046 DCA LORD /ZERO LORD SO OV WILL BE 0 45 005520 2044 ISZ EXP /DONE YET? 46 005521 5316 JMP FIXLP /NO 47 005522 1043 TAD TM /YES-PUT SIGN OF MANTISSA 48 005523 7104 CLL RAL /IN LINK 49 005524 1045 TAD HORD /GET HIGH ORDER MANTISSA 50 005525 7430 SZL /WAS ORIGINAL # NEGATIVE? 51 005526 7141 CLL CMA IAC /YES-NEGATE THIS AND CLR. LINK 52 005527 3044 FIXDNE, DCA EXP /RETURN WITH ANSWER IN 44 53 005530 5700 JMP I FFIX /RETURN 54 55 005531 7774 M4, -4 /-4 DECIMAL 56 005532 7765 M13, -13 /-11 DECIMAL 57 58 /******FLOAT****** 59 /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC 60 61 005533 0000 FFLOAT, 0 62 005534 7100 CLL 63 005535 1044 TAD EXP 64 005536 7510 SPA /IS IT NEGATIVE? 65 005537 7061 CML CMA IAC /YES-MAKE POSITIVE AND SET LINK 66 005540 3045 DCA HORD /PUT NUMBER IN HI MANTISSA 67 005541 3046 DCA LORD /CLEAR LOW MANTISSA 68 005542 7010 RAR /ROTATE SIGN FROM LINK 69 005543 1350 TAD C2170 /15(10)+ SIGN INTO EXPONENT 70 005544 3044 DCA EXP 71 005545 4747 JMS I FNORL /NORMALIZE 72 005546 5733 JMP I FFLOAT /RETURN 73 005547 7265 FNORL, FFNOR /LINK TO NORMALIZE ROUTINE 74 005550 2170 C2170, 2170 /15 DECIMAL 75 005551 7570 OTRAPA, FTRP1 /ADDRESS OF VECTOR FOR OVERFLOW TRAP 76 77 005552 2004 LOGC5, 2004 /.59897865 78 005553 6253 6253 79 005554 2522 2522 80 005555 2005 LN2, 2005 /.69314718 81 005556 4271 4271 82 005557 0300 0300 83 005560 2005 TOVPI, 2005 /.6366198 = 2/PI 84 005561 0574 0574 85 005562 6033 6033 86 005563 0000 TEMP1, 0 87 005564 0000 0 88 005565 0000 0 89 005566 0000 TEMP2, 0 /TWO TEMP STORAGE BLOCKS FOR FUNCTIONS 90 005567 0000 0 91 005570 0000 0 92 005571 4750 SPLTFK, SPLTFG 93 005572 4711 SPLITA, SPLIT 94 005573 7101 AR1A, AR1 95 *FIXFLT-500 96 97 /******SINE****** 98 99 005000 0000 SIN, 0 100 005001 4313 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG 101 005002 4666 JMS I FMPYL /X*2/PI 102 005003 5560 TOVPI 103 005004 4301 JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM,AND GET FRACTIONAL PART IN FAC 104 005005 1323 TAD NUM /GET INTEGER PART OF (2/PI)*X 105 005006 0300 AND C3 /ISOLATE BITS 10,11 106 005007 1212 TAD JMPI 107 005010 3211 DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE 108 005011 5211 JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X 109 005012 5660 JMPI, JMP I QDTBL 110 111 005013 4671 QUAD2, JMS I FSUB1L /1-X 112 005014 5472 ONE 113 005015 5222 JMP POLYSN /CALCULATE SIN(1-X) 114 005016 4672 QUAD3, JMS I FNEGL /-X 115 005017 5222 JMP POLYSN /CALCULATE SIN(-X) 116 005020 4673 QUAD4, JMS I FSUBL /X-1 117 005021 5472 ONE 118 005022 4667 POLYSN, JMS I FPUTL /SAVE X 119 005023 5563 TEMP1 120 005024 4674 JMS I FSQRL /U=X**2 121 005025 4667 JMS I FPUTL /SAVE U 122 005026 5566 TEMP2 123 005027 4666 JMS I FMPYL /A9(U) 124 005030 5412 SINA9 125 005031 4665 JMS I FADDL /A7+A9(U) 126 005032 5407 SINA7 127 005033 4666 JMS I FMPYL /A7(U)+A9(U**2) 128 005034 5566 TEMP2 129 005035 4665 JMS I FADDL /A5+A7(U)+A9(U**2) 130 005036 5404 SINA5 131 005037 4666 JMS I FMPYL /A5(U)+A7(U**2)+A9(U**3) 132 005040 5566 TEMP2 133 005041 4665 JMS I FADDL /A3+A5(U)+A7(U**2)+A9(U**3) 134 005042 5401 SINA3 135 005043 4666 JMS I FMPYL /A3(U)+A5(U**2)+A7(U**3)+A9(U**4) 136 005044 5566 TEMP2 137 005045 4665 JMS I FADDL /A1+A3(U)+A5(U**2)+A7(U**3)+A9(U**4) 138 005046 5376 PIOV2 139 005047 4666 JMS I FMPYL /A1(X)+A3(X**3)+A5(X**5)+A7(X**7)+A9(X**9) 140 005050 5563 TEMP1 141 005051 4323 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) 142 005052 5600 JMP I SIN /FAC=SIN(X) 143 144 145 /******COSINE****** 146 /USES SIN ROUTINE TO CALCULATE COS(X) 147 148 005053 0000 COS, 0 149 005054 4665 JMS I FADDL /COS(X)=SIN(PI/2+X) 150 005055 5376 PIOV2 151 005056 4200 JMS SIN 152 005057 5653 JMP I COS /RETURN 153 154 005060 5022 QDTBL, POLYSN /X IN QUAD1,SIN(X)=SIN(X) 155 005061 5013 QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) 156 005062 5016 QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) 157 005063 5020 QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) 158 005064 7306 FGETL, FFGET 159 005065 7000 FADDL, FFADD 160 005066 6600 FMPYL, FFMPY 161 005067 7322 FPUTL, FFPUT 162 005070 6722 FDIVL, FFDIV 163 005071 6400 FSUB1L, FFSUB1 164 005072 7135 FNEGL, FFNEG 165 005073 7117 FSUBL, FFSUB 166 005074 7564 FSQRL, FFSQ 167 005075 5500 FIXL, FFIX 168 005076 5533 FLOATL, FFLOAT 169 005077 6412 FDIV1L, FFDIV1 170 005100 0003 C3, 3 171 /ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC 172 /ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS 173 /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC 174 175 005101 0000 FRACT, 0 176 005102 4667 JMS I FPUTL /SAVE X 177 005103 5563 TEMP1 178 005104 4675 JMS I FIXL /INTEGER PORTION OF X 179 005105 1044 TAD EXP 180 005106 3323 DCA NUM /SAVE FIXED FORTION OF X 181 005107 4676 JMS I FLOATL /FAC=FLOAT(FIX(X)) 182 005110 4671 JMS I FSUB1L /FAC=X-INT(X)=FRACTION (X) 183 005111 5563 TEMP1 184 005112 5701 JMP I FRACT /RETURN 185 186 /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS 187 /SET TO 1 188 189 005113 0000 NHNDLE, 0 190 005114 1044 TAD EXP /GET SIGN OF MANTISSA 191 005115 7700 SMA CLA /IS IT <0? 192 005116 5321 JMP NFLGST /NO-CLEAR NFLAG 193 005117 4672 JMS I FNEGL /YES-NEGATE FAC 194 005120 7001 IAC /AND SET NFLAG 195 005121 3335 NFLGST, DCA NFLAG 196 005122 5713 JMP I NHNDLE 197 198 /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 199 200 005123 0000 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE 201 005124 1335 TAD NFLAG 202 005125 7640 SZA CLA /IS NFLAG=0? 203 005126 4672 JMS I FNEGL /NO-NEGATE FAC 204 005127 5723 JMP I NCHK /YES-RETURN 205 206 NUM=NCHK 207 005130 4711 SPLITZ, SPLIT 208 005131 4656 STICKZ, STICK 209 005132 0010 KK10, 10 210 *SIN+135 211 212 /******EXPONENTIAL****** 213 214 005135 0000 EXPON, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN 215 005136 4666 JMS I FMPYL /Y=XLOG2(E) 216 005137 5415 LOG2E 217 005140 4301 JMS FRACT /GET FRACTIONAL PART OF Y 218 005141 4666 JMS I FMPYL /(FRACTION(Y))*(LN2/2) 219 005142 5420 LN2OV2 220 005143 4667 JMS I FPUTL /SAVE Y 221 005144 5563 TEMP1 222 005145 4674 JMS I FSQRL /Y**2 223 005146 4665 JMS I FADDL /B1+Y**2 224 005147 5423 EXPB1 225 005150 4677 JMS I FDIV1L /A1/(B1+Y**2) 226 005151 5426 EXPA1 227 005152 4665 JMS I FADDL /A0+A1/(B1+Y**2) 228 005153 5431 EXPA0 229 005154 4673 JMS I FSUBL /A0-Y+A1/(B1+Y**2) 230 005155 5563 TEMP1 231 005156 4667 JMS I FPUTL /SAVE 232 005157 5566 TEMP2 233 005160 4664 JMS I FGETL /GET Y 234 005161 5563 TEMP1 235 005162 1332 TAD KK10 /MULT BY 2=2Y 236 005163 1044 TAD EXP 237 005164 3044 DCA EXP /(DONE BY ADDING 1 TO EXP.) 238 005165 4670 JMS I FDIVL /2Y/(A0-Y+A1/(B1+Y**2)) 239 005166 5566 TEMP2 240 005167 4665 JMS I FADDL /1+2Y/(AO-Y+A1/(B1+Y**2)) 241 005170 5472 ONE 242 005171 4674 JMS I FSQRL /[1+2Y/(A0-Y+A1/(B1+Y**2))]**2=EXP(Y) 243 005172 4730 JMS I SPLITZ /SPLIT FAC 244 005173 1323 TAD NUM 245 005174 1044 TAD EXP /EXP(X)=(2**N)(EXPY) 246 005175 3044 DCA EXP 247 005176 4731 JMS I STICKZ /REPACK FAC 248 005177 5735 JMP I EXPON /FAC=EXPON(X) 249 250 NFLAG=EXPON 251 252 *SIN+200 253 254 /******ARC TANGENT****** 255 256 005200 0000 ATAN, 0 257 005201 4661 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE 258 005202 4756 JMS I FPUTM /SAVE X 259 005203 5563 TEMP1 260 005204 4763 JMS I FSUBM /X-1 261 005205 5472 ONE 262 005206 1044 TAD EXP /GET SIGN OF MANTISSA 263 005207 7710 SPA CLA /WAS X>1? 264 005210 5220 JMP ARGPOL /NO-CLEAR GT1FLG 265 005211 4767 JMS I FGETM /YES-ATAN(X)=PI/2-ATAN(1/X) 266 005212 5472 ONE 267 005213 4761 JMS I FDIVM /1/X 268 005214 5563 TEMP1 269 005215 4756 JMS I FPUTM 270 005216 5563 TEMP1 271 005217 7001 IAC /SET GT1FLG 272 005220 3263 ARGPOL, DCA GT1FLG 273 005221 4767 JMS I FGETM /GET X OR 1/X 274 005222 5563 TEMP1 275 005223 4765 JMS I FSQRM /Y**2 276 005224 4756 JMS I FPUTM /SAVE 277 005225 5566 TEMP2 278 005226 4760 JMS I FADDM /Y**2+B3 279 005227 5456 ATANB3 280 005230 4762 JMS I FDIV1M /A3/(Y**2+B3) 281 005231 5453 ATANA3 282 005232 4760 JMS I FADDM /B2+A3/(Y**2+B3) 283 005233 5450 ATANB2 284 005234 4760 JMS I FADDM /Y**2+B2+A3/(Y**2+B3) 285 005235 5566 TEMP2 286 005236 4762 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) 287 005237 5445 ATANA2 288 005240 4760 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) 289 005241 5442 ATANB1 290 005242 4760 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) 291 005243 5566 TEMP2 292 005244 4762 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 293 005245 5437 ATANA1 294 005246 4760 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 295 005247 5434 ATANB0 296 005250 4757 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) 297 005251 5563 TEMP1 298 005252 1263 TAD GT1FLG /WAS X>1? 299 005253 7650 SNA CLA 300 005254 5257 JMP NGT /NO-TEST IF X<0? 301 005255 4764 JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X) 302 005256 5376 PIOV2 303 005257 4662 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC 304 005260 5600 JMP I ATAN /FAC=ATAN(X) 305 005261 5113 NHNDLL, NHNDLE 306 005262 5123 NCHKL, NCHK 307 /******NAPERIAN LOGARITHM****** 308 309 GTFLG=ATAN 310 311 005263 0000 LOG, 0 312 005264 1044 TAD EXP 313 005265 7550 SPA SNA /X<0 OR X=0? 314 005266 5770 JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP 315 005267 1371 TAD M2014 /IS EXP=2014? 316 005270 7450 SNA 317 005271 1045 TAD HORD /YES-IS HORD=0? 318 005272 7450 SNA 319 005273 1046 TAD LORD /YES-LORD=0? 320 005274 7640 SZA CLA 321 005275 5300 JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 322 005276 3044 LTRPRT, DCA EXP 323 005277 5663 JMP I LOG /YES-LOG(1)=0 324 005300 4772 POLYNL, JMS I SPLITS /SPLIT UP FAC 325 005301 1044 TAD EXP /GET TRUE EXPONENT 326 005302 1373 TAD M200 327 005303 3200 DCA GTFLG /SAVE EXPONENT FOR LATER 328 005304 1374 TAD KK200 329 005305 3044 DCA EXP /ISOLATE MANTISSA IN FAC 330 005306 4775 JMS I STICKS /REPACK FAC 331 005307 4756 JMS I FPUTM /SAVE F 332 005310 5563 TEMP1 333 005311 4760 JMS I FADDM /F+SQR(.5) 334 005312 5461 SQRP5 335 005313 4756 JMS I FPUTM /SAVE 336 005314 5566 TEMP2 337 005315 4767 JMS I FGETM 338 005316 5563 TEMP1 339 005317 4763 JMS I FSUBM /F-SQR(.5) 340 005320 5461 SQRP5 341 005321 4761 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) 342 005322 5566 TEMP2 343 005323 4756 JMS I FPUTM 344 005324 5563 TEMP1 345 005325 4765 JMS I FSQRM /Z**2 346 005326 4756 JMS I FPUTM 347 005327 5566 TEMP2 348 005330 4757 JMS I FMPYM /C5(Z**2) 349 005331 5552 LOGC5 350 005332 4760 JMS I FADDM /C3+C5(Z**2) 351 005333 5467 LOGC3 352 005334 4757 JMS I FMPYM /C3(Z**2)+C5(Z**4) 353 005335 5566 TEMP2 354 005336 4760 JMS I FADDM /C1+C3(Z**2)+C5(Z**4) 355 005337 5464 LOGC1 356 005340 4757 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) 357 005341 5563 TEMP1 358 005342 4763 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) 359 005343 5475 ONEHAF 360 005344 4756 JMS I FPUTM /SAVE LOG2(F) 361 005345 5566 TEMP2 362 005346 1200 TAD GTFLG /I 363 005347 3044 DCA EXP /SET UP FLOAT 364 005350 4766 JMS I FLOATM 365 005351 4760 JMS I FADDM /I+LOG2(F) 366 005352 5566 TEMP2 367 005353 4757 JMS I FMPYM /[I+LOG2(F)]*LOGE(2)=LOGE(X) 368 005354 5555 LN2 369 005355 5663 JMP I LOG /FAC=LN(X) 370 371 GT1FLG=LOG 372 005356 7322 FPUTM, FFPUT 373 005357 6600 FMPYM, FFMPY 374 005360 7000 FADDM, FFADD 375 005361 6722 FDIVM, FFDIV 376 005362 6412 FDIV1M, FFDIV1 377 005363 7117 FSUBM, FFSUB 378 005364 6400 FSUB1M, FFSUB1 379 005365 7564 FSQRM, FFSQ 380 005366 5533 FLOATM, FFLOAT 381 005367 7306 FGETM, FFGET 382 005370 7572 ARTRAP, FTRP3 383 005371 5764 M2014, -2014 384 005372 4711 SPLITS, SPLIT 385 005373 7600 M200, -200 386 005374 0200 KK200, 200 387 005375 4656 STICKS, STICK 388 389 /CONSTANTS USED BY VARIOUS FUNCTIONS 390 391 005376 2016 PIOV2, 2016 /1.57079633 392 005377 2207 2207 393 005400 7325 7325 394 005401 6005 SINA3, 6005 /-0.645963711 395 005402 1256 1256 396 005403 7405 7405 397 005404 1755 SINA5, 1755 /.079689679 398 005405 0632 0632 399 005406 1276 1276 400 005407 5714 SINA7, 5714 /-.00467376557 401 005410 6223 6223 402 005411 1430 1430 403 005412 1644 SINA9, 1644 /.00015148419 404 005413 7553 7553 405 005414 6723 6723 406 005415 2015 LOG2E, 2015 /1.442695 407 005416 6125 6125 408 005417 0731 0731 409 005420 1775 LN2OV2, 1775 /.34657359027 410 005421 4271 4271 411 005422 0300 0300 412 005423 2067 EXPB1, 2067 /60.0901907 413 005424 4056 4056 414 005425 1326 1326 415 005426 6124 EXPA1, 6124 /-601.804267 416 005427 5471 5471 417 005430 5711 5711 418 005431 2046 EXPA0, 2046 /12.01501675 419 005432 0036 0036 420 005433 6021 6021 421 005434 1765 ATANB0, 1765 /.174655439 422 005435 4554 4554 423 005436 3400 3400 424 005437 2027 ATANA1, 2027 /3.70925626 425 005440 3262 3262 426 005441 1643 1643 427 005442 2036 ATANB1, 2036 /6.7621392 428 005443 6061 6061 429 005444 5620 5620 430 005445 6037 ATANA2, 6037 /-7.10676005 431 005446 0665 0665 432 005447 2236 2236 433 005450 2026 ATANB2, 2026 /3.31633543 434 005451 5037 5037 435 005452 3266 3266 436 005453 5774 ATANA3, 5774 /-.264768620 437 005454 1707 1707 438 005455 7005 7005 439 005456 2015 ATANB3, 2015 /1.44863154 440 005457 6266 6266 441 005460 3017 3017 442 443 005461 2005 SQRP5, 2005 /.707106781 444 005462 5202 5202 445 005463 3630 3630 446 005464 2025 LOGC1, 2025 /2.88539129 447 005465 6125 6125 448 005466 1002 1002 449 005467 2007 LOGC3, 2007 /.961470632 450 005470 5421 5421 451 005471 3603 3603 452 005472 2014 ONE, 2014 /1 453 005473 0000 0 454 005474 0000 0 455 005475 2004 ONEHAF, 2004 /.5 456 005476 0000 0 457 005477 0000 0 458 459 FFSIN=SIN 460 FFCOS=COS 461 FFATN=ATAN 462 FFLOG=LOG 463 FFEXP=EXPON 464 PAUSE 465 /27-BIT FLOATING PT INTERPRETER 466 /DEC-08-NFPEA-A VERSION 1 467 /COPYRIGHT 1972 BY DIGITAL EQUIPMENT CORPORATION 468 /MAYNARD, MASSACHUSETTS. 01754 469 / 470 /W.J. CLOGHER 471 / 472 / 473 /DEFINITION FOR ORIGIN OF PACKAGE 474 / 475 FLPT=7400 476 / 477 /PAGE ZERO LOCATIONS USED 478 / 479 *7 480 000007 7400 FPP, FPT 481 *40 482 000040 0000 AC0, 0 483 000041 0000 AC1, 0 /HOLDS HIGH ORDER MANT. OF FAC AFTER SPLIT 484 000042 0000 AC2, 0 /HOLDS HIGH ORDER MANT. OF OPR. AFTER SPLIT 485 000043 6201 TM, CDF 0 /ONLY NEEDED ONCE (FIRST CALL TO CDFCUR) 486 000044 0000 ACX, 0 /FLOATING ACCUMULATOR-EXPONENT 487 000045 0000 ACH, 0 / " " -HIGH ORDER MANTISSA 488 000046 0000 ACLO, 0 / " " -LOW ORDER MANTISSA 489 000047 0000 OPX, 0 /STORAGE FOR OPERAND 490 000050 0000 OPH, 0 491 000051 0000 OPL, 0 492 000052 0000 DSWIT, 0 /SWITCH SHOWING IF ANY INPUT CONV. WAS DONE 493 000053 0000 CHAR, 0 /LOCATION HOLDING TERMINATOR OF LAST INPUT. 494 000054 7777 SWIT1, 7777 /=0 IF NO LINE FEED AFTER CAR.RET. ON INPUT 495 000055 7777 SWIT2, 7777 /=0 IF NO CR/LF AFTER OUTPUT 496 / 497 /IF EFLG = 0, 7 IS DEPOSITED INTO DADP, AND 16 (8) INTO FLDW 498 / 499 000056 0000 EFLG, 0 /=0 IF E FORMAT OUT 500 000057 0000 FLDW, 0 /FIELD WIDTH ON OUTPUT 501 000060 0000 DADP, 0 /=# OF PLACES AFTER DEC. PT. 502 000061 7413 FPNXT, FPNEXT /(DON'T USE FPNEXT AS A TEM!! E.G. IN I/O 503 /SINCE OS/8 BASIC MAY BE THERE INSTEAD!!!) 504 *FLPT-2600 505 / 506 /PARTS OF INTERPRETER DISPATCH ROUTINES 507 / 508 /TABLE FOR JUMPS-OP CODE 7 509 / 510 004600 5601 JMPI3, JMP I TABLE3 511 004601 7546 TABLE3, FFSKP /SKIP ON CONDITION OF FAC 512 004602 4755 FFCDF /CHANGE FLTG. DATA FIELD 513 004603 7405 FFSW0 /FLOATING SWITCH 0 514 004604 4617 FFSW1 /FLOATING SWITCH 1 515 004605 7373 FFHLT /FLOATING HALT-DISPLAY PC 516 004606 7413 FPNEXT /NOP-FOR FUTURE EXPANSION 517 004607 7413 FPNEXT / " 518 004610 7413 FPNEXT / " 519 / 520 /ROUTINE FOR DECODING SPECIAL FJMS'S-OP CODE 7 521 / 522 004611 1050 JSKP, TAD OPH /GET EFF. ADDR. 523 004612 0216 AND P7 /MASK OFF BITS 9-11 524 004613 1200 TAD JMPI3 /MAKE A JUMP THROUGH TABLE 525 004614 3215 DCA .+1 /STORE IT 526 004615 0000 0 /EXECUTE IT 527 004616 0007 P7, 7 528 / 529 /FLOATING SWITCH 1 530 / 531 004617 4655 FFSW1, JMS I CDFCRK /MUST BE CURRENT DATA FIELD 532 004620 1225 TAD FFSB1 /CHANGE INTERPRETATION OF SUB, DIV 533 004621 3627 DCA I TSUBP /SO THAT FAC IS SUBTRACTED 534 004622 1226 TAD FFDV1 /FROM OR DIVIDED INTO OPERAND 535 004623 3630 DCA I TDIVP 536 004624 5461 JMP I FPNXT /DONE 537 004625 6400 FFSB1, FFSUB1 538 004626 6412 FFDV1, FFDIV1 539 004627 7457 TSUBP, TSUB 540 004630 7461 TDIVP, TDIV 541 / 542 /ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FIELD SET TO EITHER 543 /FLTG. DATA FIELD OR FLTG. INSTR. FIELD. 544 /ADDRESS OF OPERAND IS IN THE AC ON ENTRY. 545 /ON RETURN, THE`AC IS CLEAR 546 / 547 004631 0000 ARGET, 0 548 004632 3042 DCA AC2 /STORE ADDRESS OF OPERAND 549 004633 1442 TAD I AC2 /PICK UP EXPONENT 550 004634 3047 DCA OPX 551 004635 2042 ISZ AC2 /MOVE POINTER TO HI MANTISSA WD 552 004636 1442 TAD I AC2 /PICK IT UP 553 004637 3050 DCA OPH /STORE 554 004640 2042 ISZ AC2 /MOVE PTR. TO LO MANTISSA WD. 555 004641 1442 TAD I AC2 /PICK IT UP 556 004642 3051 DCA OPL /STORE IT 557 004643 5631 JMP I ARGET /RETURN 558 / 559 /MDSET-SETS UP SIGNS FOR MULTIPLY AND DIVIDE 560 /EXIT WITH EXPONENT OF OPERAND IN AC FOR EXPONENT 561 /CALCULATION-CALLED WITH ADDRESS OF OPERAND IN AC AND 562 /DATA FIELD SET PROPERLY FOR OPERAND. 563 / 564 004644 0000 MDSET, 0 565 004645 4231 JMS ARGET /GET ARGUMENT 566 004646 4311 JMS SPLIT /SPLIT UP FAC AND OPERAND 567 004647 1043 TAD TM /ADD SIGN OF FAC AND OP 568 004650 1040 TAD AC0 569 004651 3043 DCA TM /STORE FINAL SIGN 570 004652 3040 DCA AC0 /MUST BE ZERO FOR DIVIDE 571 004653 1047 TAD OPX /EXIT WITH OPERAND EXPONENT IN AC 572 004654 5644 JMP I MDSET 573 004655 7251 CDFCRK, CDFCUR 574 575 / 576 /ROUTINE TO PACK FAC INTO 3 WORDS AFTER 577 /NORMALIZATION--ALSO CHECKS FOR EXPONENT OVERFLOW AND 578 /UNDERFLOW. 579 / 580 004656 0000 STICK, 0 581 004657 1044 TAD ACX /GET THE FINAL EXPONENT 582 004660 7510 SPA /IS IT NEGATIVE? 583 004661 5700 JMP I NDFLO /YES-UNDERFLOW-TRAP OUT 584 004662 0302 AND K7400 /NO-IS IT TOO BIG (OVERFLOW)? 585 004663 7640 SZA CLA 586 004664 5701 JMP I OVFLO /YES-TRAP OUT 587 004665 1044 TAD ACX /NO-SHIFT IT INTO POSITION 588 004666 7106 CLL RTL 589 004667 7004 RAL 590 004670 1043 TAD TM /ADD SIGN AND HIGH ORDER 591 004671 1041 TAD AC1 /MANTISSA BITS 592 004672 3044 DCA ACX /STORE IT BACK 593 004673 3350 DONES, DCA SPLTFG /CLEAR SPLIT FLAG 594 004674 3677 DCA I OVP /CLEAR OVERFLOW WORD 595 004675 7100 CLL 596 004676 5656 JMP I STICK /RETURN 597 004677 7131 OVP, OV 598 004700 7566 NDFLO, FTRP4 599 004701 7567 OVFLO, FTRP5 600 004702 7400 K7400, 7400 601 602 004703 7610 NDRFLO, SKP CLA /UNDERFLOW-ZERO FAC 603 004704 7350 OVRFLO, CLA CLL CMA RAR /OVERFLOW-SET FAC TO 3777;0;0 604 004705 3044 DCA ACX 605 004706 3045 DCA ACH 606 004707 3046 DCA ACLO 607 004710 5273 JMP DONES /DONE 608 / 609 /ROUTINE TO UNPACK FLOATING AC AND OPERAND 610 /PUT OPERAND EXPONENT INTO OPX, MANTISSA TO AC2,OPH,OPL 611 /PUT FA EXP. IN ACX, MANTISSA TO AC1,ACH,ACLO 612 /OP SIGN TO AC0, FAC SIGN TO TM 613 / 614 004711 0000 SPLIT, 0 615 004712 1350 TAD SPLTFG /IF FLAG SET-THEY'RE ALREADY UNPACKED 616 004713 7640 SZA CLA /WELL? 617 004714 5711 JMP I SPLIT /ALREADY DONE-RETN. 618 004715 4655 JMS I CDFCRK /NOT DONE - CHANGE TO DATA FLD. OF FPP 619 004716 7330 CLA CLL CML RAR /PICK OFF SIGN BIT OF OPERAND 620 004717 0047 AND OPX /MANTISSA 621 004720 3040 DCA AC0 /STORE FOR LATER 622 004721 1047 TAD OPX /PICK OFF HI ORDER MANTISSA BITS 623 004722 0346 AND KP7 624 004723 3042 DCA AC2 /STORE IN AC2 625 004724 1047 TAD OPX /NOW GET THE EXPONENT OF OP. 626 004725 7112 CLL RTR 627 004726 7010 RAR 628 004727 0347 AND K377 /MASK OFF GARBAGE 629 004730 3047 DCA OPX /AND STORE 630 004731 7330 CLA CLL CML RAR /NOW FAC-GET SIGN BIT 631 004732 0044 AND ACX 632 004733 3043 DCA TM /STORE IT 633 004734 1044 TAD ACX /GET HI MANTISSA BITS OF FAC 634 004735 0346 AND KP7 635 004736 3041 DCA AC1 /STORE AWAY 636 004737 1044 TAD ACX /NOW GET THE FAC'S EXPONENT 637 004740 7112 CLL RTR 638 004741 7010 RAR 639 004742 0347 AND K377 640 004743 3044 DCA ACX /STORE AWAY 641 004744 2350 ISZ SPLTFG /SET FLAG-WE'VE UNPACKED FAC, AND OP 642 004745 5711 JMP I SPLIT /DONE 643 004746 0007 KP7, 7 644 004747 0377 K377, 377 645 004750 0000 SPLTFG, 0 646 647 / 648 /ROUTINE TO ZERO FAC ON DIVIDE BY ZERO 649 / 650 004751 3046 DBAD, DCA ACLO 651 004752 3045 DCA ACH 652 004753 5754 JMP I DVDD /GO ZERO REST 653 004754 6716 DVDD, DVD 654 / 655 /FCDF-BITS 6-8 ARE NEW FLTG. DATA FIELD 656 / 657 004755 1050 FFCDF, TAD OPH /GET FIELD BITS (EFF. ADDR.) 658 004756 1361 TAD PCDF0 /ADD IN CDF INSTR. 659 004757 5760 JMP I SFDFP /GO STORE CDF TO FLTG. D.F. 660 004760 7412 SFDFP, SFDF 661 004761 6200 PCDF0, 6200 662 *FLPT-1600 663 664 / 665 /FLOATING OUTPUT ROUTINE 666 / 667 005600 0000 FFOUT, 0 668 005601 3041 DCA AC1 /CLR. AC1 INCASE FAC=0 669 005602 3352 DCA KNT /CLEAR COUNT WORD 670 005603 1056 TAD EFLG /IS THIS E FORMAT? 671 005604 7640 SZA CLA 672 005605 5212 JMP FFMT /NO-F FORMAT 673 005606 1342 TAD KK7 /YES-GET A 7 674 005607 3060 DCA DADP /STORE AS # OF DIGITS AFT DEC PT 675 005610 1335 TAD K16 /SET FIELD WIDTH TO 14 ( DECIMAL) 676 005611 3057 DCA FLDW 677 005612 4736 FFMT, JMS I CDFCRB /CHANGE TO FIELD OF PACKAGE 678 005613 1257 TAD KM10 /SET # OF SIGNF. DIGITS 679 005614 3741 DCA I DCNTP /TO 7 (DON'T PRINT 8TH) 680 005615 1044 TAD ACX /GET EXP WORD OF NUMBER 681 005616 7700 SMA CLA /IS NUMBER NEGATIVE? 682 005617 7144 CLL CMA RAL /NO-MAKE A -2 683 005620 1343 TAD K255 /FORM CORRECT SIGN OF # 684 005621 3377 DCA TEM /STORE FOR LATER OUTPUT 685 005622 7350 CLA CLL CMA RAR /ZERO SIGN BIT OF # 686 005623 0044 AND ACX /SO WE DEAL ONLY WITH POS. #S 687 005624 7450 SNA /IS #=0? 688 005625 5303 JMP FOUT /YES-SKIP DOWN 689 005626 3044 DCA ACX 690 005627 7332 FOUT1, CLA CLL CML RTR /GET # TO RANGE .1<=N<1 691 005630 0044 AND ACX /IS EXP. NEGATIVE? 692 005631 7640 SZA CLA 693 005632 5237 JMP FOUT2 /NO-GO ON 694 005633 4750 JMS I FFMPP /YES-MAKE # GREATER THAN 1 695 005634 6315 TEN /BY MULTIPLYING BY TEN (DEC.) 696 005635 2352 ISZ KNT /COUNT THE MULTIPLIES 697 005636 5227 JMP FOUT1 /SEE IF >1 YET 698 005637 4315 FOUT2, JMS SE /# IS >1-MAKE IT LESS THAN 1 699 005640 4747 JMS I FFPUTP /STORE IN A TEMPORARY 700 005641 6172 TM3 701 005642 1351 TAD K2035 /SET FAC TO 5 702 005643 3044 DCA ACX /(IT WILL GO TO .5 AT FIRST DIV.) 703 005644 3045 DCA ACH 704 005645 3046 DCA ACLO 705 005646 1056 TAD EFLG /IS THIS E FORMAT? 706 005647 7640 SZA CLA 707 005650 1352 TAD KNT /NO-GET COUNT OF MULTIPLIES 708 005651 7041 CMA IAC /NEGATE IT 709 005652 1060 TAD DADP /AND ADD # OF DIGTS AFT. DC. PT. 710 005653 7500 SMA /MUST BE NEGATIVE 711 005654 7040 CMA 712 005655 1344 TAD K10 /LIMIT # OF DIVS TO 8 713 005656 7510 SPA 714 005657 7770 KM10, -10 /=SPA SNA SZL CLA-WON'T SKIP=CLA 715 005660 1257 TAD KM10 /RESTORE 716 005661 3315 DCA SE /STORE AS COUNTER 717 005662 4746 JMS I FFDVP /DIVIDE .5 BY TEN THAT # OF TIMES 718 005663 6315 TEN 719 005664 2315 ISZ SE /DONE? 720 005665 5262 JMP .-3 /NO-GO ON 721 005666 4745 JMS I FFADP /YES-ADD IN ORIG.#-THIS IS ROUNDING 722 005667 6172 TM3 723 005670 4315 JMS SE /INSURE THAT IT IS IN RANGE 724 005671 4731 FOUT4, JMS I SPLITT /SPLIT UP THE FAC 725 005672 3753 DCA I SPLTFP /(CLEAR SPLIT FLAG-ELSE BAD NEWS LATER) 726 005673 1044 TAD ACX /SHIFT MANTISSA ACCORDING TO EXP 727 005674 1332 TAD M201 /0=1 LEFT; 1=NO SHIFT;2=1 RIGHT,... 728 005675 3315 DCA SE /STORE COUNTER 729 005676 4714 JMS I AL1PT /SHIFT LEFT 730 005677 7410 SKP /SKIP DOWN 731 005700 4713 JMS I AR1PTR /SHIFT FAC RIGHT 1 BIT 732 005701 2315 ISZ SE /DONE? 733 005702 5300 JMP .-2 /NO-GO BACK 734 005703 1352 FOUT, TAD KNT /DONE-GET COUNT OF MULS. 735 005704 3047 DCA OPX /PRESERVE IT 736 005705 1056 TAD EFLG /IS THIS E FORMAT OUT? 737 005706 7640 SZA CLA 738 005707 5354 JMP NOTE /NO 739 005710 3352 DCA KNT /YES-ZERO COUNT 740 005711 1333 TAD KM5 /GET MINUS 5-FOR 2 SIGNS,+EXP 741 005712 5357 JMP ADFW /GO ADD FIELD WIDTH 742 005713 7101 AR1PTR, AR1 743 005714 6667 AL1PT, AL1 744 / 745 /ROUTINE TO GET FAC<1 746 / 747 005715 0000 SE, 0 748 005716 1044 SE1, TAD ACX 749 005717 1330 TAD KM2007 750 005720 7750 SPA SNA CLA /#>1? 751 005721 5715 JMP I SE /NO-RETN. 752 005722 4746 JMS I FFDVP /YES-DIV. BY TEN 753 005723 6315 TEN 754 005724 7040 CMA 755 005725 1352 TAD KNT /REDUCE KNT BY 1 756 005726 3352 DCA KNT 757 005727 5316 JMP SE1 758 005730 5771 KM2007, -2007 759 005731 4711 SPLITT, SPLIT 760 005732 7577 M201, -201 761 005733 7773 KM5, -5 762 /CONSTANTS AND POINTERS 763 005734 6144 OUTP, OUT 764 005735 0016 K16, 16 765 005736 7251 CDFCRB, CDFCUR 766 005737 5600 FLINK, JMP I FFOUT 767 005740 6160 PRNTXP, PRNTX 768 005741 6140 DCNTP, DCNT 769 005742 0007 KK7, 7 770 005743 0255 K255, 255 771 005744 0010 K10, 10 772 005745 7000 FFADP, FFADD 773 005746 6722 FFDVP, FFDIV 774 005747 7322 FFPUTP, FFPUT 775 005750 6600 FFMPP, FFMPY 776 005751 2035 K2035, 2035 777 005752 0000 KNT, 0 778 005753 4750 SPLTFP, SPLTFG 779 /CONTINUATION OF OUTPUT MAINLINE 780 005754 1352 NOTE, TAD KNT /GET COUNT OF MULTIPLIES 781 005755 7500 SMA /IF NOT NEG-MAKE = -1 782 005756 7240 CLA CMA 783 005757 1057 ADFW, TAD FLDW /GET THE FIELD WIDTH 784 005760 7041 CMA IAC /NEGATE IT 785 005761 3746 DCA I FFDVP /STORE WHILE WE CHECK DADP 786 005762 1060 TAD DADP /GET DIGITS AFTER DEC. PT 787 005763 7440 SZA /DID HE SAY NO DEC. PLACES? 788 005764 7001 IAC /NO-ADD 1 FOR DEC. PT. 789 005765 1746 TAD I FFDVP /ADD IN REST 790 005766 7500 SMA /NEG? 791 005767 5740 JMP I PRNTXP /NO-PRINT XS-NOT ENUFF ROOM 792 005770 3315 DCA SE /STORE AS CNT OF SPACES 793 005771 5374 JMP .+3 794 005772 4734 JMS I OUTP /PRINT A SPACE 795 005773 0240 240 796 005774 2315 ISZ SE /DONE? 797 005775 5372 JMP .-3 /NO-GO ON 798 005776 4734 JMS I OUTP /PRINT PROPER SIGN OF NUMBER 799 005777 0000 TEM, 0 800 /************************************* 801 /FALL THROUGH PAGE BOUNDARY!!! 802 /'TEM, 0' MUST BE LAST LOC. ON PAGE!!! 803 /(CURSE YOU B.C.) 804 /************************************* 805 *FLPT-1400 806 /*******FALL THROUGH PAGE BOUNDARY TO HERE******* 807 006000 1757 TAD I KNTP /MUST BE FIRST LOC. OF PAGE!!********* 808 006001 7500 SMA 809 006002 5375 JMP PRZRO /PRINT LEADING ZERO 810 006003 7041 CMA IAC 811 006004 4301 JMS DGTYP /OUTPUT 'KNT' DIGITS 812 006005 1060 PRDCP, TAD DADP /CHECK DADP FOR 0 813 006006 7640 SZA CLA /DON'T PRINT '.' IF DADP=0 814 006007 4344 PDP, JMS OUT /PRINT DEC. PT. 815 006010 0256 256 816 006011 1757 GKNT, TAD I KNTP /GET COUNT AGAIN 817 006012 7750 SPA SNA CLA 818 006013 5233 JMP GD 819 006014 1757 TAD I KNTP /GET COUNT 820 006015 7040 CMA /NEGATE 821 006016 3301 DCA DGTYP /STORE AS COUNTER 822 006017 1060 TAD DADP 823 006020 7040 CMA /SAME FOR DADP 824 006021 3374 DCA SEP 825 006022 5224 JMP PR /GO ON 826 006023 4353 PZR, JMS OUTDG /PRINT A ZERO 827 006024 2301 PR, ISZ DGTYP 828 006025 7410 SKP 829 006026 5231 JMP PS 830 006027 2374 ISZ SEP 831 006030 5223 JMP PZR 832 006031 1757 PS, TAD I KNTP 833 006032 7041 CMA IAC 834 006033 1060 GD, TAD DADP 835 006034 7540 SMA SZA 836 006035 4301 JMS DGTYP 837 006036 7200 CLA 838 006037 1056 TAD EFLG 839 006040 7640 SZA CLA 840 006041 5271 JMP DONEF /DONE 841 006042 4344 JMS OUT 842 006043 0305 305 /PRINT 'E' 843 006044 1047 TAD OPX /GET PRESERVED COUNT OF MULS 844 006045 7740 SMA SZA CLA /DETERMINE SIGN 845 006046 7326 CLA CLL CML RTL /MAKE A 2 846 006047 4344 JMS OUT 847 006050 0253 253 /PRINT MINUS OR PLUS SIGN 848 006051 3044 DCA ACX /ZERO COUNT OF SUBTRACTS FOR DIV. 849 006052 1047 TAD OPX /GET THE COUNT(DEC. EXP.) 850 006053 7510 SPA 851 006054 7041 CMA IAC /NEGATE IF NEGATIVE 852 006055 3047 LOOP, DCA OPX /STORE NEW VALUE OF OPX 853 006056 1047 TAD OPX /GET DEC. EXP. BACK 854 006057 1337 TAD KM12 /SUBTRACT 10 (WE'RE DIVIDING 855 006060 7510 SPA /BY 10)-DID SUBTRACT SUCCEED? 856 006061 5264 JMP .+3 /NOPE-DONE-ACX IS TENS PLACE 857 006062 2044 ISZ ACX /YUP-BUMP CNTR. (TENS PLACE OF DEC. EXP.) 858 006063 5255 JMP LOOP /TRY AGAIN 859 006064 7200 CLA /DONE-ACX IS TENS PLACE,OPX-ONES PLACE 860 006065 1044 TAD ACX /PRINT TEN'S PLACE 861 006066 4353 JMS OUTDG 862 006067 1047 TAD OPX /PRINT ONE'S PLACE 863 006070 4353 JMS OUTDG 864 006071 1055 DONEF, TAD SWIT2 /SHOULD WE PRINT CR/LF? 865 006072 7650 SNA CLA 866 006073 5743 JMP I FLING /NO 867 006074 4344 JMS OUT 868 006075 0215 215 869 006076 4344 JMS OUT 870 006077 0212 212 871 006100 5743 JMP I FLING 872 / 873 /OUTPUT DIGITS OF FAC BY MULTIPLYING BY TEN 874 /THE HIGH ORDER OVERFLOW IS THE DIGIT 875 006101 0000 DGTYP, 0 876 006102 7041 CMA IAC 877 006103 3735 DCA I OVPTR /STORE COUNT PASSED 878 006104 1041 DT1, TAD AC1 879 006105 3042 DCA AC2 880 006106 1045 TAD ACH /GET FAC AND STORE FOR LATER 881 006107 3050 DCA OPH 882 006110 1046 TAD ACLO 883 006111 3051 DCA OPL 884 006112 4741 JMS I AL1PP /SHIFT FAC LEFT 1 = FAC*2 885 006113 4741 JMS I AL1PP /SHIFT LEFT AGAIN = FAC*4 886 006114 4742 JMS I OADDP /ADD ORIG FAC = FAC*5 887 006115 4741 JMS I AL1PP /SHIFT FAC 1 LEFT = FAC*10!! 888 006116 1041 TAD AC1 /MASK OFF HI 4 BITS OF RESULT 889 006117 0375 AND K360 890 006120 7012 RTR /SHIFT INTO PROPER PLACE 891 006121 7012 RTR 892 006122 2340 ISZ DCNT /DONE ALL SIGNIF. DIGS.? 893 006123 5326 JMP .+3 /NO-GO ON 894 006124 7240 CLA CMA /YES-PRINT ZEROS 895 006125 3340 DCA DCNT /FROM NOW ON 896 006126 4353 JMS OUTDG /PRINT DIGIT (HI ORD. OVRFLOW) 897 006127 1336 TAD K17 /REMOVE DIGIT JUST PRINTED FROM FAC 898 006130 0041 AND AC1 899 006131 3041 DCA AC1 900 006132 2735 ISZ I OVPTR /DONE REQUIRED?(MUST LEAVE OV=0!!) 901 006133 5304 JMP DT1 /NOPE 902 006134 5701 JMP I DGTYP /YUP 903 006135 7131 OVPTR, OV 904 006136 0017 K17, 17 905 006137 7766 KM12, -12 906 006140 0000 DCNT, 0 /COUNT OF SIGNF. DIGITS 907 006141 6667 AL1PP, AL1 908 006142 7160 OADDP, OADD 909 006143 5737 FLING, FLINK 910 /NEEDED FOR OS/8 BASIC 911 *FLPT-1234 912 / 913 /OUTPUT ROUTINE 914 / 915 006144 0000 OUT, 0 916 006145 1744 TAD I OUT /GET THE CHAR. 917 006146 6041 TSF 918 006147 5346 JMP .-1 919 006150 6046 TLS 920 006151 7300 CLA CLL /USE AN 'AND..' INSTEAD??? 921 006152 5744 JMP I OUT 922 923 / 924 /OUTPUT DIGIT 925 / 926 006153 0000 OUTDG, 0 927 006154 4344 JMS OUT 928 006155 0260 260 929 006156 5753 JMP I OUTDG /RETN 930 931 006157 5752 KNTP, KNT 932 *FLPT-1220 933 / 934 /DO NOT MOVE!!!! 935 /MUST BE AT LOC.160 ON PAGE!! 936 /SEE LOC.PRZRO 937 / 938 006160 7200 PRNTX, CLA 939 006161 1057 TAD FLDW /GET FIELD WIDTH 940 006162 7040 CMA /MUST BE NEGATIVE 941 006163 3374 DCA SEP /USE AS COUNTER 942 006164 2374 PRNTX1, ISZ SEP /DONE ALL? 943 006165 7410 SKP /NO-GO ON 944 006166 5271 JMP DONEF /YES-RETN. 945 006167 4344 JMS OUT /PRINT ASTERISK 946 006170 0252 252 /ASTERISK 947 006171 5364 JMP PRNTX1 948 006172 0000 TM3, 0 949 006173 0000 0 950 006174 0000 SEP, 0 951 / 952 /PRINT A LEADING ZERO 953 / 954 006175 0360 PRZRO, 360 /DOES A CLA!!!! 955 006176 4353 JMS OUTDG 956 006177 5205 JMP PRDCP 957 K360=PRZRO 958 / 959 /FLOATING POINT INPUT ROUTINE 960 / 961 *FLPT-1200 962 006200 0000 FFIN, 0 963 006201 3277 DCA SIGNF /SET SIGN SWITCH TO 0 964 006202 4710 JMS I CDFCRA /CHANGE TO DF OF PACKAGE 965 006203 7240 CLA CMA 966 006204 3707 DCA I FDVPT /INITIALIZE PERIOD SWITCH TO -1 967 006205 3052 DCA DSWIT /ZERO CONVERSION SWITCH 968 006206 3044 DECONV, DCA ACX /ZERO OUT THE FAC! 969 006207 3046 DCA ACLO 970 006210 0200 P200, 200 971 006211 3045 DCA ACH 972 006212 3303 DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT. 973 006213 4320 DECON, JMS GCHR /GET A CHAR.FROM TTY. 974 006214 5227 JMP FFIN1 /TERMINATOR- 975 006215 2052 ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH 976 006216 2303 ISZ DNUMBR /BUMP # OF DIGITS-# IS STORED IN 977 006217 4407 JMS I FPP /FORM EASILY FLOATIBLE-ENTER INTERP. 978 006220 3315 FMPY TEN /MULTIPLY # BY TEN 979 006221 6702 FPUT I TM3PT /STORE IT AWAY 980 006222 5312 FGET TP /GET NEW DIGIT 981 006223 7000 FNOR /FLOAT IT 982 006224 1702 FADD I TM3PT /ADD IT TO ACCUMULATED # 983 006225 0000 FEXT /DONE 984 006226 5213 JMP DECON /GO ON 985 006227 2707 FFIN1, ISZ I FDVPT /HAVE WE HAD A PERIOD YET? 986 006230 5236 JMP FIGO2 /YES-GO ON 987 006231 2313 ISZ TP1 /NO-IS THIS A PERIOD? 988 006232 2313 ISZ TP1 989 006233 7610 SKP CLA 990 006234 5212 JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT. 991 /AND GO CONVERT REST 992 006235 3303 DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF 993 /DIGITS AFTER DECIMAL POINT. 994 006236 1044 FIGO2, TAD ACX /ADD SIGN TO EXPONENT WORD OF FAC 995 006237 7440 SZA /UNLESS,OF COURSE, ITS 0 996 006240 1277 TAD SIGNF /(SINCE THAT COULD YIELD -0) 997 006241 3044 DCA ACX /STORE IT BACK 998 006242 7240 CLA CMA 999 006243 3277 DCA SIGNF /RESET SIGN SWITCH FOR EXP. 1000 006244 1053 TAD CHAR /NO-WAS THE TERMINATOR AN 'E'? 1001 006245 1304 TAD KME 1002 006246 7650 SNA CLA 1003 006247 4320 GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT 1004 006250 5257 JMP EDON /END OF EXPONENT 1005 006251 1043 TAD TM /GOT DIG. OF EXP-STORED IN TP1 1006 006252 7106 CLL RTL /MULT. ACCUMULATED EXP BY 10 1007 006253 1043 TAD TM 1008 006254 7104 CLL RAL 1009 006255 1313 TAD TP1 /ADD DIGIT 1010 006256 5247 JMP GETE /CONTINUE 1011 006257 1043 EDON, TAD TM /GET EXPONENT 1012 006260 2277 ISZ SIGNF /WAS EXPONENT POSITIVE? 1013 006261 7041 CMA IAC /NO-NEGATE IT 1014 006262 7041 CMA IAC 1015 006263 1303 TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN 1016 006264 7141 CLL CMA IAC 1017 006265 7510 SPA /RESULT POSITIVE? 1018 006266 7161 CLL CMA CML IAC /NO-MAKE POS. AND SET LINK 1019 006267 7040 CMA /NEGATE FOR COUNTER 1020 006270 3303 DCA DNUMBR /AND STORE 1021 006271 7004 RAL /LINK=1-DIV;=0-MUL. # BY TEN 1022 006272 1305 TAD MDV /FORM CORRECT INSTRUCTION 1023 006273 3277 DCA SIGNF /AND STORE FOR EXECUTION 1024 006274 2303 FCNT, ISZ DNUMBR /DONE ALL OPERATIONS? 1025 006275 5277 JMP SIGNF /NO 1026 006276 5600 JMP I FFIN /YES-RETURN 1027 006277 0000 SIGNF, 0 /NO-MUL OR DIV. MANTISSA 1028 006300 6315 TEN /BY TEN 1029 006301 5274 JMP FCNT /GO ON 1030 006302 6172 TM3PT, TM3 1031 006303 0000 DNUMBR, 0 1032 006304 7473 KME, -305 1033 006305 4706 MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER 1034 006306 6600 FFMPY 1035 006307 6722 FDVPT, FFDIV /!!!!!!!!!!!!!!!!! 1036 1037 006310 7251 CDFCRA, CDFCUR 1038 006311 0012 KK12, 12 1039 006312 2170 TP, 2170 1040 006313 0000 TP1, 0 1041 006314 0000 0 1042 006315 2045 TEN, 2045 1043 006316 0000 0 1044 006317 0000 0 1045 /ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT 1046 /OR A TERMINATOR. 1047 /RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT 1048 / 1049 006320 0000 GCHR, 0 1050 006321 3043 DCA TM /STORE ACCUMULATED EXPONENT (MAYBE) 1051 006322 4345 JMS INPUT /GET A CHAR FROM TTY. 1052 006323 1053 TAD CHAR /PICK IT UP 1053 006324 1376 TAD PLUS /WAS IT PLUS SIGN? 1054 006325 7450 SNA 1055 006326 5334 JMP DECON1 /YES-GET ANOTHER CHAR. 1056 006327 7112 CLL RTR /NO WAS IT MINUS SIGN? 1057 006330 7640 SZA CLA 1058 006331 5335 JMP .+4 1059 006332 7330 CLA CLL CML RAR /YES-SET SWITCH TO 4000 1060 006333 3277 DCA SIGNF /TO FLIP SIGN 1061 006334 4345 DECON1, JMS INPUT /GET A CHAR. 1062 006335 1053 TAD CHAR 1063 006336 1377 TAD K7506 /SEE IF ITS A DIGIT 1064 006337 7100 CLL 1065 006340 1311 TAD KK12 1066 006341 3313 DCA TP1 /STORE FOR LATER 1067 006342 7430 SZL /DIGIT? 1068 006343 2320 ISZ GCHR /YES-RETN. T CALL+2 1069 006344 5720 JMP I GCHR /NO-RETN. TO CALL+1 1070 / 1071 /INPUT ROUTINE-CHECKS FOR RUBOUT AND CARRIAGE RETURN 1072 006345 0000 INPUT, 0 1073 006346 6031 KSF 1074 006347 5346 JMP .-1 1075 006350 6032 KCC 1076 006351 1210 TAD P200 /FORCE CHANNEL 8 1077 006352 6034 KRS /READ CHAR. 1078 006353 3053 DCA CHAR /STORE CHAR. 1079 006354 1053 LP, TAD CHAR 1080 006355 3357 DCA TMIN /STORE IT AGAIN 1081 006356 4773 JMS I OUTPP /PRINT IT 1082 006357 0000 TMIN, 0 1083 006360 1053 TAD CHAR 1084 006361 1375 TAD MRUBOT /IS IT RUBOUT? 1085 006362 7450 SNA 1086 006363 5201 JMP FFIN+1 /YES-RESTART INPUT 1087 006364 1374 TAD MCR /NO-IS IT CARRIAGE RETN.? 1088 006365 7650 SNA CLA 1089 006366 1054 TAD SWIT1 /YES-SHOULD WE ECHO LINE FEED? 1090 006367 7640 SZA CLA 1091 006370 4773 JMS I OUTPP /YES-DO IT 1092 006371 0212 212 /LINE FEED 1093 006372 5745 JMP I INPUT /RETURN 1094 006373 6144 OUTPP, OUT 1095 006374 0162 MCR, 377-215 1096 006375 7401 MRUBOT, -377 1097 006376 7525 PLUS, -253 1098 006377 7506 K7506, 7506 1099 *FLPT-1000 1100 / 1101 /INVERSE FLOATING SUBTRACT-USES FLOATING ADD 1102 /!!FSW1!!-THIS IS OP-FAC 1103 / 1104 006400 0000 FFSUB1, 0 1105 006401 7450 SNA /WHICH MODE? 1106 006402 1600 TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP. 1107 006403 4647 JMS I ARGETL /GO PICK UP OPERAND 1108 006404 4607 JMS I FFNEGA /NEGATE FAC 1109 006405 1200 TAD FFSUB1 /AND GO ADD 1110 006406 5610 JMP I SUB0P 1111 006407 7135 FFNEGA, FFNEG 1112 006410 7127 SUB0P, SUB0 1113 006411 7745 KM27, -33 1114 / 1115 /INVERSE FLOATING DIVIDE 1116 /FSWITCH=1 1117 /THIS IS OP/FAC 1118 / 1119 006412 0000 FFDIV1, 0 1120 006413 7450 SNA /WHICH MODE OF CALL? 1121 006414 1612 TAD I FFDIV1 /CALLED BY USER-GET ADDR. 1122 006415 3200 DCA FFSUB1 /STORE IT TEMPORARILY 1123 006416 1044 TAD ACX /NOW STORE THE FAC IN THE OPERAND 1124 006417 3047 DCA OPX /EXPONENT 1125 006420 1045 TAD ACH 1126 006421 3050 DCA OPH /HIGH ORDER MANTISSA 1127 006422 1046 TAD ACLO /LOW ORDER MANTISSA 1128 006423 3051 DCA OPL 1129 006424 1600 TAD I FFSUB1 /NOW PICK UP THE OPERAND AND 1130 006425 3044 DCA ACX /STORE IT IN THE FAC 1131 006426 2200 ISZ FFSUB1 /BUMP POINTER DOWN 1132 006427 1600 TAD I FFSUB1 /HI MANTISSA 1133 006430 3045 DCA ACH 1134 006431 2200 ISZ FFSUB1 1135 006432 1600 TAD I FFSUB1 1136 006433 3046 DCA ACLO 1137 006434 4774 JMS I SPLITK /UNPACK FAC AND OP 1138 006435 1212 TAD FFDIV1 /NOW FUDGE THE ADDRESS LINKAGE 1139 006436 3645 DCA I FFDP /('SPLIT' CHANGED TO PROPER D.F.) 1140 006437 1043 TAD TM /DO THE SIGN CALCULATION 1141 006440 1040 TAD AC0 1142 006441 3043 DCA TM 1143 006442 3040 DCA AC0 /MUST BE ZERO FOR DIV. ROUTINE 1144 006443 1047 TAD OPX /JUMP INTO DIVIDE ROUTINE W/OPX IN AC 1145 006444 5646 JMP I KFD1 /DO IT 1146 006445 6722 FFDP, FFDIV 1147 006446 6726 KFD1, FFD1 1148 006447 4631 ARGETL, ARGET 1149 006450 6667 AL1K, AL1 1150 AN1=FFSUB1 1151 AN2=FFDIV1 1152 AN3=OPX 1153 /FLOATING SQUARE ROOT 1154 /USES A HARDWARE TYPE ALGORITHM FOR BINARY SQUARE ROOTS 1155 /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES-P 409 1156 / 1157 006451 0000 FROOT, 0 1158 006452 7600 F7600, 7600 /CLA 1159 006453 3047 DCA OPX /ZERO OPERAND EXP. FOR SPLIT 1160 006454 4774 JMS I SPLITK /SPLIT UP FAC 1161 006455 7326 CLA CLL CML RTL /SET FIRST TRIAL BIT-1 BIT TO THE 1162 006456 7006 RTL /LEFT OF WHERE IT SHOULD BE 1163 006457 3042 DCA AC2 /(IT WILL GET SHIFTED RIGHT) 1164 006460 3050 DCA OPH /ZERO STORAGE FOR TRIAL BIT 1165 006461 3051 DCA OPL 1166 006462 3200 DCA AN1 /ZERO STORAGE FOR RESULT 1167 006463 3212 DCA AN2 /(AN3=OPX IS ALREADY ZERO) 1168 006464 1041 TAD AC1 /IS FAC=0? 1169 006465 7650 SNA CLA 1170 006466 5370 JMP DONE /YES-RETURN ZERO 1171 006467 1211 TAD KM27 /NO-SET UP COUNTER FOR 27 BIT RESLT 1172 006470 3043 DCA TM /WE IGNORE SIGN OF FAC 1173 006471 1044 TAD ACX /GET EXPONENT OF FAC 1174 006472 7110 CLL RAR /DIVIDE IT BY 2 1175 006473 1377 TAD K100 /ADD IN 1/2 THE BIAS (SINCE IT WAS 1176 006474 3044 DCA ACX /DIVIDED BY 2 ALSO) 1177 006475 7430 SZL /BUMP EXPONENT IF ORIGINAL EXP. 1178 006476 2044 ISZ ACX /WAS ODD--CAN'T SKIP 1179 006477 7420 SNL /DO A PRE-SHIFT FOR EVEN EXPONENTS 1180 006500 4650 SLOOP, JMS I AL1K /SHIFT FAC LEFT 1 BIT 1181 006501 4775 JMS I OPSRP /SHIFT THE TRIAL BIT 1 PLACE RIGHT 1182 006502 1051 LOP01, TAD OPL /ADD THE TRIAL BIT TO THE 1183 006503 1047 TAD AN3 /RESULT SO FAR 1184 006504 7141 CLL CMA IAC /AND SUBTRACT FROM FAC 1185 006505 1046 TAD ACLO 1186 006506 3376 DCA TM1 /STORE TEMPORARILY 1187 006507 7024 CML RAL /PROPAGATE CARRY 1188 006510 1050 TAD OPH /DO MIDDLE ORDER 1189 006511 1212 TAD AN2 1190 006512 7041 CMA IAC 1191 006513 1045 TAD ACH 1192 006514 3040 DCA AC0 /STORE TEMPORARILY 1193 006515 7024 CML RAL /ROTATE CARRY 1194 006516 1042 TAD AC2 /HI ORDER 1195 006517 1200 TAD AN1 1196 006520 7041 CMA IAC 1197 006521 1041 TAD AC1 1198 006522 7420 SNL /DID SUBTRACT SUCCEED? 1199 006523 5356 JMP GON /SUBTRACT FAILED-DON' T CHANGE FAC 1200 006524 7440 SZA /OK-IS RESULT=0? 1201 006525 5335 JMP LOP02 /NO-GO ON 1202 006526 1040 TAD AC0 /YES-CHECK MIDDLE AND LO ORDER 1203 006527 7450 SNA 1204 006530 1376 TAD TM1 1205 006531 7640 SZA CLA /IS REMAINDER ALL ZERO? 1206 006532 5335 JMP LOP02 /NOT ALL 0-GO ON 1207 006533 7040 CMA /ZERO REMAINDER-TERMINATE 1208 006534 3043 DCA TM 1209 006535 3041 LOP02, DCA AC1 /STORE REVISED FAC 1210 006536 1040 TAD AC0 1211 006537 3045 DCA ACH 1212 006540 1376 TAD TM1 1213 006541 3046 DCA ACLO 1214 006542 1051 TAD OPL /SHIFT TRIAL BIT 1 PLACE TO LEFT 1215 006543 7104 CLL RAL /THIS PUTS IT WHERE RESULT BIT SHOULD BE 1216 006544 1047 TAD AN3 /AND ADD IT TO RESULT SO FAR 1217 006545 3047 DCA AN3 /(ONLY DONE IF SUBTRACT 1218 006546 1050 TAD OPH /SUCCEEDS) 1219 006547 7004 RAL 1220 006550 1212 TAD AN2 1221 006551 3212 DCA AN2 1222 006552 1042 TAD AC2 1223 006553 7004 RAL 1224 006554 1200 TAD AN1 /ALL DONE 1225 006555 3200 DCA AN1 1226 006556 7200 GON, CLA 1227 006557 2043 ISZ TM /DONE ALL 27 BITS? 1228 006560 5300 JMP SLOOP /NO-GO ON 1229 006561 1200 TAD AN1 /YES-STORE RESULT IN FAC 1230 006562 3041 DCA AC1 1231 006563 1212 TAD AN2 1232 006564 3045 DCA ACH 1233 006565 1047 TAD AN3 1234 006566 3046 DCA ACLO 1235 006567 4772 JMS I AR1K /SHIFT RESULT RIGHT 1 PLACE 1236 006570 4773 DONE, JMS I STICKP /GO PACK RESULT INTO 3 WORDS 1237 006571 5651 JMP I FROOT /DONE-RETURN 1238 1239 006572 7101 AR1K, AR1 1240 006573 4656 STICKP, STICK 1241 006574 4711 SPLITK, SPLIT 1242 006575 7066 OPSRP, OPSR 1243 006576 0000 TM1, 0 1244 006577 0100 K100, 100 1245 PAUSE 1246 /27-BIT FLOATING PT INTERPRETER 1247 *FLPT-600 1248 / 1249 /FLOATING MULTIPLY 1250 /DOES A 27 BY 27 BIT FLOATING MULTIPLY 1251 / 1252 006600 0000 FFMPY, 0 1253 006601 7450 SNA /WHICH MODE OF CALL? 1254 006602 1600 TAD I FFMPY /CALLED BY USER-GET OPERAND ADDR. 1255 006603 4666 JMS I MDSETK /SET UP FOR MPY-OPX IN AC ON RETN. 1256 006604 1044 TAD ACX /DO EXPONENT ADDITION 1257 006605 1260 TAD KM201 /SUBTRACT THE BIAS (+1) FROM EXP. 1258 006606 3044 DCA ACX /STORE FINAL EXPONENT 1259 006607 1041 TAD AC1 /GET HI ORDER MANTISSA 1260 006610 3256 DCA TM4 /STORE IN A TEMP. 1261 006611 1045 TAD ACH /SAME FOR REST OF FAC 1262 006612 3040 DCA AC0 1263 006613 1046 TAD ACLO 1264 006614 3257 DCA TM5 1265 006615 3045 DCA ACH /ZERO FAC-RESULT OF MPY WILL 1266 006616 3046 DCA ACLO /BE STORED THERE 1267 006617 3041 DCA AC1 1268 006620 1261 TAD M27 /SET UP COUNTER FOR 27 BIT MPY 1269 006621 3047 DCA OPX 1270 006622 7301 CLA CLL IAC /SET UP MASK FOR EXAMINING 1271 006623 3263 LOOPM, DCA MSK /MULTIPLIER BITS 1272 006624 4664 JMS I AR1P /SHIFT RESULT SO FAR RIGHT 1 BIT 1273 006625 1263 TAD MSK /GET THE BIT MASK 1274 006626 0257 AND TM5 /MASK MULTIPLIER BIT (FROM LO TO HI) 1275 006627 7640 SZA CLA /IS MULTIPLIER BIT 1? 1276 006630 4665 JMS I OADDK /YES-ADD MULTIPLICAND AND PART. PROD. 1277 006631 1263 TAD MSK /SHIFT THE MASK FOR NEXT BIT 1278 006632 7104 CLL RAL 1279 006633 7430 SZL /DID WE PASS A WORD BOUNDARY? 1280 006634 5243 JMP LP3 /YES-CHANGE MULTIPLIER WORD 1281 006635 2047 LP2, ISZ OPX /ARE WE DONE YET? 1282 006636 5223 JMP LOOPM /NO-GO ON 1283 006637 7300 MDONE, CLA CLL /YES-CLR. AC 1284 006640 4662 JMS I FNORK /NORMALIZE RESLT AND PACK INTO 3 WORDS 1285 006641 2200 ISZ FFMPY /BUMP RETURN ADDRESS 1286 006642 5600 JMP I FFMPY /RETURN 1287 1288 006643 1040 LP3, TAD AC0 /DONE A MULTIPLIER WORD-MOVE NEXT ONE 1289 006644 3257 DCA TM5 /INTO TM5 1290 006645 1256 TAD TM4 /MOVE LAST WORD TO AC0 FOR NEXT 1291 006646 3040 DCA AC0 /WORD BOUNDARY CROSSING 1292 006647 7101 CLL IAC /SET UP MASK BIT 1293 006650 5235 JMP LP2 /GO BACK 1294 006651 0177 K177, 177 1295 006652 7571 DVBY0P, FTRP2 1296 006653 0040 K40, 40 1297 006654 7143 OPNEGP, OPNEG 1298 006655 7743 KM29, -35 1299 006656 0000 TM4, 0 1300 006657 0000 TM5, 0 1301 006660 7577 KM201, -201 1302 006661 7745 M27, -33 1303 006662 7265 FNORK, FFNOR 1304 006663 0000 MSK, 0 1305 006664 7101 AR1P, AR1 1306 006665 7160 OADDK, OADD 1307 006666 4644 MDSETK, MDSET 1308 / 1309 /SHIFT 3 WD FAC LEFT 1 BIT 1310 /WORDS=AC1,ACH,ACLO 1311 / 1312 006667 0000 AL1, 0 1313 006670 1046 TAD ACLO 1314 006671 7104 CLL RAL 1315 006672 3046 DCA ACLO 1316 006673 1045 TAD ACH 1317 006674 7004 RAL 1318 006675 3045 DCA ACH 1319 006676 1041 TAD AC1 1320 006677 7004 RAL 1321 006700 3041 DCA AC1 1322 006701 5667 JMP I AL1 1323 / 1324 /ROUTINE TO MOVE RESULT BITS WHEN WE HAVE FILLED A WORDSWORTH(PUN!) 1325 / 1326 006702 1665 HLP, TAD I OADDK /GET THE RESULT SO FAR 1327 006703 3666 DCA I MDSETK /STORE SAFELY 1328 006704 1040 TAD AC0 /GET THE RESULT BITS JUST GENERATED 1329 006705 3665 DCA I OADDK /AND STORE THEM 1330 006706 3040 DCA AC0 /CLEAR AC0 1331 006707 7010 RAR /ROTATE RESULT BIT MASK TO AC 1332 006710 5346 JMP DGON /GO ON 1333 / 1334 /END OF FLOATING DIVIDE 1335 / 1336 006711 1040 DVDONE, TAD AC0 /YES-GET RESULT AND PUT IN FAC 1337 006712 3046 DCA ACLO 1338 006713 1665 TAD I OADDK 1339 006714 3045 DCA ACH 1340 006715 1666 TAD I MDSETK 1341 006716 3041 DVD, DCA AC1 1342 006717 4662 JMS I FNORK /NORMALIZE RESULT AND PACK TO 3 WDS 1343 006720 2322 ISZ FFDIV /BUMP RETN. ADDR. 1344 006721 5722 JMP I FFDIV /RETURN 1345 1346 *FLPT-456 1347 / 1348 /FLOATING DIVIDE ROUTINE 1349 /DONE BY MULTIPLE SUBTRACTIONS 1350 /(NOTE: MDSET SETS AC0 TO ZERO) 1351 006722 0000 FFDIV, 0 /(USED AS A TEM. BY I/O ROUTINES) 1352 006723 7450 SNA /WHICH MODE OF CALL? 1353 006724 1722 TAD I FFDIV /CALLED BY USER-GET ARG. ADDR. 1354 006725 4666 JMS I MDSETK /GO SET UP FOR DIVIDE-OPX IN AC ON RETN. 1355 006726 7041 FFD1, CMA IAC /NEGATE EXP. OF OPERAND 1356 006727 1044 TAD ACX /ADD EXP OF FAC 1357 006730 1251 TAD K177 /ADD THE BIAS (-1) 1358 006731 3044 DCA ACX /STORE AS FINAL EXPONENT 1359 006732 1042 TAD AC2 /CHECK DIVISION BY ZERO 1360 006733 7650 SNA CLA 1361 006734 5652 JMP I DVBY0P /YES-GIVE ERROR 1362 006735 1253 TAD K40 /NO-SET UP INITIAL BIT MASK 1363 006736 3263 DCA MSK /STORE 1364 006737 4654 JMS I OPNEGP /NEGATE OPERAND FOR SUBTRACTS 1365 006740 1255 TAD KM29 /SET COUNTER FOR 29 RESULT BITS 1366 006741 3256 DCA TM4 /(SO WE CAN ROUND-FIRST BIT MAY BE 0!) 1367 006742 1263 DVLP, TAD MSK /SHIFT POSITION OF RESULT BIT MASK 1368 006743 7110 CLL RAR 1369 006744 7430 SZL /DID WE CROSS A WORD BOUNDARY? 1370 006745 5302 JMP HLP /YES-MUST FIX UP SOME STUFF 1371 006746 3263 DGON, DCA MSK /STORE SHIFTED RESULT BIT BACK 1372 006747 1046 TAD ACLO /DO THE TRIAL SUBTRACT OF OPERAND 1373 006750 1051 TAD OPL /FROM FAC(LO ORDER) 1374 006751 3200 DCA FFMPY /STORE TEMPORARILY 1375 006752 7004 RAL /PROPAGATE CARRY 1376 006753 1045 TAD ACH /DO THE MIDDLE ORDER 1377 006754 1050 TAD OPH 1378 006755 3047 DCA OPX /STORE IN A TEMP. 1379 006756 7004 RAL /PROPAGATE CARRY 1380 006757 1041 TAD AC1 /DO HIGH ORDER 1381 006760 1042 TAD AC2 1382 006761 7420 SNL /WAS SUBTRACT SUCCESSFUL? 1383 006762 5370 JMP DV2 /NO-DON'T CHANGE FAC 1384 006763 3041 DCA AC1 /YES-STORE BACK THE ADJUSTED FAC 1385 006764 1047 TAD OPX 1386 006765 3045 DCA ACH 1387 006766 1200 TAD FFMPY 1388 006767 3046 DCA ACLO 1389 006770 7630 DV2, SZL CLA /WAS SUBTRACT SUCCESSFUL? 1390 006771 1263 TAD MSK /YES-PUT A 1 IN RESULT 1391 006772 1040 TAD AC0 /AND STORE BACK 1392 006773 3040 DCA AC0 1393 006774 4267 JMS AL1 /SHIFT FAC LEFT 1 BIT 1394 006775 2256 ISZ TM4 /DONE ALL 29 BITS? 1395 006776 5342 JMP DVLP /NO-GO ON 1396 006777 5311 JMP DVDONE /(JMP SO DIV. ROUTINE IS ORG'ED RIGHT) 1397 *FLPT-400 1398 / 1399 /FLOATING ADD 1400 / 1401 007000 0000 FFADD, 0 1402 007001 7450 SNA /WHICH MODE OF CALL? 1403 007002 1600 TAD I FFADD /CALLED BY USER-GET ADDR. OF OPR. 1404 007003 4732 JMS I ARGETP /PICK UP OPERAND 1405 007004 4733 FAD1, JMS I SPLITP /SPLIT UP OPERAND AND FAC 1406 007005 1044 TAD ACX /DO EXPONENT CALCULATION 1407 007006 7141 CLL CMA IAC 1408 007007 1047 TAD OPX 1409 007010 7430 SZL /WHICH EXP. GREATER? 1410 007011 5252 JMP FACR /OPERANDS-SHIFT FAC RIGHT 1411 007012 3360 DCA OADD /FAC'S-STORE COUNT-SHIFT OP RIGHT 1412 007013 1042 TAD AC2 /DON'T SHIFT A ZERO! 1413 007014 7650 SNA CLA 1414 007015 5221 JMP DOADD /ZERO-JUST ADD 1415 007016 4266 JMS OPSR 1416 007017 2360 ISZ OADD /DONE ALL SHIFTS? 1417 007020 5216 JMP .-2 /NO-GO ON 1418 007021 1043 DOADD, TAD TM /YES-ADD THE SIGNS OF FAC AND OP 1419 007022 1040 TAD AC0 /AND SEE IF THEY ARE DIFFERENT 1420 007023 7710 SPA CLA /ARE SIGNS DIFFERENT? 1421 007024 4343 JMS OPNEG /YES-NEGATE OPERAND 1422 007025 4360 JMS OADD /DO THE ADDITION 1423 007026 1041 TAD AC1 /IS THE RESULT NEG? (I.E. IS OPR 1424 007027 7700 SMA CLA /GREATER IN MAGNITUDE THAN FAC?) 1425 007030 5246 JMP DONA /NO-RESULT WILL KEEP SIGN OF FAC 1426 007031 1046 TAD ACLO /YES-NEGATE RESULT(TO MAKE IT PLUS) 1427 007032 7141 CLL CMA IAC 1428 007033 3046 DCA ACLO 1429 007034 7024 CML RAL 1430 007035 1045 TAD ACH 1431 007036 7041 CMA IAC 1432 007037 3045 DCA ACH 1433 007040 7024 CML RAL 1434 007041 1041 TAD AC1 1435 007042 7041 CMA IAC 1436 007043 3041 DCA AC1 1437 007044 1040 TAD AC0 /AND GIVE IT THE SIGN OF OPERAND 1438 007045 3043 DCA TM 1439 007046 3331 DONA, DCA OV /CLEAR THE OVERFLOW WORD 1440 007047 4734 JMS I FNORP /NORMALIZE RESULT AND PACK INTO 3 WDS 1441 007050 2200 ISZ FFADD /BUMP RETURN 1442 007051 5600 JMP I FFADD /RETURN 1443 007052 7040 FACR, CMA /SHIFT FAC-SET UP SHIFT COUNT 1444 007053 3360 DCA OADD /AND STORE 1445 007054 1047 TAD OPX /SET FINAL EXP EQUAL TO EXP OF OP 1446 007055 3044 DCA ACX 1447 007056 1041 TAD AC1 /DON'T SHIFT A ZERO! 1448 007057 7650 SNA CLA 1449 007060 5221 JMP DOADD /ZERO-JUST ADD 1450 007061 7410 SKP 1451 007062 4301 JMS AR1 /SHIFT FAC 1 PLACE RIGHT 1452 007063 2360 ISZ OADD /DONE ALL? 1453 007064 5262 JMP .-2 /NO-GO ON 1454 007065 5221 JMP DOADD /YES-DO THE ADD 1455 / 1456 /ROUTINE TO SHIFT 3 WORD OPERAND IN AC2,OPH,OPL 1457 /1 BIT TO THE RIGHT 1458 / 1459 007066 0000 OPSR, 0 1460 007067 1042 TAD AC2 1461 007070 7110 CLL RAR 1462 007071 3042 DCA AC2 1463 007072 1050 TAD OPH 1464 007073 7010 RAR 1465 007074 3050 DCA OPH 1466 007075 1051 TAD OPL 1467 007076 7010 RAR 1468 007077 3051 DCA OPL 1469 007100 5666 JMP I OPSR 1470 / 1471 /ROUTINE TO SHIFT 3 WORD FAC 1 BIT TO THE 1472 /RIGHT (FAC IS IN AC1,ACH,ACLO) 1473 /KEEP 1 BIT OF OVERFLOW IN OV FOR POSSIBLE ROUND 1474 / 1475 007101 0000 AR1, 0 1476 007102 1041 TAD AC1 1477 007103 7110 CLL RAR 1478 007104 3041 DCA AC1 1479 007105 1045 TAD ACH 1480 007106 7010 RAR 1481 007107 3045 DCA ACH 1482 007110 1046 TAD ACLO 1483 007111 7010 RAR 1484 007112 3046 DCA ACLO 1485 007113 7010 RAR 1486 007114 3331 DCA OV 1487 007115 5701 JMP I AR1 1488 *FLPT-261 1489 / 1490 /FLOATING SUBTRACT 1491 / 1492 007117 0000 FFSUB, 0 1493 007120 7450 SNA /WHICH MODE OF CALL? 1494 007121 1717 TAD I FFSUB /CALLED BY USER-GET ADDR. OF OP 1495 007122 4732 JMS I ARGETP /PICK UP THE OP. 1496 007123 7330 CLA CLL CML RAR /SWITCH SIGN OF OPERAND 1497 007124 1047 TAD OPX 1498 007125 3047 DCA OPX 1499 007126 1317 TAD FFSUB /JMP INTO FLTG. ADD 1500 007127 3200 SUB0, DCA FFADD /AFTER SETTING UP RETURN 1501 007130 5204 JMP FAD1 1502 007131 0000 OV, 0 1503 007132 4631 ARGETP, ARGET 1504 007133 4711 SPLITP, SPLIT 1505 007134 7265 FNORP, FFNOR 1506 / 1507 /FLOATING NEGATE 1508 /UED IF FAC HAS NOT BEEN SPLIT UP! 1509 / 1510 007135 0000 FFNEG, 0 /(USED AS A TEM. BY OUTPUT ROUTINE) 1511 007136 7330 CLA CLL CML RAR /GET A 4000 INTO AC 1512 007137 1044 TAD ACX /SWITCH THE SIGN BIT OF THE FAC 1513 007140 3044 DCA ACX /STORE BACK 1514 007141 7100 CLL /AC=L=0 ON RETN 1515 007142 5735 JMP I FFNEG 1516 / 1517 /NEGATE OPERAND 1518 / 1519 007143 0000 OPNEG, 0 1520 007144 1051 TAD OPL /GET LOW ORDER 1521 007145 7141 CLL CMA IAC /NEGATE AND STORE BACK 1522 007146 3051 DCA OPL 1523 007147 7024 CML RAL /PROPAGATE CARRY 1524 007150 1050 TAD OPH /GET HI ORDER 1525 007151 7041 CMA IAC /NEGATE AND STORE BACK 1526 007152 3050 DCA OPH 1527 007153 7024 CML RAL 1528 007154 1042 TAD AC2 /GET VERY HI ORDER 1529 007155 7041 CMA IAC /NEGATE 1530 007156 3042 DCA AC2 /STORE BACK 1531 007157 5743 JMP I OPNEG 1532 1533 / 1534 /ROUTINE TO ADD 3 WORD OPERAND (AC2,OPH,OPL) 1535 /TO 3 WORD FAC (AC1,ACH,ACLO) AND STORE RESULT 1536 /IN FAC 1537 / 1538 007160 0000 OADD, 0 1539 007161 7100 CLL 1540 007162 1051 TAD OPL /ADD THE LOW ORDERS 1541 007163 1046 TAD ACLO 1542 007164 3046 DCA ACLO /STORE IN LOW ORDER FAC 1543 007165 7004 RAL /ROTATE CARRY TO AC 1544 007166 1050 TAD OPH /ADD MIDDLE ORDERS 1545 007167 1045 TAD ACH 1546 007170 3045 DCA ACH /STORE IN FAC 1547 007171 7004 RAL /ROTATE CARRY 1548 007172 1042 TAD AC2 /ADD HI ORDERS 1549 007173 1041 TAD AC1 1550 007174 3041 DCA AC1 1551 007175 5760 JMP I OADD /DONE 1552 *FLPT-200 1553 / 1554 /ROUTINE TO CALL EXTENDED FUNCTIONS 1555 /THIS IS AN EXTENSION OF OP CODE 0 1556 / 1557 007200 1050 FCALL, TAD OPH /FCALL-GET FUNCTION # (=ADDR SINCE 1558 007201 1231 TAD JMSI2 /PAGE ZERO)-MAKE A JMS THRU TABLE 1559 007202 3212 DCA DCOD1 /STORE IT 1560 007203 4251 JMS CDFCUR /D.F. MUST BE FIELD OF PACKAGE 1561 007204 1407 TAD I FPP /GET AND SAVE FLTG. P.C. 1562 007205 3262 DCA FT1 1563 007206 1630 TAD I DFCDFP /GET AND SAVE FLTG. D.F. AND I.F. 1564 007207 3260 DCA FT2 1565 007210 1461 TAD I FPNXT 1566 007211 3261 DCA FT3 1567 007212 0000 DCOD1, 0 /CALL THE SUBROUTINE 1568 007213 7200 CLA 1569 007214 4251 JMS CDFCUR /CHANGE TO D.F. OF PACKAGE 1570 007215 1261 TAD FT3 /RESTORE FLTG. PC,IF,DF 1571 007216 3461 DCA I FPNXT 1572 007217 1260 TAD FT2 1573 007220 3630 DCA I DFCDFP 1574 007221 1262 TAD FT1 1575 007222 3407 FJUMP1, DCA I FPP 1576 007223 5461 JMP I FPNXT /GET NEXT INSTR. 1577 007224 4711 SPLITB, SPLIT 1578 007225 7770 K7770, 7770 1579 007226 6667 AL1P, AL1 1580 007227 5651 JMPIC, JMP I CDFCUR 1581 007230 7450 DFCDFP, DFCDF 1582 007231 4631 JMSI2, JMS I TABLE2-1 1583 007232 7564 TABLE2, FFSQ /SQUARE=1 1584 007233 6451 FROOT /SQUARE ROOT=2 1585 007234 5000 FFSIN /SIN=3 1586 007235 5053 FFCOS /COS=4 1587 007236 5200 FFATN /ARCTANGENT=5 1588 007237 5135 FFEXP /EXPONENTIAL=6 1589 007240 5263 FFLOG /LOGARITHM=7 1590 007241 7135 FFNEG /NEGATE=10 1591 007242 6200 FFIN /INPUT=11 1592 007243 5600 FFOUT /OUTPUT=12 1593 007244 5500 FFIX /FIX=13 1594 007245 5533 FFLOAT /FLOAT=14 1595 007246 7212 DCOD1 /NOP=15 1596 007247 7212 DCOD1 /NOP=16 1597 007250 7212 DCOD1 /NOP=17 1598 /CHANGE TO DATA FIELD OF FLTG. PT. PKG. 1599 /AFTER FIRST TIME THRU, ROUTINE LOOKS LIKE 1600 / CDFCUR, 0 1601 / CDF N /N IS FLD OF PKG. 1602 / JMP I CDFCUR 1603 / (NEXT 8 LOCS. FREE FOR TEMPS) 1604 007251 0000 CDFCUR, 0 1605 007252 6224 CCUR1, RIF /READ INST. FIELD 1606 007253 1043 CCUR2, TAD TM /ADD A CDF 0 INST 1607 007254 3252 DCA CCUR1 /STORE IT, MODIFYING SUBR. 1608 007255 1227 TAD JMPIC /STORE A SUBR. RETN 1609 007256 3253 DCA CCUR2 /ALL DONE 1610 /NECESSARY CONSTANTS 1611 007257 7100 7100 1612 007260 7076 FT2, 7076 1613 007261 7650 FT3, 7650 1614 007262 2267 FT1, 2267 1615 007263 5252 5252 1616 007264 4656 STICKA, STICK 1617 / 1618 /ROUTINE TO NORMALIZE THE FAC 1619 /AND THEN PACK IT INTO 3 WORDS 1620 *FLPT-113 1621 007265 0000 FFNOR, 0 1622 007266 4624 JMS I SPLITB /SPLIT UP FAC IN CASE NOT SPLIT YET 1623 007267 1041 FN0, TAD AC1 /SHOULD FAC BE SHIFTED RIGHT? 1624 007270 1225 TAD K7770 1625 007271 7710 SPA CLA 1626 007272 5277 JMP FN1 /NO-SEE IF WE SHOULD ROUND UP 1627 007273 4766 JMS I AR1PT /YES-SHIFT RIGHT 1628 007274 2044 ISZ ACX /INCREMENT EXPONENT 1629 007275 7000 NOP 1630 007276 5267 JMP FN0 /GO CHECK AGAIN 1631 007277 1705 FN1, TAD I OVPT /GET OVERFLOW WD-SEE IF WE ROUND 1632 007300 7650 SNA CLA 1633 007301 5351 JMP FN3 /NO ROUND OFF-GO ON 1634 007302 2046 ISZ ACLO /YES-INCREMENT LOW ORDER 1635 007303 5351 JMP FN3 /NO-CARRY-DONE ROUNDING 1636 007304 5340 JMP FN4 /JMP AROUND GET, PUT 1637 007305 7131 OVPT, OV 1638 / 1639 /FLOATING GET 1640 / 1641 007306 0000 FFGET, 0 1642 007307 7450 SNA /WHICH MODE OF CALL 1643 007310 1706 TAD I FFGET /CALLED BY USER-GET ADDR. OF OP 1644 007311 4772 JMS I ARGETK /PICK UP OPERAND 1645 007312 1047 TAD OPX 1646 007313 3044 DCA ACX /LOAD THE OPERAND INTO FAC 1647 007314 1051 TAD OPL 1648 007315 3046 DCA ACLO 1649 007316 1050 TAD OPH 1650 007317 3045 DCA ACH 1651 007320 2306 ISZ FFGET 1652 007321 5706 JMP I FFGET /RETN. TO CALL +2 1653 / 1654 /FLOATING PUT 1655 / 1656 007322 0000 FFPUT, 0 1657 007323 7450 SNA /WHICH MODE OF CALL? 1658 007324 1722 TAD I FFPUT /CALLED BY USER-GET OPR. ADDR 1659 007325 3306 DCA FFGET /STORE IN A TEMP 1660 007326 1044 TAD ACX /GET FAC AND STORE IT 1661 007327 3706 DCA I FFGET /AT SPECIFIED ADDRESS 1662 007330 2306 ISZ FFGET 1663 007331 1045 TAD ACH 1664 007332 3706 DCA I FFGET 1665 007333 2306 ISZ FFGET 1666 007334 1046 TAD ACLO 1667 007335 3706 DCA I FFGET 1668 007336 2322 ISZ FFPUT /BUMP RETN. 1669 007337 5722 JMP I FFPUT /RETN. TO CALL+2 1670 / 1671 /CONTINUATION OF NORMALIZE ROUTINE 1672 / 1673 007340 2045 FN4, ISZ ACH /CARRY-INCREMENT MIDDLE ORDER 1674 007341 5351 JMP FN3 /NO FURTHER CARRY-DONE 1675 007342 2041 ISZ AC1 /CARRY OUT OF MIDDLE-BUMP HIGH ORDER 1676 007343 3705 DCA I OVPT /ZERO OVERFLOW WD 1677 007344 5267 JMP FN0 /GO CHECK IF NORMALIZED 1678 007345 4626 FN2, JMS I AL1P /SHIFT FAC LEFT 1 1679 007346 7240 CLA CMA /SUBTRACT 1 FROM EXPONENT 1680 007347 1044 TAD ACX 1681 007350 3044 DCA ACX 1682 007351 1041 FN3, TAD AC1 /CHECK I FAC=0 1683 007352 7450 SNA 1684 007353 1045 TAD ACH /HI ORDER 1685 007354 7450 SNA 1686 007355 1046 TAD ACLO 1687 007356 7650 SNA CLA /IS WHOLE FAC=0? 1688 007357 5367 JMP ZEXP /YES-ZERO EXPONENT 1689 007360 7346 CLA CLL CMA RTL /NO-INSURE THAT # IS NORMALIZED 1690 007361 1041 TAD AC1 /(I.E. HI ORDER DIGIT IS 4,5,6,OR 7) 1691 007362 7750 SPA SNA CLA /IS IT? 1692 007363 5345 JMP FN2 /NO-SHIFT FAC LEFT AND DECREMENT EXP 1693 007364 4664 NDON, JMS I STICKA /YES-CHECK FOR ERRORS AND PACK FAC 1694 007365 5665 JMP I FFNOR /DONE-RETURN 1695 007366 7101 AR1PT, AR1 1696 007367 3044 ZEXP, DCA ACX 1697 007370 3043 DCA TM /ZERO SIGN 1698 007371 5364 JMP NDON /GO PACK FAC 1699 007372 4631 ARGETK, ARGET 1700 / 1701 /FLOATING HALT-DISPLAY FLOATING P.C. 1702 / 1703 007373 4251 FFHLT, JMS CDFCUR /MUST BE DATA FIELD OF PACKAGE 1704 007374 1407 TAD I FPP /GET THE P.C. 1705 007375 7402 HLT 1706 007376 7200 CLA /CLR IT OUT 1707 007377 5461 JMP I FPNXT /DONE-GET NEXT INSTR. 1708 / 1709 /BEGINNING OF INTERPRETER 1710 / 1711 *FLPT 1712 007400 0000 FPT, 0 1713 007401 7600 L7600, 7600 /CLA 1714 007402 6214 RDF /READ DATA FIELD-THIS WILL BE 1715 007403 1267 TAD KCDF0 /INITIAL FLTG. DATA AND INSTR. FLD 1716 007404 3213 DCA FPNEXT /STORE CDF TO FLTG. INST. FLD 1717 007405 1342 FFSW0, TAD FFSB0 /INLINE IN INTERPRETER--SET FLOATING SWITCH 1718 007406 3257 DCA TSUB /TO 0 1719 007407 1341 TAD FFDV0 1720 007410 3261 DCA TDIV 1721 007411 1213 TAD FPNEXT 1722 007412 3250 SFDF, DCA DFCDF 1723 007413 0000 FPNEXT, 0 /BECOMES CDF TO FLTG. INST FLD. 1724 007414 1600 TAD I FPT /GET NEXT FLTG. PT. INSTR. 1725 007415 3047 DCA OPX /STORE IN A TEMPORARY 1726 007416 1047 TAD OPX /GET IT BACK AND PICK OFF 1727 007417 0265 AND P177 /THE ADDRESS 1728 007420 3050 DCA OPH /STORE THAT AWAY 1729 007421 1047 TAD OPX /PICK OFF THE PAGE BIT 1730 007422 0224 AND K200 /AND MAKE A 7600 IF CURRENT PAGE 1731 007423 7041 CMA IAC /OR 0 IF PAGE ZERO 1732 007424 0200 K200, AND FPT /THIS SETS UP HI ORDER 5 BITS OF ADDR. 1733 007425 2200 ISZ FPT /INCREMENT FLTG. P.C. 1734 007426 1050 TAD OPH /ADD IN LOW ORDER 7 BITS OF ADDR 1735 007427 3050 DCA OPH /THIS IS FINAL ADDR UNLESS INDIRECT. 1736 007430 1047 TAD OPX /NOW DECODE THE OP CODE 1737 007431 7106 CLL RTL 1738 007432 7006 RTL 1739 007433 0344 AND K7 /PICK OFF OP CODE BITS 1740 007434 1254 TAD JMSI /AND MAKE A JMS THRU TABLE 1741 007435 3251 DCA DCOD /STORE IT FOR LATER 1742 007436 1050 TAD OPH /GET ADDRESS INTO AC 1743 007437 7420 SNL /INDIRECT BIT IN LINK-IS IT ON? 1744 007440 5251 JMP DCOD /NO-CALL THE PROPER ROUTINE 1745 007441 0270 AND P7770 /YES-IS ADDR AN AUTO INDEX REG.? 1746 007442 1270 TAD P7770 1747 007443 7650 SNA CLA 1748 007444 1343 TAD K3 /YES-ADD 3 TO XREG. BEFORE USING 1749 007445 1450 TAD I OPH /THE ADDR. 1750 007446 3450 DCA I OPH 1751 007447 1450 TAD I OPH /GET EFF. ADDR.INTO AC FOR CALL 1752 007450 0000 DFCDF, 0 /CHANGE TO FLTG. D.F.-INDIRECT ADDRESSING 1753 007451 0000 DCOD, 0 /CALL SUBRS. WITH ADDR IN AC-D.F.IS 1754 /SET TO FLTG. D.F. OR I.F.-RETN. IS 1755 /TO CALL+2 1756 007452 4671 FNRM, JMS I FFNORP /NORMALIZE ROUTINE-CALL NORM SUBR. 1757 007453 5213 JMP FPNEXT /GO GET NEXT INSTR. 1758 / 1759 /TABLE FOR JUMPS 1760 / 1761 007454 4655 JMSI, JMS I TABLE 1762 007455 7472 TABLE, FFJMP /FLOATING JMP OP CODE 0 1763 007456 7000 FFADD / " ADD " 1 1764 007457 7117 TSUB, FFSUB / " SUBTRACT 2 1765 007460 6600 TMPY, FFMPY / " MULTIPLY 3 1766 007461 6722 TDIV, FFDIV / " DIVIDE 4 1767 007462 7306 FFGET / " GET " 5 1768 007463 7322 FFPUT / " PUT " 6 1769 007464 7520 FFJMS / " JMS " 7 1770 / 1771 /CONSTANTS AND POINTERS 1772 / 1773 007465 0177 P177, 177 1774 007466 7200 FCALLP, FCALL 1775 007467 6201 KCDF0, CDF 0 1776 007470 7770 P7770, 7770 1777 007471 7265 FFNORP, FFNOR 1778 / 1779 /FLOATING JUMP-CHECK FOR FCALL OR FISZ 1780 / 1781 007472 0000 FFJMP, 0 1782 007473 7450 SNA /IS IT FEXT? 1783 007474 5313 JMP EXIT /YES-LEAVE INTERPRETER 1784 007475 3050 DCA OPH /NO-STORE ADDR. 1785 007476 1047 TAD OPX /ARE INDIRECT AND PAGE BITS=0 1786 007477 0201 AND L7600 /(WORKS SINCE OP`CODE=0) 1787 007500 7640 SZA CLA 1788 007501 5355 JMP FJUMP /NO-IT IS FJUMP-EFF. ADR. IN OPH 1789 007502 1047 TAD OPX /YES-ARE BITS 5-7=0? 1790 007503 0312 AND K160 /(ANY ON=FISZ) 1791 007504 7650 SNA CLA 1792 007505 5666 JMP I FCALLP /FLOATING CALL-DO IT 1793 007506 2447 FFISZ, ISZ I OPX /FISZ-SZ THAT ADDR (DF=FLTG. IF) 1794 007507 5213 JMP FPNEXT /NO-SKIP-GO GET NEXT INST. 1795 007510 2200 FISZ1, ISZ FPT /SKIP-INCREMENT FLTG. P.C. 1796 007511 5213 JMP FPNEXT /GO ON 1797 007512 0160 K160, 160 1798 / 1799 /FEXT-LEAVE INTERPRETER 1800 / 1801 007513 7326 EXIT, CLA CLL CML RTL /MAKE A CDF CIF TO FLTG. INST FLD. 1802 007514 1213 TAD FPNEXT 1803 007515 3316 DCA .+1 /STORE IT 1804 007516 0000 0 1805 007517 5600 JMP I FPT /GO BACK TO USER,AC=L=0 1806 / 1807 /FLOATING JMS-IF BITS 3-11=0 = NORMALIZE FAC (FNOR) 1808 / " 3-4 =0 = DECODE FURTHER BY BITS 9-11 1809 / " 9-11=0 = SKIP ON CONDITION OF FAC 1810 / " =1 = FCDF (BITS 6-8=NEW FLTG. D.F.) 1811 / " =2 = FSW0 1812 / " 3 = FSW1 1813 / " =4 = FHLT-DISPLAY FLTG. PC 1814 / " =5-7 NOP 1815 / 1816 007520 0000 FFJMS, 0 1817 007521 7450 SNA /IS IT NORMALIZE? 1818 007522 5252 JMP FNRM /YEAH-DO IT 1819 007523 3050 DCA OPH /NO-STORE EFF ADDR. 1820 007524 1047 TAD OPX /GET THE INSTR. 1821 007525 0345 AND K600 /INDIRECT AND PAGE BITS=0? 1822 007526 7650 SNA CLA 1823 007527 5740 JMP I JSKPP /YES-GO DECODE FURTHER 1824 007530 1213 TAD FPNEXT /NO-ITS JMS-GET CDF TO FLTG. I.F. 1825 007531 3332 DCA .+1 /STORE IT 1826 007532 0000 IFCDF, 0 /EXECUTE IT 1827 007533 1200 TAD FPT /GET THE FLTG. P.C. 1828 007534 3450 DCA I OPH /STORE IT AT THE EFF.ADDR. 1829 007535 1050 TAD OPH /GET THE EFF. ADDR. 1830 007536 3200 DCA FPT /STORE IN`FLTG. PC. 1831 007537 5310 JMP FISZ1 /GO INCREMENT FLTG. PC 1832 007540 4611 JSKPP, JSKP 1833 007541 6722 FFDV0, FFDIV 1834 007542 7117 FFSB0, FFSUB 1835 007543 0003 K3, 3 1836 007544 0007 K7, 7 1837 007545 0600 K600, 600 1838 / 1839 /FLOATING SKIP-ADD 600 TO THE INSTRUCTION TO MAKE IT 1840 /A SKIP WITH CLA--THE SKIP PRODUCED IS THE REVERSE OF 1841 /WHAT IS EXPECTED (SNA NOT SZA) TO FACILITATE THE 1842 /DECODING 1843 / 1844 007546 1345 FFSKP, TAD K600 /ADD 600 TO MAKE A SKP WITH CLA 1845 007547 1047 TAD OPX /ADD IN ORIG INSTR 1846 007550 3352 DCA .+2 1847 007551 1044 TAD ACX /GET EXP OF FAC TO AC FOR SENSING 1848 007552 0000 0 /EXECUTE THE SKIP WE MADE 1849 007553 2200 ISZ FPT /NO SKIP=SKIP-BUMP FLTG.PC 1850 007554 5213 JMP FPNEXT /SKIP=NO SKIP-LEAVE PC ALONE-GO ON 1851 1852 / 1853 /FLOATING JUMP-STORE EFF. ADDR IN FLTG.PC 1854 / 1855 007555 1050 FJUMP, TAD OPH /GET EFF ADDR OF JUMP 1856 007556 3200 DCA FPT /STORE IN FLTG. PC 1857 007557 5213 JMP FPNEXT /GO ON 1858 1859 007560 4660 FFSQC, JMS I TMPY /CALL MULTIPLY TO MULTIPLY 1860 007561 0044 ACX /FAC BY ITSELF 1861 007562 5764 JMP I FFSQ /DONE 1862 *FPT+164 1863 / 1864 /FSQUARE-SQUARE FAC-CALLS MULTIPLY TO MUL. FAC BY ITSELF 1865 / 1866 007564 0000 FFSQ, 0 1867 007565 5360 JMP FFSQC /JUMP TO LEAVE ROOM 4 EXTRA TRAPS 1868 / 1869 /FLOATING TRAPS TO USER-INITIALLY SET TO NOPS 1870 / 1871 007566 5777 FTRP4, JMP I FTRAP4 /EXP. UNDERFLOW 1872 007567 5773 FTRP5, JMP I FTRAP5 /EXP. OVERFLOW 1873 007570 5774 FTRP1, JMP I FTRAP1 /FIX OVERFLOW 1874 007571 5775 FTRP2, JMP I FTRAP2 /DIV. ERR. 1875 007572 5776 FTRP3, JMP I FTRAP3 /ILL. FUNCT. ARG. 1876 007573 4704 FTRAP5, OVRFLO 1877 007574 5507 FTRAP1, FTRPRT 1878 007575 4751 FTRAP2, DBAD 1879 007576 5276 FTRAP3, LTRPRT 1880 007577 4703 FTRAP4, NDRFLO 1881 $ AC0 0040 AC1 0041 AC2 0042 ACH 0045 ACLO 0046 ACX 0044 ADFW 5757 AL1 6667 AL1K 6450 AL1P 7226 AL1PP 6141 AL1PT 5714 AN1 6400 AN2 6412 AN3 0047 AR1 7101 AR1A 5573 AR1K 6572 AR1P 6664 AR1PT 7366 AR1PTR 5713 ARGET 4631 ARGETK 7372 ARGETL 6447 ARGETP 7132 ARGPOL 5220 ARTRAP 5370 ATAN 5200 ATANA1 5437 ATANA2 5445 ATANA3 5453 ATANB0 5434 ATANB1 5442 ATANB2 5450 ATANB3 5456 C2170 5550 C3 5100 CCUR1 7252 CCUR2 7253 CDFCRA 6310 CDFCRB 5736 CDFCRK 4655 CDFCUR 7251 CHAR 0053 COS 5053 DADP 0060 DBAD 4751 DCNT 6140 DCNTP 5741 DCOD 7451 DCOD1 7212 DECNV 6212 DECON 6213 DECON1 6334 DECONV 6206 unreferenced DFCDF 7450 DFCDFP 7230 DGON 6746 DGTYP 6101 DNUMBR 6303 DOADD 7021 DONA 7046 DONE 6570 DONEF 6071 DONES 4673 DSWIT 0052 DT1 6104 DV2 6770 DVBY0P 6652 DVD 6716 DVDD 4754 DVDONE 6711 DVLP 6742 EDON 6257 EFLG 0056 EXIT 7513 EXP 0044 EXPA0 5431 EXPA1 5426 EXPB1 5423 EXPON 5135 F7600 6452 unreferenced FACR 7052 FAD1 7004 FADD 1000 FADDL 5065 FADDM 5360 FCALL 7200 FCALLP 7466 FCNT 6274 FDIV 4000 unreferenced FDIV1L 5077 FDIV1M 5362 FDIVL 5070 FDIVM 5361 FDVPT 6307 FEXT 0000 FFADD 7000 FFADP 5745 FFATN 5200 FFCDF 4755 FFCOS 5053 FFD1 6726 FFDIV 6722 FFDIV1 6412 FFDP 6445 FFDV0 7541 FFDV1 4626 FFDVP 5746 FFEXP 5135 FFGET 7306 FFHLT 7373 FFIN 6200 FFIN1 6227 FFISZ 7506 unreferenced FFIX 5500 FFJMP 7472 FFJMS 7520 FFLOAT 5533 FFLOG 5263 FFMPP 5750 FFMPY 6600 FFMT 5612 FFNEG 7135 FFNEGA 6407 FFNOR 7265 FFNORP 7471 FFOUT 5600 FFPUT 7322 FFPUTP 5747 FFSB0 7542 FFSB1 4625 FFSIN 5000 FFSKP 7546 FFSQ 7564 FFSQC 7560 FFSUB 7117 FFSUB1 6400 FFSW0 7405 FFSW1 4617 FGET 5000 FGETL 5064 FGETM 5367 FIGO2 6236 FISZ1 7510 FIXDNE 5527 FIXFLT 5500 FIXL 5075 FIXLP 5516 FJUMP 7555 FJUMP1 7222 unreferenced FLDW 0057 FLING 6143 FLINK 5737 FLOATL 5076 FLOATM 5366 FLPT 7400 FMPY 3000 FMPYL 5066 FMPYM 5357 FN0 7267 FN1 7277 FN2 7345 FN3 7351 FN4 7340 FNEGL 5072 FNOR 7000 FNORK 6662 FNORL 5547 FNORP 7134 FNRM 7452 FOUT 5703 FOUT1 5627 FOUT2 5637 FOUT4 5671 unreferenced FPNEXT 7413 FPNXT 0061 FPP 0007 FPT 7400 FPUT 6000 FPUTL 5067 FPUTM 5356 FRACT 5101 FROOT 6451 FSQRL 5074 FSQRM 5365 FSUB 2000 unreferenced FSUB1L 5071 FSUB1M 5364 FSUBL 5073 FSUBM 5363 FT1 7262 FT2 7260 FT3 7261 FTRAP1 7574 FTRAP2 7575 FTRAP3 7576 FTRAP4 7577 FTRAP5 7573 FTRP1 7570 FTRP2 7571 FTRP3 7572 FTRP4 7566 FTRP5 7567 FTRPRT 5507 GCHR 6320 GD 6033 GETE 6247 GKNT 6011 unreferenced GON 6556 GT1FLG 5263 GTFLG 5200 HLP 6702 HORD 0045 IFCDF 7532 unreferenced INPUT 6345 JMPI 5012 JMPI3 4600 JMPIC 7227 JMSI 7454 JMSI2 7231 JSKP 4611 JSKPP 7540 K10 5744 K100 6577 K16 5735 K160 7512 K17 6136 K177 6651 K200 7424 K2035 5751 K255 5743 K3 7543 K360 6175 K377 4747 K40 6653 K600 7545 K7 7544 K7400 4702 K7506 6377 K7770 7225 KCDF0 7467 KFD1 6446 KK10 5132 KK12 6311 KK200 5374 KK7 5742 KM10 5657 KM12 6137 KM2007 5730 KM201 6660 KM27 6411 KM29 6655 KM5 5733 KME 6304 KNT 5752 KNTP 6157 KP7 4746 L7600 7401 LN2 5555 LN2OV2 5420 LOG 5263 LOG2E 5415 LOGC1 5464 LOGC3 5467 LOGC5 5552 LOOP 6055 LOOPM 6623 LOP01 6502 unreferenced LOP02 6535 LORD 0046 LP 6354 unreferenced LP2 6635 LP3 6643 LTRPRT 5276 M13 5532 M200 5373 M201 5732 M2014 5371 M27 6661 M4 5531 MCR 6374 MDONE 6637 unreferenced MDSET 4644 MDSETK 6666 MDV 6305 MRUBOT 6375 MSK 6663 NCHK 5123 NCHKL 5262 NDFLO 4700 NDON 7364 NDRFLO 4703 NFLAG 5135 NFLGST 5121 NGT 5257 NHNDLE 5113 NHNDLL 5261 NOTE 5754 NUM 5123 OADD 7160 OADDK 6665 OADDP 6142 ONE 5472 ONEHAF 5475 OPH 0050 OPL 0051 OPNEG 7143 OPNEGP 6654 OPSR 7066 OPSRP 6575 OPX 0047 OTRAPA 5551 OUT 6144 OUTDG 6153 OUTP 5734 OUTPP 6373 OV 7131 OVFLO 4701 OVP 4677 OVPT 7305 OVPTR 6135 OVRFLO 4704 P177 7465 P200 6210 P7 4616 P7770 7470 PCDF0 4761 PDP 6007 unreferenced PIOV2 5376 PLUS 6376 POLYNL 5300 POLYSN 5022 PR 6024 PRDCP 6005 PRNTX 6160 PRNTX1 6164 PRNTXP 5740 PRZRO 6175 PS 6031 PZR 6023 QDTBL 5060 QUAD2 5013 QUAD3 5016 QUAD4 5020 SE 5715 SE1 5716 SEP 6174 SFDF 7412 SFDFP 4760 SIGNF 6277 SIN 5000 SINA3 5401 SINA5 5404 SINA7 5407 SINA9 5412 SLOOP 6500 SPLIT 4711 SPLITA 5572 SPLITB 7224 SPLITK 6574 SPLITP 7133 SPLITS 5372 SPLITT 5731 SPLITZ 5130 SPLTFG 4750 SPLTFK 5571 SPLTFP 5753 SQRP5 5461 STICK 4656 STICKA 7264 STICKP 6573 STICKS 5375 STICKZ 5131 SUB0 7127 SUB0P 6410 SWIT1 0054 SWIT2 0055 TABLE 7455 TABLE2 7232 TABLE3 4601 TDIV 7461 TDIVP 4630 TEM 5777 TEMP1 5563 TEMP2 5566 TEN 6315 TM 0043 TM1 6576 TM3 6172 TM3PT 6302 TM4 6656 TM5 6657 TMIN 6357 TMPY 7460 TOVPI 5560 TP 6312 TP1 6313 TSUB 7457 TSUBP 4627 ZEXP 7367