X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fexpcc.ra;fp=sw%2Fos8%2Fv3d%2Fsources%2Ffortran%2Fdectapes%2Fdectape2%2Fexpcc.ra;h=691dc0c9898e620fd034834d2f546535cdb73538;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/os8/v3d/sources/fortran/dectapes/dectape2/expcc.ra b/sw/os8/v3d/sources/fortran/dectapes/dectape2/expcc.ra new file mode 100644 index 0000000..691dc0c --- /dev/null +++ b/sw/os8/v3d/sources/fortran/dectapes/dectape2/expcc.ra @@ -0,0 +1,165 @@ +/ +/EXPCC +/COMPLEX RAISED TO COMPLEX +/ +/ VERSION 5A 4-26-77 MH +/ +/(A+I*B)^(C+I*D) +/A+B=0 YIELDS 0 +/B+D=0 MEANS USE EXP3 TO CALCULATTE A^C +/A+B=0,C+D=0 YIELDS 1.0 +/ENTER + EXIT IN STARTE + SECT #EXPCC + DPCHK + EXTERN #CAC + EXTERN EXP + EXTERN COS + EXTERN SIN + EXTERN ALOG + EXTERN EXP3 + EXTERN ATAN2 + EXTERN SQRT + BASE 0 +EXPCC, JA . + FSTA C,0 + FLDA 0 + FSTA A,0 + STARTF + BASE .+2000 + XTA 0 + FSTA T1 /SAVE XR 0 + FLDA A + JNE EX1 /A NOT 0 + FLDA B + JNE EX1 + STARTE /A=B=0 + FCLA +EX, FSTA #CAC /RESULT = 0 + JA EXPCC +EX1, FLDA C /C+D=0? + JNE EX2 + FLDA D + JNE EX2 + STARTE + FLDA FP1 /RESULT = 1 IF C=D=0 + JA EX +EX2, FLDA B + JNE EX3 /USE EXP3 IF B=D=0 + FLDA D + JNE EX3 + STARTF + JSR EXP3 + JA .+6 + JA A + JA C + FSTA A + STARTE + FLDA A /RETURN AS REAL PART + JA EX +EX3, STARTF +/TH=ATAN(B/A) + JSR ATAN2 + JA .+6 + JA B + JA A + FSTA TH +/ +/LOGR=ALOG(SQRT(A*A+B*B)) + FLDA A + FMUL A + FSTA LOGR + FLDA B + FMUL B + FADDM LOGR + JSR SQRT + JA .+4 + JA LOGR + FSTA LOGR + JSR ALOG + JA .+4 + JA LOGR + FSTA LOGR +/ARG=C*TH+D*LOGR + FLDA C + FMUL TH + FSTA ARG + FLDA D + FMUL LOGR + FADDM ARG +/ +/CALCULATE IN AND COS OF ARG. SAVE SIGN OF EACH + JSR SIN + JA .+4 + JA ARG + FSTA SINE + JSR COS + JA .+4 + JA ARG + FSTA CSINE +/CALL C*LOGR-D*TH + FLDA D + FMUL TH + FSTA REST + FLDA C + FMUL LOGR + FSUB REST + FSTA REST +/REAL = EXP(REST+ALOG(CSINE)) + FLDA CSINE /REAL + JLT .+6 + LDX 0,1 /=1 IF POSITIVE + JA .+3 + FNEG + JSA DO + JXN .+3,0 /SKIP IF POS + FNEG + FSTA A + FLDA SINE /IMAG + JLT .+6 + LDX 0,1 + JA .+5 + LDX 0,0 + FNEG + JSA DO + JXN .+3,0 + FNEG /RESTORE SIGN + FSTA B + FLDA T1 /RESTORE XR0 + ATX 0 + STARTE + FLDA A + FSTA #CAC + JA EXPCC +/ +DO, JA . + FSTA TH + JSR ALOG + JA .+4 + JA TH + FADD REST + FSTA ARG + JSR EXP + JA .+4 + JA ARG + FSTA ARG + FLDA TH /CHECK SIGN + JGE DOX + FLDA ARG + FNEG + FSTA ARG +DOX, FLDA ARG + JA DO +A, F 0.0 +B, F 0.0 +C, F 0.0 +D, F 0.0 +LOGR, F 0.0 +TH, F 0.0 +ARG, F 0.0 +SINE, F 0.0 +CSINE, F 0.0 +REST, F 0.0 +FP1, F 1.0 + F 0.0 +T1, F 0.0 +