| 1 | SECT #EXPDI |
| 2 | / B**E |
| 3 | / WHERE E IS INTEGER |
| 4 | / AND B IS DOUBLE PRECISION |
| 5 | / |
| 6 | / VERSION 5A 4-26-77 MH |
| 7 | / |
| 8 | DPCHK |
| 9 | BASE 0 |
| 10 | EXPDI, JA . |
| 11 | FSTA SIGN /SAVE SIGN OF EXPONENT |
| 12 | JGE POSINT /ITS POSITIVE |
| 13 | FNEG |
| 14 | POSINT, FSTA EXP |
| 15 | XTA 1 /SAVE XR 1 |
| 16 | FSTA XR1 |
| 17 | LDX -27,1 /BIT COUNT |
| 18 | STARTE |
| 19 | FLDA ONE /START WITH ONE |
| 20 | FSTA PROD |
| 21 | STARTF |
| 22 | FLDA EXP |
| 23 | LOOP, JEQ YES /DONE IF ITS ZERO |
| 24 | FDIV TWO /DIVIDE BY TWO |
| 25 | ALN 0 /INTEGERIZE |
| 26 | FNORM |
| 27 | FSTA TEMP /SAVE AT |
| 28 | FMUL TWO /IS EXPONENT ODD ? |
| 29 | FSUB EXP |
| 30 | STARTE |
| 31 | JLT ODD /YES, JUMP |
| 32 | FLDA 0 /SQUARE BASE |
| 33 | SQUARE, FMULM 0 |
| 34 | STARTF |
| 35 | FLDA TEMP /EXPONENT OVER 2 |
| 36 | FSTA EXP |
| 37 | JXN LOOP,1+ /LOOP IF MORE BITS |
| 38 | YES, FLDA XR1 /DONE, RESTORE XR 1 |
| 39 | ATX 1 |
| 40 | FLDA SIGN /CHECK SIGN OF EXPONENT |
| 41 | JLT INVERT /IT WS NEGATIVE, INVERT RESULT |
| 42 | STARTE |
| 43 | FLDA PROD /RETURN ANSWER |
| 44 | JA EXPDI |
| 45 | INVERT, STARTE |
| 46 | FLDA ONE /RETURN WITH 1/PROD |
| 47 | FDIV PROD |
| 48 | JA EXPDI |
| 49 | ODD, FLDA 0 |
| 50 | FMULM PROD |
| 51 | JA SQUARE /GO SQUARE THE BASE |
| 52 | ONE, F 1.0 |
| 53 | F 0.0 |
| 54 | TWO, F 2.0 |
| 55 | PROD, F 0.0 |
| 56 | F 0.0 |
| 57 | SIGN, F 0.0 |
| 58 | TEMP, F 0.0 |
| 59 | XR1, F 0.0 |
| 60 | EXP, F 0.0 |
| 61 | F 0.0 |
| 62 | END |
| 63 | \f |