*DECK     CCGC   CCG CONTROLLER 
          IDENT  CCGC 
 CCGC     SECT   (CCG CONTROLLER AND SUPPORT.)
 CCGC     SPACE  4,10 
***              CCGC IS THE CONTROLLER FOR THE CYBER CODE GENERATOR. 
  
  
 .FAST    EQU    0
 .OPT     EQU    1
 .CG      EQU    .OPT        INDICATE CYBER CODE GENERATOR
 BT       MICRO  1,,/B4/     TEMP B-REG FOR COMDECKS
 O$       MICRO  1,,/O$/
 L$       MICRO  1,,/L$/
 CCGC     SPACE  4,8
*         IN BRIDGE 
          EXT    BRIDGE 
  
*         IN CCGLINK
          EXT    CGL.RTN,ERR22
  
*         IN FTN
          EXT    CO.SNAP,F.PB,MSG=,OT.RM
  
*         IN IDP
          EXT    SNP= 
  
*         IN PUC
          EXT    BN=BUF,BN=TEM,F.LBT,IDENT,L=API
          EXT    L=APL,L=ASG,L=BLKS,L=CON,L=FILE,L=GL,L=IOA,L=IOI 
          EXT    L=NLST,L=SYM,MOD,N.STMAX,N.VD,O=API,O=APL
          EXT    O=ASG,O=BLKS,O=CON,O=GL,O=IOA,O=IOI,O=NLST 
          EXT    O=SYM,PASS,PIK=PS,S=CP,S=CPL,S=CT,S=ENTRY,S=GPL,S=IT 
          EXT    S=LC,S=OT,S=SPA,S=ST,S=SUB,S=SUBI,S=TA0,S=TRACE,S=VD 
          EXT    WOF
  
*         IN UTILITY
          EXT    CDD,WTO= 
          SPACE  4,10 
 F$STITL  BSSENT
          DIS    6,                  **** MESSAGES FROM JASIK'S SUPER 
          DIS    6,CODE GENERATOR.    ****
 N$STITL  CONENT 0
  
 CC$FT    CONENT 0           0 TO EVICT OPT SCRATCH FILE
 CC$SUB   CONENT 0           SUB OCCURRED FLAG
 CC$SUB0  CONENT 0           SUB0 OCCURRED FLAG 
 HO$DC    CONENT 0           .NE. 0 IF DEAD CODE ENCOUNTERED BY CCG 
 HO$OBO   BSSENT 1           CCG SCRATCH BUFFER ORIGIN
 HO$OFLL  CONENT 0           ORIGIN OF LCM FOR CCG
 HO$OPT   BSSENT 1           CO.OPT S 58
 N.ALTEN  CONENT 0           NUMBER OF ALTERNATE ENTRIES
 CCGC     SPACE  4,10 
**        CCGC - CCG CONTROLLER.
* 
*         CCGC IS CALLED BY INIT22 AFTER OVERLAY INITIALIZATION.
  
  
 CCGC     BSSENT 0           ...ENTRY 
          =X6    PASS=CCG 
          SA6    =XPASS      SET PASS TO CCG
          CALL   BRIDGE      INTERFACE TO CCG 
          SA1    =XHO$OPT 
          SA4    =XMOD
          PL     X1,CCG2     IF OPT NE 2
          HX4    MO.BLK 
          MI     X4,CCG2     IF BLOCK DATA
          CALL   CG$GPO      PERFORM GLOBAL OPTIMIZATION
 CCG2     CALL   OTC         OUTPUT TERMINAL CODE 
  
*         COMMUNICATE TO PASS1-3 TM POSITIONS OF PASS2 TABLES.
  
 CCG4     BSS    0
  
          MACRO  TABSH,PASS1,D1,D2,PASS2
 PA2      MICRO  1,,/PASS2/ 
          IFC    EQ,/PASS2//,1
 PA2      MICRO  1,,/PASS1/ 
          SA1    =XO$"PA2"
          SA2    =XL$"PA2"
          BX6    X1 
          LX7    X2 
          SA6    =XO=PASS1
          SA7    =XL=PASS1
          ENDM
  
*CALL COMSTAB 
  
 FE       TABSH              FOR PSEUDO TABLE OF PRESERVED TABLES 
  
          EQ     =XCGL.RTN   RETURN TO CODE GENERATOR LOADER... 
 CCGC     TITLE  CCG SUPPORT ROUTINES.
 DPT      SPACE  4,10 
**        DPT -  DEFINE PROGRAM TAG.
* 
*         ENTRY  (X6) = ENTRY FOR *T.GL*, (WC) FORMAT 
  
  
 DPT      SUBR               ...ENTRY/EXIT... 
          SA1    =XO$GLT
          SA6    B3+X1
          EQ     EXIT.
 FA=LOL   SPACE  4,10 
**        FA=LOL - LIST ONE LINE. 
* 
*         ENTRY  (B6) = LINE BUFFER ADDRESS.
*                (B7) = LENGTH OF LINE. 
*                (X6) = NUMBER OF PRECEDING BLANK LINES TO LIST.
  
  
 FA=LOL   SUBR   =           ...ENTRY/EXIT... 
          PLINE  B6,B7,X6 
          EQ     EXIT.       DONE...
 ABT      SPACE  4,10 
**        CCG EXIT HERE WHEN ERRORS.
* 
*         THE SUBROUTINE ENTRY IS FOR CALLING SEQUENCE COMPATIBLITY.
*         EXITS TO CCG4.
  
  
 HE$ABT   SUBR   =           ...ENTRY 
          SX6    1
          EQ     HE1
  
 HE$CTX   BSSENT 0
 HE$EPX   BSSENT 0
          SX6    2
  
 HE1      SA6    ERR22
          EQ     CCG4 
 HR$LDC   SPACE  4,10 
**        HR$LDC - LIST DEAD CODE.
* 
*         ENTRY  (O$RND) = DEAD LINE NUMBERS (IN BINARY). 
* 
*         CALLS  CDD, PLINE.
  
  
 HR$LDC   SUBR   =           ENTRY/EXIT...
          PLINE  LDCA,5,1 
          PLINE  LDCB,3 
          SA1    IDENT
          SA2    =XO$RND
          SA3    =XL$RND
          BX7    X1 
          SA5    X2-1        (A5) -> PREVIOUS ITEM IN TABLE 
          SA7    LDCD 
          SX5    X3          (X5) = NUMBER OF ITEMS YET TO LIST 
          MESSAGE LDCC,,RCL  ** DEAD CODE IN PROGNAM ** 
  
 LDC2     SX0    -7+1        1 - (ITEMS PER LISTING LINE) 
          SB6    X5 
          SA6    LDCA 
 LDC4     SA5    A5+B1
          SX1    X5 
          CALL   CDD         CONVERT DECIMAL DIGITS 
          SX0    X0+B1
          SB6    B6-1 
          SA6    A6+B1
          LE     B6,LDC6     IF TABLE EXHAUSTED 
          MI     X0,LDC4     IF LINE NOT FULL 
 LDC6     SB7    A6+B1
          SX5    B6 
          SB6    LDCA+1 
          PLINE  B6,B7-B6 
          NZ     X5,LDC2     IF TABLE NOT EXHAUSTED 
          EQ     EXIT.
  
 LDCA     DIS    5,  STATEMENTS BEGINNING AT BELOW LINE NUMBERS ARE 
 LDCB     DIS    3,  UNREACHABLE (DEAD CODE). 
 LDCC     DATA   A/ DEAD CODE IN /
 LDCD     BSS    1           (IDENT)
  
  
 T.SYM    EQUEXT O$SYM
*CALL     COMFWIN            WRITE INSTRUCTIONS TO PREBINARY
          ENTRY  WIN
  
 ORG      EQUEXT CC$BLEN
 PARCEL   EQUEXT CC$PC
          ENTRY  WTE
 CBI      EQUEXT CC$LBO 
*CALL     COMFITS 
          ENTRY  ITS
          ENTRY  PSTAB
          ENTRY  WINOC
*CALL     COMFUSE            PROCESS USE PSEUDO INSTRUCTION 
  
          TITLE  SUBROUTINES. 
 OTC      EJECT 
 ISSUE    SPACE  4,8
**        ISSUE - ISSUE OPERATION OR PSEUDO TO PB.
  
 ISSUE    MACRO  OP,TAG 
          =X7    OP 
          LX7    PB.GHIJP 
          IFC    NE,/TAG//,3
          XR=    X5,TAG 
          LX5    PB.TAGP
          BX7    X7+X5
          WCODE  X7 
 ISSUE    ENDM
 XR=      SPACE  4,8
**        XR= - X-REGISTER VERSION OF R= PSEUDO INSTRUCTION.
* 
*         IF *EXPR* = *LDREG*, GENERATES NOTHING. 
*         IF *EXPR* = OTHER X-REG, GENERATES BOOLEAN XMIT TO *LDREG*. 
*         IF *EXPR* = ELSE, GENERATES INCREMENT INSTR TO LOAD *LDREG*.
* 
* 
*         XR=       LDREG,EXPR
* 
*         ENTRY  *LDREG* = X-REGISTER TO BE LOADED.  MUST BE X1 THRU X5.
*                *EXPR*  = ADDRESS EXPRESSION FOR VALUE TO BE LOADED. 
* 
*         USES   *LDREG* AND ITS A-REGISTER.
* 
*         CALLS  NONE 
  
  
          PURGMAC   XR= 
  
 XR=      MACRO  R,E
  LOCAL A 
A MICRO 1,, E 
A MICCNT A
  IFEQ A,2,5
A MICRO 1,1, E
  IFC EQ, "A" X ,3
  IFC NE, R E ,1
  B_R E 
  SKIP 6
A MICRO 2,1, R
  IFC GE, "A" 1 ,3
  IFC LT, "A" 6 ,2
  SA"A" E 
  SKIP 1
  ERR (R) NOT X1-X5 "SEQUENCE"
 XR=      ENDM
          SPACE  4,8
**        OTC - OUTPUT TERMINAL CODE. 
  
**        AI. - APLIST INDEX TABLE ENTRY FORMAT 
          DESCRIBE AI.,60 
 EQV      DEFINE 1
 BASE     DEFINE 1           BASE MEMBER OF A CLASS OF EQUIV APLISTS
          DEFINE 4
 LINK     DEFINE 18 
 LEN      DEFINE 18 
 INDX     DEFINE 18 
  
 BIAS     DEQU   LEN
 ORD      DEQU   INDX 
  
 OTCA     BSS    1
 OTCB     BSS    1
  
 OTC      SUBR   =
          SX1    =XBN=STRT
          CALL   CG$CUB      VARDIM CODE TO GO TO START.
          ISSUE  I.ECI       FLAG END OF CCG OUTPUT 
          SA1    CC$SUB 
          ZR     X1,OTC1     IF NO SUBS 
  
          ISUSE  SUB         USE SUB. 
          ISSUE  I.BSS,=XS=SUB     SUB. BSS 0 
          ISUSE  TEM
          ISSUE  I.BSS,=XS=SUBI 
          =X6    0
          RJ     OSI         OUTPUT SUB INDEX TABLE 
          ISUSE  STRT        USE START. 
          SA4    =XS=ENTRY
          RJ     OSC         OUTPUT SUB CODE FOR HEADER 
  
 OTC1     RJ     MZP         MARK POSSIBLE LEVEL-0 VARDIMS FOR OZC
          ISUSE  TEM
          ISSUE  I.BSS,=XS=SUB0I
          =X6    1
          RJ     OSI         ISSUE SUB0 INDEX TABLE 
  
 OTC15    ISUSE  STRT 
          SA4    S=ENTRY
          RJ     OZC         ISSUE SUB0 CODE FOR HEADER 
          RJ     OVC
          SA4    =XS=ENTRY
          RJ     OLC         OUTPUT FP LOCAL COPIES 
          SA2    =XN.ALTEN
          ZR     X2,OTC4     IF NO ALTERNATE ENTRIES
          ISUSE  CODE        USE CODE.
  
*         ISSUE ALTERNATE ENTRY BLOCKS. 
  
          SA2    =XS=ENTRY
          SX6    X2+B1       I = (S=ENTRY)
  
 OTC2     SA3    =XO$SYM
          LX2    B1,X6
          IX4    X6+X2
          IX0    X3+X4
          SA3    X0+B1
          SX6    X6+B1       I = I + 1
          HX3    WB.ENT 
          PL     X3,OTC2     IF NOT ENT[WB(I)]
          LX3    WB.ENTP-WB.LABP
          MI     X3,OTC2     IF LAB[WB(I)]
          SX4    X6-1 
          BX6    X4 
          SA6    OTCA 
          MX0    -WC.EGLL 
          SA3    A3+B1
          LX3    -WC.EGLP 
          BX2    -X0*X3 
          SX6    I.GL+X2     OTCB = EGL[WC(I)]
          SA6    OTCB 
          ISSUE  I.BSS,X4    LNAME BSS 0
          ISSUE  I.UJP,X4    ENTRY/EXIT WORD
          ISSUE  5140B,X4    SA4 ENAME
          ISSUE  1064B       BX6 X4 
          ISSUE  5160B,=XS=ENTRY   SA6 HNAME
          MX6    0
          SA6    =XENTRJ     FLAG NO RJ SINCE PLUG
  
          RJ     ISA         ISSUE SAVE A0 / RJ CPL.
          SA4    OTCA 
          RJ     OSC         ISSUE SUB CODE 
          RJ     OZC         ISSUE SUB0 CODE
          RJ     OVC         OUTPUT VARDIM CODE 
          SA4    OTCA 
          RJ     OLC         OUTPUT FP LOCAL COPIES 
  
*         IF NO RJ ISSUED SINCE PLUG, ISSUE ONE NOW TO VOID STACK.
  
          SA5    ENTRJ
          NZ     X5,OTC3     IF RJ ISSUED AS PART OF INITIALIZATION 
          ADDWRD GLT,B0      ADD GENERATED LABEL
          SX4    B6+K.GL     TAG OF LABEL 
          ISSUE  I.RJ3,X4    RJ GL
          ISSUE  I.BSS,X4    GL BSS 0 
          ISSUE  I.ZERO      BSS 1
  
*         ISSUE JUMP INTO CODE BODY.
  
 OTC3     SA5    OTCB 
          SA1    N.ALTEN
          SX6    X1-1 
          SA6    A1          N.ALTEN = N.ALTEN + 1
          SB5    X6 
          ISSUE  I.UJP,X5    EQ EGL[WC(I)]
          SA4    OTCA 
          SX6    X4+1 
          NZ     B5,OTC2     IF N LT MAX  */MORE ENTRIES
  
 OTC4     ISSUE  I.EMI
          MX7    0
          SA7    =XL$ASG     SHRINK *ASG* 
          SB5    B0 
          RJ     CAW         CONVERT APT TO WC. FORMAT
          SB5    B1 
          RJ     CAW         CONVERT IOI TO WC. FORMAT. 
          CALL   ITS
          RJ     MEP         MISC. END PROCESSING 
          ISSUE  OC$END 
          EQ     EXIT.
 OLC      EJECT 
**        OLC - OUTPUT LOCAL COPIES OF FORMAL PARAMETERS. 
* 
*         ENTRY  X4 = ENTRY SYMTAB ORD. 
  
 OLC      SUBR
          SA1    N$LC 
          ZR     X1,EXIT.    IF NO LOCAL COPIES 
          SA2    O$SYM
          LX3    B1,X4
          IX4    X4+X3
          =B7    X2+WB.W
          SA1    B7+X4
          MX0    -WB.PNTL 
          LX1    -WB.PNTP 
          BX5    -X0*X1 
          ZR     X5,EXIT.    IF NO FP*S AT THIS ENTRY 
  
*         ALLOCATE FOR LD, XMT ST SEQUENCE FOR ALL FPS. 
  
          SA1    =XL$FPI
          LX2    B1,X1
          IX1    X2+X1
          LX1    2
          SX1    X1+4        L$TXT = 4 (FOR BOS) + 3*4*L$FPI
          MX7    0
          SA7    L$TXT
          ALLOC  TXT,X1 
  
*         INITIALIZE SEQ. TO BOS. 
  
          =X7    1
          LX7    R1.INP 
          =B6    OC.BOS 
          PX6    B6,X7
          MX7    0
          SA6    X2 
          SA1    F$RDT+OC.BOS 
          SA7    A6+B1
          BX6    X1 
          SA6    A7+B1
          SA7    A6+B1
          SB3    4           RI = 4 
          SA1    =XO$ENTP 
          SA3    =XO$FPI
          IX0    X1+X5
          SB6    X3-1 
          SA2    X0 
          SB4    60 
  
 OLC10    NZ     B4,OLC20    IF WORD NOT EXHAUSTED
          SB4    60 
          SA2    A2+1 
  
 OLC20    SB4    B4-15
          MX0    -EF.ORDL 
          AX4    B4,X2
          BX6    -X0*X4 
          ZR     X6,OLC30    IF END OF PARAMATER LIST 
  
*         IF FPI.LC IS SET, ISSUE CODE TO DEFINE LOCAL COPY.
  
          LX4    B1,X6
          IX4    X4+X6
          SA4    B7+X4
          MX0    -WB.FPNOL
          BX5    X4 
          LX4    -WB.FPNOP
          BX3    -X0*X4 
          SA4    B6+X3       FPI(FP)
          HX4    FP.LC
          PL     X4,OLC10    IF NO LOCAL COPY 
          MX0    -WB.MODEL
          LX5    -WB.MODEP
          SA6    OLCA        SAVE IH
          BX0    -X0*X5 
          =B2    1           FLAG DOUBLE WORD 
          SB5    X0-M.DBL 
          ZR     B5,OLC24    IF FP DOUBLE 
          EQ     B5,B1,OLC24 IF FP COMPLEX
          =B2    0           FLAG SINGLE WORD 
  
 OLC24    LX4    1+FP.LCP-FP.CAP
          MX0    -FP.CAL
          BX0    -X0*X4 
  
 OLC25    SX5    B3          RI 
          SB5    OC.LD
          LX6    IH.IHP 
          RJ     SRI         ISSUE LD 4,FP
          SX5    B3 
          SX4    B3-4 
          LX4    R1.RJP 
          BX5    X5+X4
          MX6    0
          SB5    OC.XMT 
          RJ     SRI         ISSUE XMT 10,4 
          SX5    B3-4 
          SB5    OC.ST
          SA1    =XS=LC 
          LX0    IH.CAP 
          LX1    IH.IHP 
          BX6    X0+X1
          RJ     SRI         ISSUE ST 10,LC.+K
          ZR     B2,OLC10    IF NOT ABOUT TO DO LOWER 
          =X5    1
          LX5    IH.CAP-IH.IHP     CA = 1 
          SA3    OLCA 
          BX6    X3+X5
          LX0    -IH.CAP
          =X0    X0+1        K = K + 1
          =B2    0           FLAG LOWER DONE
          EQ     OLC25       OUTPUT LOWER 
  
 OLC30    SX6    B3 
          SX7    B3-4 
          SA6    L$TXT
          ZR     X7,EXIT. 
          SA7    =XCC$BRN+1 
          ISSUE  I.BCI
          CALL   CG$CPC 
          ISSUE  I.ECI
          EQ     EXIT.
  
 OLCA     BSS    1
 SRI      SPACE  4,8
**        SRI - STORE RLIST INSTRUCTION.
* 
*         ENTRY  B5 = OPCODE
*                X5 = R1
*                X6 = R2
* 
*         BUMPS RI IN B3
  
 SRI      SUBR
          PX7    B5,X5
          SA3    F$RDT+B5 
          SA7    A7+B1
          SA6    A7+B1
          MX7    0
          BX6    X3 
          SA6    A6+B1
          SB3    B3+4 
          SA7    A6+1 
          EQ     EXIT.
 OVC      SPACE  4,10 
**        OVC - OUTPUT VARDIM CODE. 
  
 OVC      SUBR
          BX6    X4 
          SA6    OVCA 
          SA1    =XL$VDT
          ZR     X1,EXIT.    IF NO VARDIM 
          RJ     MVT         MOVE VARDIM TO TXT 
  
*         ZERO ALL VD.ALO BITS AND RESET THOSE FOR VD. CELLS WHICH
*         THIS ENTRY POINT IS ALLOWED TO ACCESS.
  
          SA1    OVCA 
          RJ     MAV         MARK VARDIMS APPLICABLE TO THIS ENTRY
          RJ     MMV         MARK MATERIALIZED VARDIM 
          ISSUE  I.BCI       START OF CCG OUTPUT
          SA1    L$TXT
          SX6    X1-4 
          SA6    =XCC$BRN+1 
          CALL   CG$CPC 
          ISSUE  I.ECI
          EQ     EXIT.
  
 OVCA     BSS    1           ENTRY SYMTAB ORDINAL 
 MVT      SPACE  4,8
**        MVT - MOVE VARDIM TO TXT. 
  
 MVT      SUBR
          MX6    0
          SA6    =XL$TXT
          ALLOC  TXT,X1+3 
          MX7    60 
          SB7    X3-1 
          SA7    X2+B7
          SX1    X3-3 
          BX6    X1 
          BX3    X2 
          SA6    A3 
          SA2    =XO$VDT
          MOVE   X1,X2,X3    MOVE (L$VDT, VDT, TXT) 
          EQ     EXIT.
 MMV      SPACE  4,8
**        MMV - MARK MATERIALIZED VARDIMS.
*         LOOP THROUGH TXT COPY OF VARDIM CODE, PROCESSING ALL STORES.
*         THOSE VD. CELLS WHICH ARE NEEDED (ALLOWED FOR THIS ENTRY POINT
*         AND USED IN THE PROGRAM) ARE GIVEN THEIR REAL CA FROM VDT.
*         OTHER VD. STORES ARE NO-OP*ED.
  
 MMV      SUBR
          SA2    =XO$TXT
          SB4    59-D.STP 
          SA1    X2+2+3*4    I = 4  STORE MAY BE 4TH INST. AT EARLIEST
          SA2    =XO$VDI
          SB6    X2 
          SA2    =XF$RDT+OC.NOP 
          SB5    OC.NOP 
          BX7    X2 
          MX5    VD.MAL 
          SB3    4
          LX5    VD.MAL+VD.MAP
          MX0    -VD.CAL
  
 MMV10    LX3    B4,X1
          SA1    A1+B3
          PL     X3,MMV10    IF NOT ST[D(I)]
          ZR     X3,EXIT.    IF I = LEN(TXT)
          SA2    A1-5        R2W = R2(I)
          LX2    -IH.CAP
          SA4    X2+B6       VDW = VDT(CA[R2W]) 
          HX4    VD.MA
          BX3    -X4*X5 
          NZ     X3,MMV15    IF THIS VD. NOT NEEDED 
          LX4    VD.MAP+VD.MAL-VD.CAP 
          BX4    -X0*X4 
          BX6    X0*X2
          BX6    X4+X6       CA[R2W] = CA[VDW]
          LX6    IH.CAP 
          SA6    A2 
          EQ     MMV10
  
 MMV15    MX3    0
          SA7    A2+B1       D(I) = RDT(OC.NOP) 
          PX6    B5,X3
          SA6    A2-B1       R1(I) = P(OC.NOP)
          EQ     MMV10
*CALL COMFISA 
*CALL COMFMAV 
 OSI      EJECT 
**        OSI - ISSUE SUB INDEX TABLE.
  
 OSI      SUBR
          SA6    OSIA 
          MX7    0
          SA7    =XL$TST
          SA7    OSIB 
          SA1    =XN.CPL
          SX1    X1+B1
          ALLOC  TST,X1 
          MX7    0
          SA7    A3          L$TST = 0
  
*         ISSUE CPL WORD FOR EACH FORMAL PARAMETER. 
  
          SA1    =XO$ENTP 
          SA2    =XL$ENTP 
          IX0    X1+X2
          SA5    X1-1 
          SB5    X0 
          EQ     OSI20
  
*         ISSUE ZERO TERMINATOR FOR THIS LIST.
  
 OSI10    SA2    OSIB 
          SA3    L$TST
          IX1    X3-X2
          ZR     X1,OSI20    IF NO SUBS THIS LIST 
          MX1    1
          ADDWRD TST,X1 
          SA1    OSIB 
          SB2    X1 
          SA1    =XO$TST
          SA3    L$TST
          RJ     SLE         SQUEEZE LAST ENTRY IF POSSIBLE 
          SA6    OSIB 
          SA6    L$TST
          SX6    B2+B1
          SA1    OSIC 
          SA2    X1 
          SA1    OSIA 
          SA1    OSIS+X1
          SB3    X1 
          LX6    B3 
          BX7    X2+X6
          SA7    A2          SUBI[ENTP(I)] = OLD SUBI LEN 
  
 OSI20    SB3    A5+B1
          SX6    B3 
          SA6    OSIC        SAVE HEADER ADDRESS
          SB6    B3-B5
          ZR     B6,OSI50    IF END OF ENTP 
          SA5    B3+B1       SKIP HEADER
          SB4    60 
  
 OSI30    NZ     B4,OSI40    IF THIS WORD NOT EXHAUSTED 
          SB4    60 
          SA5    A5+1 
  
 OSI40    SB4    B4-15
          MX0    -EF.ORDL 
          AX3    B4,X5
          BX6    -X0*X3 
          ZR     X6,OSI10    IF END OF LIST 
          SA1    O$SYM
          LX7    B1,X6
          IX3    X7+X6
          =B7    X1+WB.W
          SA1    B7+X3
          MX0    -WB.FPNOL
          SA2    =XO$FPI
          LX1    -WB.FPNOP
          BX1    -X0*X1 
          IX3    X1+X2
          SA3    X3-1 
          SA4    OSIA 
          SA2    OSIM3+X4 
          SA1    OSIM2+X4 
          BX0    X1*X3
          ZR     X0,OSI30    IF FP NOT APPLICABLE 
          BX0    X2*X3
          ZR     X0,OSI30    IF SUB0 AND NOT LEVEL = 0
          ADDWRD TST,X6 
          EQ     OSI30
  
 OSI50    SA1    L$TST
          SA2    O$TST
  
*         LOOP THROUGH TEMP. SUB TABLE AND ISSUE SUB INDEX TABLE. 
  
          MX7    0
          IX0    X1+X2
          SA7    A1          L$TST = 0
          SA7    X0          ZERO TERMINATE TST 
          SA4    X2-1 
  
 OSI60    SA4    A4+B1
          ZR     X4,EXIT.    IF TST TERMINATOR
          MI     X4,OSI70    IF SUBLIST TERMINATOR
          SA1    OSIA 
          SA2    OSIO+X1
          ISSUE  X2,X4
          EQ     OSI60
  
 OSI70    ISSUE  I.ZERO 
          EQ     OSI60
  
 OSIA     BSS    1
 OSIB     BSSZ   1
 OSIC     BSS    1
 OSIS     CON    EH.SUBIP,EH.SB0IP
 OSIO     CON    I.SUBI,I.SB0I
 OSIM2    BFMW   FP,LEN 
          BFMW   FP,(LC,VD,SUB0)
 OSIM3    VFD    60/-0
          BFMW   FP,LEV0
 SLE      EJECT 
*         SLE - SQUEEZE LAST TABLE ENTRY. 
* 
*         ENTRY  A1,X1 = TABLE FWA
*                A3,X3 = TABLE LENGTH (INCLUDING NEW ENTRY) 
*                B2 = INDEX OF NEW ENTRY (LENGTH WITHOUT NEW ENTRY) 
* 
*         EXIT   X6 = LENGTH INCLUDING NEW ENTRY IF NOT ALREADY PRESENT 
*                B2 = INDEX OF ENTRY (SQUEEZED OR NOT)
* 
*         PRESERVES A4,A5, X4,X5 ,B5
  
 SLE      SUBR
          BX6    X3 
          SB3    X3 
          EQ     B2,B3,EXIT. IF NOTHING ADDED 
          SB4    B3-B2
          SB3    B2-B4
          LT     B2,B4,EXIT. IF NOT ENOUGH ROOM FOR POSSIBLE COPY 
  
 SLE10    SA2    X1+B2
          SB7    B4-B1
          SA3    X1+B3
  
*         SCAN BACKWARDS FOR COPY OF FIRST ELEMENT OF NEW ENTRY.
  
 SLE20    BX7    X3-X2
          =A3    A3-1 
          MI     B3,EXIT.    IF BEGINNING OF TABLE - NO HIT 
          =B3    B3-1 
          NZ     X7,SLE20    IF NOT MATCH 
          =X0    A3+1 
          =A2    A2+1 
          =A3    X0+1 
  
 SLE30    ZR     B7,SLE40    IF WHOLE ENTRY MATCHES 
          BX7    X2-X3
          =B7    B7-1 
          =A2    A2+1 
          =A3    A3+1 
          ZR     X7,SLE30    IF MATCH 
  
*         START LOOKING FOR FIRST ELEMENT AGAIN.
  
          IX3    X0-X1
          SB3    X3-1 
          EQ     SLE10
  
 SLE40    SX6    B2          NEW LENGTH 
          IX3    X0-X1
          SB2    X3          BIAS 
          EQ     EXIT.
*CALL COMFOSC 
 AFT      EJECT 
**        BR$AFT - CALLED AFTER *SQZ* BY CCG. 
* 
*         NORMALLY DO-NOTHING ROUTINE, BUT USED BY MZP TO REGAIN
*         CONTROL WITH NO CODE GENERATION 
  
 BR$AFT   SUBR   =
          EQ     EXIT.
 MZP      SPACE  4,8
**        MZP - MARK PARAMETERS USED IN VD. EXPRESSIONS.
*         THIS INFORMATION IS NEEDED WHEN OUTPUTING SUB0 INDEX TABLE
*         SINCE SOME SUB0 REFERENCES HAVE NOT YET BEEN POSTED (FROM VD. 
*         CODE. 
  
 MZP      SUBR
          SA3    =XLEVEL0 
          SA1    =XL$VDT
          ZR     X3,EXIT.    IF NO POSSIBLE SUB0*S
  
 #MD      IFEQ   .DAL,1 
          ZR     X1,EXIT.    IF NO VARDIM 
          RJ     MVT         MOVE VARDIM TO TXT 
  
*         SET *ALLOWED* PROPERTY ON ALL VARDIMS, AS WE WANT 
*         THIS SEQ. TO CONTAIN THE UNION OF VARDIM CODE FROM
*         ALL ENTRY BLOCKS. 
  
          SA2    O$VDI
          SA3    L$VDI
          SB7    X3 
          CLAS=  X0,VD,ALO
          SA4    X2 
  
 MZP10    BX6    X0+X4
          SB7    B7-B1
          SA6    A4 
          SA4    A4+B1
          NZ     B7,MZP10    IF VDI NOT EXHAUSTED 
          RJ     MMV         MARK NEEDED VARDIM (SQUEEZE UNNEEDED)
          PLUG   AT=BR$AFT+1,TO=MZP20,VOID=NO 
          SA1    L$TXT
          SX6    X1-4 
          SA6    =XCC$BRN+1 
          CALL   CG$CPC 
  
*         REGAIN CONTROL AFTER *SQZ* AND MARK FPS LOADED IN VD. CODE. 
  
 MZP20    PLUG   AT=BR$AFT+1,TO=BR$AFT,VOID=NO
          SX7    4
          SA7    L$TXT
          SA2    O$TXT
          SA1    X2 
          CLAS=  X4,D,(FP,L2,LD)
          BX0    X4 
          SA4    =XO$FPI
          SB7    X4-1 
          SA5    =XO$SYM
          =B6    X5+WB.W
          MX7    -WB.FPNOL
          CLAS=  X5,FP,VD 
  
 MZP30    UX1    B2,X1
          ERRNZ  OC.EOQ 
          SA1    A1+2 
          ZR     B2,EXIT.    IF END OF SEQUENCE 
          BX2    X0*X1
          SA1    A1+2 
          BX3    X0-X2
          NZ     X3,MZP30    IF NOT LCM FORMAL LOAD 
  
*         SET FP.VD.
  
          SA2    A1-3 
          LX2    -IH.IHP
          SX3    X2 
          LX4    B1,X3
          IX2    X3+X4
          SA2    B6+X2       WBI = WB(IH[R2(I)])
          LX2    -WB.FPNOP
          BX3    -X7*X2 
          SA2    B7+X3       FPI(FPNO[WBI]) 
          BX6    X2+X5       VD[FPI] = 1
          SA6    A2 
          EQ     MZP30
 #MD      ELSE
 .TEST    IFEQ   TEST,1,1 
          EQ     "BLOWUP" 
 #MD      ENDIF 
 CAW      EJECT 
**        CAW - CONVERT APLIST INDEX TABLE TO WC FORMAT.
* 
*         ENTRY  B5 - 0 FOR APT,  1 FOR IOA.
  
 CAW      SUBR
          ADDWRD APT+B5,B0   ADD SEARCH TERMINATOR
          SX7    X3-1 
          SX0    =XBN=APL+B5
          SA1    X2          N = 0
          SB6    X2 
          LX0    WC.RBP 
          MX5    0           EQFLAG = 0 
          SA7    A3          L$APT = L$APT - 1
  
*         DEFINE ADDRESSES OF NON-EQUIVALENCED APLISTS. 
  
 CAW10    BX5    X5+X1       EQFLAG = EQFLAG .OR. EQV[APT(N)] 
          SA1    A1+B1       N=N+1
          ZR     X1,CAW20    IF N GT L$APT
          LX1    59-AI.EQVP 
          MI     X1,CAW10    IF EQV[APT(N)] 
          LX1    1+AI.EQVP-AI.INDXP 
          SX4    X1          ILWA1 = INDX[APT(N)] 
          LX1    AI.INDXP-AI.LENP 
          SX3    X1          LEN = LEN[APT(N)]
          IX6    X4-X3
          MX1    0
          LX6    WC.RAP      RA[APT(N)] = ILWA1 - LEN 
          AX6    B5          IOA IS 2 WORDS PER ENTRY 
          BX6    X6+X0       RB[APT(N)] = BN=APL
          SA6    A1 
          EQ     CAW10
  
*         DEFINE ADDRESSES OF EQV. ENTRYIES.
  
 CAW20    PL     X5,EXIT.    IF .NOT. EQFLAG
          SA5    B6+         N=0
  
 CAW30    SA5    A5+B1       N = N + 1
          ZR     X5,EXIT.    IF N GT L$APT
          LX5    59-AI.EQVP 
          PL     X5,CAW30    IF NOT EQV[APT(N)] 
          SB3    B0          CA = 0 
          BX1    X5          L = N
  
 CAW40    LX1    1+AI.EQVP-AI.ORDP
          SB7    X1 
          LX1    AI.ORDP-AI.BIASP 
          SB3    B3+X1       CA = CA + BIAS[APT(L)] 
          SA1    B6+B7       L=ORD[APT(L)]
          LX1    59-AI.EQVP 
          MI     X1,CAW40    IF EQV[APT(L)] 
          SX2    B3 
          AX2    B5          IOA 2-WORD/ENTRY 
          LX1    1+AI.EQVP
          LX2    WC.RAP 
          IX6    X1+X2       RA[APT(N)] = RA[APT)] + CA 
          SA6    A5 
          EQ     CAW30
 MEP      EJECT 
*         MEP - MISCELLANEOUS END PROCESSING FOR CCG MODE ONLY. 
*         PASS 3 TYPE PROCESSING THAT MUST BE PERFORMED IN PASS 2.
  
 MEP      SUBR
  
*         SET LENGTH OF RUN-TIME CONSTANT TABLE FOR PASS3.
  
          SA1    =XL$CUT
          SA2    =XO$CUT
          MX6    0
          ZR     X1,MEP10    IF NO CONSTANTS
          SB2    X1 
  
 MEP5     SB2    B2-1 
          SA1    X2+B2
          IX6    X6+X1       N.CON = N.CON + CUT(I) 
          NZ     B2,MEP5     IF NOT TOP OF CUT
  
 MEP10    SA6    =XN.CON
  
          SA3    =XCC$PC
          SA4    =XCC$BLEN
          SA2    =XCC$LBO 
          LX3    18 
          BX6    X3+X4
          SA6    =XF$LBT+X2 
          CALL   CG$IEP 
          RJ     MDV         REFORMAT APPROPRIATE VD POINTERS IN DIMTAB 
          EQ     EXIT.
 MDV      SPACE  4,8
**        MDV - MARK CERTAIN DIMTAB-RESIDENT VARDIMS AS NEEDED. 
* 
*         MDV MARKS SPAN AND LOWER BOUND OF *MAT* DIMTAB AS 
*         NEEDED. 
* 
  
 MDV      SUBR
          MX0    -DM.INFL 
          SA2    =XO$DIM
          SA3    =XL$DIM
          IX7    X2+X3
          SB7    X7 
          SA2    X2-1 
  
 MDV5     SA2    A2+B1
          SB2    A2-B7
          ZR     B2,EXIT.    IF DIMTAB EXHAUSTED
          BX4    X2 
          HX4    DH.VD
          LX2    -DH.DIMP 
          MX3    -DH.DIML 
          BX3    -X3*X2 
          PL     X4,MDV40    IF NOT VARDIM
          LX4    DH.VDP-DH.MATP 
          PL     X4,MDV40    IF NOT NEEDED
          SB6    X3 
  
 MDV10    =A2    A2+1 
          LX2    59-D1.SPANP-DM.TDP 
          PL     X2,MDV20    IF NOT VARIABLE SPAN 
          LX2    1+DM.TDP 
          BX1    -X0*X2 
          CALL   CG$AVO 
          BX6    X0*X2       CLEAR CA 
          BX6    X1+X6       NEW CA FROM AVO
          LX6    D1.SPANP 
          SA6    A2 
  
 MDV20    =A2    A2+1 
          LX2    59-D2.LBP-DM.TDP 
          PL     X2,MDV30    IF NOT VARIABLE LOWER BOUND
          LX2    1+DM.TDP 
          BX1    -X0*X2 
          CALL   CG$AVO 
          BX6    X0*X2       CLEAR CA 
          BX6    X1+X6       NEW CA FROM AVO
          LX6    D2.LBP 
          SA6    A2 
  
 MDV30    =B6    B6-1 
          NZ     B6,MDV10    IF MORE DIMENSIONS TO GO 
          EQ     MDV5 
  
 MDV40    LX4    B1,X3
          ERRNZ  Z=DD-2 
          SB6    X4 
          SA2    A2+B6
          EQ     MDV5 
 OUTPTK   EJECT 
  
  
          LIST   D
          END 
