*DECK             EXPGEN
USETEXT   TSOURCE 
USETEXT   TCEXECQ 
USETEXT   TSYMCNS 
USETEXT   TCOM37Q 
USETEXT   TCOM39Q 
USETEXT   TCOM78Q 
USETEXT   TCEXEC
USETEXT   TC7DECS 
PROC EXPGEN((A)); 
BEGIN 
  
  
  
  
*CALL COMEX 
  
  
  
  
ITEM A; #TRIAD POINTER# 
ITEM I,K; 
ITEM IPLUSI,IPLUSJ,IPLUSK;
ITEM IMULI,                                                              JANDRE 
     IDIVI;                                                              JANDRE 
ITEM IRLTI,IRLTJ,IRLTK,IRLTL; 
ITEM LBOPI; 
ITEM PRIMI; 
ITEM VAR,MVAR,CONSTANT,PERE;                                             JANDRE 
ITEM TR1,TR2,TR3,TR4;                                                    JANDRE 
ARRAY [QILOP"LOR":QILOP"LIMP"]S(1); ITEM
    LBOPJ S:QICFOP (0,0,9)=[S"LOR",S"LAND",S"LXOR",S"LEQV",S"LIMP"],
    LBOPL S:QICFOP (0,9,9)=[S"LIMP",S"LNND",S"LEQV",S"LXOR",S"LOR"],
    LBOPM B        (0,18,1)=[F,T,F,F,F] 
    ; 
  
  
ITEM REXPI C(10); 
ITEM RIEXPI,RIEXPJ,RIEXPK;
ITEM UNNORM B; # TRUE IF EXPGEN(LOAD) MAY LEAVE UNNORMALIZED VALUE#      JANDRE 
##  DEF SPECSYMADC # B<59 - "F">OPTION #; 
    DEF J834 #834#;                # SYMABT DIAGNOSTIC 834             # EXPGEN 
    DEF J836 #836#;                # SYMABT DIAGNOSTIC 836             # EXPGEN 
    DEF J864 #864#;                # SYMABT DIAGNOSTIC 864             # EXPGEN 
    DEF J868 #868#;                # SYMABT DIAGNOSTIC 868             # EXPGEN 
  
    XREF PROC ADCON;
    XREF PROC CALOC;
    XREF FUNC CLABL;
    XREF PROC CLSS; 
    XREF FUNC CRAOP; #DEFAULT TRICKS SYMPL# 
    XREF FUNC CRREL B;
    XREF PROC DMPTRD; 
    XREF PROC DHASH;
    XREF PROC EXPOS;                                                     JANDRE 
    XREF FUNC FADCON; 
    XREF PROC FILLTR; 
    XREF PROC FILTRD; 
    XREF PROC FIND; 
    XREF FUNC FYLSTS; 
    XREF FUNC GETRD;
    XREF FUNC GHASH;
    XREF FUNC GTRSP;
    XREF PROC ICFGEN; 
    XREF PROC ICFGNR; 
    XREF FUNC IHASH;
    XREF PROC JOVBIT; 
    XREF PROC JOVBYT; 
    XREF FUNC KFIND;
    XREF PROC KRL00;
    XREF PROC LOAD; 
    XREF PROC MOVET;
    XREF FUNC MSKGEN; 
    XREF PROC MULV6;
    XREF FUNC PLNG; 
    XREF FUNC PSCARY; 
    XREF FUNC PSCPRC; 
    XREF FUNC PSICON; 
    XREF PROC PSICONS;                                                   JANDRE 
    XREF FUNC PTWO; 
    XREF PROC REPRC;
    XREF PROC SADCON; 
    XREF PROC SAVESV; 
    XREF PROC SVSTIX; 
    XREF PROC SLOD; 
    XREF PROC SLODL;
    XREF FUNC SOPND;
    XREF PROC SPTWO;
    XREF PROC SYMABTL;                                                   EXPGEN 
    XREF PROC SYMBIT; 
    XREF PROC SYMBYT; 
    XREF FUNC TMPGEN; 
    XREF PROC TMPRLS; 
      XREF FUNC KCT00;
CONTROL EJECT;
FUNC PCKOPN((I)); 
BEGIN 
    ITEM I # TRIAD INDEX#,
         J; 
    J=MEMR[I];
    IF KFLG[I] THEN 
         BEGIN
         J=KONS[I]; 
         K=ABS(J);
         IF K GQ O"400000" THEN 
         BEGIN
         B<0,12>K=O"2000";
         IF J LS 0 THEN K=-K; 
         PCKOPN=PSICON(K);
         RETURN;
         END
              ELSE # SMALL INTEGER: SX AND PACK IN-LINE # 
              BEGIN 
              PFLG[I]=F;
              J=PSICON(J);
              END 
         END
    PCKOPN=J; 
    IF NOT PFLG[I] THEN 
         BEGIN
         ICFGEN(QICFOP"PACK",J,0);
         PCKOPN=ICFPTR; 
         END
END 
DEF PCKOPNS # MLP=PCKOPN(LOP);MRP=PCKOPN(ROP) #; #PACK OPERANDS#         JANDRE 
CONTROL EJECT;                                                           JANDRE 
                                                                         JANDRE 
PROC FETCH((I)); ITEM I;
   BEGIN                                                                 JANDRE 
         PRIMI=ICFPTR;                                                   JANDRE 
         LOAD(I);                                                        JANDRE 
         IF PRIMI NQ ICFPTR THEN MEMR[I]=ICFPTR;                         JANDRE 
   END #FETCH#                                                           JANDRE 
##       CONTROL EJECT; 
  
    SWITCH    OPSW:QILOP
              LBOP:LOR, 
              LBOP:LAND,
              LBOP:LXOR,
              LBOP:LEQV,
              LBOP:LIMP,
              COMP:COMP,
              COMP:IMNUS, 
              COMP:RMNUS, 
              IPLUS:IPLUS,
              ISUB:ISUB,
              IABS:IABS,
              IABS:RABS,
              PLUSR:PLUSR,
              RPLUS:RPLUS,
              DIFFR:DIFFR,
              RSUB:RSUB,
              IMUL:IMUL,
              MULR:MULR,
              RMUL:RMUL,
              IDIV:IDIV,
              DIVR:DIVR,
              RDIV:RDIV,
              IRLTEL:IEQU,
              IRLTEL:INEQ,
              IRLTNL:ILES,
              IRLTNL:IGRT,
              IRLTNL:ILEQ,
              IRLTNL:IGRQ,
              RRLTEL:REQU,
              RRLTEL:RNEQ,
              RRLTNL:RLES,
              RRLTNL:RGRT,
              RRLTNL:RLEQ,
              RRLTNL:RGRQ,
              SUBS:SUBS,
              PRIM:PRIM,
              NULL:NULL,
              FUNI:FUNI,
              FLST:FLST,
              JOVY:VALB,           #ILLEGAL -- GLOBAL OPTIMIZER INST   #
              JOVY:VALU,           #ILLEGAL -- GLOBAL OPTIMIZER INST   #
              FLST:PLST, #FUNCTION PLST#
              FCAL:FCAL 
              ,IUEXP:ICEXP
              ,RIEXP:RIEXP
              ,RREXP:RREXP
              ,CRLTEL:CEQU
              ,CRLTEL:CNEQ
              ,CRLTNL:CLES
              ,CRLTNL:CGRT
              ,CRLTNL:CLEQ
              ,CRLTNL:CGRQ
              ,JOVY:FMNUS,                                               JANDRE 
               JOVY:FABS,                                                JANDRE 
               JOVY:IMOD,                                                JANDRE 
               JOVY:FPLUS,                                               JANDRE 
               JOVY:FSUB,                                                JANDRE 
               JOVY:FMUL,                                                JANDRE 
               JOVY:FDIV,                                                JANDRE 
               JOVY:FCEXP,                                               JANDRE 
               JOVY:FEQU,                                                JANDRE 
               JOVY:FNEQ,                                                JANDRE 
               JOVY:FLES,                                                JANDRE 
               JOVY:FGRT,                                                JANDRE 
               JOVY:FLEQ,                                                JANDRE 
               JOVY:FGRQ,                                                JANDRE 
               JOVY:EEQU,                                                JANDRE 
               JOVY:ENEQ                                                 JANDRE 
              ; 
    CONTROL EJECT;                                                       JANDRE 
     I=A;                                                                JANDRE 
    IF OPTR[I] EQ S"PRIM" THEN # QUICK ACTION WHEN CONST/PRIM #          JANDRE 
               BEGIN                                                     JANDRE 
               IF NOT KFLG[I] THEN                                       JANDRE 
                 BEGIN                                                   JANDRE 
                 QREP[I]=QREP[I] AND QREP[NXOP[I]];                      JANDRE 
                 FETCH(I);                                               JANDRE 
                 END                                                     JANDRE 
                 $BEGIN                                                  JANDRE 
                    DMPTRD(I);                                           JANDRE 
                 $END                                                    JANDRE 
               RETURN;                                                   JANDRE 
               END                                                       JANDRE 
    I=NXOP[A];                                                           JANDRE 
    UNNORM=QREP[I];                                                      JANDRE 
      SDFG[I]=1;                                                         JANDRE 
                                                                         JANDRE 
TR10:    QREP[A]=UNNORM AND QREP[A];                                     JANDRE 
         UNNORM=QREP[A];                                                 JANDRE 
         IF LOPD[A] EQ 0 THEN GOTO AE10;                                 JANDRE 
                          ELSE BEGIN #TRACE DOWN LEFT NODE#              JANDRE 
                                     A=LOPD[A];                          JANDRE 
                                     GOTO TR10;                          JANDRE 
                               END                                       JANDRE 
                                                                         JANDRE 
AE30: #RETURN TO SET MEMR #                                              JANDRE 
     MEMR[TRX]=ICFPTR;                                                   JANDRE 
                                                                         JANDRE 
AE40: # ALTERNATE RETURN FOR NON MEMR-SETTING #                          JANDRE 
     $BEGIN                                                              JANDRE 
        DMPTRD(TRX);                                                     JANDRE 
    $END                                                                 JANDRE 
                                                                         JANDRE 
NULL:                                                                    JANDRE 
FLST:                                                                    JANDRE 
AE80: # BACK UP TO PARENT NODE #                                         JANDRE 
    A=PERE;                                                              JANDRE 
    IF A EQ 0 THEN GOTO AE10;                                            JANDRE 
    IF SDFG[A] NQ 0 THEN SDFG[A]=0;                                      JANDRE 
                    ELSE BEGIN                                           JANDRE 
                               GOTO TW20;                                JANDRE 
                         TW10: QREP[A]=UNNORM AND QREP[A];               JANDRE 
                               UNNORM=QREP[A];                           JANDRE 
                               IF LOPD[A] NQ 0 THEN                      JANDRE 
                                               BEGIN                     JANDRE 
                                                   A=LOPD[A];            JANDRE 
                                                   GOTO TW10;            JANDRE 
                                               END                       JANDRE 
                         TW20: IF ROPD[A] NQ 0 THEN                      JANDRE 
                                               BEGIN                     JANDRE 
                                               SDFG[A]=1;                JANDRE 
                                               A=ROPD[A];                JANDRE 
                                               GOTO TW10;                JANDRE 
                                               END                       JANDRE 
                         END                                             JANDRE 
                                                                         JANDRE 
AE10:                                                                    JANDRE 
    $BEGIN                                                               JANDRE 
         DMPTRD(A);                                                      JANDRE 
    $END                                                                 JANDRE 
    IF A EQ I THEN BEGIN                                                 JANDRE 
                         RETURN;                                         JANDRE 
                   END                                                   JANDRE 
    TRX=A;                                                               JANDRE 
    PERE=NXOP[TRX];                                                      JANDRE 
    LOP=LOPD[TRX];
    ROP=ROPD[TRX];
    MLP=MEMR[LOP];
    MRP=MEMR[ROP];
    KBL=FALSE;
    IF KFLG[ROP] THEN 
         BEGIN # RIGHT OPERAND CONSTANT # 
         KBL=T; 
         KDS=0; 
         KVL=KONS[ROP]; 
             VAR =LOP;                                                   JANDRE 
             MVAR=MLP;                                                   JANDRE 
         END
    ELSE
    IF KFLG[LOP] THEN 
         BEGIN # LEFT OPERAND CONSTANT #
         KBL=T; 
         KDS=1; 
         KVL=KONS[LOP]; 
             VAR =ROP;                                                   JANDRE 
             MVAR=MRP;                                                   JANDRE 
         END
    OPT=OPTR[TRX];
    GOTO OPSW[OPT]; 
  
    SWITCH LBOPSW  LBOO,LBZR,LBOO,LBCO,LBLP;
                  #LOR ,LAND,LXOR,LEQV,LIMP#
  
    SWITCH LBOPSZ  LBZZ,LBOO,LBCO,LBOO,LBLP;
                  #LOR ,LAND,LXOR,LEQV,LIMP#
  
    SWITCH LBOPSX  LBOO,LBOO,LBZR,LBMZ,LBMZ;
                  #LOR ,LAND,LXOR,LEQV,LIMP#
  
LBOP: #LOGICAL BINARY OPERATION#
    IF KBL THEN 
         BEGIN #ONE CONSTANT OPERAND# 
         IF KVL EQ 0 THEN 
            IF B<0>KVL EQ 0 THEN GOTO LBOPSW[OPT-QILOP"LOR"]; 
                           ELSE GOTO LBOPSZ[OPT-QILOP"LOR"]; #MINUS 0#
         LBOPI=PSICON(LNO KVL); 
         IF CONL[MOP[1-KDS]] GR CONL[LBOPI] AND 
            (OPT NQ QILOP"LIMP" OR KDS EQ 0) THEN 
              BEGIN #CAN USE COMPLEMENTED CONSTANT# 
              ICFGEN(LBOPL[OPT],LBOPI,MOP[KDS]);
              IF LBOPM[OPT] THEN TTST[TRX]=T; 
              GOTO AE30;
              END 
         END
    IF QREP[TRX] THEN # TRY TO OPERATE IN SITU #                         JANDRE 
         IF OPTR[PERE] NQ QILOP"REPL" # ONLY ONE OPTIM DONE TODAY #      JANDRE 
              THEN BEGIN #  OPERAND ARE NOT NORMALIZED - DO IT #         JANDRE 
LOGUNO:            POS=0;                                                JANDRE 
          FBT = EFBT[LOP];                                               L414 
          NBT = ENBT[LOP];                                               L414 
                   EXPOS(MLP);                                           JANDRE 
          MLP = ICFPTR;                                                  L414 
          FBT = EFBT[ROP];                                               L414 
          NBT = ENBT[ROP];                                               L414 
                   EXPOS(MRP);                                           JANDRE 
          MRP = ICFPTR;                                                  L414 
                   UNNORM=FALSE;                                         JANDRE 
                   QREP[PERE]=FALSE;                                     JANDRE 
                   END                                                   JANDRE 
              ELSE BEGIN # TRY TO AVOID SHIFTS.   SINK = LOP OP ROP #    JANDRE 
                   TR1=ENBT[OBJX];    #OBJX = SINK OBJECT TRIAD #        JANDRE 
                   TR4=EFBT[OBJX];                                       JANDRE 
                   TR2=ENBT[LOP];                                        JANDRE 
                   TR3=ENBT[ROP];                                        JANDRE 
                   IF TR1 GR TR2 OR TR1 GR TR3                           JANDRE 
                      THEN # BETTER TO EXPOS # GOTO LOGUNO;              JANDRE 
                   IF EFBT[LOP]+TR2 EQ EFBT[ROP]+TR3                     JANDRE 
                   THEN BEGIN # PERFORM OP- REPL WILL SHIFT IF NEEDED #  JANDRE 
                        EFBT[TRX]=EFBT[LOP];                             JANDRE 
                        ENBT[TRX]=TR2;                                   JANDRE 
                        END                                              JANDRE 
                   ELSE                                                  JANDRE 
                   BEGIN # SHIFT FIRST, PERFORM OPERATION AFTER #        JANDRE 
                   TR2=EFBT[LOP]+TR2-(TR4+TR1);  # SHIFT COUNTS #        JANDRE 
                   TR3=EFBT[ROP]+TR3-(TR4+TR1);                          JANDRE 
                   IF TR2 NQ 0 THEN                                      JANDRE 
                        BEGIN # SHIFT LEFT OPERAND TO RIGHT BIT OF SINK# JANDRE 
                        IF TR2 LS 0 THEN TR2=TR2+60;                     JANDRE 
                        ICFGEN(QICFOP"LSHC",MLP,TR2);                    JANDRE 
                        MLP=ICFPTR;                                      JANDRE 
                        END                                              JANDRE 
                   IF TR3 NQ 0 THEN                                      JANDRE 
                        BEGIN # SHIFT RIGHT OPERAND #                    JANDRE 
                        IF TR3 LS 0 THEN TR3=TR3+60;                     JANDRE 
                        ICFGEN(QICFOP"LSHC",MRP,TR3);                    JANDRE 
                        MRP=ICFPTR;                                      JANDRE 
                        END                                              JANDRE 
                   EFBT[TRX]=TR4;                                        JANDRE 
                   ENBT[TRX]=TR1;                                        JANDRE 
                   END                                                   JANDRE 
                   END                                                   JANDRE 
    IF MLP EQ MRP THEN GOTO LBOPSX[OPT-QILOP"LOR"]; 
LBMZ: 
    ICFGEN(LBOPJ[OPT],MLP,MRP); 
    GOTO AE30;
  
LBZR: #RESULT IS ZERO#
    MEMR[TRX]=PZERO;
    LBZE:OPTR[TRX]=QILOP"PRIM"; 
    FILLTR(TRX);
    GOTO AE40;
  
LBOO: #RESULT IS OTHER OPERAND# 
   MOVET(VAR,TRX);                                                       JANDRE 
    GOTO AE40;
  
LBCO: #RESULT IS COMPLEMENT OF OTHER OPERAND# 
   ICFGEN(QICFOP"COMP",MVAR,0);                                          JANDRE 
   IF UNNORM THEN                                                        JANDRE 
         BEGIN                                                           JANDRE 
              EFBT[TRX]=EFBT[VAR];                                       JANDRE 
              ENBT[TRX]=ENBT[VAR];                                       JANDRE 
         END                                                             JANDRE 
    GOTO AE30;
  
LBLP: #LIMP IS NOT COMMUTATIVE# 
    IF B<0>KVL EQ 0 THEN
       IF KDS EQ 0 THEN GOTO LBCO; # I LIM 0 #
                   ELSE GOTO LBZZ; # 0 LIM I #
       IF KDS NQ 0 THEN GOTO LBOO; #-0 LIM I #
                #ELSE#             # I LIM-0 #
  
    LBZZ: #RESULT IS MINUS ZERO#
         MEMR[TRX]=MZERO; 
         GOTO LBZE; 
  
IPLUS:  
    IF QREP[TRX] THEN                                                    JANDRE 
         BEGIN # ADD/SUB IN SITU #                                       JANDRE 
         IF KVL EQ 0 THEN GOTO LBOO;                                     JANDRE 
IPLUSQ:  CONSTANT=0;                                                     JANDRE 
         IPLUSI= EFBT[VAR]; EFBT[TRX]=EFBT[VAR];                         JANDRE 
         IPLUSJ=IPLUSI+ENBT[VAR]; ENBT[TRX]=ENBT[VAR];                   JANDRE 
         B<0,IPLUSJ>CONSTANT=KVL; # EXTEND SIGN #                        JANDRE 
         KVL=CONSTANT;                                                   JANDRE 
         IF ABS(CONSTANT) LS O"200000" AND IPLUSI GQ 42 THEN             JANDRE 
              BEGIN # SMALL CONSTANT IN SITU #                           JANDRE 
              ICFGEN(QICFOP"ADSC",MVAR,PSICON(CONSTANT));                JANDRE 
              GOTO AE30;                                                 JANDRE 
              END                                                        JANDRE 
         IPLUSI=0;                                                       JANDRE 
         GOTO IPLUS21; # ADD/SUB WITH THE BEST CONSTANT GEN #            JANDRE 
         END # QUICK #                                                   JANDRE 
    IF KBL THEN 
         BEGIN #ONE OPERAND IS CONSTANT#
         IF KVL EQ 0 THEN GOTO LBOO;
         TTST[TRX]=TRUE;
         IF ABS(KVL) LS O"200000" THEN
              BEGIN 
              IPLUSJ=ENBT[VAR]-17;                                       JANDRE 
              IF IPLUSJ NQ -17 AND                                       JANDRE 
                   (IPLUSJ LS 0 OR IPLUSJ EQ 0 AND $IGN[VAR])            JANDRE 
              THEN
                   BEGIN
                   ICFGEN(QICFOP"ADSC",MVAR,MOP[1-KDS]);                 JANDRE 
                   GOTO AE30; 
                   END
              END # ABS LS O"200000" #
IPLUS20: IPLUSI=0; IPLUSJ=60;                                            JANDRE 
IPLUS21:                                                                 JANDRE 
         IPLUSK=1;                                                       JANDRE 
         PSICONS(KVL,IPLUSI,IPLUSJ,IPLUSK,IPLUSI);                       JANDRE 
         ICFGEN(ADOP[IPLUSK],MOP[KDS],IPLUSI);
         GOTO AE30; 
         END
    ICFGEN(QICFOP"IADD",MLP,MRP); 
    TTST[TRX]=TTST[LOP] OR TTST[ROP]; 
    GOTO AE30;
  
ISUB: 
    IF KBL THEN 
         BEGIN #ONE OPERAND IS CONSTANT#
         IF KVL EQ 0 THEN 
              BEGIN 
              IF KDS EQ 0 THEN GOTO LBOO; 
              GOTO LBCO;
              END 
ISUB10: 
         TTST[TRX]=TRUE;
         IF KDS EQ 0 THEN 
              BEGIN # 2ND OPERAND CONSTANT #
              IF ABS(KVL) LS O"200000" THEN 
                   BEGIN
                   IPLUSI=ENBT[LOP]  -17; 
                   IF IPLUSI NQ -17 AND 
                        (IPLUSI LS 0 OR IPLUSI EQ 0 AND $IGN[LOP])
                   THEN 
                        BEGIN 
                        ICFGEN(QICFOP"ADSC",MLP,PSICON(-KVL));
                        GOTO AE30;
                        END # ADSC #
                   END
              KVL=-KVL; 
              GOTO IPLUS20; # MAY BE ABLE TO USE CONVERTED CONSTANT # 
              END # KDS EQ 0 #
         END
ISUB20: 
    IF MLP EQ MRP THEN GOTO LBZR; 
    ICFGEN(QICFOP"ISUB",MLP,MRP); 
    TTST[TRX]=TTST[LOP];
    GOTO AE30;
  
COMP: #UNARY COMPLEMENTATION# 
    ICFGEN(QICFOP"COMP",MLP,0); 
    IF UNNORM THEN MOVET(LOP,TRX);                                       JANDRE 
    GOTO AE30;
  
IABS: #ABSOLUTE VALUE#
    ICFGEN(QICFOP"RSHC",MLP,59);
    ICFGEN(QICFOP"LXOR",MLP,ICFPTR);
    TTST[TRX]=TRUE; 
    GOTO AE30;
  
IMOD: #MOD FUNCTION#
      # MOD FUNCTION NOT CURRENTLY IMPLEMENTED IN SYNTAX, 
      CODE LEFT FOR LATER USE#
      $BEGIN
      ITEM IMODI,IMODJ,IMODK;                                            JANDRE 
    IMODI=MLP;
    IMODK=MLP;
    IF PFLG[LOP] THEN 
         BEGIN
         ICFGEN(QICFOP"UNPK",MLP,0);
         IMODK=ICFPTR;
         END
    ELSE BEGIN
         IF KFLG[LOP] AND KONS[LOP] EQ 0 THEN GOTO LBZR;
         IMODI=PCKOPN(LOP); 
         END
    #IMODI=PACKED VALUE, IMODK=UNPACKED VALUE#
    IMODJ=PCKOPN(ROP);
    #IMODJ=PACKED VALUE#
    IF KFLG[ROP] THEN 
         BEGIN
         ITEM IMODR R;
         IMODR=KONS[ROP]; #CONVERT# 
         ICFGEN(QICFOP"FDIV",IMODI,PSICON(IMODR));
         END
    ELSE BEGIN
         ICFGEN(QICFOP"NORM",IMODJ,0);
         ICFGEN(QICFOP"FDIV",IMODI,ICFPTR); 
         END
    ICFGNR(QICFOP"UNPB",-1,0);
    ICFGNR(QICFOP"SELB",-1,0);
    ICFGNR(QICFOP"LSHV",-1,-2); 
    ICFGNR(QICFOP"PACK",-1,0);
    ICFGEN(QICFOP"DMUL",ICFPTR,IMODJ);
    ICFGNR(QICFOP"UNPK",-1,0);
    ICFGEN(QICFOP"ISUB",IMODK,ICFPTR);
    TTST[TRX]=TRUE; 
    GOTO AE30;
      $END
JOVY: #JOVIAL ONLY OPERATORS#                                            JANDRE 
      SYMABTL(J868,"ILLEGAL IL OP VALUE(EXPGEN) LINE XXXXX",38,LINUM);   EXPGEN 
  
PLUSR:  
    ROUN[TRX]=1;
  
RPLUS:  
    IF KBL AND KVL EQ 0 THEN GOTO LBOO; 
    ICFGEN(RAOP[ROUN[TRX]],MLP,MRP);
    ICFGNR(QICFOP"NORM",-1,0);
    TTST[TRX]=TRUE; 
    GOTO AE30;
  
DIFFR:  
    ROUN[TRX]=1;
  
RSUB: 
    IF KBL AND KVL EQ 0 THEN
         BEGIN
         IF KDS EQ 0 THEN GOTO LBOO;
         GOTO LBCO; 
         END
    IF MLP EQ MRP THEN GOTO LBZR; 
    ICFGEN(RSOP[ROUN[TRX]],MLP,MRP);
    ICFGNR(QICFOP"NORM",-1,0);
    TTST[TRX]=TRUE; 
    GOTO AE30;
  
    SWITCH IMULSW IMUL00,IMUL10,IMUL20,IMUL30;
IMUL: #INTEGER MULTIPLY#
    IF INDX[TRX] NQ 0 THEN
         BEGIN #VARIABLE-LENGTH SHIFT#
         IMULI=LOP; 
         IF OFFS[TRX] EQ LOP THEN IMULI=ROP;
         #IMULI IS SHIFTED OPERAND PTR# 
         IF PFLG[IMULI] THEN
              BEGIN #UNPACK VARIABLE# 
              ICFGEN(QICFOP"UNPK",MEMR[IMULI],0); 
              MEMR[IMULI]=ICFPTR; 
              END 
         ICFGEN(QICFOP"LSHV",INDX[TRX],MEMR[IMULI]);
         GOTO AE30; 
         END
    IF KBL THEN 
         BEGIN
         IF KVL EQ 0 THEN GOTO LBZR;
         SPTWO(KVL);
         IF SPTWOC NQ 0 THEN
              BEGIN #SHIFT/ADD CODE#
              TTST[TRX]=TTST[TOP[KDS]] AND NOT $IGN[TOP[1-KDS]];
              IF PFLG[TOP[KDS]] THEN
                   BEGIN #UNPACK VARIABLE#
                   ICFGEN(QICFOP"UNPK",MOP[KDS],0); 
                   MOP[KDS]=ICFPTR; 
                   PFLG[TOP[KDS]]=FALSE;
                   END
              GOTO IMULSW[SPTWOC];
              END 
         END
IMUL00: 
    TTST[TRX]=TRUE; 
    #NOTE - TO PULL THE IMUL CODE OUT, JUST YANK THIS IDENT            #
    PFLG[TRX] = FALSE;
    IF KFLG[LOP]
        THEN MLP = PSICON(KONS[LOP]); 
        ELSE MLP = MEMR[LOP]; 
    IF KFLG[ROP]
        THEN MRP = PSICON(KONS[ROP]); 
        ELSE MRP = MEMR[ROP]; 
    ICFGEN(QICFOP"DMUL",MLP,MRP); 
    GOTO AE30;
IMUL10:  #POWER OF TWO# 
         IF KVL EQ 1 THEN GOTO LBOO;
         IF SPTWO1 NQ 0 THEN
              BEGIN 
              IF SPTWO1 EQ 1 THEN ICFGEN(QICFOP"IADD",MOP[KDS], 
                             MOP[KDS]); 
              ELSE                ICFGEN(QICFOP"LSHC",MOP[KDS],SPTWO1); 
IMUL15:       MOP[KDS]=ICFPTR;
          MVAR = ICFPTR;                                                 L428 
              END 
         IF KVL LS 0 THEN GOTO LBCO;
         MEMR[TRX]=MOP[KDS];
         GOTO AE40; 
IMUL20:  #SUM OF POWERS OF TWO# 
         IF SPTWO2 EQ 1 THEN
              BEGIN #MORE PARALLELISM#
              ICFGEN(QICFOP"IADD",MOP[KDS],MOP[KDS]); 
              ICFGEN(QICFOP"LSHC",MOP[KDS],SPTWO1); 
              ICFGNR(QICFOP"IADD", -1,-2);
              END 
         ELSE BEGIN 
              ICFGEN(QICFOP"LSHC",MOP[KDS],SPTWO1-SPTWO2);
              ICFGEN(QICFOP"IADD",ICFPTR,MOP[KDS]); 
              IF SPTWO2 NQ 0 THEN ICFGNR(QICFOP"LSHC",-1,SPTWO2); 
              END 
         GOTO IMUL15; 
IMUL30:  #DIFFERENCE OF POWERS OF TWO#
         IF SPTWO2 EQ 1 THEN
              BEGIN #MORE PARALLELISM#
              ICFGEN(QICFOP"IADD",MOP[KDS],MOP[KDS]); 
              ICFGEN(QICFOP"LSHC",MOP[KDS],SPTWO1); 
              IF KVL LS 0 THEN ICFGNR(QICFOP"ISUB",-2,-1);
              ELSE             ICFGNR(QICFOP"ISUB",-1,-2);
              GOTO AE30;
              END 
         ICFGEN(QICFOP"LSHC",MOP[KDS],SPTWO1-SPTWO2); 
         IF KVL LS 0 THEN ICFGEN(QICFOP"ISUB",MOP[KDS],ICFPTR); 
         ELSE             ICFGEN(QICFOP"ISUB",ICFPTR,MOP[KDS]); 
         IF SPTWO2 NQ 0 THEN ICFGNR(QICFOP"LSHC",-1,SPTWO2);
         GOTO AE30; 
  
MULR: 
    ROUN[TRX]=1;
  
RMUL: #REAL MULTIPLY-ENTERED BY RDIV FOR CONSTANT DIVISOR#
    TTST[TRX]=TRUE; 
    IF KBL THEN 
         BEGIN
         IF KVL EQ 0 THEN GOTO LBZR;
         IF CRREL(KVL,1.0,QRLTL"EQ") THEN GOTO LBOO;
         IF CRREL(KVL,2.0,QRLTL"EQ") THEN 
              BEGIN 
              ICFGEN(RAOP[ROUN[TRX]],MOP[KDS],MOP[KDS]);
              ICFGNR(QICFOP"NORM",-1,0);
              GOTO AE30;
              END 
         END
    ICFGEN(RMOP[ROUN[TRX]],MLP,MRP);
    GOTO AE30;
  
IDIV: #INTEGER DIVIDE-RESULT IS INTEGER#
    IF INDX[TRX] NQ 0 THEN
         BEGIN #VARIABLE-LENGTH SHIFT#
         IF PFLG[LOP] THEN
              BEGIN #UNPACK VARIABLE# 
              ICFGEN(QICFOP"UNPK",MLP,0); 
              MLP=ICFPTR; 
              END 
         ICFGEN(QICFOP"RSHV",INDX[TRX],MLP);
         GOTO AE30; 
         END
    IF KBL THEN 
         BEGIN
         IF KVL EQ 0 THEN 
              BEGIN 
              IF KDS NQ 0 THEN GOTO LBZR; 
              SYMABTL(-J834,"ZERO DIVIDE ATTEMPT(EXPGEN) LINE XXXXX",38, EXPGEN 
                     LINUM);                                             EXPGEN 
              GOTO IDIV00;
              END 
         IF KDS EQ 0 THEN 
              BEGIN     #DIVISOR IS CONSTANT# 
              IF KVL EQ 1 THEN GOTO LBOO; 
              IDIVI=PTWO(ABS(KVL)); 
              IF IDIVI GQ 0 THEN
                   BEGIN
                   IF PFLG[LOP] THEN
                        BEGIN 
                        ICFGEN(QICFOP"UNPK",MLP,0); 
                        MLP=ICFPTR; 
                        END 
                   IF IDIVI NQ 0 THEN 
                        BEGIN 
                        ICFGEN(QICFOP"RSHC",MLP,IDIVI); 
                        MLP=ICFPTR; 
                        END 
                   IF KVL LS 0 THEN GOTO LBCO;
                   MEMR[TRX]=MLP; 
                   GOTO AE40; 
                   END
              ITEM IDIVR R; 
              MLP=PCKOPN(LOP);                                           JANDRE 
              IF OPTR[LOP] NQ S"PRIM" OR ENBT[LOP] GQ 21
                 OR KVL NQ 10 THEN # REGULAR CASE # 
              BEGIN                                                      JANDRE 
              IDIVR=KVL; #CONVERT#
              IF IDIVR GQ 0 AND B<18,42>IDIVR EQ 0                       JANDRE 
              THEN BEGIN # AVOID FETCH #                                 JANDRE 
                   ICFGEN(QICFOP"LSHC",PSICON(B<0,18>IDIVR),42);         JANDRE 
                   KVL=ICFPTR;                                           JANDRE 
                   END                                                   JANDRE 
              ELSE KVL=PSICON(IDIVR);                                    JANDRE 
              ICFGEN(QICFOP"FDIV",MLP,KVL);                              JANDRE 
              GOTO IDIV10;
              END 
              # ELSE MULTIPLY BY (0.10+EPSILON) #                        JANDRE 
               ICFGEN(QICFOP"FMUL",MLP,PSICON(TENTH));                   JANDRE 
               ICFGNR(QICFOP"BXND",-1,0);                                JANDRE 
               GOTO AE30;                                                JANDRE 
              END                                                        JANDRE 
         END
    IF MLP EQ MRP THEN
         BEGIN
IDIV00: 
         MEMR[TRX]=PONE;
         KONS[TRX]=1; 
         KFLG[TRX]=TRUE;
         TTST[TRX]=TRUE;
         ENBT[TRX]=1; 
         GOTO AE40; 
         END
    PCKOPNS;
    ICFGEN(QICFOP"NORM",MRP,0); 
    ICFGEN(QICFOP"FDIV",MLP,ICFPTR);
IDIV10: 
    ICFGNR(QICFOP"UNPB",-1,0);
    ICFGNR(QICFOP"SELB",-1,0);
    ICFGNR(QICFOP"LSHV",-1,-2); 
    GOTO AE30;
  
DIVR: 
    ROUN[TRX]=1;
  
RDIV: #REAL DIVIDE# 
    IF KBL THEN 
         BEGIN
         IF KDS EQ 0 THEN 
              BEGIN #DIVISOR IS CONSTANT# 
              IF KVL NQ 0 THEN
                   BEGIN #RECIPROCAL MULTIPLY#
                   KVL=CRAOP(1.0,KVL,QAOP"DIV");
                   MRP=PSICON(KVL); 
                   GOTO RMUL; 
                   END
              #ZERO DIVIDE# 
              SYMABTL(-J834,"ZERO DIVIDE ATTEMPT(EXPGEN) LINE XXXXX",38, EXPGEN 
                     LINUM);                                             EXPGEN 
              GOTO RDIV00; #REPLACE WITH 1.0# 
              END #CONSTANT DIVISOR#
         IF KVL EQ 0 THEN GOTO LBZR;
         END
    TTST[TRX]=TRUE; 
    IF MLP EQ MRP THEN
RDIV00:  BEGIN
         MEMR[TRX]=PSICON(1.0); 
         KONS[TRX]=KFIND(MEMR[TRX]);
         KFLG[TRX]=TRUE;
         GOTO AE40; 
         END
    ICFGEN(RDOP[ROUN[TRX]],MLP,MRP);
    GOTO AE30;
CONTROL EJECT;
PROC SWPOPNS; #SWAP OPERANDS# 
BEGIN 
    ITEM I; 
  
    I=LOP;
    LOP=ROP;
    ROP=I;
    I=MLP;
    MLP=MRP;
    MRP=I;
    KDS=1-KDS;
    RLTL[TRX]=RSWP[RLTL[TRX]];
END 
  
IRLTNL: #INTEGER NON-EQNQ RELATIONAL# 
    IRLTI=RLTL[TRX];
    IF MLP GR 0 AND CLAS[MLP] EQ S"FILE" THEN 
                   GOTO JOVY;                                            JANDRE 
    IF KBL THEN 
         BEGIN #ONE OPERAND IS CONSTANT#
         IF KVL NQ 0 THEN 
              BEGIN #NON-ZERO CONSTANT# 
                   IRLTJ=NRLT[IRLTI,1-KDS]; #NEW RELATIONAL#
                   IRLTK=INCR[IRLTI,1-KDS]+KVL;#NEW CONSTANT# 
                   IRLTL=PSICON(IRLTK); 
                   IF CONL[MOP[1-KDS]] GR CONL[IRLTL] THEN
                        BEGIN #CONVERT TO BETTER CONSTANT#
                        IRLTI=IRLTJ;
                        KVL=IRLTK;
                        MOP[1-KDS]=IRLTL; 
                        RLTL[TRX]=IRLTJ;
                        IF KVL EQ 0 THEN GOTO IRLT10; 
                        END 
                   IF SWOP[IRLTI] THEN SWPOPNS; 
                   GOTO ISUB10; #GENERATE SUBTRACT# 
              END 
IRLT10:  #ONE OPERAND IS ZERO#
         IF KDS NQ 0 THEN SWPOPNS;
         GOTO LBOO; 
         END
    #NEITHER OPERAND IS CONSTANT# 
    IF SWOP[IRLTI] THEN SWPOPNS;
    GOTO ISUB20;
  
IRLTEL: #EQNQ RELATIONAL# 
    IF MLP GR 0 AND CLAS[MLP] EQ S"FILE" THEN 
                   GOTO JOVY;                                            JANDRE 
    IF (KBL AND KDS NQ 0) THEN SWPOPNS; 
    GOTO ISUB;
  
RRLTNL: #REAL NON-EQNQ RELATIONAL#
    IF SWOP[RLTL[TRX]] THEN SWPOPNS;
    GOTO RSUB;
  
RRLTEL: #EQNQ RELATIONAL# 
    IF (KBL AND KDS NQ 0) THEN SWPOPNS; 
    GOTO RSUB;
  
SUBS: #SUBSCRIPTED VALUE# 
             # INHIBIT LOAD OF SUBSCRIPTED ARRAY NAMES AS PARAMS    # 
            IF KLSS[TRX] EQ S"ADDR" 
            AND ( OPTR[PERE] EQ QILOP"PLST" 
                  OR OPTR[PERE] EQ QILOP"FCAL"
                  OR OPTR[PERE] EQ QILOP"PCAL"  )     THEN
             GOTO AE40; 
  
    INDX[LOP]=MRP;
SUBS00: #FUNIBIT ENTRY# 
    MOVET(LOP,TRX); 
    IF KLSS[TRX] EQ S"SOURCE" THEN LOAD(TRX); 
    UNNORM=QREP[NXOP[TRX]]; # RESET AS BEFORE SUBS #                     JANDRE 
    GOTO AE40;
  
PRIM: #PRIMITIVE OPERAND# 
    IF KFLG[TRX] THEN GOTO AE40;                                         JANDRE 
    IF KLSS[TRX] EQ S"SOURCE" THEN
         FETCH(TRX);                                                     JANDRE 
    GOTO AE40;
  
  
ITEM FUNII,FUNIJ; 
ITEM FUNIK,FUNIR R; 
    SWITCH FUNISW:QFNBS                                                  JANDRE 
              FUNIIRX:IRX,
              FUNIRIX:RIX,
              FUNIRCX:RCX,
              FUNICIX:CRX,
              FUNILOC:LOC,
              FUNIBIT:BIT,
              FUNIBYTE:BYTE 
              ,FUNIPFUN:PFUN
              ,FUNICIX:CIX
              ,FUNIICX:ICX
              ,FUNIIDN:RDX
              ; 
FUNI: #INTRINSIC FUNCTION#
    FUNII=FNBR[MRP];
    FUNII=FNBS[FUNII]; # TO BE DELETED WHEN FNBR WILL BE UPDATED #       JANDRE 
    GOTO FUNISW[FUNII]; 
FUNIIRX: #INTEGER-TO-REAL CONVERSION# 
    #ROUNDING IS MEANINGLESS SINCE LENGTH ASSUMED LQ 48 BITS# 
    FUNII=-$CLG[LOP]; 
    IF NOT PFLG[LOP] THEN 
         BEGIN #UNPACKED# 
         IF FUNII NQ 0 THEN ICFGEN(QICFOP"PAKB",PSICON(FUNII),MLP); 
         ELSE               ICFGEN(QICFOP"PACK",MLP,0); 
         MLP=ICFPTR;
         END
    ICFGEN(QICFOP"NORM",MLP,0); 
    GOTO AE30;
FUNIRIX: #REAL-TO-INTEGER CONVERSION# 
    IF ROUN[TRX] NQ 0 THEN
         BEGIN #FIXED-ROUNDING# 
         FUNII=$CLG[TRX]+1; 
         IF FUNII GR 0 THEN FUNIR=1.0/2.0**FUNII; 
         ELSE               FUNIR=2.0**(-FUNII);
         ICFGEN(QICFOP"RSHC",MLP,59); 
         FUNIK=ICFPTR;
         ICFGEN(QICFOP"LXOR",ICFPTR,MLP); 
         ICFGEN(QICFOP"FADD",ICFPTR,PSICON(FUNIR)); 
         ICFGEN(QICFOP"LXOR",ICFPTR,FUNIK); #NORM NOT NEEDED# 
         MLP=ICFPTR;
         END #ROUN# 
    FUNII=$CLG[TRX];
    ICFGEN(QICFOP"UNPB",MLP,0); 
    FUNIJ=ICFPTR; 
    ICFGNR(QICFOP"SELB",-1,0);
    IF FUNII NQ 0 THEN ICFGEN(QICFOP"ADSC",ICFPTR,PSICON(FUNII)); 
    ICFGEN(QICFOP"LSHV",ICFPTR,FUNIJ);
    GOTO AE30;
FUNIIDN: #IDENTITY# 
    VAR=LOP; #REPLACE WITH LEFT OPERANDE #
    GOTO LBOO;
FUNILOC: #LOC FUNCTION-OPERAND NOT LOADED SINCE KLSS=ADR# 
    SLOD(LOP);
    ICFGEN(QICFOP"LOC",MEMR[LOP],0);
    GOTO AE30;
  
##  FUNIBIT:  # BIT BEAD FUNC--OBJECT NOT LOADED #
##       SYMBIT(TRX); 
##       GOTO AE40; 
##  FUNIBYTE:  # BYTE BEAD FUNC--OBJECT NOT LOADED #
##       SYMBYT(TRX); 
##       GOTO AE40; 
  
FUNIPFUN: #SYMPL P-FUNCTION FOR BASED ITEMS#
    IF OPAT15[OPTR[NXOP[TRX]]] THEN            #DON"T INSERT LOAD IF   #
         BEGIN                                 #NXOP IS F/PLST,F/PCAL  #
         MEMR[TRX] = MLP; 
         IF  FPRI[MLP] EQ S"NAMC" 
         AND TTYP[MLP] EQ S"BASED" THEN        #SET BASD FOR FORMAL BA #
              BEGIN 
              BASD[PERE] = T;                  #SET BOTH TO BE SAFE    #
              BASD[TRX] = T;
              END 
         END
    ELSE
         BEGIN  #FORMAL BA# 
         ICFGEN(QICFOP"PFUN", MLP, 0);
         IF NOT(OPTR[PERE] EQ QILOP"FUNI" 
            AND FNBR[MEMR[ROPD[PERE]]] EQ QFNBR"LOC") THEN
              ICFGEN(QICFOP"LOAD", ICFPTR, 0);
         MEMR[TRX] = ICFPTR;
         END  #FORMAL BA# 
    GOTO AE80;
  
FUNICIX: #SYMPL CHARACTER-INTEGER CONVERSION# 
    IF NOT VLNG[LOP] THEN 
         BEGIN #FIXED-LENGTH STRING#
         FUNIJ=ENBT[LOP]; 
         IF ENBY[LOP] GR 10 OR FUNIJ GR 60 THEN 
             BEGIN # TAKE ONLY 10 FIRST CHARS # 
             ENBT[LOP]=60;
             ENBY[LOP]=10;
             END
         ELSE 
         IF FUNIJ NQ 60 AND NOT QREP[TRX] THEN                           JANDRE 
              BEGIN 
              ICFGEN(QICFOP"LAND",MLP,MSKGEN(FUNIJ));                    JANDRE 
              ICFGNR(QICFOP"LSHC",-1,FUNIJ);
              GOTO AE30;
              END 
         VAR=LOP;                                                        JANDRE 
         VFLG[LOP]=S"NUMB"; 
         GOTO LBOO; 
         END
    #VARIABLE-LENGTH STRING#
    IF FNUM[LOP] EQ S"BYTE" THEN
    FUNIJ = ENBT[LOP];       # POINTER TO NBIT EXP #
    ELSE
    FUNIJ=ENBY[LOP];
    MULV6(FUNIJ); 
    FUNII=ICFPTR;  #BIT COUNT#
    ICFGEN(QICFOP"ADSC",ICFPTR,PMINUS1); #6*M-1#
    ICFGEN(QICFOP"RSHV",ICFPTR,MASK1); #MASKS 6*M UPPER BITS #
    ICFGEN(QICFOP"LAND",MLP,ICFPTR);  #ISOLATE M BYTES #
    ICFGEN(QICFOP"LSHV",FUNII,ICFPTR);   # RIGHT ADJUSTED # 
    EFBT[LOP]=0;   ENBT[LOP]=60;
    IF FUNIJ LS 0 THEN
          BEGIN 
          MEMR[TRX] = ICFPTR; 
          ICFGEN(QICFOP"DEAD",FUNIJ,0); 
          GOTO AE40;
          END 
    GOTO AE30;
  
FUNIRCX: #REAL TO CHARACTER#
    ICFGEN(QICFOP"UNPB",MLP,0); 
    ICFGEN(QICFOP"SELB",ICFPTR,0);
    ICFGNR(QICFOP"LSHV",-1,-2); 
    MLP=ICFPTR; 
  
FUNIICX: #SYMPL INTEGER-CHARACTER CONVERSION# 
    #ONE CHARACTER ONLY IS ASSUMED# 
    IF QREP[TRX] THEN 
         IF OPTR[LOP] EQ S"PRIM"
          THEN
            BEGIN 
            IF ENBT[LOP] LS 6 THEN
              BEGIN 
              EFBT[TRX] = EFBT[LOP];
              ENBT[TRX] = ENBT[LOP];
              GOTO FUNIICX1;
              END 
            ELSE
              EFBT[TRX] = EFBT[LOP] + ENBT[LOP] - 6;
            END 
              ELSE EFBT[TRX]=54;
    ELSE BEGIN                                                           JANDRE 
    ICFGEN(QICFOP"LNND",MSKGEN(54),MLP);
    ICFGEN(QICFOP"IAOR",ICFPTR,PSICON("          " LAN LNO O"77")); 
    ICFGEN(QICFOP"LSHC",ICFPTR,54); 
    ENBY[TRX]=1;
    ADJF[TRX]=TRUE;                                                      JANDRE 
    END                                                                  JANDRE 
    ENBT[TRX]=6;
FUNIICX1: 
    VFLG[TRX]= S"LITR"; 
    OPTR[TRX]=S"PRIM";
      CTYP[TRX]=S"H"; 
         IF OPTR[LOP] EQ S"VALU" THEN 
           BEGIN
           MEMR[TRX] = MEMR[LOP]; 
           GOTO AE40; 
           END
    GOTO AE30;
  
ITEM
    FCALI, #FUNC NAME ENTRY#
    FCALJ, #PARAMETER TRIAD#
    FCALK, #FCAL/PLST TRIAD#
    FCALL, #PARAMETER COUNTER#
    FCALN, #TEMP RELEASE CHAIN HEAD#
    FCALO, #PARAMETER LABEL ENTRY#
    FCALP, #TEMP ENTRY FOR PARAMETER VALUE# 
    FCALT,
    FCALU, #ADCON COUNTER#
    FCALV;
CONTROL EJECT;
PROC GTNP; #GETS THE NEXT NON-JOVIAL PARAMETER# 
    BEGIN 
    FCALV=FCALK;
    IF FCALU EQ 0 THEN FCALV=FCALJ; 
    FCALK=NXOP[FCALV];
    FCALJ=ROPD[FCALK];
    FCALU=FCALU+1;
    FCALL=FCALL-1;
    END 
CONTROL EJECT;
PROC IGTNP; #INITIALIZES GTNP PROC# 
    BEGIN 
    FCALK=TRX; #FCAL TRIAD# 
    FCALJ=ROPD[TRX]; #1ST PARAMETER TRIAD#
    FCALL=1; #PARAMETER COUNT#
IG00: 
    IF OPTR[FCALJ] EQ QILOP"PLST" THEN
         BEGIN #MORE PARAMETERS#
         FCALL=FCALL+1; 
         FCALJ=LOPD[FCALJ]; 
         GOTO IG00; 
         END
    IF OPTR[FCALJ] EQ QILOP"NULL" THEN FCALL=0; 
    FCALU=0;
    END 
  
FCAL: #FUNCTION CALL# 
    SAVESV(TRX);
    FCALN=0; #TEMP RELEASE CHAIN HEAD#
    FCALO=0; #CLABL LABEL, PARAMETER LIST GENERATED FLAG# 
    FCALP=0; #PARAMETER VALUE TEMP, PARAMETER FLAG# 
    FCALI=MLP; #FUNCTION NAME#
    IGTNP;
    IF FCALL EQ 0 THEN
         BEGIN #NO PARAMETERS#
          IF XTRN[FCALI] EQ S"EXT" OR XTRN[FCALI] EQ S"WEAK" THEN 
              BEGIN 
##     SADCON;
##     ADCON(0,0);
##       FCALO = FADCON;
##            END 
##     ICFGEN(QICFOP"PCAL",FCALI,FCALO ); 
         GOTO FC10; 
         END
  
#     HERE WE SEARCH THE ENTIRE PARAMETER STRING FOR LONG CHAR ACTUALS,#
#     GENERATING A CALL TO SYMSM$ FOR ANY WE FIND                      #
  
      FOR FCALO=FCALO WHILE FCALL NQ 0 DO 
          BEGIN 
          IF AC$S[FCALJ] EQ S"GR" AND 
          (OPTR[FCALJ] NQ S"PRIM" OR SFLG[FCALJ]) THEN BEGIN
  
#     PARAMETER REQUERES SYMSM$ CALL.  NOTICE WE MUST ISSUE SAVES FOR  #
#     THE ENTIRE PARAMETER STRING SINCE IN-LINE CODE COULD ALREADY HAVE#
#     BEEN GENERATED TO LOAD A PARAMETER WHICH FOLLOWS THIS ONE        #
  
              SAVESV(ROPD[TRX]);
              MEMR[FCALJ]=KCT00(FCALJ); 
              END 
          GTNP; 
          END 
      IGTNP;
    SADCON; 
SP00:    #AT LEAST ONE PARAMETER LEFT#
         FCALT=MEMR[FCALJ]; 
  
         IF OPTR[FCALJ] EQ QILOP"SUBS"
         AND CLAS[MEMR[LOPD[FCALJ]]] EQ QCLAS"TABL" THEN
  
           BEGIN
                    # SUBSCRIPTED ARRAY NAME  # 
           MEMR[FCALK] = MEMR[LOPD[FCALJ]] ;
           BASD[ FCALJ] = TRUE; 
           BASD[ FCALK] = TRUE; 
           INDX[LOPD[FCALJ]] = MEMR[ROPD[FCALJ]] ;
  
           SLOD ( LOPD[FCALJ] );   # GENERATE OFFS / SUBS   # 
  
           INDX[FCALK] = FCALU; 
           ICFGEN ( QICFOP"LOC" , ICFPTR , 0 ); 
           ADCON ( MEMR[FCALJ] , 1 ); 
           MEMR[FCALK] = ICFPTR;
           END
  
         ELSE 
  
         IF FCALT LS 0 THEN 
              BEGIN #PASS BY VALUE IN TEMP# 
              FCALP=TMPGEN(1);
              TPCH[FCALP]=FCALN;
              FCALN=FCALP;
              ICFGEN(QICFOP"REPL",FCALP,FCALT); 
              FCALT=FCALP;
              ADCON(FCALT,0); 
              END 
         ELSE BEGIN #PASS BY ADDRESS# 
  
              IF CLAS[FCALT] EQ S"TABL" 
              AND SFLG[FCALJ]           THEN
  
                BEGIN 
                  # ARRAY SUBSCRIPT WITH CONSTANT OFFSET    # 
                IF FPRI[FCALT] EQ S"NAMC" 
                OR BASD[FCALJ]        THEN
                  BEGIN 
  
                  ICFGEN ( QICFOP"OFFS" , FCALT , OFFS[FCALJ] );
  
                  ICFGEN ( QICFOP"LOC" , ICFPTR , 0 );
  
                  MEMR[FCALK] = ICFPTR; 
                  BASD[FCALK] = TRUE; 
                  INDX[FCALK] = FCALU;
                  ADCON ( FCALT , 1 );
                  END 
  
                ELSE
  
                  BEGIN 
                  XREF PROC ADCNO;
                  ADCNO ( FCALT , OFFS[FCALJ] , 0 );
                  MEMR[FCALJ] = FCALT;
                END 
  
              END 
  
            ELSE
  
              IF FPRI[FCALT] NQ S"NULL" THEN
                   BEGIN #ACTUAL-PARAMETER# 
                   BASD[FCALK]=T; #ADCON STORE FLAG#
                   INDX[FCALK]=FCALU; #OFFSET FROM 1ST ADCON# 
                   MEMR[FCALK]=FCALT; 
                   IF NOT(CLAS[FCALT] EQ S"TABL" AND BASD[FCALJ]) THEN
                        BEGIN #NOT A FORMAL BASED ARRAY#
                        ICFGEN(QICFOP"LOC",FCALT,0);
                        MEMR[FCALK]=ICFPTR; 
                        END 
                   ELSE 
                        BEGIN  #FORMAL BASED ARRAY# 
                        ICFGEN(QICFOP"PFUN",FCALT,0); 
                        ICFGEN(QICFOP"LOAD",ICFPTR,0);
                        MEMR[FCALK] = ICFPTR; 
                        END 
                   ADCON(FCALT,1);
                   END #ACTUAL PARAMETER# 
              ELSE BEGIN #NON-PARAMETER#
                   IF CLAS[FCALT] EQ S"TABL" AND BASD[FCALJ] THEN 
                        BEGIN #LOCAL BASED ARRAY# 
                        BASD[FCALK]=T;
                        INDX[FCALK]=FCALU;
                        FCALV = FCALT;
                        IF OPTR[FCALJ] EQ S"FUNI" THEN  #ASSUME PFUN   #
                             BEGIN  #PARM BA# 
                             ICFGEN(QICFOP"PFUN",FCALV,0);
                             FCALV = ICFPTR;
                             END
                        ICFGEN(QICFOP"LOC",FCALV,0);
                        MEMR[FCALK] = ICFPTR; 
                        ADCON(FCALT,1); 
                        END 
                   ELSE ADCON(FCALT,0); 
      IF CLAS[FCALT] EQ S"TEMP" THEN BEGIN
          TPCH[FCALT]=FCALN;
          FCALN=FCALT;
          END 
                   END #NON-PARAMETER#
              END #PASS BY ADDRESS# 
         GTNP;
         IF FCALL NQ 0 THEN GOTO SP00;
      IF SPECSYMADC NQ 0 AND
          (XTRN[FCALI] EQ S"EXT" OR XTRN[FCALI] EQ S"WEAK") 
         THEN ADCON(0,0); 
         FCALO=FADCON;
         IGTNP; 
         FOR FCALO=FCALO WHILE FCALL NQ 0 DO
              BEGIN 
              IF BASD[FCALK] THEN 
                   BEGIN #ADCON STORE#
                   ICFGEN(QICFOP"OFFS",FCALO,INDX[FCALK]);
                   ICFGEN(QICFOP"REPL",ICFPTR,MEMR[FCALK]); 
                   END
              GTNP; 
              END 
         ICFGEN(QICFOP"PCAL",FCALI,FCALO);
FC10: 
         MOVET(LOP,TRX);
          ICFGEN(QICFOP"DRV",0,XREG6);
SP35:    #RELEASE ANY TEMPS#
         IF FCALN NQ 0 THEN 
              BEGIN 
              FCALP=FCALN;
              FCALN=TPCH[FCALN];
              TMPRLS(FCALP);
              GOTO SP35;
              END 
    FCALJ=PLNG(FCALI);
    IF FCALJ GR 1 THEN
         BEGIN # LONG LITERAL MOVED TO TEMP#
         FCALK=TMPGEN(FCALJ); 
         NBYT[FCALK]=ENBY[TRX]; 
         MEMR[TRX]=FCALK; 
         FCALT=ICFPTR;
         FOR FCALL=0 STEP 1 UNTIL FCALJ-1 DO
              BEGIN 
              ICFGEN(QICFOP"OFFS",FCALK,FCALL); 
              ICFGEN(QICFOP"OFFS",0,FCALL); 
              ICFGEN(QICFOP"SUBS",ICFPTR,FCALT);
              ICFGNR(QICFOP"LOAD",-1,0);
              ICFGNR(QICFOP"REPL",-4,-1); 
              END 
         GOTO AE40; 
         END #MULTI-WORD FUNCTION RESULT# 
    GOTO AE30;
  
ITEM     ICEXPI, #ICF PTR TO INSTRUCTION COMPUTING CURRENT BASE#
         ICEXPJ, #ICF PTR TO INSTRUCTION COMPUTING LAST PRODUCT#
         ICEXPK; #1-BIT MASK FOR CHECKING BITS IN EXPONENT# 
IUEXP: #INTEGER EXPONENTIATED BY UNSIGNED INTEGER CONSTANT OR VARIABLE# 
    IF KBL THEN 
         BEGIN #ONE OPERAND IS CONSTANT#
         IF KDS NQ 0 THEN 
              BEGIN #LEFT OPERAND IS CONSTANT#
              IF KVL EQ 2 THEN
                   BEGIN #POWER OF TWO= SHIFT#
                   ICEXPI=PERE;                                          JANDRE 
                   IF OPTR[ICEXPI] EQ QILOP"IMUL" OR
                      OPTR[ICEXPI] EQ QILOP"IDIV" AND 
                      ROPD[ICEXPI] EQ TRX THEN
                        BEGIN 
                        IF INDX[ICEXPI] EQ 0 THEN 
                             BEGIN #WE ARE THE FIRST PTWO#
                             INDX[ICEXPI]=MRP; #VARIABLE SHIFT COUNT# 
                             OFFS[ICEXPI]=TRX; #OPERAND#
                             GOTO AE40; 
                             END #INDX EQ 0 # 
                        END #NXOP=IMUL/IDIV, ETC# 
                   #MUST GENERATE VARIABLE PTWO#
                   ICFGEN(QICFOP"LSHV",MRP,PONE); 
                   GOTO AE30; 
                   END #KVL EQ 2# 
              IF KVL EQ 0 THEN GOTO LBZR; #RESULT IS ZERO#
              IF KVL EQ 1 THEN GOTO IDIV00; #RESULT IS ONE# 
              END #KDS NQ 0#
         ELSE BEGIN #RIGHT OPERAND IS CONSTANT# 
              IF KVL GR 1 THEN
                   BEGIN #KVL GQ 2# 
                   ICEXPI=MLP;
                   ICEXPJ=0;
                   ICEXPK=1;
IC00:              IF KVL LAN ICEXPK EQ 0 THEN
IC10:                   BEGIN #NOT THIS BIT#
                        ICFGEN(QICFOP"DMUL",ICEXPI,ICEXPI);#SQUARE BASE#
                        ICEXPI=ICFPTR;
                        ICEXPK=ICEXPK+ICEXPK; 
                        GOTO IC00;
                        END 
                   #BIT ON# 
                   IF ICEXPJ NQ 0 THEN
                        BEGIN #PREVIOUS ACCUMULATED PRODUCT#
                        ICFGEN(QICFOP"DMUL",ICEXPI,ICEXPJ); 
                        ICEXPJ=ICFPTR;
                        END 
                   ELSE ICEXPJ=ICEXPI;
                   KVL=KVL LXR ICEXPK;
                   IF KVL NQ 0 THEN GOTO IC10;
                   #EXPONENTIATION FINISHED#
                   TTST[TRX]=TRUE;
                   GOTO AE30; 
                   END #KVL GR 1# 
              IF KVL EQ 0 THEN GOTO IDIV00; #RESULT IS ONE# 
              IF KVL EQ 1 THEN GOTO LBOO; #RESULT IS OTHER OPERAND# 
              END #KDS EQ 0=CONSTANT EXPONENT#
         END #KBL#
    TTST[TRX]=TRUE; 
    REXPI="ITOJ$";
    GOTO RI02;
  
ITEM RCEXPI, #ICF PTR TO INSTRUCTION COMPUTING CURRENT BASE#
     RCEXPJ, #ICF PTR TO INSTRUCTION COMPUTING LAST PRODUCT#
     RCEXPK; #1-BIT MASK FOR CHECKING EXPONENT BITS#
  
RCEXP: #REAL NUMBER EXPONENTIATED BY POSITIVE INTEGER CONSTANT GR 0#
    #RCEXPI SET ON ENTRY# 
    RCEXPJ=0; #FLAG FOR FIRST ACCUMULATED PRODUCT#
    RCEXPK=1; 
RC00: 
    IF KVL LAN RCEXPK EQ 0 THEN 
RC10:    BEGIN #NOT THIS BIT# 
         ICFGEN(RMOP[ROUN[TRX]],RCEXPI,RCEXPI); 
         RCEXPI=ICFPTR; 
         RCEXPK=RCEXPK+RCEXPK;
         GOTO RC00; 
         END
    #BIT ON#
    IF RCEXPJ NQ 0 THEN 
         BEGIN #PREVIOUS ACCUMULATED PRODUCT# 
         ICFGEN(RMOP[ROUN[TRX]],RCEXPI,RCEXPJ); 
         RCEXPJ=ICFPTR; 
         END
    ELSE RCEXPJ=RCEXPI; 
    KVL=KVL LXR RCEXPK; 
    IF KVL NQ 0 THEN GOTO RC10; 
    #EXPONENTIATION FINISHED# 
    TTST[TRX]=TRUE; 
    GOTO AE30;
  
RIEXP: #REAL EXPONENTIATED TO AN INTEGRAL POWER#
    TTST[TRX]=TRUE; 
    IF KBL THEN 
         BEGIN #ONE OPERAND IS CONSTANT#
         IF KDS EQ 0 THEN 
RI00:         BEGIN #CONSTANT EXPONENT# 
              IF KVL GR 1 THEN
                   BEGIN #USE MULTIPLY EXPANSION# 
                   RCEXPI=MLP; #BASE# 
                   GOTO RCEXP;
                   END
              IF KVL EQ 0 THEN GOTO RDIV00; 
              IF KVL EQ 1 THEN GOTO LBOO; 
              #KVL LS 0 # 
              ICFGEN(RDOP[ROUN[TRX]],PSICON(1.0),MLP);
              KVL=-KVL; 
              MLP=ICFPTR; 
              GOTO RI00;
              END #CONSTANT EXPONENT# 
         #CONSTANT BASE#
         IF KVL EQ 0 THEN GOTO LBZR;
         IF CRREL(KVL,1.0,QRLTL"EQ") THEN GOTO RDIV00;
         END
    #SET UP XTOI$ FUNCTION CALL#
    REXPI="XTOI$";
RI02: 
    SAVESV(TRX);
    RIEXPJ=0; #TEMP RELEASE FLAG# 
    RIEXPK=0; #TEMP RELEASE FLAG# 
    SADCON; 
    IF MLP GR 0 AND FPRI[MLP] EQ 0 THEN 
RI05:    BEGIN #PASS SCALAR BY NAME#
         ADCON(MLP,0);
         GOTO RI10; 
         END
    RIEXPJ=TMPGEN(1); 
    ICFGEN(QICFOP"REPL",RIEXPJ,MLP);
    ADCON(RIEXPJ,0);
RI10: 
    IF MRP GR 0 AND FPRI[MRP] EQ 0 THEN 
         BEGIN #PASS SCALAR BY NAME#
         ADCON(MRP,0);
         GOTO RI15; 
         END
    RIEXPK=TMPGEN(1); 
    ICFGEN(QICFOP"REPL",RIEXPK,MRP);
    ADCON(RIEXPK,0);
RI15: 
    ADCON(0,0); 
    RIEXPI=FADCON;
    ICFGEN(QICFOP"PCAL",PSCPRC(REXPI),RIEXPI);
    IF RIEXPJ NQ 0 THEN TMPRLS(RIEXPJ); 
    IF RIEXPK NQ 0 THEN TMPRLS(RIEXPK); 
          ICFGEN(QICFOP"DRV",0,XREG6);
    GOTO AE30;
  
RREXP: #REAL EXPONENTIATED BY REAL# 
     # NOT USED#
      GOTO AE40;
  
ARRAY [QRLTL"LS":QRLTL"GQ"]S(1); ITEM 
    CRELN S:QRLTL  (0,0,6)=[S"NQ",,,S"EQ"]; 
ARRAY [0:1]S(1); ITEM 
    CRELM S:QICFOP (0,6,9)=[S"LAND",S"LIMP"]; 
  
CRLTEL: #EQNQ UNSIGNED RELATIONAL#
FUNC RMSK(A);#BUILDS RIGHT-ADJUSTED VARIABLE MASK#
    BEGIN 
    ITEM A; 
    ITEM I; 
    I=A;
    MULV6(I); 
    ICFGEN(QICFOP"ADSC",ICFPTR,PMINUS1);                                 JANDRE 
    ICFGEN(QICFOP"RSHV",MASK1,ICFPTR);                                   JANDRE 
    ICFGNR(QICFOP"RSHC",-2,59); 
    ICFGNR(QICFOP"LNND",-1,-2); 
    ICFGNR(QICFOP"LSHV",-5,-1); 
    RMSK=ICFPTR;
    END 
    ITEM CRLI,CRLJ,CRLK,CRLL,CRLM;
      IF AC$S[LOP] EQ S"GR" OR AC$S[ROP] EQ S"GR" THEN
          BEGIN 
          SAVESV(TRX);
          KRL00(TRX); 
          GOTO AE40;
          END 
    GOTO ISUB20; #SYMPL EQNQ# 
  
CRLTNL: #NON-EQNQ UNSIGNED RELATIONAL#
    TTST[TRX]=T;
      IF AC$S[LOP] EQ S"GR" OR AC$S[ROP] EQ S"GR" THEN
          BEGIN 
          SAVESV(TRX);
          KRL00(TRX); 
          GOTO AE40;
          END 
CR00:    BEGIN #SYMPL IS 1-WORD#
         IF SWOP[RLTL[TRX]] THEN SWPOPNS; 
         $TST[TRX]=T; 
         RLTL[TRX]=CRELN[RLTL[TRX]];
         ICFGEN(QICFOP"ISUB",MLP,MRP); #VALID FOR SAME SIGNS# 
           # CANNT SPECAIL CASE CONSTANTS#
         ICFGEN(QICFOP"LEQV",MLP,MRP); #EQUIVALENCE SIGN BITS#
         ICFGEN(QICFOP"LNND",ICFPTR,MRP); 
         ICFGNR(QICFOP"LAND",-2,-3);
         ICFGNR(QICFOP"LOR",-1,-2); #LNND OR ISUB#
         GOTO AE30; 
         END #SYMPL AND 1-WORD JOVIAL OPERANDS# 
END 
TERM
