. 1108 FORTRAN 5 PHASE 3 CONSTANT ARITHMETIC AND CONVERSION PACKAGE . N3CAR RGS . REGISTER DEFINITION CONTR . TRIAD DEFINITION MEMX EQU 4 IDX EQU 1 $(1) . LIT . LV* PROC 1,3 L,H2 LV(1,1),LV(1,2) TNZ,S2 LV(1,2) LM LV(1,1),0,LV(1,1) END . SLJ CNVT B357770 . ERROR EXIT B357780 . NORMAL RETURN B357790 . ON ENTRY, A0 HAS FUNCTION TYPE . ON EXIT, A5 HAS COMPLETED FILE ITEM CNVTR SZ BMD REENT DO IDX=1 , TZ DX11 578110 DO IDX=1 , SLJ XD11 578120 . THIS SECTION EVALUATES INTRINSIC FUNCTIONS . WHOSE ARGUMENTS ARE CONSTANTS . ARGUMENT IS IN COPND2 L,M A1,1 . S A1,DAD . L,H2 A1,CNVT AA,XM A1,1 S A1,CNVTX SR R4,CNVFLG J $,A0 J ABS . 01 J IABS . 02 J AINT . 03 J INT . 04 J *CNVT . 05 (AMOD) J *CNVT . 06 (MOD) J *CNVT . 07 (AMAX0) J *CNVT . 10 (AMAX1) J *CNVT . 11 (MAX0) J *CNVT . 12 (MAX1) J *CNVT . 13 (AMIN0) J *CNVT . 14 (AMIN1) J *CNVT . 15 (MIN0) J *CNVT . 16 (MIN1) J FLOAT . 17 J INT . 20 IFIX=INT J *CNVT . 21 (SIGN) J *CNVT . 22 (ISIGN) J *CNVT . 23 (DIM) J *CNVT . 24 (IDIM) J SINGL . 25 J IDINT . 26 J REAL . 27 J *CNVT . 30 (CMPLX) J CONJG . 31 J *CNVT . 32 (DMOD) J *CNVT . 33 (MAX) J *CNVT . 34 (MIN) J INT . 35 FIX=INT J *CNVT . 36 (DMAX1) J *CNVT . 37 (DMIN1) J AIMAG . 40 J DBLE . 41 J AIMAG . 42 IMAG=AIMAG J *CNVT . 43 (DSIGN) J *CNVT . 44 (LOC) J *CNVT . 45 (CSIGN) J INT . 46 ICLX=INT J DINX . 47 J *CNVT . 50 (DDIM) J CINT . 51 J CFLT . 52 J DINT . 53 J DABS . 54 J CABSX . 55 J *CNVT . 56 (FLD) J *CNVT . 57 (AND) J *CNVT . 60 (OR) J COMPL . 61 J CBOOL J *CNVT . 63 J *CNVT . 64 (XOR) J DCX . 65 J CDX . 66 ABS L,H2 A0,COPND2 . FLOATING POINT ABSOLUTE VALUE LM A4,0,A0 . SZ,S3 COPND2 . MARK AS + J RLV . INSERT IN SYMBOL TABLE,EXIT IABS TNZ,S2 COPND2 . INTEGER ABSOLUTE VALUE J IABSV . LM,H2 A4,COPND2 . IF IMMEDIATE, LOAD AND... SZ,S3 COPND2 . MARK AS + J IMLV . IABSV L,H2 A0,COPND2 . IF NOT IMM., LOAD INDIRECT LM A4,0,A0 . SZ,S3 COPND2 . MARK AS + J ILV . AINT L,H2 A0,COPND2 . STEP FUNCTION FOR FLOATING POINT LM A4,0,A0 FA A4,(0233000,0) . SHIFT RIGHT TO LOSE FRACTION J RLV . INT L,H2 A0,COPND2 . FLOATING POINT TO INTEGER L A3,0,A0 L,M A4,4 TEP,S3 A4,COPND2 LN A3,A3 FA A3,(0233000,0) LUF A3,A3 ANA,XM A3,0243 . FIND SHIFT COUNT TG,M A3,1 J INT01 SMA,H2 A3,INTSH LSSC A4,8 . ALLOW FOR POSSIBLE 35 BIT INTEGER SSA A4,*INTSH J IMLV . INT01 XERF ERRAX+16 CONSTANT OVERFLOW SZ A4 SZ A5 J IMLV FLOAT LV A0,COPND2 . INTEGER TO FLOATING POINT L,XM A3,0233 . EXPONENT OF UNNORMALIZED INTEGER LCF A3,A0 . PACK LM A4,A4 J RLV . SINGL L,H2 A0,COPND2 . DOUBLE PRECISION TO SINGLE PREC. L A1,0,A0 . MOST SIG. WORD L A2,3,A0 . LEAST SIG. WORD FCL A4,A1 . COMPRESS J RLV . IDINT L,H2 A0,COPND2 . DOUBLE PRECISION TO INTEGER L A1,0,A0 . MOST SIG. WORD L A2,3,A0 . LEAST SIG. WORD L,M A4,4 TEP,S3 A4,COPND2 DLN A1,A1 DFA A1,DPZ DFU A3,A1 . UNPACK ANA,XM A3,02074 . FIND SHIFT COUNT TG,M A3,1 J INT01 SMA,H2 A3,INTSH DSA A4,*INTSH L A4,A5 . J IMLV . REAL L,H2 A0,COPND2 . REAL PART OF COMPLEX NUMBER LM A4,0,A0 J RLV . CONJG L,H2 A0,COPND2 . CONJUGATE OF IMAGINARY NUMBER L A4,0,A0 LN A5,3,A0 . NEGATIVE OF IMAGINARY J CLV . AIMAG L,H2 A0,COPND2 . IMAG. PART OF COMPLEX NUMBER L A4,3,A0 . S,H2 A0,COMX J RLV DBLE L,H2 A0,COPND2 . SINGLE TO DOUBLE PRECISION LM A4,0,A0 FEL A4,A4 J DLV . DINX LV A1,COPND2 . INTEGER TO DOUBLE PRECISION SZ A0 . MOST SIG. WORD L,XM A3,02074 . EXPONENT OF UNNORMALIZED INTEGER DFP A3,A0 J DLV . CINT LV A0,COPND2 . INTEGER TO COMPLEX L,XM A3,0233 LCF A3,A0 SZ A5 J CLV CFLT L,H2 A0,COPND2 . REAL TO COMPLEX L A4,0,A0 SZ A5 . J CLV DINT L,H2 A0,COPND2 . STEP FUNCTION FOR DOUBLE PRECISION L A4,0,A0 . MOST SIG. L A5,3,A0 . LEAST SIG. DFA A4,DPZ . SHIFT RIGHT TO LOSE FRACTION J DLV . DABS L,H2 A0,COPND2 . DOUBLE PRECISION ABSOLUTE VALUE L A4,0,A0 . L A5,3,A0 . LEAST SIG. DLM A4,A4 SZ,S3 COPND2 . MARK AS + J DLV . CABSX L,H2 A0,COPND2 COMPLEX ABSOLUTE VALUE LM A1,0,A0 . REQL PART S A1,TEMP LM A3,3,A0 . IMAGINARY PART S A3,TEMP+1 LMJ B11,CABS + TEMP + TEMP+1 NOP 0,0 L A4,A0 . SQRT(X*X+Y*Y) SZ,S3 COPND2 . MARK AS + J RLV . COMPL L A0,COPND2 . LOGICAL 36-BIT COMPLEMENT TE A0,(030100,0) J COMPLV L A4,(0777777777777) SZ,S3 COPND2 J BLV+2 INSERT UNDER BOOLEAN HEADLINK COMPLV L,H2 A0,COPND2 TNZ,S2 COPND2 L A0,0,A0 VALUE OF CONSTANT L,M A4,4 TEP,S3 A4,COPND2 TEST FOR MINUS CONSTANT LN A0,A0 LN A4,A0 SZ,S3 COPND2 J BLV+2 CBOOL L,H2 A0,COPND2 TNZ,S2 COPND2 L A0,0,A0 VALUE OF CONSTANT L A4,A0 L,M A0,4 TEP,S3 A0,COPND2 LN A4,A4 J BLV INSERT AS BOOLEAN CONSTANT DCX L,H2 A0,COPND2 . COMPLEX TO DOUBLE PRECISION FEL A4,0,A0 . J DLV CDX L,H2 A0,COPND2 . DOUBLE PRECISION TO COMPLEX SZ A5 L A1,0,A0 . L A2,3,A0 . FCL A4,A1 J CLV IMLV LM A1,A4 . MAKE SURE IT'S PLUS L,M A5,07777 . TNG A5,A1 . IF 12 BITS OR LESS ... J ILV . A A1,(0100,0) . MARK AS IMMEDIATE TP A4 A A1,(4,0) J SIGNJ ILV L,M A0,6 TE A0,MA TNE A0,MB J BLV XSLT 1,CRIHL,013 J SIGN . RLV L A6,A4 LM A4,A4 XSLT 1,CRRHL,023 J SIGN . DLV DL A6,A4 DLM A4,A4 XSLT 2,CRDHL,033 J SIGN . CLV DL A6,A4 DLM A4,A4 XSLT 2,CRCHL,043 J SIGN . BLV L A6,A4 LM A4,A4 XSLT 1,CRBHL,063 L,M A0,040 SET EQUIVALENCE BIT S,S2 A0,2,A1 AS A FLAG BETWEEN BOOLEAN AND FRACTIONAL SIGN L,M A1,0,A1 TZ,H2 COMX J LABL L A2,COPND2 TEP A2,(04,0) A A1,(04,0) . TZ,S2 COPND2 J SIGNJ XOR A4,0,A2 JP A5,SIGNJ . TEST IF SIGN DIFFERENT FROM START TP 0,A2 A A1,(04,0) SIGNJ A A1,(030000,0) . MARK AS CONSTANT S A1,A5 DF L A15,FNC . AN A15,DAD S A15,FNC . SZ CNVFLG SZ,H2 COMX J *CNVTX LABL TP A6 A A1,(04,0) J SIGNJ . THE NEXT SECTION PERFORMS ON CONSTANTS THE INTRINSIC FUNCIONS . WITH MORE TNAN ONE ARGUEMENT -- MOD,MAX,MIN,SIGN,DIM,CMPLX, . AND,OR,XOR (OPERANDS ARE IN COPND1 AND COPND2, FUNCTION TYPE IN . COPER, RESULTANT ITEM IN A5 ON EXIT ) CARCMR . REENT DO IDX=1 , TZ DX11 . DO IDX=1 , SLJ XD11A . L,H2 A0,CARCOM . S,H2 A0,CNVT A,M A0,1 . S,H2 A0,COMX . NORMAL RETURN S,H2 A0,CNVTX S R4,CNVFLG SLJ LOAD MOVE OPERANDS SZ DAD . FUNCTION LEVEL DECREMENT L,S6 A0,COPER . PICK UP FUNCTION TYPE L A1,MA L,M A5,6 TNE A5,MA L A1,EMODE TNE A5,MB L A1,EMODE J $,A0 . JUMP ON FUNCTION TYPE J MOD-1,A1 . MOD J MAX-1,A1 . MAX J MIN-1,A1 . MIN J SGN-1,A1 . SIGN J DIM-1,A1 . DIM J CPX . CMPLX J *CARCOM . -FLD,R OF = J *CARCOM -FLD,L OF = J *CARCOM . CHARACTER R OF = J *CARCOM . CHARACTER L OF = J CAND . AND J COR . OR J CXOR . XOR MOD J MODI . JUMP ON OPERAND MODE J MODR . J MODD . MAX J MAXI . J MAXR . J MAXD . MIN J MINI . J MINR . J MIND . SGN J SGNI J SGNR . J SGND . DIM J DIMI . J DIMR . J DIMD . MODI L A3,CARTP . DSA A3,36 . DI A3,CARTP+2 . J IMLV . MODR LN A4,CARTP . FD A4,CARTP+2 . FA A4,(0233000,0) . FM A4,CARTP+2 . FA A4,CARTP . J RLV . MODD DLN A4,CARTP . DFD A4,CARTP+2 . DFA A4,DPZ . DFM A4,CARTP+2 . DFA A4,CARTP . J DLV . MAXI L A4,CARTP . TNG A4,CARTP+2 . L A4,CARTP+2 . J IMLV . MAXR L A1,CARTP . L A4,A1 . FAN A1,CARTP+2 . TP A1 . L A4,CARTP+2 . J RLV . MAXD DL A1,CARTP . DL A4,A1 . DFAN A1,CARTP+2 . TP A1 . DL A4,CARTP+2 . J DLV . MINI L A4,CARTP . TG A4,CARTP+2 . L A4,CARTP+2 . J IMLV . MINR L A1,CARTP . L A4,A1 . FAN A1,CARTP+2 . TN A1 . L A4,CARTP+2 . J RLV . MIND DL A1,CARTP . DL A4,A1 . DFAN A1,CARTP+2 . TN A1 . DL A4,CARTP+2 . J DLV . SGNI LM A4,CARTP . TP CARTP+2 . LN A4,A4 . J IMLV . SGNR LM A4,CARTP . TP CARTP+2 . LN A4,A4 . J RLV . SGND DLM A4,CARTP . TP CARTP+2 . DLN A4,A4 . J DLV . DIMI L A1,CARTP . L A4,A1 . TG A1,CARTP+2 . L A1,CARTP+2 . AN A4,A1 . J IMLV . DIMR L A1,CARTP . L A4,A1 . FAN A1,CARTP+2 . TN A1 . L A1,CARTP+2 . FAN A4,A1 . J RLV . DIMD DL A1,CARTP . DL A4,A1 . DFAN A1,CARTP+2 . TN A1 . DL A1,CARTP+2 . DFAN A4,A1 . J DLV . CPX L A4,CARTP . L A5,CARTP+2 . J CLV . CAND L A3,CARTP . AND A3,CARTP+2 . J BLV . COR L A3,CARTP . OR A3,CARTP+2 . J BLV . CXOR L A3,CARTP . XOR A3,CARTP+2 . J BLV . . . CARIN FILES THE INTEGER IN A0 IN SYM OR INTO ITEM ITSELF . A0 = THE VALUE OF THE INTEGER TO FILE . A2= THE RESULTANT ITEM . USES A0 THROUGH A5 IF FILES IN THE SYM TABLE CARINR LM A2,A0 REENT SA A0,TA . SAVE TO CHECK FOR SIGN TNZ NGCN . IF A FUNCTION ARGUMENT PLACE IN SYMBOL TABLE TG A2,(04000) BIG J CARIN1 YES, TO SYM B040 A A2,(030100000000) SET ID'S B050 CARIN0 TP TA . TEST FOR NEGATIVE RESULT TZ NGCN . TEST FOR NEGATIVE FUNCTION ARGUMENT J *CARIN A A2,(04000000) SET MINUS B070 J *CARIN EXIT B080 CARIN1 L A4,A2 B090 TZ NGCN . TEST FOR NEGATIVE FUNCTION ARGUMENT L A4,A0 . PUT NEGATIVE NUMBER IN SYMBOL TABLE TZ BMD J CARIN2 L,M A0,6 TNE A0,MB TE A0,MA TEST IF BOTH ARGUMENTS BOOLEAN J $+2 J CARIN2 XSLT 1,CRIHL,013 MAKE ENTRY FOR INTEGER L,M A1,0,A1 REMOVE EXTRANEOUS SIGN BIT AU A1,(030000,0) A1= LOC IN SYM+ID B110 J CARIN0 B120 CARIN2 XSLT 1,CRBHL,063 MAKE ENTRY FOR BOOLEAN L,M A1,0,A1 L,M A0,040 S,S2 A0,2,A1 AU A1,(030000,0) J CARIN0 . . . . SLJ CAR CONSTANT ARITHMETIC B359120 . ERROR RETURN B359130 . CAN NOT PERFORM ARITHMETIC . NORMAL RETURN B359140 . A0 =OPERAND 1 (IX) B359150 . A1 =OPERAND 2 (IX) B359160 . A2 =USED TEMPORARILY B359170 . A3 =OPERATOR (RT ADJUSTED, AND -8), MODE OP 2 IN POWER) B359180 . A4 =RAW DATA OPER 1 B359190 . A5 =RAW DATA OPER 2 B359200 . A6 =TEMPORARY B359210 . A8 =RESULT OF RELATIONALS . A12 =OPERAND (CLEARED) FOR RESULT OUTPUT B359220 . A13 =INPUT OPERATOR B359230 . A14 =OPERAND 1 (INPUT) B359240 . A15 =OPERAND 2 (INPUT) B359250 CARR SZ BMD REENT DO IDX=1 , TZ DX11 592910 DO IDX=1 , SLJ XD11A 592920 S A14,A14S S A15,A15S LA,H2 A0,CAR B359300 A,M A0,2 SET FOR NORMAL EXIT SA,1 A0,CARX B359320 SLJ LOAD J CARX6A LOADR LA A3,(04,0) . USED TO TEST FOR MINUS REENT LA,H2 A0,COPND1 TZ,S2 COPND1 J CARX2 . SELF CONTAINED CONSTANT TEP A3,COPND1 J CARX1 . OPERAND IS MINUS MVW 0,A0 CARTP . MOST SIGNIFICANT MVW 3,A0 CARTP+1 . LEAST SIGNIFICANT CARX3 LA,H2 A0,COPND2 TZ,S2 COPND2 J CARX4 . SELF CONTAINED INTEGER TEP A3,COPND2 J CARX5 . OPERAND IS MINUS MVW 0,A0 CARTP+2 MVW 3,A0 CARTP+3 CARX6 J *LOAD CARX6A LA A0,A14 . L,M A8,1 . .TRUE. , FOR RELATIONALS L A12,(030000,0) B3593400 LA A2,A13 OPERATOR B359360 SSL A2,24 MOVE TYPE OPERATOR B359370 AND,M A2,63 RT ADJUST, MASK OFF=A3 B359380 SA A3,A3S B359400 LA A4,A15 B359410 AND,M A4,0177777 B359420 SA A5,A1S B359430 CAR09 AND,M A0,0177777 B359440 LA A0,A1 B359450 SA A0,A0S B359460 L A1,MA J CAR10,A1 CAR10 J *CAR 0 ERR B359530 J CAR11 1 INT B359540 J CAR21 2 REAL B359550 J CAR31 3 DB B359560 J CAR41 4 COMPLX B359570 J REL . 5 LOGICAL J CAR11 6 BOOLEAN CARX2 TEP A3,COPND1 LN A0,A0 SA A0,CARTP J CARX3 CARX1 LN A1,0,A0 . MOST SIGNIFICANT SA A1,CARTP LN A1,3,A0 . LEAST SIGNIFICANT SA A1,CARTP+1 J CARX3 CARX4 TEP A3,COPND2 LN A0,A0 S A0,CARTP+2 J CARX6 CARX5 LN A1,0,A0 SA A1,CARTP+2 . MOST SIGNIFICANT LN A1,3,A0 SA A1,CARTP+3 . LEAST SIGNIFICANT J CARX6 . INTEGER FOR OPERAND 1 B359610 . . CAR11 LA A4,CARTP LA A5,CARTP+2 . SELECT OPERATOR ON A3 B359680 CART2 J $-1,A3 . SELECT OPERATOR J IOR . J IAND . J ILOG EQ J ILOG NE J ILOG LT J ILOG GT J ILOG GE J ILOG LE CAR12 J CAR13 + B359700 J CAR15 . / 597100 J CAR14 . * 597200 J CAR16 ** B359730 . INTEGERS + B359740 CAR13 AA A4,A5 + B359750 JO *CAR B359760 CAR17 LA A0,A4 597700 SLJ CARIN INSERT INTEGER IN SYM OR SELF B3597800 L A15,A2 RESULT OPERAND TO A15 B3597900 J *CARX B359800 . PRODUCT OF INTEGERS B359810 CAR14 MF A4,A5 B359820 DSC A4,37 A5 TO A4 B359840 JNZ A5,*CAR OVERFLOW J CAR17 GO TO SEARCH, INSERT, ETC B359850 . DIVIDE INTEGERS B359860 CAR15 LA A3,A4 SET PROPER SIGN S A4,A2 INTO A3,A4 DSA A3,36 DI A3,A5 B3598730 TZ CONFCF JNZ A4,CAR15V JZ A3,CAR15A B3598760 L A4,A3 B3598800 J CAR17 GO[SEARCH ETC [ [ #359890 CAR15A TNZ RCPF . FRACTIONAL ONLY ALLOWED IN RECIPROCALS J $-3 L A3,A2 SET FRACTIONAL SZ A4 DF A3,A5 SSL A4,35 A A4,A3 L A2,A4 MF A2,CARTP+2 TE,M A2,1 J CHTDV9 JNZ A3,CHTDV9 JP A4,$+3 + B3598940 A A12,(04000000) NO, CHANGE TO - B3598950 LN A4,A4 B3598960 XSLT 1,CRFHL,063 FILE FRACTIONAL B3598970 J CAR3F TO EXIT B3598980 CAR15V L A0,CAR A,M A0,1 TNZ RCPF J 0,A0 ERROR RETURN J CHTDV9 . INTEGER RAISED TO POWER B359900 CAR16 TEP A15,(0100000000) B359910 J *CAR DONE IN LINE TV A3,MB 4 $+4 J *CAR 0 ERR B359980 J *CAR THESE ARE DONE IN LINE J CAR1B 2 REAL B360000 J CAR1C 3 DP B360010 J CAR1D 4 COMPLX B360020 . INTEGER RAISED TO REAL POWER B360130 CAR1B LA A0,A4 B360140 LA A1,A5 B360150 LMJ B11,RIRP CONVERT REAL TO REAL B360160 J *CAR B360170 CAR2B TZ NGCN . TEST FOR NEGATIVE FUNCTION ARGUMENT J $+4 JP A4,$+3 A A12,(04000000) -SIGN,OUTPUT B360190 LNA A4,A4 B360200 XSLT 1,CRRHL,023 . INSERT REAL 60210 CAR3B J CAR3F TO EXIT 60220 CAR1C1 SZ A4 B360230 SZ A5 B360240 J CAR3E B360250 . INTEGER RAISED TO DOUBLE PRECISION POWER B360260 CAR1C JZ A4,CAR1C1+1 CONVERT INTEGER TO D.P. BVER3 LSC A0,A4 BVER3 AN,M A1,02043 BVER3 JN A0,$+2 BVER3 LN A1,A1 BVER3 SSC A0,35 BVER3 DSC A0,12 BVER3 CAR1J SA A1,CARTP+1 B360400 LA A1,A1S B360410 SA A0,CARTP B360420 LA A0,0,A1 B360430 TEP A15,(04000000) TEST SIGN OP 2 B060440 LN A0,A0 B360450 SA A0,CARTP+2 B360460 LA A0,3,A1 B360470 TEP A15,(04000000) TEST SIGN OP 2 B060480 LN A0,A0 B360490 SA A0,CARTP+3 B360500 J CAR3Y B360510 . . . DOUBLE PRECISION COMBINATIONS B360540 . CAR31 L,M A0,CARTP LA,M A1,CARTP+2 B360710 J $-1,A3 . SELECT OPERATOR J *CAR . (OR) J *CAR . (AND) J DLOG . EQ J DLOG . NE J DLOG . LT J DLOG . GT J DLOG . GE J DLOG . LE J CAR3A + B360730 J CAR3X . / J CAR3W . * J CAR3YA B360760 CAR3YA TZ,S2 COPND2 . TEST FOR IMMEDIATE CONSTANT J *CAR TV A3,MB 3 $+4 . JUMP ON MODE OF EXPONENT J *CAR B360880 J *CAR J *CAR J CAR3Y B360910 CAR3A DL A4,0,A0 D.P.SUM BVER3 DFA A4,0,A1 BVER3 CAR3E TZ NGCN . TEST FOR NEGATIVE FUNCTION ARGUMENT J $+5 JP A4,$+4 A A12,(04,0) LN A4,A4 B361370 LN A5,A5 B361380 XSLT 2,CRDHL,033 . INSERT DOUBLE 61390 CAR3F LA,M A15,0,A1 FINAL ITEM + SYM 61400 A A15,A12 61410 J *CARX B361420 . PRODUCT D.P. B361430 CAR3W DL A4,0,A0 BVER3 DFM A4,0,A1 BVER3 J CAR3E B361450 . DIVISION D.P. B361580 CAR3X DL A4,0,A0 BVER3 DFD A4,0,A1 BVER3 TNZ RCPF J CAR3E DL A1,A4 DFM A1,CARTP+2 DTE A1,(1.0D) J CHTDV9 J CAR3E B361600 . DOUBLE PRECISION POWER B361750 CAR3Y SX,H2 B11,CAR3YX B361790 LMJ B11,NEXPB$ + CARTP + CARTP+2 NOP 0,0 DL A4,A0 LX B11,CAR3YX REENT J CAR3E B361990 CAR1D LA,M A3,0233 LCF A3,A4 J CAR1H CALCULATE AS REAL TO CPLX. B362090 . REAL OPERAND 1 . . CAR21 L A4,CARTP L A5,CARTP+2 J $-1,A3 . SELECT OPERATOR J ROR . J RAND . J RLOG . EQ J RLOG . NE J RLOG . LT J RLOG . GT J RLOG . GE J RLOG . LE CAR22 J CAR23 + B362190 J CAR25 . / 622000 J CAR24 . * 622100 J CAR27 CAR23 FA A4,A5 REAL + REAL B362230 J CAR2B SEARCH, ETC B362240 CAR24 FM A4,A5 REAL * REAL B362250 J CAR2B B362260 CAR25 FEL A2,A5 REAL/REAL FEL A4,A4 DO IT IN DOUBLE PRECISION DFD A4,A2 TO AVOID TESTING RESIDUE ON 1110 DLM A2,A4 FCL A2,A2 LSSL A3,3 GET LEADING BIT OF LEAST SIGNIF. PART TZ RCPF NON ZERO WHEN CALCULATING RECIPROCAL TNZ A3 IF NON ZERO, ROUND UP TP A3 IS HIGH BIT ON A,M A2,1 TP A4 LN A2,A2 L A4,A2 TNZ RCPF J CAR2B FM A2,CARTP+2 TE A2,(1.0) J CHTDV9 J CAR2B B362280 CAR27 TV A3,MB 4 $+4 . JUMP ON MODE OF EXPONENT J *CAR 0 - B362340 J CAR2J J CAR1F 2 REAL B362360 J CAR1E J CAR1H 4 COMPLX B362380 CAR1E FEL A0,A4 DS A0,CARTP J CAR3Y CAR1F LA A0,A4 REAL TO REAL POWER B362470 LA A1,A5 B362480 LMJ B11,RRRP B362490 J *CAR B362500 J CAR2B B362510 CAR1H SA A4,CARTP REAL TO COMPLEX POWER B362600 SZ CARTP+1 IMAG=0 B362610 LA,M A0,CARTP LOC OF BASE=A0 B362620 DL A1,CARTP+2 REAL PART OF EXPONENT . IMAG PART OF EXPONENT CAR2H LMJ B11,RCCP (CCP)=COMPLEX TO COMPLEX POWER B362650 J *CAR B362660 J CARG3 B362670 CAR2J TLE,M A5,64 IF EXP GT 64, FLOAT J *CAR ERROR L,M A0,0233 LCF A0,A5 FLOAT OF EXP GOES TO A1 L A0,A4 J CAR1F+2 . COMPLEX COMBINATIONS B362690 . . CAR41 LA,M A0,CARTP LA A1,CARTP+2 LA A2,CARTP+3 . SELECT TYPE OF OPERATION B362870 J $-1,A3 . SELECT OPERATOR J *CAR . (OR) J *CAR . (AND) J CEQ . J CNE . J *CAR (LT) J *CAR (GT) J *CAR (GE) J *CAR ((LE) CAR42 J CAR43 + B362890 J CAR45 . / 629000 J CAR44 . * 629100 J CAR46 ** B362920 . SUM COMPLEX B362930 CAR43 LMJ B11,CXA B362940 J *CAR B362950 CARG3 TZ NGCN . TEST FOR NEGATIVE FUNCTION ARGUMENT J $+5 JP A4,$+4 LN A5,A5 B362970 LN A4,A4 B362980 A A12,(04000000) OUTPUT SIGN B362990 XSLT 2,CRCHL,043 INSERT COMPLEX 63000 CARF3 J CAR3F TO EXIT 63010 . PRODUCT COMPLEX B363020 CAR44 LMJ B11,CXP B363030 J *CAR B363040 J CARG3 B363050 . COMPLEX TO POWERS B363100 . CAR46 TV A3,MB 4 $+4 . JUMP ON MODE OF EXPONENT J *CAR 0 ERR B363250 J *CAR J CAR4B 2 REAL B363270 J *CAR 3 DP (ERR) B363280 J CAR2H 4 COMPLX B363290 . . COMPLEX TO REAL POWER B363700 CAR4B LA,M A2,0 B363710 J CAR2H B363720 . . . COMPLEX OPERATORS B363730 . . A0 = LOCATION OF REAL Z2 B363740 . A1 = REAL Z1 [ B363750 . A2 = IMAGINARY Z1 A3 = TEMPORARY B363760 . A4,A5 = RESULT B363770 . ADDITION B363780 CXA LA A3,1,A0 IMAGINARY B363790 FA A3,A2 B363800 LA A4,0,A0 B363810 FA A4,A1 B363820 LA A5,A3 IMAG TO A5 B363830 J 1,B11 B363840 . PRODUCT (COMPLEX) B363850 . USES R1 B363860 CXP LA A3,1,A0 B B363870 FM A3,A1 B*C B3638800 LA A4,0,A0 A B363890 FM A4,A2 D B363900 FA A3,A4 B363910 SA A3,R1 SAVE IMAGIN B363920 LA A3,1,A0 B363930 FM A3,A2 B363940 LA A4,0,A0 B363950 FM A4,A1 C*A B3639600 FAN A4,A3 B363970 LA A5,R1 IMAGIN B363980 J 1,B11 B363990 . COMPLEX DIVISION B364000 . (A,B)/(C,D) CAR45 SX,H2 B11, CAR45X LMJ B11, CDV$ + CARTP + CARTP+2 J *CAR DL A4,A0 LX B11,CAR45X REENT J CARG3 $(2) . REENT A0S + 0 B364680 A1S + 0 B364690 A3S + 0 TEMP STORAGE FOR A3 B364700 A14S + 0 SAVE INPUT OPERAND 1 A15S + 0 SAVE INPUT OPERAND 2 $(1) . REENT . RAISE INTEGER TO REAL POWER B364980 . REGISTERS SAME AS RRRP B364990 . THIS CHANGES MODE OF BASE B365000 RIRP LSC A4,A0 CONVERT INT. TO REAL B365010 SSC A4,35 B365020 AN,M A5,0243 B365030 JB A4,$+2 B365040 LN A5,A5 B365050 DSC A4,9 B365060 LA A0,A4 B365070 J RRRP B365080 . . RAISE FLOATING POINT TO FLOATING POINT POWER B365430 . . A0 = BASE B365440 . A1 = POWER B365450 . A2 = TEMP [ B365460 . A3 = TEMP B365470 . A4 = RESULT B365480 . A5 = TEMP B365490 . R1 = FLAG OF SIGN OF POWER B365500 RRRP SZ A4 TOP A0,(0400400000000) J 1,B11 . 0**N=0 SX,H2 B11,RRR3 DS A0,TEMP LMJ B11,NEXP6$ REAL TO THE REAL POWER + TEMP BASE + TEMP+1 POWER NOP 0,0 LX B11,RRR3 REENT LA A4,A0 B365760 J 1,B11 B365770 RCCP LA A4,0,A0 B365830 SA A4,TEMP B365840 LA A4,1,A0 [ B365850 SA A4,TEMP+1 B365860 DS A1,TEMP+2 SX,H2 B11,RCCPX B365890 LMJ B11,NEXPG$ + TEMP + TEMP+2 NOP 0,0 LX B11,RCCPX REENT DL A4,A0 J 1,B11 B366060 REL L A4,CARTP . EX TABL-2,A3 . J LLV . TABL OR A4,CARTP+2 . AND A4,CARTP+2 . IOR OR A4,A5 . S A3,BMD IOUT L A0,A5 . SLJ CARIN L A15,A2 . J *CARX IAND AND A4,A5 . S A3,BMD SET FOR BOOLEAN RESULT J IOUT . ROR OR A4,A5 . L A4,A5 . J CAR2B . RAND AND A4,A5 . L A4,A5 . J CAR2B . ILOG EX TABR-4,A3 . SZ A8 . J RELV . TABR TE A4,A5 . .EQ. TNE A4,A5 . .NE. TG A4,A5 . .LT. TG A5,A4 . .GT. TNG A4,A5 . GE. TNG A5,A4 . .LE. RLOG FAN A4,A5 . EX TAB1-4,A3 . TEST FOR POS OR NEG . EX TAB2-4,A3 . TEST FOR ZERO OR NON-ZERO SZ A8 . IF FALSE J RELV . TAB1 NOP 0 . EQ NOP 0 . NE TP A4 . LT TN A4 . GT JP A4,RELV . GE JN A4,RELV . LE TAB2 TEP A4,(0400400,0) . EQ TOP A4,(0400400,0) . NE TOP A4,(0400400,0) . LT TOP A4,(0400400,0) . GT TEP A4,(0400400,0) . GE TEP A4,(0400400,0) DLOG DL A4,CARTP . DFAN A4,CARTP+2 . EX DTAB1-4,A3 . TEST FOR + OR - EX DTAB2-4,A3 . TEST FOR 0 OR NON ZERO SZ A8 . J RELV . DTAB1 NOP 0 . EQ NOP 0 NE TP A4 . LT TN A4 . GT JP A4,RELV . GE JN A4,RELV . LE DTAB2 TEP A4,(0400040,0) . EQ TOP A4,(0400040,0) . NE TOP A4,(0400040,0) . LT TOP A4,(0400040,0) . GT TEP A4,(0400040,0) . GE TEP A4,(0400040,0) . LE CEQ L A4,CARTP . FAN A4,CARTP+2 . TEP A4,(0400400,0) J $+4 . L A4,CARTP+1 . FAN A4,CARTP+3 . TEP A4,(0400400,0) SZ A8 . J RELV . CNE L A4,CARTP . FAN A4,CARTP+2 . TEP A4,(0400400,0) J RELV . L A4,CARTP+1 . FAN A4,CARTP+3 . TOP A4,(0400400,0) SZ A8 . RELV L A5,A8 . LLV AND,M A5,1 . A A6,(030200,0) MARK AS LOGICAL CONSTANT L A15,A6 . J *CARX . NORMAL RETURN $(2) CARDP . CARTP . DO 4 , +0 . TEMP STORAGE TEMP . DO 4 , +0 . TEMP STORAGE CNVTX + 0 DPZ + 0207400,0 + 0 SA4 + 0 DAD + 0 . FUNCTION LEVEL DECREMENT, 0 OR 1 BMD +0 NON ZERO FOR BOOLEAN RESULT COMX J $-$ . NORMAL EXIT FOR CARCOM RCCPX +0 REENT CAR3YX +0 REENT CAR45X +0 REENT RRR3 +0 REENT INTSH +0 . HOLDS INDIRECT SHIFT COUNTS LOAD J $-$ REENT J LOADR REENT CARIN J $-$ REENT J CARINR REENT CAR* J $-$ REENT J CARR REENT CNVT* J $-$ REENT J CNVTR REENT CARCOM* J $-$ REENT J CARCMR REENT CARX J $-$ REENT A6S +0 REENT NERRA$* . NERRB$* . NERRC$* . NERR$* J $+1 XERF ERRAX+16 LIB TRIG FUNCTION ABORT J *CAR END