/ COPYRIGHT 1970, DIGITAL EQUIPMENT CORP., MAYNARD MASS. /8K FORTRAN LIBRARY /INTEGER POWERS OF INTEGER AND FLOATING-POINT NUMBERS ENTRY IIPOW ENTRY FIPOW OPDEF TADI 1400 LAP FIPOW, BLOCK 2 TAD FIPOW DCA IIPOW TAD FIPOW# DCA IIPOW# CALL 1,STO ARG X /SAVE BASE JMP FIFI X, BLOCK 3 RSLT, BLOCK 3 N, 0 FISW, 0 IIPOW, BLOCK 2 DCA X /SAVE BASE IAC FIFI, DCA FISW TAD IIPOW DCA II II, NOP TADI IIPOW# DCA NCDF INC IIPOW# TADI IIPOW# DCA N INC IIPOW# NCDF, NOP /GET FIELD OF EXPONENT TADI N /GET EXPONENT CLL SPA CIA CML DCA N /SAVE ABS VALUE TAD X /********* THE FOLLOWING CODE MAY BE REPLACED BY JUST "SNA CLA" /********* IF THE RULES ARE THAT 0**ANYTHING=0 FOR FLOATING /********* POINT TOO. (REMEMBER 0**0 AND 0**-1!) SNA CLA TAD FISW SZA CLA /********* JMP IPRTRN /BASE=0 MEANS RESULT=0 TAD FISW SZA JMP DCARSL ACHONE, TAD (2014 DCA ACH /INITIALIZE FPAC TO 1.0 DCARSL, DCA RSLT /INITIALIZE RSLT TO FISW SNL /THE LINK SHOULD CONTAIN THE EXPONENT SIGN JMP BACK /POSITIVE - ALLS WELL TAD FISW SZA CLA JMP IPRTRN /I**-N = 0 CALL 1,FDV ARG X /THERE'S A 1.0 IN THE AC, REMEMBER? CALL 1,STO ARG X CLL /FAKE A POSITIVE SIGN JMP ACHONE /GO BACK AND RESTORE FPAC TO 1.0 BACK, TAD N /USE STANDARD POWER-OF-2 ALGORITHM FOR POWERS SNA JMP DONE CLL RAR DCA N SNL JMP LOOP TAD RSLT SNA JMP FPMULT /RSLT=0 MEANS FLOATING POINT CALL 1,MPY ARG X STRSLT, DCA RSLT LOOP, TAD N SNA CLA JMP DONE TAD FISW SNA CLA JMP FPSQR TAD X CALL 1,MPY ARG X DCA X JMP BACK FPMULT, CALL 1,FMP /DO THE SAME STUFF IN FLOATING POINT ARG X /THAT WE DID ABOVE IN INTEGERS JMP STRSLT FPSQR, CALL 1,STO ARG RSLT /SAVE FLTG AC CALL 1,FAD ARG X CALL 1,FMP ARG X CALL 1,STO ARG X /SQUARE X CALL 1,FAD ARG RSLT DCA RSLT /KEEP RSLT ZERO! JMP BACK DONE, TAD RSLT IPRTRN, RETRN IIPOW END