1 /EAE EXTENDED FUNCTIONS-23 BIT 2 3 /1-31-72 R BEAN 4 5 /COPYRIGHT 1972 DIGITAL EQUIPMENT CORPORATION,MAYNARD, MASS. 01754 6 7 /DEC-8E-NEAEA-A VERSION 1 8 9 10 FIXMRI FADD=1000 11 FIXMRI FSUB=2000 12 FIXMRI FMPY=3000 13 FIXMRI FDIV=4000 14 FIXMRI FGET=5000 15 FIXMRI FPUT=6000 16 FEXT=0000;FNOR=7000 17 18 19 EXP=44;HORD=45;LORD=46 20 21 FIXFLT=5500 22 *FIXFLT 23 24 /******FIX****** 25 /ROUTINE TO FIX ANY FLOATING NUMBER IN FAC BETWEEN -2047 AND +2047 TO 26 /A TWELVE BIT INTEGER AND LEAVE RESULT IN EXP (LOC 44) 27 28 005500 0000 FFIX, 0 29 005501 7200 CLA 30 005502 1044 TAD EXP /FETCH EXPONENT 31 005503 7540 SZA SMA /IS NUMBER <1? 32 005504 5307 JMP .+3 /NO-CONTINUE ON 33 005505 7200 FTRPRT, CLA 34 005506 5326 JMP FIXDNE+1 /YES-FIX IT TO 0 35 005507 1330 TAD M13 /SET BINARY POINT AT 11 36 005510 7450 SNA /PLACES TO RIGHT OF CURRENT POINT? 37 005511 5325 JMP FIXDNE /NO-NUMBER IS ALREADY FIXED THEN. 38 005512 7500 SMA /YES-IS NUMBER TOO LARGE TO FIX? 39 005513 5732 JMP I OTRAPA /YES-TAKE OVERFLOW TRAP 40 005514 3044 DCA EXP /NO-SET SCALE COUNT 41 005515 7100 FIXLP, CLL /0 IN LINK 42 005516 1045 TAD HORD /GET HIGH MANTISSA 43 005517 7510 SPA /IS IT <0? 44 005520 7020 CML /YES-PUT A 1 IN LINK 45 005521 7010 RAR /SCALE RIGHT 46 005522 3045 DCA HORD /SAVE 47 005523 2044 ISZ EXP /DONE YET? 48 005524 5315 JMP FIXLP /NO 49 005525 1045 FIXDNE, TAD HORD /YES-ANSWER IN AC 50 005526 3044 DCA EXP /RETURN WITH ANSWER IN 44 51 005527 5700 JMP I FFIX /RETURN 52 53 005530 7765 M13, -13 /-11 DECIMAL 54 005531 0013 C13, 13 /11 DECIMAL 55 005532 7570 OTRAPA, FTRP1 /ADDRESS OF VECTOR FOR OVERFLOW TRAP 56 57 /******FLOAT****** 58 /ROUTINE TO FLOAT ANY INTEGER IN EXP (LOC 44) INTO FAC 59 60 005533 0000 FFLOAT, 0 61 005534 1044 TAD EXP 62 005535 3045 DCA HORD /PUT NUMBER IN HI MANTISSA 63 005536 3046 DCA LORD /CLEAR LOW MANTISSA 64 005537 1331 TAD C13 /11(10) INTO EXPONENT 65 005540 3044 DCA EXP 66 005541 4743 JMS I FNORL /NORMALIZE 67 005542 5733 JMP I FFLOAT /RETURN 68 005543 7265 FNORL, FFNOR /LINK TO NORMALIZE ROUTINE 69 *5000 70 71 /******SINE****** 72 73 005000 0000 SIN, 0 74 005001 4320 JMS NHNDLE /IF X<0,NEGATE X AND SET NFLAG 75 005002 4662 JMS I FMPYL /X*2/PI 76 005003 5175 TOVPI 77 005004 4306 JMS FRACT /SAVE X IN TEMP1,THE INTEGER PART OF X IN NUM 78 /AND GET FRACTIONAL PART IN FAC 79 005005 1330 TAD NUM /GET INTEGER PART OF (2/PI)*X 80 005006 0274 AND C3 /ISOLATE BITS 10,11 81 005007 1212 TAD JMPI 82 005010 3211 DCA .+1 /MAKE JUMP TO ARGUMENT REDUCING ROUTINE 83 005011 5211 JMP . /AND ADJUST ARG ACCORDING TO QUADRANT OF X 84 005012 5613 JMPI, JMP I .+1 85 005013 5026 POLYSN /X IN QUAD1,SIN(X)=SIN(X) 86 005014 5017 QUAD2 /X IN QUAD2,SIN(X)=SIN(1-X) 87 005015 5022 QUAD3 /X IN QUAD3,SIN(X)=SIN(-X) 88 005016 5024 QUAD4 /X IN QUAD4,SIN(X)=SIN(X-1) 89 90 005017 4665 QUAD2, JMS I FSUB1L /1-X 91 005020 5103 ONE 92 005021 5226 JMP POLYSN /CALCULATE SIN(1-X) 93 005022 4666 QUAD3, JMS I FNEGL /-X 94 005023 5226 JMP POLYSN /CALCULATE SIN(-X) 95 005024 4667 QUAD4, JMS I FSUBL /X-1 96 005025 5103 ONE 97 005026 4663 POLYSN, JMS I FPUTL /SAVE X 98 005027 5075 TEMP1 99 005030 4670 JMS I FSQRL /U=X**2 100 005031 4663 JMS I FPUTL /SAVE U 101 005032 5100 TEMP2 102 005033 4662 JMS I FMPYL /A7*U 103 005034 5402 SINA7 104 005035 4661 JMS I FADDL /A5+A7*U 105 005036 5377 SINA5 106 005037 4662 JMS I FMPYL /A5*U+A7*U**2 107 005040 5100 TEMP2 108 005041 4661 JMS I FADDL /A3+A5(U)+A7(U**2) 109 005042 5374 SINA3 110 005043 4662 JMS I FMPYL /A3(U)+A5(U**2)+A7(U**3) 111 005044 5100 TEMP2 112 005045 4661 JMS I FADDL /A1+A3(U)+A5(U**2)+A7(U**3) 113 005046 5371 SINA1 114 005047 4662 JMS I FMPYL /A1(X)+A3(X**3)+A5(X**5)+A7(X**7) 115 005050 5075 TEMP1 116 005051 4330 JMS NCHK /IF NFLAG IS SET,SET SIN(X)=-SIN(X) 117 005052 5600 JMP I SIN /FAC=SIN(X) 118 119 120 /******COSINE****** 121 /USES SIN ROUTINE TO CALCULATE COS(X) 122 123 005053 0000 COS, 0 124 005054 4661 JMS I FADDL /COS(X)=SIN(PI/2+X) 125 005055 5405 PIOV2 126 005056 4200 JMS SIN 127 005057 5653 JMP I COS /RETURN 128 129 005060 7306 FGETL, FFGET 130 005061 7000 FADDL, FFADD 131 005062 6600 FMPYL, FFMPY 132 005063 7322 FPUTL, FFPUT 133 005064 6722 FDIVL, FFDIV 134 005065 6400 FSUB1L, FFSUB1 135 005066 7135 FNEGL, FFNEG 136 005067 7117 FSUBL, FFSUB 137 005070 7564 FSQRL, FFSQ 138 005071 5500 FIXL, FFIX 139 005072 5533 FLOATL, FFLOAT 140 005073 6412 FDIV1L, FFDIV1 141 005074 0003 C3, 3 142 005075 0000 TEMP1, 0 143 005076 0000 0 144 005077 0000 0 145 005100 0000 TEMP2, 0 /TWO TEMP STORAGE BLOCKS FOR FUNCTIONS 146 005101 0000 0 147 005102 0000 0 148 005103 0001 ONE, 1 /1 149 005104 2000 2000 150 005105 0000 0 151 152 /ROUTINE TO SEPERATE THE INTEGER AND FRACTIONAL PARTS OF FAC 153 /ORIGINAL FAC IS SAVED IN TEMP1,THE INTEGER PORTION OF FAC IS 154 /SAVED AT NUM,AND THE FRACTIONAL FORTION OF THE FAC IS LEFT IN THE FAC 155 156 005106 0000 FRACT, 0 157 005107 4663 JMS I FPUTL /SAVE X 158 005110 5075 TEMP1 159 005111 4671 JMS I FIXL /INTEGER PORTION OF X 160 005112 1044 TAD EXP 161 005113 3330 DCA NUM /SAVE FIXED FORTION OF X 162 005114 4672 JMS I FLOATL /FAC=FLOAT(FIX(X)) 163 005115 4665 JMS I FSUB1L /FAC=X-INT(X)=FRACTION (X) 164 005116 5075 TEMP1 165 005117 5706 JMP I FRACT /RETURN 166 167 /ROUTINE TO CHECK IF FAC<0; IF IT IS,FAC IS NEGATED AND NFLAG IS 168 /SET TO 1 169 170 005120 0000 NHNDLE, 0 171 005121 1045 TAD HORD /FETCH HIGH ORDER MANTISSA 172 005122 7700 SMA CLA /IS IT <0? 173 005123 5326 JMP NFLGST /NO-CLEAR NFLAG 174 005124 4666 JMS I FNEGL /YES-NEGATE FAC 175 005125 7001 IAC /AND SET NFLAG 176 005126 3335 NFLGST, DCA NFLAG 177 005127 5720 JMP I NHNDLE 178 179 /ROUTINE TO NEGATE FAC IF NFLAG IS NOT =0 180 181 005130 0000 NCHK, 0 /LOC ALSO USED FOR TEMP STORAGE 182 005131 1335 TAD NFLAG 183 005132 7640 SZA CLA /IS NFLAG=0? 184 005133 4666 JMS I FNEGL /NO-NEGATE FAC 185 005134 5730 JMP I NCHK /YES-RETURN 186 187 NUM=NCHK 188 189 /******EXPONENTIAL****** 190 191 005135 0000 EXPON, 0 /LOC USED FOR TEMP STORAGE BY SIN,ARCTAN 192 005136 4662 JMS I FMPYL /Y=XLOG2(E) 193 005137 5410 LOG2E 194 005140 4306 JMS FRACT /GET FRACTIONAL PART OF Y 195 005141 4662 JMS I FMPYL /(FRACTION(Y))*(LN2/2) 196 005142 5413 LN2OV2 197 005143 4663 JMS I FPUTL /SAVE Y 198 005144 5075 TEMP1 199 005145 4670 JMS I FSQRL /Y**2 200 005146 4661 JMS I FADDL /B1+Y**2 201 005147 5416 EXPB1 202 005150 4673 JMS I FDIV1L /A1/(B1+Y**2) 203 005151 5421 EXPA1 204 005152 4661 JMS I FADDL /A0+A1/(B1+Y**2) 205 005153 5424 EXPA0 206 005154 4667 JMS I FSUBL /A0-Y+A1/(B1+Y**2) 207 005155 5075 TEMP1 208 005156 4663 JMS I FPUTL /SAVE 209 005157 5100 TEMP2 210 005160 4660 JMS I FGETL /GET Y 211 005161 5075 TEMP1 212 005162 2044 ISZ EXP /MULT. BY 2=2Y 213 005163 7000 NOP 214 005164 4664 JMS I FDIVL /2Y/(A0-Y+A1/(B1+Y**2)) 215 005165 5100 TEMP2 216 005166 4661 JMS I FADDL /1+2Y/(AO-Y+A1/(B1+Y**2)) 217 005167 5103 ONE 218 005170 4670 JMS I FSQRL / 1+2Y/(A0-Y+A1/(B1+Y**2)) **2=EXP(Y) 219 005171 1330 TAD NUM 220 005172 1044 TAD EXP /EXP(X)=(2**N)(EXPY) 221 005173 3044 DCA EXP 222 005174 5735 JMP I EXPON /FAC=EXPON(X) 223 224 NFLAG=EXPON 225 226 /CONSTANT THAT WOULDN'T FIT ELSEWHERE 227 005175 0000 TOVPI, 0 /.6366198 228 005176 2427 2427 229 005177 6302 6302 230 *SIN+200 231 232 /******ARC TANGENT****** 233 234 005200 0000 ATAN, 0 235 005201 4661 JMS I NHNDLL /IF X<0,SET NFLAG AND NEGATE 236 005202 4756 JMS I FPUTM /SAVE X 237 005203 5075 TEMP1 238 005204 4763 JMS I FSUBM /X-1 239 005205 5103 ONE 240 005206 1045 TAD HORD /GET HI MANTISSA 241 005207 7710 SPA CLA /WAS X>1? 242 005210 5220 JMP ARGPOL /NO-CLEAR GT1FLG 243 005211 4767 JMS I FGETM /YES-ATAN(X)=PI/2-ATAN(1/X) 244 005212 5103 ONE 245 005213 4761 JMS I FDIVM /1/X 246 005214 5075 TEMP1 247 005215 4756 JMS I FPUTM 248 005216 5075 TEMP1 249 005217 7001 IAC /SET GT1FLG 250 005220 3263 ARGPOL, DCA GT1FLG 251 005221 4767 JMS I FGETM /GET X OR 1/X 252 005222 5075 TEMP1 253 005223 4765 JMS I FSQRM /Y**2 254 005224 4756 JMS I FPUTM /SAVE 255 005225 5100 TEMP2 256 005226 4760 JMS I FADDM /Y**2+B3 257 005227 5451 ATANB3 258 005230 4762 JMS I FDIV1M /A3/(Y**2+B3) 259 005231 5446 ATANA3 260 005232 4760 JMS I FADDM /B2+A3/(Y**2+B3) 261 005233 5443 ATANB2 262 005234 4760 JMS I FADDM /Y**2+B2+A3/(Y**2+B3) 263 005235 5100 TEMP2 264 005236 4762 JMS I FDIV1M /A2/(Y**2+B2+A3/(Y**2+B3)) 265 005237 5440 ATANA2 266 005240 4760 JMS I FADDM /B1+A2/(Y**2+B2+A3/(Y**2+B3)) 267 005241 5435 ATANB1 268 005242 4760 JMS I FADDM /Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)) 269 005243 5100 TEMP2 270 005244 4762 JMS I FDIV1M /A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 271 005245 5432 ATANA1 272 005246 4760 JMS I FADDM /B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3))) 273 005247 5427 ATANB0 274 005250 4757 JMS I FMPYM /ATAN(Y)=X*(B0+A1/(Y**2+B1+A2/(Y**2+B2+A3/(Y**2+B3)))) 275 005251 5075 TEMP1 276 005252 1263 TAD GT1FLG /WAS X>1? 277 005253 7650 SNA CLA 278 005254 5257 JMP NGT /NO-TEST IF X<0? 279 005255 4764 JMS I FSUB1M /ATAN(X)=PI/2-ATAN(1/X) 280 005256 5405 PIOV2 281 005257 4662 NGT, JMS I NCHKL /IF NFLAG SET,NEGATE FAC 282 005260 5600 JMP I ATAN /FAC=ATAN(X) 283 284 005261 5120 NHNDLL, NHNDLE 285 005262 5130 NCHKL, NCHK 286 287 288 /******NAPERIAN LOGARITHM****** 289 290 GTFLG=ATAN 291 292 005263 0000 LOG, 0 293 005264 1045 TAD HORD 294 005265 7550 SPA SNA /X<0 OR X=0? 295 005266 5770 JMP I ARTRAP /YES-TAKE ILLEGAL ARGUMENT TRAP 296 005267 7106 CLL RTL 297 005270 7450 SNA /NO-HORD=2000? 298 005271 1044 TAD EXP /YES-EXP=1? 299 005272 7041 CMA IAC 300 005273 7001 IAC 301 005274 7450 SNA 302 005275 1046 TAD LORD /YES-LORD=0? 303 005276 7640 SZA CLA 304 005277 5304 JMP POLYNL /NO-ARG IS LEGAL AND NOT 1 305 005300 3044 DCA EXP 306 005301 3046 DCA LORD 307 005302 3045 LTRPRT, DCA HORD 308 005303 5663 JMP I LOG /YES-LOG(1)=0 309 005304 1044 POLYNL, TAD EXP 310 005305 3200 DCA GTFLG /SAVE EXPONENT FOR LATER 311 005306 3044 DCA EXP /ISOLATE MANTISSA IN FAC 312 005307 4756 JMS I FPUTM /SAVE F 313 005310 5075 TEMP1 314 005311 4760 JMS I FADDM /F+SQR(.5) 315 005312 5454 SQRP5 316 005313 4756 JMS I FPUTM /SAVE 317 005314 5100 TEMP2 318 005315 4767 JMS I FGETM 319 005316 5075 TEMP1 320 005317 4763 JMS I FSUBM /F-SQR(.5) 321 005320 5454 SQRP5 322 005321 4761 JMS I FDIVM /Z=F+SQR(.5)/F-SQR(.5) 323 005322 5100 TEMP2 324 005323 4756 JMS I FPUTM 325 005324 5075 TEMP1 326 005325 4765 JMS I FSQRM /Z**2 327 005326 4756 JMS I FPUTM 328 005327 5100 TEMP2 329 005330 4757 JMS I FMPYM /C5(Z**2) 330 005331 5465 LOGC5 331 005332 4760 JMS I FADDM /C3+C5(Z**2) 332 005333 5462 LOGC3 333 005334 4757 JMS I FMPYM /C3(Z**2)+C5(Z**4) 334 005335 5100 TEMP2 335 005336 4760 JMS I FADDM /C1+C3(Z**2)+C5(Z**4) 336 005337 5457 LOGC1 337 005340 4757 JMS I FMPYM /C1(Z)+C3(Z**3)+C5(Z**5) 338 005341 5075 TEMP1 339 005342 4763 JMS I FSUBM /C1(Z)+C3(Z**3)+C5(Z**5)-1/2=LOG2(F) 340 005343 5470 ONEHAF 341 005344 4756 JMS I FPUTM /SAVE LOG2(F) 342 005345 5100 TEMP2 343 005346 1200 TAD GTFLG /I 344 005347 3044 DCA EXP /SET UP FLOAT 345 005350 4766 JMS I FLOATM 346 005351 4760 JMS I FADDM /I+LOG2(F) 347 005352 5100 TEMP2 348 005353 4757 JMS I FMPYM / I+LOG2(F) *LOGE(2)=LOGE(X) 349 005354 5473 LN2 350 005355 5663 JMP I LOG /FAC=LN(X) 351 352 GT1FLG=LOG 353 005356 7322 FPUTM, FFPUT 354 005357 6600 FMPYM, FFMPY 355 005360 7000 FADDM, FFADD 356 005361 6722 FDIVM, FFDIV 357 005362 6412 FDIV1M, FFDIV1 358 005363 7117 FSUBM, FFSUB 359 005364 6400 FSUB1M, FFSUB1 360 005365 7564 FSQRM, FFSQ 361 005366 5533 FLOATM, FFLOAT 362 005367 7306 FGETM, FFGET 363 005370 7572 ARTRAP, FTRP3 364 365 /CONSTANTS USED BY VARIOUS FUNCTIONS 366 367 005371 0001 SINA1, 1 /1.5707949 368 005372 3110 3110 369 005373 3747 3747 370 005374 0000 SINA3, 0 /-.64592098 371 005375 5325 5325 372 005376 1167 1167 373 005377 7775 SINA5, 7775 /.07948766 374 005400 2426 2426 375 005401 2466 2466 376 005402 7771 SINA7, 7771 /-.004362476 377 005403 5610 5610 378 005404 3164 3164 379 005405 0001 PIOV2, 1 /1.5707963 380 005406 3110 3110 381 005407 3756 3756 382 005410 0001 LOG2E, 1 /1.442695 383 005411 2705 2705 384 005412 2434 2434 385 005413 7777 LN2OV2, 7777 /.34657359 386 005414 2613 2613 387 005415 4415 4415 388 005416 0006 EXPB1, 6 /60.090191 389 005417 3602 3602 390 005420 7054 7054 391 005421 0012 EXPA1, 12 /-601.80427 392 005422 5514 5514 393 005423 3104 3104 394 005424 0004 EXPA0, 4 /12.015017 395 005425 3001 3001 396 005426 7301 7301 397 005427 7776 ATANB0, 7776 /.17465544 398 005430 2626 2626 399 005431 6157 6157 400 005432 0002 ATANA1, 2 /3.7092563 401 005433 3553 3553 402 005434 1071 1071 403 005435 0003 ATANB1, 3 /6.762139 404 005436 3303 3303 405 005437 0670 670 406 005440 0003 ATANA2, 3 /-7.10676 407 005441 4344 4344 408 005442 5267 5267 409 005443 0002 ATANB2, 2 /3.3163354 410 005444 3241 3241 411 005445 7554 7554 412 005446 7777 ATANA3, 7777 /-.26476862 413 005447 5703 5703 414 005450 4040 4040 415 005451 0001 ATANB3, 1 /1.44863154 416 005452 2713 2713 417 005453 3140 3140 418 005454 0000 SQRP5, 0 /.7071068 419 005455 2650 2650 420 005456 1170 1170 421 005457 0002 LOGC1, 2 /2.8853913 422 005460 2705 2705 423 005461 2440 2440 424 005462 0000 LOGC3, 0 /.9614706 425 005463 3661 3661 426 005464 0566 566 427 005465 0000 LOGC5, 0 /.59897865 428 005466 2312 2312 429 005467 5525 5525 430 005470 0000 ONEHAF, 0 /.5 431 005471 2000 2000 432 005472 0000 0 433 005473 0000 LN2, 0 /.6931472 434 005474 2613 2613 435 005475 4415 4415 436 437 FFSIN=SIN 438 FFCOS=COS 439 FFATN=ATAN 440 FFLOG=LOG 441 FFEXP=EXPON 442 /EAE FLOATING POINT INTERPRETER 443 /FOR PDP8/E WITH KE8-E EAE 444 /DEC-8E-NEAEA-A VERSION 1 445 /COPYRIGHT 1972 BY DIGITAL EQUIPMENT CORPORATION 446 /MAYNARD, MASSACHUSETTS. 01754 447 / 448 /W.J. CLOGHER 449 / 450 /DEFINITIONS OF EAE INSTRUCTIONS 451 SWAB=7431;SWBA=7447;SCA=7441;MUY=7405;DVI=7407;NMI=7411;SHL=7413 452 ASR=7415;LSR=7417;ACS=7403;SAM=7457;DAD=7443;DLD=7663;DST=7445 453 DPIC=7573;DCM=7575;DPSZ=7451;SWP=7521;CAM=7621 454 MQA=7501;MQL=7421;SGT=6006 455 / 456 /DEFINITION FOR ORIGIN OF PACKAGE 457 / 458 FLPT=7400 459 / 460 /PAGE ZERO LOCATIONS USED 461 / 462 *7 463 000007 7400 FPP, FPT /IF THIS IS MOVED, FIX LOC. K7 464 *40 465 000040 0000 AC0, 0 466 000041 0000 AC1, 0 467 000042 0000 AC2, 0 468 000043 6201 TM, CDF 0 /ONLY NEEDED ONCE (FIRST CALL TO CDFCUR) 469 000044 0000 ACX, 0 /FLOATING ACCUMULATOR-EXPONENT 470 000045 0000 ACH, 0 / " " -HIGH ORDER MANTISSA 471 000046 0000 ACLO, 0 / " " -LOW ORDER MANTISSA 472 000047 0000 OPX, 0 /STORAGE FOR OPERAND 473 000050 0000 OPH, 0 474 000051 0000 OPL, 0 475 000052 0000 DSWIT, 0 /SWITCH SHOWING IF ANY INPUT CONV. WAS DONE 476 000053 0000 CHAR, 0 /LOCATION HOLDING TERMINATOR OF LAST INPUT. 477 000054 7777 SWIT1, 7777 /=0 IF NO LINE FEED AFTER CAR.RET. ON INPUT 478 000055 7777 SWIT2, 7777 /=0 IF NO CR/LF AFTER OUTPUT 479 / 480 /IF EFLG = 0, 6 IS DEPOSITED INTO DADP, AND 16 (8) INTO FLDW 481 / 482 000056 0000 EFLG, 0 /=0 IF E FORMAT OUT 483 000057 0000 FLDW, 0 /FIELD WIDTH ON OUTPUT 484 000060 0000 DADP, 0 /=# OF PLACES AFTER DEC. PT. 485 000061 7413 FPNXT, FPNEXT 486 *FLPT-1600 487 488 / 489 /FLOATING OUTPUT ROUTINE 490 / 491 005600 0000 FFOUT, 0 492 005601 7431 SWAB /ALSO DOES MQL TO CLR. AC 493 005602 3376 DCA SGN /CLEAR SIGN AND COUNT WORDS 494 005603 3375 DCA KNT 495 005604 1056 TAD EFLG /IS THIS E FORMAT? 496 005605 7640 SZA CLA 497 005606 5213 JMP FFMT /NO-F FORMAT 498 005607 7127 CLL CML IAC RTL /YES-MAKE A 6 499 005610 3060 DCA DADP /STORE AS # OF DIGITS AFT DEC PT 500 005611 1351 TAD K16 /SET FIELD WIDTH TO 14 ( DECIMAL) 501 005612 3057 DCA FLDW 502 005613 4753 FFMT, JMS I CDFCRB /CHANGE TO FIELD OF PACKAGE 503 005614 1366 TAD KM7 /SET # OF SIGNF. DIGITS 504 005615 3760 DCA I DCNTP /TO 6 (DON'T PRINT 7TH) 505 005616 1045 TAD ACH /DETERMINE IF #=0 506 005617 7450 SNA 507 005620 5303 JMP FOUT3 /YES-SKIP DOWN 508 005621 7700 SMA CLA /NO-IS IT NEGATIVE? 509 005622 5225 JMP .+3 /POSITIVE 510 005623 2376 ISZ SGN /NEGATIVE-SET FLAG 511 005624 4774 JMS I FFNGP /AND NEGATE # 512 005625 1044 FOUT1, TAD ACX /GET # INTO RANGE .1<=N<1 513 005626 7740 SMA SZA CLA /IS EXP. NEG.? 514 005627 5234 JMP FOUT2 /NO-GO ON 515 005630 4773 JMS I FFMPP /YES-MAKE # GREATER THAN 1 516 005631 6315 TEN /BY MULTIPLYING BY TEN (DEC.) 517 005632 2375 ISZ KNT /COUNT THE MULTIPLIES 518 005633 5225 JMP FOUT1 /SEE IF >1 YET 519 005634 4772 FOUT2, JMS I SEP /# IS >1-MAKE IT LESS THAN 1 520 005635 4771 JMS I FFPUTP /STORE IN A TEMPORARY 521 005636 6162 TM3 522 005637 3044 DCA ACX /SET FAC TO .5 523 005640 7132 CLL CML RTR 524 005641 3045 DCA ACH 525 005642 3046 DCA ACLO 526 005643 1056 TAD EFLG /IS THIS E FORMAT? 527 005644 7640 SZA CLA 528 005645 1375 TAD KNT /NO-GET COUNT OF MULTIPLIES 529 005646 7041 CMA IAC /NEGATE IT 530 005647 1060 TAD DADP /AND ADD # OF DIGITS AFT. DC. PT. 531 005650 7500 SMA /MUST BE NEGATIVE 532 005651 7040 CMA 533 005652 1362 TAD KK7 /LIMIT # OF DIVS TO 7 534 005653 7510 SPA 535 005654 7200 CLA 536 005655 1366 TAD KM7 /RESTORE 537 005656 3772 DCA I SEP /STORE AS COUNTER 538 005657 5262 JMP .+3 539 005660 4770 JMS I FFDVP /DIVIDE .5 BY TEN THAT # OF TIMES 540 005661 6315 TEN 541 005662 2772 ISZ I SEP /DONE? 542 005663 5260 JMP .-3 /NO-GO ON 543 005664 4767 JMS I FFADP /YES-ADD IN ORIG.#-THIS IS ROUNDING 544 005665 6162 TM3 545 005666 4772 JMS I SEP /INSURE THAT IT IS IN RANGE 546 005667 1044 FOUT4, TAD ACX /GET EXPONENT 547 005670 7041 CMA IAC /USE AS COUNT FOR SHIFTING MANT. 548 005671 3277 DCA FOUT5 549 005672 7663 DLD /PICK UP MANTISSA 550 005673 0045 ACH 551 005674 7533 SWP SHL /PUT IN CORRECT ORDER 552 005675 0001 1 /SHIFT LEFT 1(FOR 0 EXP.) 553 005676 7417 LSR /NOW SHIFT RIGHT ACCORD TO EXP. 554 005677 0000 FOUT5, 0 555 005700 3045 DCA ACH /STORE BACK 556 005701 7521 SWP 557 005702 3046 DCA ACLO 558 005703 1375 FOUT3, TAD KNT /DONE-GET COUNT OF MULS. 559 005704 3047 DCA OPX /PRESERVE IT 560 005705 1056 TAD EFLG /IS THIS E FORMAT OUT? 561 005706 7640 SZA CLA 562 005707 5313 JMP NOTE /NO 563 005710 3375 DCA KNT /YES-ZERO COUNT 564 005711 1366 TAD KM7 /GET MINUS 7-FOR 2 SIGNS,PT,+EXP 565 005712 5317 JMP ADFW /GO ADD FIELD WIDTH 566 005713 1375 NOTE, TAD KNT /GET COUNT OF MULTIPLIES 567 005714 7500 SMA /IF NOT NEG-MAKE = -2 568 005715 7240 CLA CMA 569 005716 1361 TAD M1 /MINUS 1 FOR DEC.PT 570 005717 1057 ADFW, TAD FLDW /GET THE FIELD WIDTH 571 005720 7041 CMA IAC /NEGATE IT 572 005721 1060 TAD DADP /ADD DIGITS AFTER DEC. PT 573 005722 7500 SMA /NEG? 574 005723 5755 JMP I PRNTXP /NO-PRINT XS-NOT ENUFF ROOM 575 005724 3772 DCA I SEP /STORE AS CNT OF SPACES 576 005725 5330 JMP .+3 577 005726 1365 TAD K240 578 005727 4764 JMS I OUTP /PRINT A SPACE 579 005730 2772 ISZ I SEP /DONE? 580 005731 5326 JMP .-3 /NO-GO ON 581 005732 1376 TAD SGN /YES-GET SIGN 582 005733 7104 CLL RAL /MAKE A ZERO OR 2 583 005734 1356 TAD K253 /FOR PLUS OR MINUS 584 005735 4764 JMS I OUTP /PRINT SIGN 585 005736 1375 TAD KNT /GET MUL COUNT 586 005737 7500 SMA 587 005740 5747 JMP I PRZROP /PRINT LEADING ZERO 588 005741 7041 CMA IAC 589 005742 4763 JMS I DGTYPP /OUTPUT 'KNT' DIGITS 590 005743 1060 PRDCP, TAD DADP /DON'T PRINT DEC. PT 591 005744 7650 SNA CLA /IF DADP IS 0 592 005745 5752 JMP I GKNTP 593 005746 5750 JMP I PDPP 594 005747 6141 PRZROP, PRZRO 595 005750 6000 PDPP, PDP 596 005751 0016 K16, 16 597 005752 6002 GKNTP, GKNT 598 005753 7356 CDFCRB, CDFCUR 599 005754 5600 FLINK, JMP I FFOUT 600 005755 6126 PRNTXP, PRNTX 601 005756 0253 K253, 253 602 005757 6015 PRP, PR 603 005760 6165 DCNTP, DCNT 604 005761 7777 M1, 7777 605 005762 0007 KK7, 7 606 005763 6100 DGTYPP, DGTYP 607 005764 6145 OUTP, OUT 608 005765 0240 K240, 240 609 005766 7771 KM7, -7 610 005767 7000 FFADP, FFADD 611 005770 6722 FFDVP, FFDIV 612 005771 7322 FFPUTP, FFPUT 613 005772 6066 SEP, SE 614 005773 6600 FFMPP, FFMPY 615 005774 7135 FFNGP, FFNEG 616 005775 0000 KNT, 0 617 005776 0000 SGN, 0 618 *FLPT-1400 619 006000 7344 PDP, CLA CLL CMA RAL 620 006001 4353 JMS OUTDG /PRINT DEC. PT. 621 006002 1757 GKNT, TAD I KNTP /GET COUNT AGAIN 622 006003 7750 SPA SNA CLA 623 006004 5224 JMP GD 624 006005 1757 TAD I KNTP /GET COUNT 625 006006 7040 CMA /NEGATE 626 006007 3300 DCA DGTYP /STORE AS COUNTER 627 006010 1060 TAD DADP 628 006011 7040 CMA /SAME FOR DADP 629 006012 3266 DCA SE 630 006013 5215 JMP PR /GO ON 631 006014 4353 PZR, JMS OUTDG /PRINT A ZERO 632 006015 2300 PR, ISZ DGTYP 633 006016 7410 SKP 634 006017 5222 JMP PS 635 006020 2266 ISZ SE 636 006021 5214 JMP PZR 637 006022 1757 PS, TAD I KNTP 638 006023 7041 CMA IAC 639 006024 1060 GD, TAD DADP 640 006025 7540 SMA SZA 641 006026 4300 JMS DGTYP 642 006027 1056 TAD EFLG 643 006030 7640 SZA CLA 644 006031 5256 JMP DONEF /DONE 645 006032 1366 TAD K305 /PRINT 'E' 646 006033 4345 JMS OUT 647 006034 1047 TAD OPX /GET PRESERVED COUNT OF MULS 648 006035 7740 SMA SZA CLA /DETERMINE SIGN 649 006036 7205 CLA IAC RAL /MAKE A 2 650 006037 1371 TAD P253 /PRINT MINUS OR PLUS SIGN 651 006040 4345 JMS OUT 652 006041 1047 TAD OPX /GET THE COUNT 653 006042 7510 SPA 654 006043 7041 CMA IAC /NEGATE IF NEGATIVE 655 006044 7427 MQL DVI /DIVIDE BY ONE HUNDRED 656 006045 6173 K144 657 006046 7521 SWP /QUOT TO AC, REM TO MQ 658 006047 4353 JMS OUTDG /THIS IS FIRST DIG-PRINT IT 659 006050 7407 DVI /DIVIDE REM BY TEN 660 006051 6311 K12 661 006052 7521 SWP /GET SECOND DIGIT 662 006053 4353 JMS OUTDG /PRINT IT 663 006054 7521 SWP 664 006055 4353 JMS OUTDG /PRINT LAST 665 006056 1055 DONEF, TAD SWIT2 /SHOULD WE PRINT CR/LF? 666 006057 7650 SNA CLA 667 006060 5772 JMP I FLING /NO 668 006061 1360 TAD K215 669 006062 4345 JMS OUT 670 006063 1361 TAD K212 671 006064 4345 JMS OUT 672 006065 5772 JMP I FLING 673 / 674 /ROUTINE TO GET FAC<1 675 / 676 006066 0000 SE, 0 677 006067 1044 SE1, TAD ACX 678 006070 7750 SPA SNA CLA /#>1? 679 006071 5666 JMP I SE /NO-RETN. 680 006072 4770 JMS I FFDV /YES-DIV. BY TEN 681 006073 6315 TEN 682 006074 7040 CMA 683 006075 1757 TAD I KNTP /REDUCE KNT BY 1 684 006076 3757 DCA I KNTP 685 006077 5267 JMP SE1 686 687 / 688 /OUTPUT DIGITS OF FAC BY MULTIPLYING BY TEN 689 /THE HIGH ORDER OVERFLOW IS THE DIGIT 690 691 006100 0000 DGTYP, 0 692 006101 7041 CMA IAC 693 006102 3266 DCA SE /STORE COUNT PASSED 694 006103 7431 SWAB /MODE B OF EAE 695 006104 1046 DT1, TAD ACLO /GET LOW ORDER FAC 696 006105 7425 MQL MUY /MUL BY TEN 697 006106 6311 K12 698 006107 7521 SWP /NEW ACLO TO AC 699 006110 3046 DCA ACLO /STORE IT BACK 700 006111 1045 TAD ACH /GET ACH-SEND TO MQ, AND 701 006112 7525 SWP MUY /HI ORD. OVERFLO OF MUY TO AC 702 006113 6311 K12 /MULT BY TEN, OVRFLO IS ADDED 703 006114 2365 ISZ DCNT /DONE ALL SIGNIF. DIGS.? 704 006115 5320 JMP .+3 /NO-GO ON 705 006116 7240 CLA CMA /YES-PRINT ZEROS 706 006117 3365 DCA DCNT /FROM NOW ON 707 006120 4353 JMS OUTDG /PRINT DIGIT (HI ORD. OVRFLOW) 708 006121 7521 SWP /NEW ACH IS IN MQ 709 006122 3045 DCA ACH /STORE IT 710 006123 2266 ISZ SE /DONE REQUIRED? 711 006124 5304 JMP DT1 /NOPE 712 006125 5700 JMP I DGTYP /YUP 713 714 006126 7200 PRNTX, CLA 715 006127 1057 TAD FLDW /GET FIELD WIDTH 716 006130 7040 CMA /MUST BE NEGATIVE 717 006131 3266 DCA SE /USE AS COUNTER 718 006132 2266 PRNTX1, ISZ SE /DONE ALL? 719 006133 7410 SKP /NO-GO ON 720 006134 5256 JMP DONEF /YES-RETN. 721 006135 1340 TAD K252 722 006136 4345 JMS OUT /PRINT ASTERISK 723 006137 5332 JMP PRNTX1 724 006140 0252 K252, 252 /ASTERISK 725 006141 7200 PRZRO, CLA /CLR. GARBAGE 726 006142 4353 JMS OUTDG /PRINT ZERO 727 006143 5744 JMP I PRDCPP /PRINT DEC. PT. (MAYBE) 728 006144 5743 PRDCPP, PRDCP 729 / 730 /OUTPUT ROUTINE 731 / 732 006145 0000 OUT, 0 733 006146 6041 TSF 734 006147 5346 JMP .-1 735 006150 6046 TLS 736 006151 7300 CLA CLL /USE AN 'AND..' INSTEAD??? 737 006152 5745 JMP I OUT 738 739 / 740 /OUTPUT DIGIT 741 / 742 006153 0000 OUTDG, 0 743 006154 1367 TAD P260 744 006155 4345 JMS OUT 745 006156 5753 JMP I OUTDG /RETN 746 747 006157 5775 KNTP, KNT 748 006160 0215 K215, 215 749 006161 0212 K212, 212 750 006162 0000 TM3, 0 751 006163 0000 0 752 006164 0000 0 753 006165 0000 DCNT, 0 /COUNT OF SIGNF. DIGITS 754 006166 0305 K305, 305 755 006167 0260 P260, 260 756 006170 6722 FFDV, FFDIV 757 006171 0253 P253, 253 758 006172 5754 FLING, FLINK 759 006173 0144 K144, 144 760 761 762 763 764 / 765 /FLOATING POINT INPUT ROUTINE 766 / 767 *FLPT-1200 768 006200 0000 FFIN, 0 769 006201 7240 CLA CMA 770 006202 3300 DCA PRSW /INITIALIZE PERIOD SWITCH TO -1 771 006203 7040 CMA /SET SIGN SWITCH TO -1 772 006204 3302 DCA SIGNF 773 006205 4710 JMS I CDFCRA /CHANGE TO DF OF PACKAGE 774 006206 3052 DCA DSWIT /ZERO CONVERSION SWITCH 775 006207 3044 DECONV, DCA ACX /ZERO OUT THE FAC! 776 006210 3046 DCA ACLO 777 006211 3045 DCA ACH 778 006212 3301 DECNV, DCA DNUMBR /ZERO # OF DIGITS SINCE DEC. PT. 779 006213 4320 DECON, JMS GCHR /GET A CHAR.FROM TTY. 780 006214 5230 JMP FFIN1 /TERMINATOR- 781 006215 2052 ISZ DSWIT /DIGIT-BUMP CONVERSION SWITCH 782 006216 2301 ISZ DNUMBR /BUMP # OF DIGITS 783 006217 3313 DCA TP1 /STORE IT IN FORM EASILY FLOATIBLE 784 006220 4407 JMS I FPP /ENTER INTERPRETER 785 006221 3315 FMPY TEN /MULTIPLY # BY TEN 786 006222 6040 FPUT AC0 /STORE IT AWAY 787 006223 5312 FGET TP /GET NEW DIGIT 788 006224 7000 FNOR /FLOAT IT 789 006225 1040 FADD AC0 /ADD IT TO ACCUMULATED # 790 006226 0000 FEXT /DONE 791 006227 5213 JMP DECON /GO ON 792 006230 2300 FFIN1, ISZ PRSW /HAVE WE HAD A PERIOD YET? 793 006231 5236 JMP FIGO2 /YES-GO ON 794 006232 1303 TAD K2 /NO-IS THIS A PERIOD? 795 006233 7650 SNA CLA 796 006234 5212 JMP DECNV /YES-ZERO DIG. COUNT AFTER DEC. PT. 797 /AND GO CONVERT REST 798 006235 3301 DCA DNUMBR /NO-TERMINATOR-ZERO COUNT OF 799 /DIGITS AFTER DECIMAL POINT. 800 006236 7621 FIGO2, CLA MQL /0 TO MQ FOR LATER MULTIPLY 801 006237 2302 ISZ SIGNF /IS # NEGATIVE?(DID WE GET - SIGN?) 802 006240 4677 JMS I FFNEGP /YES-NEGATE IT 803 006241 7431 SWAB 804 006242 7040 CMA /RESET SIGN SWITCH FOR EXP. 805 006243 3302 DCA SIGNF 806 006244 1053 TAD CHAR /NO-WAS THE TERMINATOR AN 'E'? 807 006245 1304 TAD KME 808 006246 7650 SNA CLA 809 006247 4320 GETE, JMS GCHR /YES-GET A CHAR. OF EXPONENT 810 006250 5254 JMP EDON /END OF EXPONENT 811 006251 7405 MUY /GOT DIGIT OF EXP-MULT ACCUMULATED 812 006252 6311 K12 /EXPONENT BY TEN AND ADD DIGIT 813 006253 5247 JMP GETE /CONTINUE 814 006254 2302 EDON, ISZ SIGNF /WAS EXPONENT NEGATIVE? 815 006255 7575 DCM /YES-NEGATE IT 816 006256 7300 CLA CLL /CLEAR AC AND LINK 817 006257 1301 TAD DNUMBR /GET # TIMES TO DIV MANTISSA BY TEN 818 006260 7457 SAM /SUBTRACT FROM EXPONENT 819 006261 7100 CLL 820 006262 7510 SPA /RESULT POSITIVE? 821 006263 7161 CLL CMA CML IAC /NO-MAKE POS. AND SET LINK 822 006264 7040 CMA /NEGATE FOR COUNTER 823 006265 3301 DCA DNUMBR /AND STORE 824 006266 7004 RAL /LINK=1-DIV;=0-MUL. # BY TEN 825 006267 1305 TAD MDV /FORM CORRECT INSTRUCTION 826 006270 3274 DCA FINST /AND STORE FOR EXECUTION 827 006271 2301 FCNT, ISZ DNUMBR /DONE ALL OPERATIONS? 828 006272 5274 JMP FINST /NO 829 006273 5600 JMP I FFIN /YES-RETURN 830 006274 0000 FINST, 0 /NO- MUL OR DIV. MANTISSA 831 006275 6315 TEN /BY TEN 832 006276 5271 JMP FCNT /GO ON 833 006277 7135 FFNEGP, FFNEG 834 006300 0000 PRSW, 0 835 006301 0000 DNUMBR, 0 836 006302 0000 SIGNF, 0 837 006303 0002 K2, 2 838 006304 7473 KME, -305 839 006305 4706 MDV, JMS I .+1 /THESE 3 WDS. MUST BE IN THIS ORDER 840 006306 6600 FFMPY 841 006307 6722 FFDIV /!!!!!!!!!!!!!!!!! 842 843 006310 7356 CDFCRA, CDFCUR 844 006311 0012 K12, 12 845 006312 0013 TP, 13 846 006313 0000 TP1, 0 847 006314 0000 0 848 006315 0004 TEN, 4 849 006316 2400 2400 850 006317 0000 0 851 /ROUTINE TO GET A CHAR FROM THE TTY AND SEE IF IT IS DIGIT 852 /OR A TERMINATOR. 853 /RETURN TO CALL + 1 IF TERMINATOR, TO CALL + 2 IF DIGIT 854 /THIS ROUTINE MUST NOT MODIFY THE MQ!! 855 006320 0000 GCHR, 0 856 006321 4345 JMS INPUT /GET A CHAR FROM TTY. 857 006322 1053 TAD CHAR /PICK IT UP 858 006323 1343 TAD PLUS /WAS IT PLUS SIGN? 859 006324 7450 SNA 860 006325 5332 JMP DECON1 /YES-GET ANOTHER CHAR. 861 006326 1344 TAD MINUS /NO WAS IT MINUS SIGN? 862 006327 7640 SZA CLA 863 006330 5333 JMP .+3 864 006331 3302 DCA SIGNF /YES-FLIP SWITCH 865 006332 4345 DECON1, JMS INPUT /GET A CHAR. 866 006333 1053 TAD CHAR 867 006334 1342 TAD K7506 /SEE IF ITS A DIGIT 868 006335 7100 CLL 869 006336 1311 TAD K12 870 006337 7430 SZL /DIGIT? 871 006340 2320 ISZ GCHR /YES-RETN. TO CALL+2 872 006341 5720 JMP I GCHR /NO-RETN. TO CALL+1 873 006342 7506 K7506, 7506 874 006343 7525 PLUS, -253 875 006344 7776 MINUS, 253-255 876 / 877 /INPUT ROUTINE-CHECKS FOR RUBOUT AND CARRIAGE RETURN 878 / 879 006345 0000 INPUT, 0 880 006346 6031 KSF 881 006347 5346 JMP .-1 882 006350 6032 KCC 883 006351 1376 TAD P200 /FORCE CHANNEL 8 884 006352 6034 KRS /READ CHAR. 885 006353 3053 DCA CHAR /STORE CHAR. 886 006354 1053 LP, TAD CHAR 887 006355 4772 JMS I OUTPP /PRINT IT 888 006356 1053 TAD CHAR 889 006357 1375 TAD MRUBOT /IS IT RUBOUT? 890 006360 7450 SNA 891 006361 5201 JMP FFIN+1 /YES-RESTART INPUT 892 006362 1374 TAD MCR /NO-IS IT CARRIAGE RETN.? 893 006363 7650 SNA CLA 894 006364 1054 TAD SWIT1 /YES-SHOULD WE ECHO LINE FEED? 895 006365 7650 SNA CLA 896 006366 5745 JMP I INPUT /NO-GO BACK 897 006367 1373 TAD LFED /YES-DO IT 898 006370 4772 JMS I OUTPP 899 006371 5745 JMP I INPUT /RETURN 900 006372 6145 OUTPP, OUT 901 006373 0212 LFED, 212 902 006374 0162 MCR, 377-215 903 006375 7401 MRUBOT, -377 904 006376 0200 P200, 200 905 /EAE FLOATING POINT INTERPRETER 906 *FLPT-1000 907 / 908 /FLOATING SUBTRACT-USES FLOATING ADD 909 /FSW1!! 910 006400 0000 FFSUB1, 0 911 006401 7450 SNA /WHICH MODE? 912 006402 1600 TAD I FFSUB1 /CALLED BY USER-GET ADDR. OF OP 913 006403 4644 JMS I ARGETL /PICK UP ARGUMENT 914 006404 4645 JMS I CDFCRL 915 006405 4610 JMS I FFNEGA /NEGATE FAC! 916 006406 1200 TAD FFSUB1 917 006407 5611 JMP I SUB0P 918 006410 7135 FFNEGA, FFNEG 919 006411 7132 SUB0P, SUB0 920 921 922 / 923 /FLOATING DIVIDE 924 /FSWITCH=1 925 /THIS IS OP/FAC 926 / 927 006412 0000 FFDIV1, 0 928 006413 7450 SNA /WHICH MODE OF CALL? 929 006414 1612 TAD I FFDIV1 /CALLED BY USER-GET ADDR. 930 006415 4644 JMS I ARGETL /(INTERP.)-GET OPRND.-ADDR. IN AC 931 006416 4645 JMS I CDFCRL /CDF TO FIELD OF PACKAGE 932 006417 1045 TAD ACH /SWAP FAC AND OPRND-OPH IN MQ! 933 006420 3050 DCA OPH /STORE ACH IN OPH 934 006421 1044 TAD ACX /GET EXP OF FAC 935 006422 7521 SWP /OPH TO AC, ACX TO MQ 936 006423 3045 DCA ACH /STORE OPH IN ACH 937 006424 1047 TAD OPX /STORE OPX IN ACX 938 006425 3044 DCA ACX 939 006426 1051 TAD OPL /OPL TO MQ, ACX TO AC 940 006427 7521 SWP 941 006430 3047 DCA OPX /STORE ACX IN OPX 942 006431 1046 TAD ACLO 943 006432 3051 DCA OPL /STORE ACLO IN OPL 944 006433 1050 TAD OPH /OPH TO MQ FOR LATER 945 006434 7521 SWP 946 006435 3046 DCA ACLO /STORE OPL IN ACLO 947 006436 1212 TAD FFDIV1 /SET UP SO WE RETN TO 948 006437 3647 DCA I FFDP /NORMAL DIVIDE ROUTINE 949 006440 1250 TAD FD1 950 006441 3646 DCA I MDSETP 951 006442 5643 JMP I MD1P /GO ARRANGE OPERANDS 952 953 006443 6673 MD1P, MD1 954 006444 7251 ARGETL, ARGET 955 006445 7356 CDFCRL, CDFCUR 956 006446 6670 MDSETP, MDSET 957 006447 6722 FFDP, FFDIV 958 006450 6726 FD1, FFD1 959 960 961 / 962 /FLOATING SQUARE ROOT 963 /USES MODIFIED HARDWARE ALGORITHM FOR BINARY SQUARE ROOTS 964 /REF: THE LOGIC OF COMPUTER ARITHMETIC-IVAN FLORES; P-409 965 / 966 006451 0000 FROOT, 0 967 006452 7332 CLA CLL CML RTR /SET RESLT TO 2000,0000 968 006453 3051 DCA OPL 969 006454 3050 DCA OPH 970 006455 7431 SWAB /MODE B OF EAE-ALSO DOES MQL 971 006456 4645 JMS I CDFCRL /CDF TO FIELD OF PACKAGE 972 006457 3353 DCA RBCNT /CLR. SHIFT COUNTER 973 006460 1370 TAD KM22 974 006461 3042 DCA AC2 /SET COUNTER FOR 23 BITS OF RESULT 975 006462 1044 TAD ACX /GET EXPONENT OF FAC 976 006463 7415 ASR /DIVIDE BY 2 977 006464 0001 1 978 006465 3044 DCA ACX /STORE IT BACK 979 006466 7451 DPSZ /INCREMENT EXP. IF ORIG. EXP 980 006467 2044 ISZ ACX /WAS ODD 981 006470 7000 NOP 982 006471 7501 MQA /DETERMINE WHETHER TO DO A 983 006472 7104 CLL RAL /PRE-SHIFT FOR EVEN EXPONENTS. 984 006473 7024 CML RAL 985 006474 3312 DCA RKNT /STORE BIT-0 OR 1 SHIFT CNT 986 006475 7132 CLL CML RTR /SET UP FIRST TRIAL BIT 987 006476 7012 RTR 988 006477 3041 DCA AC1 989 006500 3040 DCA AC0 /STORE AWAY 990 006501 3330 DCA ACNT /ZERO COUNTER 991 006502 7663 DLD /GET THE FAC 992 006503 0045 ACH 993 006504 7521 SWP /GET IN RIGHT ORDER 994 006505 7450 SNA /IS IT ZERO? (HI ORD=0) 995 006506 5651 JMP I FROOT /YES-ROOT = 0 996 006507 7510 SPA /NEGATIVE? 997 006510 7575 DCM /YES-TAKE ABSOL. VALUE 998 006511 7413 SHL /SHIFT # 1 BIT IF EXP WAS EVEN 999 006512 0000 RKNT, 0 /SO FIRST BIT PAIR IS 10 NOT 01 1000 006513 1371 TAD K6000 /SUBTRACT 2000-KNOW FIRST BIT 1001 006514 7451 DPSZ /IS 1(NORMALIZED)-DONE?? 1002 006515 5323 JMP LOP1 /NO-WE MUST LOOP 1003 006516 5362 JMP DONE /YES-AN EASY ONE!!! 1004 006517 7663 LOOP, DLD /GET THE FAC 1005 006520 0045 ACH 1006 006521 7413 SHL /SHIFT FAC APPROPRIATELY 1007 006522 0001 1 1008 006523 7445 LOP1, DST /MUST STOR BACK IN CASE RESLT 1009 006524 0045 ACH /BIT IS 0 1010 006525 7663 DLD /GET TRIAL BIT 1011 006526 0040 AC0 1012 1013 006527 7415 ASR /SHIFT THE BIT APPROPRIATELY 1014 006530 0000 ACNT, 0 1015 006531 2330 ISZ ACNT /SHIFT 1 MORE NEXT TIME 1016 006532 7443 DAD /ADD IN RESULT SO FAR 1017 006533 0050 OPH 1018 006534 7575 DCM /NEGATE IT 1019 006535 2353 ISZ RBCNT /BUMP COUNTER FOR RESLT BIT 1020 006536 7443 DAD /DO THE SUBTRACT 1021 006537 0045 ACH 1022 006540 7420 SNL /RESULT NEGATIVE? 1023 006541 5360 JMP GON /YES-NEXT RESULT BIT = 0 1024 1025 006542 7451 DPSZ /NO-DID WE GET A ZERO REMAINDER? 1026 006543 5346 JMP NOTZRO /NOPE 1027 006544 7040 ZREM, CMA /YES-SET SO LOOKS LIKE WE'RE DONE 1028 006545 3042 DCA AC2 1029 006546 7445 NOTZRO, DST /GOOD SUBTR.-MODIFY FAC 1030 006547 0045 ACH /ITS NOT CHANGED BY BAD SUBTRACT 1031 006550 7621 CAM /CLEAR EVERYTHING 1032 006551 7012 RTR 1033 006552 7415 ASR /SHIFT RESLT BIT TO RIGHT PLACE 1034 006553 0000 RBCNT, 0 1035 006554 7443 DAD /ADD IT TO THE RESULT SO FAR 1036 006555 0050 OPH /WE APPEND IT TO RIGHT OF LAST 1037 006556 7445 DST /BIT 1038 006557 0050 OPH /STORE IT BACK 1039 006560 2042 GON, ISZ AC2 /DONE 23 BITS? 1040 006561 5317 JMP LOOP /NO-GO ON 1041 006562 7663 DONE, DLD /YES-GET RESULT-ITS NORMALIZED 1042 006563 0050 OPH 1043 006564 3045 DCA ACH /STORE HIGH ORDER BACK 1044 006565 7521 SWP 1045 006566 3046 DCA ACLO /STORE LOW ORDER BACK 1046 006567 5651 JMP I FROOT /RETURN 1047 006570 7752 KM22, -26 1048 006571 6000 K6000, 6000 1049 / 1050 /FLOATING HALT-DISPLAY FLOATING P.C. 1051 / 1052 006572 4645 FFHLT, JMS I CDFCRL /MUST BE CURRENT DATA FLD. 1053 006573 1407 TAD I FPP /PICK UP THE P.C. 1054 006574 7402 HLT /HALT 1055 006575 7200 CLA /CLR. IT OUT 1056 006576 5461 JMP I FPNXT /GO ON 1057 / 1058 /FLOATING MULTIPLY--DOES 4 SINGLE MULTIPLIES WITH EAE 1059 /THIS USES THE FACT THAT IF AC IS NON-ZERO WHEN YOU DO 1060 /A MUY INSTR, THE AC IS ADDED TO RESULT OF THE MULTIPLY. 1061 /(IN THE LOW ORDER, NATCHERLY) 1062 *FLPT-600 1063 006600 0000 FFMPY, 0 1064 006601 7450 SNA /WHICH MODE? 1065 006602 1600 TAD I FFMPY /CALLED BY USER-GET ADDRESS 1066 006603 4270 JMS MDSET /SET UP FOR MULT 1067 006604 7605 CLA MUY /MULTIPLY-LOW ORDER FAC STILL IN MQ 1068 006605 0050 OPH /THIS IS PRODUCT OF LOW ORDERS 1069 006606 7421 MQL /ZAP LOW ORDER RESULT-INSIGNIFICANT 1070 006607 1045 TAD ACH /GET LOW ORDER(!) OF FAC 1071 006610 7525 SWP MUY /TO MQ-HIGH ORD. RESLT OF LAST MPY 1072 006611 0051 OPL /TO AC-WILL BE ADDED TO RESLT-THIS 1073 006612 7445 DST /IS PRODUCT-LOW ORD FAC,HI ORD OP 1074 006613 0040 AC0 /STORE RESULT 1075 006614 7663 DLD /HIGH ORDER FAC TO MQ, OPX TO AC 1076 006615 0046 ACLO 1077 006616 1044 TAD ACX /ADD FAC EXPONENT-GET SUM OF EXPS. 1078 006617 3044 DCA ACX /STORE RESULT 1079 006620 7405 MUY /MUL. HIGH ORDER FAC BY LOW ORD OP. 1080 006621 0050 OPH /HIGH ORDER FAC WAS IN MQ 1081 006622 7443 DAD /ADD IN RESULT OF SECOND MULTIPLY 1082 006623 0040 AC0 1083 006624 3045 DCA ACH /STORE HIGH ORDER RESULT 1084 006625 1046 TAD ACLO /GET HIGH ORDER FAC 1085 006626 7521 SWP /SEND IT TO MQ AND LOW ORD. RESULT 1086 006627 3040 DCA AC0 /OF ADD TO AC-STORE IT 1087 006630 7004 RAL /ROTATE CARRY TO AC 1088 006631 3046 DCA ACLO /STORE AWAY 1089 006632 7405 MUY /NOW DO PRODUCT OF HIGH ORDERS 1090 006633 0051 OPL /FAC HIGH IN MQ, OP HIGH IN OPL 1091 006634 7443 DAD /ADD IN THE ACCUMULATED # 1092 006635 0045 ACH 1093 006636 7450 SNA /ZERO? 1094 006637 5247 JMP RTZRO /YES-GO ZERO EXPONENT 1095 006640 7411 NMI /NO-NORMALIZE (1 SHIFT AT MOST!) 1096 006641 3045 DCA ACH /STORE HIGH ORDER RESULT 1097 006642 7641 CLA SCA /GET STEP CNTR-DID WE NEED A SHIFT? 1098 006643 7650 SNA CLA 1099 006644 5253 JMP SNCK /NO-JUST CHECK SIGN 1100 006645 7240 CLA CMA /YES-MUST DECREASE EXP. BY 1 1101 006646 1044 TAD ACX 1102 006647 3044 RTZRO, DCA ACX /STORE BACK 1103 1104 006650 1040 TAD AC0 1105 006651 7710 SPA CLA /IS HIGH ORDER OF OVERFLO WD. 1? 1106 006652 7573 DPIC /YES-ADD 1 TO LOW ORDER-STILL IN MQ 1107 006653 2264 SNCK, ISZ MSIGN /RESULT NEGATIVE? 1108 006654 5260 JMP MPOS /NO-GO ON 1109 006655 1045 TAD ACH /YES-GET HIGH ORDER BACK 1110 006656 7575 DCM /LOW ORDER STILL IN MQ-NEGATE 1111 006657 3045 DCA ACH /STORE HIGH ORDER BACK 1112 006660 7521 MPOS, SWP /LOW ORDER TO AC 1113 006661 3046 DCA ACLO /STORE AWAY 1114 006662 2200 ISZ FFMPY /BUMP RETURN 1115 006663 5600 JMP I FFMPY /RETIRN 1116 006664 0000 MSIGN, 0 1117 006665 7251 ARGETK, ARGET 1118 006666 7356 CDFCRK, CDFCUR 1119 006667 7571 DVOFL, FTRP2 1120 1121 / 1122 /ROUTINE TO SET UP FOR MULTIPLY AND DIVIDE 1123 / 1124 006670 0000 MDSET, 0 1125 006671 4665 JMS I ARGETK /GET OPERAND (ADDR. IN AC) 1126 006672 4666 JMS I CDFCRK /CHANGE TO DATA FIELD OF PACKAGE 1127 006673 7344 MD1, CLA CLL CMA RAL /MAKE A MINUS TWO 1128 006674 3264 DCA MSIGN /AND STORE IN MSIGN. 1129 006675 1051 TAD OPL /GET LOW ORDER MANTISSA OF OP. 1130 006676 7521 SWP /GET INTO RIGHT ORDER ( OPH IN MQ) 1131 006677 7500 SMA /NEGATIVE? 1132 006700 5303 JMP .+3 /NO 1133 006701 7575 DCM /YES-NEGATE IT 1134 006702 2264 ISZ MSIGN /BUMP SIGN COUNTER 1135 006703 7413 SHL /SHIFT OPRND LEFT 1 TO AVOID OVRFLO 1136 006704 0001 1 1137 006705 7445 DST /STORE BACK-OPH CONTAINS LOW ORDER 1138 006706 0050 OPH / OPL CONTAINS HIGH ORDER 1139 006707 7663 DLD /GET THE MANTISSA OF THE FAC 1140 006710 0045 ACH 1141 006711 7521 SWP /MAKE IT CORRECT ORDER 1142 006712 7500 SMA /NEGATIVE? 1143 006713 5317 JMP FPOS /NO 1144 006714 7575 DCM /YES-NEGATE IT 1145 006715 2264 ISZ MSIGN /BUMP SIGN COUNTER (MAY SKIP) 1146 006716 7000 NOP 1147 006717 7445 FPOS, DST /STORE BACK-ACH CONTAINS LOW ORDER 1148 006720 0045 ACH / ACLO CONTAINS HIGH ORDER 1149 006721 5670 JMP I MDSET /RETURN 1150 1151 1152 1153 / 1154 /FLOATING DIVIDE 1155 / 1156 006722 0000 FFDIV, 0 1157 006723 7450 SNA /WHICH MODE? 1158 006724 1722 TAD I FFDIV /CALLED BY USER-GET ARG. ADDRESS 1159 006725 4270 JMS MDSET /GET ARG. AND SET UP SIGNS 1160 006726 7407 FFD1, DVI /DIVIDE-ACH AND ACLO IN AC,MQ 1161 006727 0051 OPL /THIS IS HI (!) ORDER DIVISOR 1162 006730 7445 DST /QUOT TO AC0,REM TO AC1 1163 006731 0040 AC0 1164 006732 7630 SZL CLA /DIVIDE ERROR? 1165 006733 5667 JMP I DVOFL /YES-HANDLE IT 1166 006734 1047 TAD OPX /DO EXPONENT CALCULATION 1167 006735 7041 CMA IAC /EXP. OF FAC - EXP. OF OP 1168 006736 1044 TAD ACX 1169 006737 3044 DCA ACX 1170 006740 7451 DPSZ /IS QUOT = 0? 1171 006741 7410 SKP /NO-GO ON 1172 006742 3044 DCA ACX /YES-ZERO EXPONENT 1173 006743 7405 DVLP, MUY /NO-THIS IS Q*OPL*2**-12 1174 006744 0050 OPH 1175 006745 7575 DCM /NEGATE IT 1176 006746 1041 TAD AC1 /SEE IF GREATER THAN REMAINDER 1177 006747 7420 SNL 1178 006750 5774 JMP I DVOPSP /YES-ADJUST FIRST DIVIDE 1179 006751 7407 DVI /NO-DO Q*OPL*2**-12/OPH 1180 006752 0051 OPL 1181 006753 7630 SZL CLA /DIV ERROR? 1182 006754 5667 JMP I DVOFL /YES 1183 006755 1040 DVLP1, TAD AC0 /NO-GET QUOT OF FIRST DIV. 1184 006756 7500 SMA /NEGATIVE? 1185 006757 5364 JMP .+5 /NO-REMEMBER-QUOT OF 2ND DIV. IN MQ 1186 006760 7417 LSR /YES-MUST SHIFT IT RIGHT 1 1187 006761 0001 1 1188 006762 2044 ISZ ACX /ADJUST EXPONENT 1189 006763 7000 NOP 1190 006764 2264 ISZ MSIGN /SHOULD SIGN BE MINUS? 1191 006765 7410 SKP /NO 1192 006766 7575 DCM /YES-DO IT 1193 006767 3045 DBAD1, DCA ACH /STORE IT BACK 1194 006770 7521 SWP 1195 006771 3046 DCA ACLO 1196 006772 2322 ISZ FFDIV 1197 006773 5722 JMP I FFDIV /BUMP RETN. AND RETN. 1198 1199 006774 7150 DVOPSP, DVOPS 1200 006775 7621 DBAD, CAM 1201 006776 3044 DCA ACX /ZERO EXPONENT 1202 006777 5367 JMP DBAD1 /GO ZERO MANTISSA 1203 /FLOATING ADDITION-IN ORDER NOT TO LOSE BITS, WE DO NOT 1204 /SHIFT BOTH NUMBERS RIGHT 1 BIT BEFORE ADD-ONLY SHIFTS DONE 1205 /ARE TO ALIGN EXPONENTS. 1206 / 1207 *FLPT-400 1208 007000 0000 FFADD, 0 1209 007001 7450 SNA /WHICH MODE OF CALLING 1210 007002 1600 TAD I FFADD /CALLED DIRECTLY BY USER 1211 007003 4716 JMS I ARGETP /PICK UP ARGUMENTS 1212 007004 4747 FAD1, JMS I CDFCRP /CHANGE TO CURRENT DATA FIELD 1213 007005 1047 TAD OPX /PICK UP EXPONENT OF OPERAND 1214 007006 7421 MQL /SEND IT TO MQ FOR SUBTRACT 1215 007007 1044 TAD ACX /GET EXPONENT OF FAC 1216 007010 7457 SAM /SUBTRACT-RESULT IN AC 1217 007011 7510 SPA /NEGATIVE RESULT? 1218 007012 7041 CMA IAC /YES-MAKE IT POSITIVE 1219 007013 3246 DCA CNT /STORE IT AS A SHIFT COUNT 1220 007014 1246 TAD CNT /COUNT TOO BIG?(CAN'T BE ALIGNED) 1221 007015 1315 TAD M27 1222 007016 7750 SPA SNA CLA 1223 007017 7040 CMA /NO-OK 1224 007020 3040 DCA AC0 /YES-MAKE IT A LOAD OF LARGEST # 1225 007021 7663 DLD /GET ADDRESSES TO SEE WHO'S SHIFTED 1226 007022 7176 ADDRS 1227 007023 6006 SGT /WHICH EXP GREATER(GT FLG SET 1228 /BY SUBTR. OF EXPS.) 1229 007024 7521 SWP /OPERAND'S-SHIFT THE FAC 1230 007025 3243 DCA SHFBG /STORE ADDRESS OF WHO GETS SHIFTED 1231 007026 7521 SWP /GET ADDRESS OF OTHER (0 TO MQ) 1232 007027 3234 DCA DADR /THIS ONE JUST GETS ADDED 1233 007030 1044 TAD ACX /GET FAC EXP.INTO AC 1234 007031 6006 SGT /WHICH EXPONENT WAS GREATER? 1235 007032 3047 DCA OPX /FAC'S-STORE FINAL EXP. IN OPX 1236 007033 7663 DLD /GET THE LARGER # TO AC,MQ 1237 007034 0000 DADR, 0 1238 007035 7521 SWP /PUT IN THE RIGHT ORDER 1239 007036 2040 ISZ AC0 /COULD EXPONENTS BE ALIGNED? 1240 007037 5273 JMP LOD /NO-JUST LEAVE LARGER IN AC,MQ 1241 007040 7445 DST /YES-STORE THIS TEMPORARILY 1242 007041 0040 AC0 /(IF ONLY FAC STORAGE WAS REVERSED) 1243 007042 7663 DLD /GET THE SMALLER # 1244 007043 0000 SHFBG, 0 1245 007044 7521 SWP /PUT IT IN RIGHT ORDER 1246 007045 7415 ASR /DO THE ALIGNMENT SHIFT 1247 007046 0000 CNT, 0 1248 007047 7443 DAD /ADD THE LARGER # 1249 007050 0040 AC0 1250 007051 7445 DST /STORE RESULT 1251 007052 0040 AC0 1252 007053 7430 SZL /OVERFLOW?(L NOT = SIGN BIT) 1253 007054 7040 CMA /NOTE-WE DIDN'T SHIFT BOTH RIGHT 1 1254 007055 7700 SMA CLA 1255 007056 5264 JMP NOOV /NOPE 1256 007057 7330 CLA CLL CML RAR /MAYBE-SEE IF 2 #S HAD SAME SIGN 1257 007060 0045 AND ACH 1258 007061 1050 TAD OPH 1259 007062 7700 SMA CLA /SIGNS ALIKE? 1260 007063 5306 JMP OVRFLO /YES-OVERFLOW 1261 007064 1041 NOOV, TAD AC1 /NO-GET HIGH ORDER RESULT BACK 1262 007065 1314 TAD K4000 /CHECK FOR 4000 0000 MANTISSA 1263 007066 7451 DPSZ /IT WILL BE SET TO 0 BY NMI 1264 007067 5272 JMP .+3 /OK-RESTORE NUMBER 1265 007070 7132 CLL CML RTR /GOT A 4000 0000-SET TO 6000 0000 1266 007071 5311 JMP DOIT /AND INCREMENT EXPONENT 1267 007072 1314 TAD K4000 /RESTORE NUMBER 1268 007073 7411 LOD, NMI /NORMALIZE (LOW ORDER STILL IN MQ) 1269 007074 3045 DCA ACH /STORE FINAL RESULT 1270 007075 7441 SCA /GET SHIFT COUNTER(# OF NMI SHIFTS) 1271 007076 7040 CMA /NEGATE IT 1272 007077 7001 ADON, IAC 1273 007100 1047 TAD OPX /AND ADJUST FINAL EXPONENT 1274 007101 3044 DCA ACX 1275 007102 7521 SWP /GET AND STORE LOW ORDER 1276 007103 3046 DCA ACLO 1277 007104 2200 ISZ FFADD /BUMP RETURN PAST ADDRESS 1278 007105 5600 JMP I FFADD /RETURN 1279 007106 1041 OVRFLO, TAD AC1 /OVERFLOW-GET HIGH ORDER RESLT BACK 1280 007107 7415 ASR /SHIFT IT RIGHT 1 1281 007110 0001 1 1282 007111 1314 DOIT, TAD K4000 /REVERSE SIGN BIT 1283 007112 3045 DCA ACH /AND STORE 1284 007113 5277 JMP ADON /DONE 1285 007114 4000 K4000, 4000 1286 007115 7751 M27, -27 1287 007116 7251 ARGETP, ARGET 1288 /FLOATING SUBTRACT-USES FLOATING ADD 1289 /FSW0!! 1290 007117 0000 FFSUB, 0 1291 007120 7450 SNA /WHICH MODE? 1292 007121 1717 TAD I FFSUB /CALLED BY USER-GET ADDRESS OF OP. 1293 007122 4716 JMS I ARGETP 1294 007123 1051 TAD OPL /OPH IS IN MQ! 1295 007124 7521 SWP /PUT IT IN RIGHT ORDER 1296 007125 7575 DCM /NEGATE IT 1297 007126 3050 DCA OPH /STORE BACK 1298 007127 7501 MQA 1299 007130 3051 DCA OPL 1300 007131 1317 TAD FFSUB /GO TO ADD 1301 007132 3200 SUB0, DCA FFADD 1302 007133 5204 JMP FAD1 1303 007134 7571 DVOVR, FTRP2 1304 / 1305 /FLOATING NEGATE--NEGATE FLOATING AC 1306 / 1307 007135 0000 FFNEG, 0 1308 007136 7431 SWAB /MUST BE MODE B 1309 007137 7663 DLD /GET MANTISSA 1310 007140 0045 ACH 1311 007141 7521 SWP /CORRECT ORDER PLEASE! 1312 007142 7575 DCM /NEGATE IT 1313 007143 3045 DCA ACH /RESTORE 1314 007144 7521 SWP /SEND 0 TO MQ 1315 007145 3046 DCA ACLO 1316 007146 5735 JMP I FFNEG 1317 1318 007147 7356 CDFCRP, CDFCUR 1319 1320 / 1321 /CONTINUATION OF DIVIDE ROUTINE 1322 /WE ARE ADJUSTING THE RESULT OF THE 1323 /FIRST DIVIDE. 1324 / 1325 007150 7041 DVOPS, CMA IAC 1326 007151 3041 DCA AC1 /ADJUST REMAINDER 1327 007152 1051 TAD OPL /WATCH FOR OVERFLOW 1328 007153 7141 CLL CMA IAC 1329 007154 1041 TAD AC1 1330 007155 7420 SNL 1331 007156 5363 JMP DVOP1 /DON'T ADJUST QUOT. 1332 007157 3041 DCA AC1 1333 007160 7040 CMA 1334 007161 1040 TAD AC0 1335 007162 3040 DCA AC0 /REDUCE QUOT BY 1 1336 007163 7300 DVOP1, CLA CLL 1337 007164 1041 TAD AC1 /GET REMAINDER 1338 007165 7450 SNA /ZERO? 1339 007166 7621 CAM /YES-ZERO EVERYTHING 1340 007167 7407 DVI /NO 1341 007170 0051 OPL 1342 007171 7630 SZL CLA /DIV. OVERFLOW? 1343 007172 5734 JMP I DVOVR /YES 1344 007173 7575 DCM /NO-ADJUST HI QUOT (MAYBE) 1345 007174 5775 JMP I DVLP1P /GO BACK 1346 007175 6755 DVLP1P, DVLP1 1347 007176 0050 ADDRS, OPH 1348 007177 0045 ACH 1349 / 1350 /ROUTINE TO CALL EXTENDED FUNCTIONS 1351 /THIS IS EXTENSION OF OP CODE 0 1352 / 1353 *FLPT-200 1354 007200 7521 FCALL, SWP /FCALL-GET FUNCTION #(ALSO 0 TO MQ) 1355 007201 1231 TAD JMSI2 /MAKE A JMS THROUGH TABLE 1356 007202 3212 DCA DCOD1 /STORE IT 1357 007203 4356 JMS CDFCUR /D. F. MUST BE FIELD OF FLT PT PKG. 1358 007204 1407 K7, TAD I FPP /GET FLTG. P.C. 1359 007205 3361 DCA FT1 /SAVE IT 1360 007206 1627 TAD I DFCDFP /SAVE FLTG DATA AND INST. FIELD 1361 007207 3362 DCA FT2 1362 007210 1461 TAD I FPNXT 1363 007211 3363 DCA FT3 1364 007212 0000 DCOD1, 0 /CALL THE SUBR. 1365 007213 7621 CAM /CLEAR AC AND MQ. 1366 007214 4356 JMS CDFCUR /IN CASE USER CHANGED DATA FLD. 1367 007215 1363 TAD FT3 /RESTORE DF,IF, AND FLTG. PC 1368 007216 3461 DCA I FPNXT 1369 007217 1362 TAD FT2 1370 007220 3627 DCA I DFCDFP 1371 007221 1361 TAD FT1 1372 007222 7501 FJUMP1, MQA /EFF ADDR IN MQ FOR JMP(0 IF FCALL) 1373 007223 3407 DCA I FPP 1374 007224 5461 JMP I FPNXT 1375 007225 4356 FJUMP, JMS CDFCUR /D.F. MUST BE CURRENT 1376 007226 5222 JMP FJUMP1 /GO DO IT 1377 007227 7450 DFCDFP, DFCDF 1378 007230 7464 TDIVP, TDIV 1379 007231 4631 JMSI2, JMS I TABLE2-1 1380 007232 7564 TABLE2, FFSQ /SQUARE 1381 007233 6451 FROOT /SQUARE ROOT 1382 007234 5000 FFSIN /SIN 1383 007235 5053 FFCOS /COS 1384 007236 5200 FFATN /ATN 1385 007237 5135 FFEXP /EXP 1386 007240 5263 FFLOG /LOG 1387 007241 7135 FFNEG /NEGATE FAC 1388 007242 6200 FFIN /INPUT 1389 007243 5600 FFOUT /OUTPUT 1390 007244 5500 FFIX /FIX 1391 007245 5533 FFLOAT /FLOAT 1392 007246 7212 DCOD1 /NOP 1393 007247 7212 DCOD1 /NOP 1394 007250 7212 DCOD1 /NOP 1395 / 1396 /ARGUMENT PICK UP ROUTINE-ENTER WITH DATA FLD SET TO EITHER 1397 /FLOATING DATA FIELD OR FLOATING INSTRUCTION FIELD. 1398 /ADDRESS OF OPERAND IS IN THE AC ON ENTRY. 1399 /ON RETURN, THE AC IS CLEAR, AND THE MQ CONTAINS THE 1400 /HIGH ORDER MANTISSA WD. OF THE OPERAND. 1401 / 1402 007251 0000 ARGET, 0 1403 007252 3260 DCA ADR1 /STORE ADDRESS PASSED 1404 007253 1660 TAD I ADR1 /PICK UP EXPONENT OF OPERAND 1405 007254 3047 DCA OPX /STORE 1406 007255 2260 ISZ ADR1 /MOVE POINTER TO HI ORDER MANTISSA 1407 007256 7431 SWAB /MUST BE MODE B OF EAE 1408 007257 7663 DLD 1409 007260 0000 ADR1, 0 /PICK UP MANTISSA 1410 007261 3051 DCA OPL /LOW ORDER IN AC-STORE 1411 007262 7501 MQA /HIGH ORDER IN MQ 1412 007263 3050 DCA OPH /STORE 1413 007264 5651 JMP I ARGET /RETURN 1414 1415 / 1416 /ROUTINE TO NORMALIZE THE FAC 1417 / 1418 007265 0000 FFNOR, 0 1419 007266 4356 JMS CDFCUR /CHANGE D.F. TO FIELD OF PACKAGE 1420 007267 7431 SWAB /FORCE MODE B 1421 007270 7663 DLD /PICK UP MANTISSA 1422 007271 0045 ACH 1423 007272 7521 SWP /PUT IT IN CORRECT ORDER 1424 007273 7411 NMI /NORMALIZE IT 1425 007274 7450 SNA /IS THE # ZERO? 1426 007275 3044 DCA ACX /YES-INSURE ZERO EXPONENT 1427 007276 3045 DCA ACH /STORE HIGH ORDER BACK 1428 007277 7521 SWP /STORE LOW ORDER BACK 1429 007300 3046 DCA ACLO 1430 007301 7641 CLA SCA /STEP COUNTER TO AC 1431 007302 7041 CMA IAC /NEGATE IT 1432 007303 1044 TAD ACX /AND ADJUST EXPONENT 1433 007304 3044 DCA ACX 1434 007305 5665 JMP I FFNOR /RETURN 1435 / 1436 /FLOATING GET 1437 / 1438 007306 0000 FFGET, 0 1439 007307 7450 SNA /WHICH MODE? 1440 007310 1706 TAD I FFGET /CALLED BY USER-GET ADDR. OF OP. 1441 007311 4251 JMS ARGET /PICK UP OPERAND 1442 007312 1047 TAD OPX /STORE OPERAND IN FAC 1443 007313 3044 DCA ACX 1444 007314 1051 TAD OPL 1445 007315 3046 DCA ACLO 1446 007316 7521 SWP /OPH IS IN MQ 1447 007317 3045 DCA ACH 1448 007320 2306 ISZ FFGET /BUMP RETURN 1449 007321 5706 JMP I FFGET /RETURN 1450 1451 / 1452 /FLOATING PUT 1453 / 1454 007322 0000 FFPUT, 0 1455 007323 7450 SNA /DETERMINE MODE 1456 007324 1722 TAD I FFPUT /USER-GET ADDR. 1457 007325 3335 DCA TM1 /STORE ADDRESS TO PUT FAC 1458 007326 1044 TAD ACX /GET FAC EXPONENT 1459 007327 3735 DCA I TM1 /STORE IT 1460 007330 2335 ISZ TM1 /CAN'T DO 'DLD;ACH' FOR DATA FIELD 1461 007331 1045 TAD ACH /WON'T BE RIGHT 1462 007332 7431 SWAB /EAE MODE B (ALSO DOES MQL!) 1463 007333 1046 TAD ACLO 1464 007334 7445 DST /D.F. SET BY INTERP. ELSE-CURRENT 1465 007335 0000 TM1, 0 1466 007336 7621 CAM /CLEAR AC AND MQ 1467 007337 2322 ISZ FFPUT /BUMP RETURN 1468 007340 5722 JMP I FFPUT /RETURN 1469 1470 /TABLE FOR JUMPS 1471 / 1472 007341 5742 JMPI3, JMP I TABLE3 1473 007342 7544 TABLE3, FFSKP /SKIP ON COND. OF FAC 1474 007343 7553 FFCDF /CHANGE FLTG. D.F. 1475 007344 7405 FFSW0 /FSWITCH 0 1476 007345 7366 FFSW1 /FSWITCH 1 1477 007346 6572 FFHLT /FLOATING HALT-DISPLAY P.C. 1478 007347 7413 FPNEXT /NOP-FOR FUTURE EXPANSION 1479 007350 7413 FPNEXT /NOP 1480 007351 7413 FPNEXT /NOP 1481 /ROUTINE FOR DECODING SPECIAL FJMS'S 1482 / 1483 007352 7501 JSKP, MQA /EFFECTIVE ADDR TO AC 1484 007353 0204 AND K7 /MASK OFF IMPORTANT BITS 1485 007354 1341 TAD JMPI3 /K7 MUST HAVE BITS 9-11=1,4-8=0 1486 007355 3356 DCA .+1 /DO A JUMP THROUGH TABLE 1487 1488 / 1489 /CHANGE TO DATA FIELD OF FLTG. PT. PKG. 1490 /AFTER FIRST TIME THRU, SUBR. LOOKS LIKE: 1491 / CDFCUR, 0 1492 / CDF N /WHERE N IS FIELD OF PKG. 1493 / JMP I CDFCUR 1494 / (NEXT 5 LOCS. FREE FOR TEM. STORAGE) 1495 / 1496 007356 0000 CDFCUR, 0 /USED AS TEM BY JSKP ROUTINE(ABOVE) 1497 007357 6224 CCUR1, RIF /READ INST. FIELD. 1498 007360 1043 CCUR2, TAD TM /MAKE A CDF TO THIS FIELD 1499 007361 3357 FT1, DCA CCUR1 /STORE IT, MODIFYING SUBR. 1500 007362 1365 FT2, TAD JMPIC /PICK UP THE RETURN JUMP. 1501 007363 3360 FT3, DCA CCUR2 /STORE IT-MODIFYING SUBR. 1502 007364 5357 JMP CCUR1 /GO CHANGE THE FIELD 1503 007365 5756 JMPIC, JMP I CDFCUR 1504 1505 / 1506 /FLOATING SWITCH 1 1507 / 1508 007366 4356 FFSW1, JMS CDFCUR /MUST BE CURRENT DATA FIELD 1509 007367 1374 TAD FFSB1 /CHANGE INTERPRETATION OF SUB,DIV 1510 007370 3775 DCA I TSUBP 1511 007371 1376 TAD FFDV1 1512 007372 3630 DCA I TDIVP 1513 007373 5461 JMP I FPNXT /DONE 1514 007374 6400 FFSB1, FFSUB1 1515 007375 7462 TSUBP, TSUB 1516 007376 6412 FFDV1, FFDIV1 1517 / 1518 /BEGINNING OF INTERPRETER 1519 / 1520 *FLPT 1521 007400 0000 FPT, 0 1522 007401 7600 L7600, 7600 /CLA 1523 007402 6214 RDF /READ DATA FLD-THIS WILL BE INITIAL 1524 007403 1272 TAD KCDF0 /FLOATING DATA AND INSTR. FIELD 1525 007404 3213 DCA FPNEXT /STORE CDF TO FLTG. IF AT FPNEXT 1526 007405 1343 FFSW0, TAD FFSB0 /SET FLOATING SWITCH TO 0 1527 007406 3262 DCA TSUB /SUBTR. AND DIV. WORK AS NORMAL 1528 007407 1342 TAD FFDV0 1529 007410 3264 DCA TDIV 1530 007411 1213 TAD FPNEXT 1531 007412 3250 SFDF, DCA DFCDF 1532 007413 0000 FPNEXT, 0 /CHANGE TO FLOATING INST. FIELD 1533 007414 7431 SWAB /GO TO MODE B OF THE EAE 1534 007415 1600 TAD I FPT /GET FLOATING POINT INSTRUCTION 1535 007416 7421 MQL /SEND IT TO MQ 1536 007417 7501 MQA /GET IT BACK 1537 007420 0256 AND K177 /PICK OFF ADDRESS PORTION 1538 007421 3050 DCA OPH /STORE IT 1539 007422 7501 MQA /GET INSTR. BACK 1540 007423 0225 AND K200 /CURRENT PAGE? 1541 007424 7041 CMA IAC /IF SO WE ADJUST ADDRESS 1542 007425 0200 K200, AND FPT /IF NOT AC WILL BE ZERO 1543 007426 2200 ISZ FPT /MOVE FLTG. PC. TO NEXT INSTR. 1544 007427 1050 TAD OPH /NOW HAVE ADDR. IN AC 1545 007430 3050 DCA OPH /THIS IS FINAL (UNLESS INDIRECT) 1546 007431 7413 SHL /MOVE OP CODE OF INSTR. TO 1547 007432 0003 3 /BITS 9-11 OF THE AC 1548 007433 1257 TAD JMSI /MAKE AN INDIRECT JMS THROUGH TABLE 1549 007434 3253 DCA DCOD /STORE IT 1550 007435 7501 MQA /GET INST TO AC-HIGH ORDER AC 1551 007436 7700 SMA CLA /BIT IS NOW INDIRECT BIT OF INST. 1552 007437 5252 JMP GTAD /NOT INDIRECT REF-GO ON 1553 007440 1050 TAD OPH /INDIRECT-SEE IF AUTO INDEX REG. 1554 007441 0273 AND K7770 1555 007442 1273 TAD K7770 1556 007443 7650 SNA CLA /WELL-IS IT? 1557 007444 7125 CLL CML IAC RAL /YES-BUMP ADDR. BY THREE 1558 007445 1450 TAD I OPH 1559 007446 3450 DCA I OPH /AND STORE IT BACK 1560 007447 1450 TAD I OPH /GET FINAL ADDRESS. 1561 007450 0000 DFCDF, 0 /CHANGE TO FLTG D. F.-ITS INDIRECT 1562 007451 7410 SKP /ALL DONE 1563 007452 1050 GTAD, TAD OPH /CALL SUBRS. WITH ADR. OF OP IN AC 1564 007453 0000 DCOD, 0 /BECOMES JMS I TABLE WITH DATA 1565 /FLD SET TO FLTG. DF OR IF 1566 007454 4756 FNRM, JMS I FFNORP /NORMALIZE FAC(SUBR. CALLS SKIP THIS) 1567 007455 5213 JMP FPNEXT /GO GET NEXT INSTR. 1568 007456 0177 K177, 177 1569 /TABLE FOR DECODING OP CODES 1570 007457 4660 JMSI, JMS I TABLE 1571 007460 7474 TABLE, FFJMP /FLOATING JMP OP CODE 0 1572 007461 7000 FFADD /FLOATING ADD OP CODE 1 1573 007462 7117 TSUB, FFSUB / " SUBTRACT " 2 1574 007463 6600 TMPY, FFMPY / " MULTIPLY " 3 1575 007464 6722 TDIV, FFDIV / " DIVIDE " 4 1576 007465 7306 FFGET / " GET " 5 1577 007466 7322 FFPUT / " PUT " 6 1578 007467 7521 FFJMS / " JMS " 7 1579 1580 007470 7200 FCALLP, FCALL 1581 007471 7225 FJUMPP, FJUMP 1582 007472 6201 KCDF0, CDF 0 1583 007473 7770 K7770, 7770 1584 / 1585 /FLOATING JUMP-CHECK FOR FCALL OR FISZ 1586 / 1587 007474 0000 FFJMP, 0 1588 007475 7521 SWP /ADDR IN AC TO MQ, INST IN MQ TO AC 1589 007476 7450 SNA /IS IT FEXT? 1590 007477 5313 JMP EXIT /YES-LEAVE INTERPRETER 1591 007500 7104 CLL RAL /NO- INDIRECT AND PAGE BITS ZERO? 1592 007501 7730 SPA SZL CLA 1593 007502 5671 JMP I FJUMPP /NO-IT IS FJUMP-EFF. ADDR. IS IN MQ 1594 007503 7501 MQA /YES-GET INSTR (=ADDR. SINCE PG 0) 1595 007504 0357 AND K160 /CHECK BITS 5-7 ANY ON=FISZ 1596 007505 7650 SNA CLA 1597 007506 5670 JMP I FCALLP /NONE ON-ITS A FUNCTION CALL 1598 007507 2450 FFISZ, ISZ I OPH /FISZ-ISZ PAGE 0 ADDR.(DF=FLTG.I.F.) 1599 007510 5213 JMP FPNEXT /NO SKIP-RETURN 1600 007511 2200 FISZ1, ISZ FPT /SKIP-BUMP FLOATING PC BY 1 1601 007512 5213 JMP FPNEXT /RETN. 1602 1603 /LEAVE INTERPRETER 1604 007513 7005 EXIT, IAC RAL /MAKE A CDF CIF TO FLTG. INSTR. FLD 1605 007514 1213 TAD FPNEXT 1606 007515 3316 DCA .+1 /STORE IT 1607 007516 0000 0 1608 007517 7447 SWBA /MODE A OF EAE FOR EXIT. 1609 007520 5600 JMP I FPT /GO BACK TO USER 1610 1611 / 1612 /FLOATING JMS-IF BITS 3-11=0 = NORMALIZE FAC (FNOR) 1613 / BITS 3-4 =0 = DECODE FURTHER BY BITS 9-11 1614 / 9-11=0 = SKIP ON COND. OF FAC 1615 / =1 = FCDF (BITS 6-8=NEW FLTG DF.) 1616 / =2 = FSW0 1617 / =3 = FSW1 1618 / =4-7 = ?? 1619 / 1620 007521 0000 FFJMS, 0 1621 007522 7521 SWP /EFF. ADDR. OF JMS IN AC TO MQ 1622 007523 7450 SNA /INST. TO AC-IS IT NORMALIZE? 1623 007524 5254 JMP FNRM /YES-GO DO IT 1624 007525 7104 CLL RAL /NO-ARE INDIRECT AND PAGE BITS 0? 1625 007526 7720 SMA SNL CLA 1626 007527 5741 JMP I JSKPP /YES-DECODE FURTHER BY BITS 9-11 1627 007530 1200 TAD FPT /NO-ITS A FJMS-GET FLTG. P.C. 1628 007531 7521 SWP /SEND TO MQ-E.A. TO AC 1629 007532 3200 DCA FPT /PUT E.A. OF FJMS INTO FLTG. P.C. 1630 007533 1213 TAD FPNEXT 1631 007534 3335 DCA .+1 1632 007535 0000 IFCDF, 0 /CHANGE TO FLOATING INSTR. FIELD 1633 007536 7501 MQA /GET CURRENT FLTG. P.C. 1634 007537 3600 DCA I FPT /STORE IN 1ST WD. OF SUBR. FOR RETN 1635 007540 5311 JMP FISZ1 /GO BUMP FLTG. P.C. AND EXEC. SUBR. 1636 007541 7352 JSKPP, JSKP /ROUTINE TO DECODE INST. BY BITS 9-11 1637 1638 007542 6722 FFDV0, FFDIV 1639 007543 7117 FFSB0, FFSUB 1640 1641 /ROUTINE TO DO FLOATING SKIPS ON CONDITION OF FAC 1642 /THE E.A. OF INST. IS IN MQ-TO THIS WE 'OR' 7600 TO 1643 /MAKE THE PROPER SKIP PLUS A CLA--SENSING IS REVERSED 1644 /TO FACILITATE DECODING 1645 007544 1201 FFSKP, TAD L7600 /GET BITS TO MAKE PROPER SKIPW/CLA 1646 007545 7501 MQA /'OR' IN THE INST. 1647 007546 3350 DCA .+2 /STORE FOR SKIP DECODING 1648 007547 1045 TAD ACH /GET HIGH ORDER MANTISSA FOR CHECK 1649 007550 0000 0 /EXECUTE THE SKIP 1650 007551 2200 ISZ FPT /NO SKIP=SKIP-BUMP PC (REV. SENSE) 1651 007552 5213 JMP FPNEXT /GO GET NEXT 1652 / 1653 /ROUTINE TO HANDLE AN FCDF--BITS 6-8 ARE THE NEW DATA FIELD 1654 / 1655 007553 1272 FFCDF, TAD KCDF0 /GET A BLANK CDF 1656 007554 7501 MQA /'OR' THE DATA FIELD BITS INTO IT 1657 007555 5212 JMP SFDF /STORE AS NEW FLTG. DATA FIELD 1658 007556 7265 FFNORP, FFNOR 1659 007557 0160 K160, 160 /REPLACE WITH INST:BITS 5-7=1,8-11=0 1660 / 1661 /FLOATING SQUARE 1662 / 1663 *FPT+164 1664 007564 0000 FFSQ, 0 1665 007565 4663 JMS I TMPY /CALL MULTIPLY TO MUL. 1666 007566 0044 ACX /FAC BY ITSELF 1667 007567 5764 JMP I FFSQ /DONE 1668 1669 1670 / 1671 /FLOATING TRAPS TO USER 1672 / 1673 *FPT+170 1674 007570 5774 FTRP1, JMP I FTRAP1 1675 007571 5775 FTRP2, JMP I FTRAP2 1676 007572 5776 FTRP3, JMP I FTRAP3 1677 007573 5777 FTRP4, JMP I FTRAP4 1678 007574 5505 FTRAP1, FTRPRT /OVERFLOW 1679 007575 6775 FTRAP2, DBAD /DIV. ERR - 1680 007576 5302 FTRAP3, LTRPRT /ILLEGAL FUNCT. ARG. 1681 007577 7213 FTRAP4, DCOD1+1 /UNDERFLOW 1682 $END$