*DECK     QCGC - QUICK CODE GENERATOR CONTROLLER. 
          IDENT  QCGC 
 QCGC     SECT   (QUICK CODE GENERATOR CONTROLLER.) 
 QCGC     SPACE  4,10 
***       QCGC - QUICK CODE GENERATOR CONTROLLER. 
* 
*         FOR QCG.
  
  
 .FAST    EQU    0
 .OPT     EQU    1
 .CG      EQU    .FAST       INDICATE QUICK CODE GENERATOR
  
  
*         IN ALLOC
          EXT    ADW,ALC.CAI,ALC.REG,ALC.00,ALC 
  
*         IN CONRED 
          EXT    REG=T
  
*         IN FEC
          EXT    CHARMAP,SCS,SCSA 
  
*         IN FSNAP
          EXT    DMT=,SN.PAR
  
*         IN FTN
          EXT    CO.CS,CO.DBID,CO.DBST,CO.DOOT,CO.SNAP,F.PB 
  
*         IN FUN
          EXT    APLFLG,L.APLF
  
*         IN GEN
          EXT    EIS,ENT.EGL,ENT.VD,OCIOL 
  
*         IN IDP
          EXT    SNP= 
  
*         IN PUC
          EXT    BINIO,BN=BUF,BN=TEM,CBI,F.LBT,MOD,N$LC,N.CTMAX,N.GL
          EXT    N.STMAX,N.ST,N.TABLE,N.VD,PIK=PS,S=CT,S=LC,S=IT,S=OT 
          EXT    S=ST,S=TA0,S=TRACE,S=VD,T=GL,T=OUS,T=PAR,T=SYM 
          EXT    T=VDIM,T.API,T.GL,T.IOI,T.OUS,T.PAR,T.SYM,T.VDIM 
  
*         IN QSKEL
          EXT    F.SCT
          EXT    V=ARY,V=BVD,V=NOOP,V=SUBST 
  
*         IN REG
          EXT    CDS
  
*         IN UTILITY
          EXT    MVE=,WTO=
*CALL     COMAQCG            QCG MACRO DEFINITIONS
*CALL     COMSQCG            QCG STRUCTURE DECLARATIONS.
*CALL     COMSQRF            QCG REGISTER ASSOCIATES
          ENTRY  REGFILE
  
          LIST   -X          SKPSET IS LISTED IN QSKEL
*CALL     SKPSET             SET SOMETHING FOR SKOP 
*                            SKPCONQ IS LISTED IN QSKEL 
*CALL     SKPCONQ            CONSTANTS FOR SKOP 
          LIST   *
 REG=G    SPACE  4,10 
**        REG=G  - VECTORS OF GENERATED OPERANDS. 
  
  
 REG=G    BSZENT SKU.GOP
  
 REG=GL   EQUENT REG=G       USE-COUNTED (L) OPERANDS 
 REG=GP   EQUENT REG=G       NO REGISTER (P) OPERANDS 
          TITLE  DATA CELLS.
 CELLS    SPACE  4,10 
**        DATA CELLS GLOBAL TO QCG. 
  
  
  
 CII      BSSENT 0           DUMMY ENTRY POINT FOR QCG ONLY 
 N$IT     CONENT 0
 N$OT     CONENT 0
  
 DRITE    BSZENT 3           DELAYED STORE INFO 
  
 NOLDS    CONENT 0           NUMBER OF LOADS
  
 RGC      CONENT 6           REGISTER USAGE COUNT 
                             = 1 + NUMBER OF LOAD REGISTERS 
  
 RGX      CONENT 5           NUMBER OF LOAD REGISTERS 
  
 RREG     CONENT -0          REQUIRED HARD REGISTER TO ASSIGN FOR LOAD
                             .GE. 0  =  0TR, REGISTER TO LOAD INTO
                             .LT. 0  = -0TR, MEANS LOAD SATISFIED 
                             .EQ. -0,  NOT ACTIVE 
  
 TRACE    CONENT 0           LINE NUMBER OF RJ IN PROCESS 
  
 TYPLOD   CONENT 0           TYPE OF CURRENT LOAD (0=UPPER, 1=LOWER)
  
 UUC      CONENT 0           USE COUNT INCREMENT
 WQ.      SPACE  4,10 
**        QCG WORKING COPY OF COMPILER OPTIONS. 
*         1.  INITIALIZED = (CO.) AT BEGINNING OF PROGRAM-UNIT. 
*         2.  RESET BY (V=C$) TURPLES.
*         3.  USED TO DETERMINE QCG BEHAVIOR. 
*         THESE EXIST BECAUSE (WO.) MAY BE OUT OF SYNCH.
  
  
 WQ.CS    BSSENT 1           COLLATING SEQUENCE 
 WQ.DOOT  BSSENT 1           DO-LOOP ONE-TRIP 
          TITLE  CAI - COMPILE ALL INSTRUCTIONS.
 CAI      SPACE  4,10 
**        CAI -  COMPILE ALL INSTRUCTIONS.
* 
*         ENTRY  (T.PAR) = IL SEGMENT TO PROCESS. 
*                          THE SEGMENT MUST BE WELL-FORMED AND
*                          CANNOT BE EMPTY. 
*                (PASS)  SET. 
* 
*         EXIT   (T.PAR) = EMPTY. 
*                (T.OUS) = EMPTY. 
*                (N.STMAX) = MAXIMUM TEMPORARY CELL USED. 
* 
*         USES   ALL. 
*         CALLS  DOW, DUC, EIS. 
  
  
 CAI      SUBR   =           ENTRY/EXIT...
          SETMEM REGFILE,L.RGFILE 
          SETMEM APLFLG,L.APLF
          RJ     PIG         PROCESS I. L. FOR GEN
          SA4    T.PAR
  
**        DUMP NUMBER OF TERMS FOUND (ONLY IF IN TEST MODE) 
  
 .TEST    IFEQ   TEST,ON     IF TEST MODE 
          SA2    CO.SNAP
          LX2    1RA
          PL     X2,CAI2SN   IF *ARITH* SNAP NOT REQUESTED
 SNP=A    DUMPT  (OUS)       OPERAND USAGE STATUS 
          CALL   SN.PAR 
 CAI2SN   BSS    0
 .TEST    ENDIF 
  
          SETMEM =XREG=T,SKU.TMP   CLEAR T_N VECTOR 
  
**        PROCESS EXPANSION OF PARSED FILE FOR CODE GENERATION. 
  
          SB4    X4          PRESET *B4* TO START OF PARSED FILE
          SA1    ALC.CAI
          BX7    X1          LOCK (B4) _ PARSED FILE
          SA7    ALC.REG
          CALL   EIS         EXPAND INSTRUCTION SKELETONS 
          DRITE  DEACTIVATE 
          SA1    ALC.00      UNLOCK (B4)
          BX7    X1 
          SA7    ALC.REG
  
**        EXIT --   P A S S   T W O.... 
  
  
          SHRINK T=PAR,0
          SHRINK T=OUS,X6 
  
**        RESET N.STMAX TO MAXIMUM TEMPORARY BIAS.
  
          SA2    N.STMAX
          SA3    N.ST 
          MX6    X2+X3       (X6) = MAX TEMP-TAG GENERATED
          SA6    A2          RESET N.STMAX
          =X7    0
          SA7    A3          RESET (TG.TEM) 
          EQ     EXIT.       EXIT...
  
 PIG      SPACE  4,20 
**        PIG -  PREPARE I. L. FOR GEN
*         PIG CALLS THE I. L. REFORMATTERS AND CHECKS THE 
*         I. L. TYPE FOR A VAR DIM I. L. WHEN A V-DIM I. L. 
*         IS FOUND IT IS SAVED IN T.VDIN FOR REPEATED USE 
*         AT ENTRY CODE TIME
* 
*         ENTRY  I. L. IN PASS 1 FORM(OPERATORS - TH, OPERANDS - TP)
* 
*         EXIT   OPERATORS ARE OP, AND OPERANDS ARE P2 FORMAT 
*                IF PROCESSING V-DIM I. L.: 
*                ENT.VD SET TO 1
*                T.VDIM CONTAINS V-DIM I. L.
* 
*         USES   A1,A2,A3,A6,A7 X0,X1,X2,X3,X6,X7 
* 
*         CALLS  ADW, ALC, DUC, DOW, MVE= 
  
  
 PIG      SUBR   =           ...ENTRY/EXIT... 
          SHRINK T=OUS,0
          SA1    T.PAR
          =A2    X1          GET THE FIRST OPERAND FOR V-DIM TEST 
          HX2    OP.SKEL
          SX0    V=BVD
          AX2    -OP.SKELL
          IX0    X0-X2
          NZ     X0,PIG5     IF NOT A BVD, CONTINUE NORMALLY
          =X7    1
          SA2    ENT.VD      GET VDIM FLAG
          NZ     X2,PIG5     IF VAR-DIM PROCESS ALREADY INITIALIZED 
          SA7    A2          SET V-DIM FLAG 
          SHRINK T=VDIM,0 
          SA2    T=PAR
          ALLOC  T.VDIM,X2-Z=TURP  MAKE ROOM TO MOVE V-DIM I.L. 
          SA1    T=VDIM      COUNT
          SA2    T.PAR       SOURCE 
          SA3    T.VDIM      DESTINATION
          MOVE   X1,X2,X3    MOVE V-DIM I.L. TO T.VDIM
          SHRINK T=PAR,3     SHRINK T.PAR BY LENGTH OF VDIM IL
          SA2    T=VDIM      (X2) = VDIM LENGTH = VDIM I.L. LENGTH
          SA3    T.PAR       DESTINATION
          IX2    X3+X2       FWA TO BE MOVED = FIN TURPLE ADDERESS
          MOVE   Z=TURP,X2,X3      MOVE FIN TURP TO FWA I. L. 
  
 PIG5     SA1    T.PAR
          RJ     DOW         DEFORM  OPERATOR WORD
  
**        SET-UP USAGE TABLE -- THEN SORT FROM HIGHEST TO LOWEST USAGE
  
          =X6    0
          ADDWD  T.OUS       START OUS WITH A ZERO WORD 
          SA1    T.PAR       (A1,X1) _,= FWA I. L. FOR DUC
          RJ     DUC         DETERMINE USE COUNTS 
          BX6    0
          ADDWD  T.PAR       END INDICATOR
          EQ     EXIT.
  
 DOW      SPACE  4,30 
**        DOW - DEFORM OPERATOR WORD. 
* 
*         THE OPERATOR WORD OF EACH TURPLE (TH. FORMAT) IS DEFORMED 
*         INTO THE QCG OPERATOR/STATUS WORD (OP. FORMAT). 
* 
*         ENTRY  (A1, X1) = ORIGIN WORD OF TABLE CONTAINING PARSED FILE.
* 
*         EXIT   (A1, X1) PRESERVED.
  
  
 DOW      SUBR               ...ENTRY/EXIT... 
          SA2    A1+N.TABLE  LENGTH OF TABLE
          SB3    Z=TURP 
          SA3    X1-Z=TURP
          SB5    X2 
          MX2    -OP.QATRL
          LX2    TH.QATRP 
          ERRNZ  TH.QATRL-OP.QATRL
          MX4    -OP.CHINL
          LX4    TH.OVALP 
          ERRMI  TH.OVALL-OP.CHINL
          CLAS=  X5,OP,(SKEL,LINE,MODE) 
          ERRNZ  TH.SKELP-OP.SKELP
          ERRNZ  TH.SKELL-OP.SKELL
          ERRNZ  TH.LINEP-OP.LINEP
          ERRNZ  TH.LINEL-OP.LINEL
          ERRNZ  TH.MODEP-OP.MODEP
          ERRNZ  TH.MODEL-OP.MODEL
  
 DOW2     SA3    A3+B3       FETCH NEXT OPERAND 
          SB5    B5-B3
          MI     B5,EXIT.    IF TABLE EXHAUSTED 
          BX0    X5*X3       PRESERVE USEFUL FIELDS 
          BX7    -X2*X3      EXTRACT QATR BITS
          LX7    -TH.QATRP+OP.QATRP      POSITION QATR BITS 
          BX0    X7+X0       ADD IN NEW QATR FIELD
          BX6    -X4*X3      EXTRACT CHARMAP INDEX
          LX6    -TH.OVALP+OP.CHINP 
          BX7    X0+X6
          SA7    A3          STORE QCG FORM OF OPERATOR/STATUS WORD 
          EQ     DOW2        LOOP.. 
 DUC      SPACE  4,20 
**        DUC -  DECIDE ON USE COUNT
*                DUC IS THE CONTROLLER FOR REFORMATTING OF
*                OPERANDS FROM PASS1 TO PASS2 FORMAT. THE 
*                PRIMARY DECISION IS WHETHER OPERANDS ARE 
*                REFORMATTED WITH OR WITHOUT USE COUNTS.
* 
*         ENTRY  INTERMEDIATE LANGUAGE BUILT
*                OPERANDS IN TP. FORMAT 
*                (A1) _ T.PAR 
*                (X1) = FWA OF I. L.
* 
*         EXIT   I. L. ORERANDS IN P2. FORMAT 
*                USE COUNTS SET IN P2.USE OF CHOSEN OPERANDS
*                USE COUNT SET IN OP.USE FIELD OF OPERATOR/STAT WORDS 
* 
*         USES   A1,A2,A3,  X1,X2,X3,X4,  B4,B5,B6,B7 
* 
*         CALLS  KUT, TIL, TIU
  
 DUC      SUBR               ...ENTRY/EXIT... 
          SA2    A1+N.TABLE  LOAD LENGTH OF TABLE BEING PROCESSED 
          IX0    X2+X1
          SB4    A1          SAVE TABLE ADDRESS 
          SX4    X2-Z=TURP   LENGTH - Z=TURP
          SB5    X1          FWA OF TABLE 
          BX1    X2 
          SA3    X4+B5
          EQ     DUC1       CONTINUE
  
**        REGISTER ALLOCATION 
*         (X2) = WORD FROM TABLE
*         (X4) = DECREMENT WORD 
*         (B4) _ TABLE ORIGIN WORD OF TABLE BEING SCANNED 
*         (B5) = FWA OF TABLE 
  
  
 DUC.NX   SA1    B4 
          SB5    X1          RESET FWA OF TABLE 
          SA3    X4+B5       NEXT TURPLE HEADER 
          MI     X4,EXIT.    IF FINISHED
  
*         DETERMINE TYPE OF OPERAND 
*         (X3) = OPERATOR WORD
  
 DUC1     MX1    -OP.CHINL
          LX3    -OP.CHINP
          BX2    -X1*X3      EXTRACT (X3) = CHARMAP INDEX 
          SA1    X2+CHARMAP  FETCH DUCABILITY VECTOR ELEMENT
          SX4    X4-Z=TURP
          =A2    A3+OR.2OP   PRELOAD 2ND OPERAND
          LX3    OP.CHINP    RESTORE (X3) 
          SB6    X1          B6 = DUC., DUC.1ST, DUC.2ND OR DUC.BTH 
          ERRNZ  18-CH.OPCL 
          JP     B6          (B6) = DUC.,DUC.1ST,DUC.2ND OR DUC.BTH 
  
 DUC.     BSSENT 0                 NEITHER OPPERAND IS USE COUNTED
          RJ     TIL               REFORMAT WITHOUT USE COUNT 
 DUC2     SA2    A2-OR.2OP+OR.1OP   FETCH SECOND OPERAND
          RJ     TIL         REFORMAT WITHOUT USE COUNT 
          EQ     DUC.NX      CONTINUE 
  
 DUC.1ST  BSSENT 0                 FIRST OPERAND USE COUNTED
          RJ     KUT         KILL UNUSED TURPLE 
          RJ     TIL               REFORMAT WITHOUT USE COUNT 
 DUC3     SA2    A2-OR.2OP+OR.1OP   FETCH FIRST OPERAND 
          RJ     TIU         REFORMAT WITH USE COUNT
          EQ     DUC.NX      CONTINUE 
  
 DUC.2ND  BSSENT 0           2ND OPERAND USE COUNTED
          RJ     KUT         KILL UNUSED TURPLE 
          RJ     TIU         REFORMAT WITH USE COUNT
          SA2    A2-OR.2OP+OR.1OP   GET FIRST OPERAND 
          RJ     TIL         REFORMAT WITHOUT USE COUNT 
          EQ     DUC.NX      CONTINUE 
  
 DUC.BTH  BSSENT 0           BOTH OPERANDS USE COUNTED
          RJ     KUT         KILL UNUSED TURPLE 
          RJ     TIU         REFORMAT WITH USE COUNT
          SA1    B4          FWA INTERMEDIATE LANGUAGE
          SB5    X1                PASS FWA TO TIU
          SA2    A2-OR.2OP+OR.1OP  GET FIRST OPERAND
          RJ     TIU         REFORMAT WITH USE COUNT
          EQ     DUC.NX      CONTINUE 
 KUT      SPACE  4,10 
**        KUT - KILL UNUSED TURPLE. 
* 
*         KUT ATTEMPTS TO NO-OP 'DANGLING' INTERMEDIATES, THOSE WHICH 
*         GENERATE VALUES WHICH ARE NEVER REFERRED TO.  THIS IS 
*         NECESSARY IN VARDIM EXPANSION, AND DESIREABLE IN GENERAL. 
* 
*         ENTRY  (A3) -> TURPLE HEADER. 
* 
*         EXIT   NORMAL, IF TURPLE NOT KILLED.
*         ELSE   TO *DUC.*, IF TURPLE IS NO-OPED. 
* 
*         KEEPS  (A2,X2),  X4,  B4,B5.
  
  
 KUT      SUBR   0           ENTRY/EXIT.
          MX1    -OP.1ORDL
          SA3    A3 
          LX1    OP.1ORDP 
          BX6    -X1*X3      EXTRACT (X6) = INDEX INTO (T.OUS)
          NZ     X6,EXIT.    IF THIS RESULT NEEDED
  
** MQ - NEED A 'KILL' BIT IN (F.SCT). 
*         FOR NOW, ASSUME THAT OPERATORS WHICH ARE NOT CONSTANT-REDUCIBL
*         ARE PRESENT FOR A GOOD REASON AND SHOULD NOT BE KILLED. 
*         NOTE THAT (DUC=NONE) OPERATORS ARE NEVER PRESENTED TO KUT.
  
          HX3    OP.SKEL
          AX3    -OP.SKELL
          SA1    X3+F.SCT    FETCH SKELETON CONTROL WORD
          HX1    VS.CRA 
          AX1    -VS.CRAL 
          ZR     X1,EXIT.    IF NOT A VALUE TURPLE
  
*         FOR NOW, DON'T KILL EXCEPT WHEN EXPANDING VARDIM. 
  
          SA1    B4 
          SA1    X1 
          HX1    OP.SKEL
          AX1    -OP.SKELL
          SX6    V=BVD
          IX7    X1-X6
          NZ     X7,EXIT.    IF NOT EXPANDING VARDIM
** FV            THIS SHOULD ALSO WORK FOR NORMAL IL SEGMENTS.... 
          SX6    V=NOOP 
          SX0    O.NONE 
          LX6    OP.SKELP 
          LX0    OP.CHINP 
          BX7    X6+X0       CHANGE TO NO-OP OPERATOR 
          SA7    A3 
          EQ     DUC. 
 POS      SPACE  4,20 
**        POS - PREPARE OPERAND AND STATUS WORD 
*                1. AN OPERAND STATUS WORD IS EITHER CREATED
*                   OR UPDATED AND PLACED IN T.OUS. 
*                2. L AND GL TYPE OPERANDS (IDENTICAL FORMATS) ARE
*                   CREATED AND RETURNED TO THE CALLER TO BE PLACED 
*                   IN THE I. L. OR REG=GL TABLE AS NEEDED. 
* 
*         CALLED BY:  
*                TIU WHICH PLACES OPERANDS IN THE I. L. AND 
*                SUBSKEL PROCESSORS WHICH PLACE OPERANDS IN REG=GL. 
* 
*         ENTRY  (X2) = OPERAND IN P2 FORMAT
*                (X6) = USE COUNT INCREMENT.
*                       1 IF CALLER IS TIU
*                       0 OTHERWISE 
* 
*         EXIT   (X2) = (X6) FOR INTERMEDIATES
*                     = OPERAND STATUS WORD FOR NON-INTERMEDIATES 
*                (X6) = I. L. ENTRY/PSEUDO OPERAND
*                T.OUS ENTRY IS SET 
* 
*         CALLS  SCS AND ADDWD
* 
*         SAVES  A4, B4,B5 X4,X5
* 
*         WARNING - NO GL OPERAND SHOULD BE CREATED WITHOUT CALLING POS.
  
 POS      SUBR   =           ENTRY/EXIT 
          SA6   POS.INC 
          CLAS=  X3,P2,(TAG,BIAS,2ATR,CLAS)  SCAN MASK
          BX6    X3 
          SA6    SCSA 
          CLAS=  X1,RG,(USE)
          BX6    X2 
          BX1    X1*X2       EXTRACT USE COUNT
          NZ     X1,EXIT.    IF OPERAND USE ALREADY COUNTED 
  
 .TEST    IFEQ   TEST,ON
          BX1    X2 
          SBIT   X1,P2.INTRP
          MI     X1,"BLOWUP" MUST COUNT ALL INTERMEDIATES 
 .TEST    ENDIF 
  
          SCAN   T.OUS,SCS   SCAN STATUS WORD TABLE 
          SA1    POS.INC     GET USE COUNT INCREMENT
          MI     B7,POS1     IF NOT ALREADY IN TABLE
          IX6    X2+X1       INCREMENT USE COUNT (MAY BE 0) 
          SA6    A2          REPLACE STATUDS WORD 
          SA1    T.OUS
          EQ     POS2 
  
*         *OPERAND* NOT IN TABLE (1ST USE) INITALIZE USE COUNT
*         AND ADD TO OPERAND USE TABLE
*         (X6) = I. L. ENTRY/PSUEDO OPERAND NOT YET USE COUNTED 
  
 POS1     SA3    SCSA        RELOAD MASK
          BX6    X3*X6       CLEAR USE COUNT FIELD
          IX6    X6+X1       SET USE COUNT TO POS.INC 
          ADDWD  T.OUS
  
**        HERE WE BUILD THE NEW I.L. ENTRY OR PSEUDO OPERAND.  THIS 
*         MEANS CREATING A NEW T.OUS TAG NEEDED BY REG. 
*         T.OUS TAG = C.OUS + ORDINAL INTO T.OUS
*         (A6) _ OPERAND STATUS WORD. 
*         (X1) = FWA T.OUS. 
*         (X6) = OPERAND STATUS WORD OF THE I. L. ENTRY/PSEUDO OPERAND
  
 POS2     SB7    X1          (B7) = FWA OF T.OUS
          MX0    P2.TAGL     MASK TO REMOVE SYM,PRO OR SHRT CON TAG 
          SX1    A6-B7       (X1) = ORDINAL INTO T.OUS
          LX0    P2.TAGL+P2.TAGP
          BX6    -X0*X6      REMOVE TAG 
          LX1    P2.TAGP     POSITION NEW TAG 
          SA2    A6          PUT STATUS WORD IN X2 FOR EXIT 
          IX6    X6+X1       REPLACE *TAG* WITH T.OUS ORDINAL 
          EQ     EXIT.
  
 POS.INC  CON    0           INC = 1 IF TIU IS CALLER, 0 OTHERWISE
 RED      SPACE  4,10 
**        RED -  REFORMAT FOR EXPANSION AND DEFINITION
* 
*         RED REFORMATS THE OPERATOR AS FOLLOWS:  
*                (1) THE LINE NUMBER IS REPLACED BY THE OUS ORDINAL 
*                (2) THE USE TOTALS ARE SET IN THE OP.LTOT AND OP.UTOT
*                    FIELDS.
* 
*         ENTRY  (X5) = OPERATOR WORD 
* 
*         EXIT   (X6) = SKELETON ORDINAL
*                (X7) = OPERATOR WORD NEW FORMAT
*                       OP.SKELL/SKEL,OP.2ORD/OUS ORDINAL,OP.CHIN/CHIN, 
*                       OP.MODEL/MODE,OP.LTOTL/LOWER USE TOTAL, 
*                       OP.UTOTL/UPPER USE TOTAL
*                ((B4)+OR.OPR) = NEW OPERATOR WORD (X7) 
* 
*         USES   A1,A5,A7   X0,X1,X5,X6,X7,   B7
* 
*         NOTE - UNLIKE THE OTHER REFORMATTERS RED IS NOT CALLED
*         FROM QCGC.  IT IS CALLED FORM THE MAIN LOOP IN EIS, AF- 
*         TER THE LINE NO. FIELD HAS BEEN USED. 
  
  
 RED      SUBR   =           ENTRY/EXIT 
          CLAS=  X1,OP,(SKEL,CHIN,MODE,BSSI)  PRESERVED FIELDS
          MX0    -OP.1ORDL   SET OUS ORDINAL MASK 
          ERRNZ  OP.2ORDL-OP.1ORDL
          ERRNZ  OP.1ORDP 
          BX6    X1*X5       SANITIZE NEW OPERATOR WORD 
          BX0    -X0*X5      EXTRACT OUS ORDINAL
          SA1    T.OUS       GET OUS FWA
          SB7    X0          (B7) = OUS ORDINAL 
          LX0    OP.2ORDP    POSITION OUS ORDINAL 
          SA5    B7+X1       GET STATUS WORD
          MX1    -RG.USEL    SET USE COUNT MASK 
          IX7    X0+X6       ADD IN OUS ORDINAL TO 2ORD FIELD 
          BX1    -X1*X5      EXTRACT USE TOTAL  FROM STATUS WORD
          ERRNZ  RG.USEP
          BX0    X1 
          LX0    OP.LTOTP    POSITION LOWER TOTAL 
          LX1    OP.UTOTP    OPSITION UPPER TOTAL 
          IX7    X7+X1       ADD IN UPPER TOTAL 
          HX6    OP.SKEL
          AX6    -OP.SKELL   EXTRACT SKELETON ORDINAL 
          IX7    X7+X0       ADD IN LOWER TOTAL 
          SA7    B4+OR.OPR   RESET OPERATOR WORD
          EQ     EXIT.
 TIL      SPACE  4,20 
**        TIL -  TRANSFORM INTERMEDIATE LANGUAGE. 
* 
*         CHANGES PASS 1 (TP.) OPERAND STRUCTURE TO THE (P2.) OPERAND 
*         STRUCTURE REQUIRED BY (QCG).
* 
*         ENTRY  (A2) _ OPERAND WORD
*                (X0) = C.XXX (P2. TAG PREFIX). 
*                (X2) = OPERAND WORD (TP. FORMAT).
* 
*         EXIT   (A2) _ OPERAND WORD
*                (X2) = OPERAND WORD IN P2. FORMAT. 
*                (X5) = OPERAND WORD IN TP. FORMAT. 
* 
*                PARSED FILE OPERAND SET TO P2. FORMAT. 
* 
*         USES   A1,A3,  X0,X1,X2,X3,X5,X6,  B2,B3
  
  
 TIL      SUBR               ENTRY/EXIT 
          BX5    X2          TP. WORD KEPT IN X5 THROUGHOUT 
          CLAS=  X3,TP,(TAG,BIAS,LCM,FP,INTR,SHRT,ADDR,ARR,CAT) 
          ECHO   2,F=(TAG,BIAS,LCM,FP,INTR,SHRT,ADDR,ARR,CAT) 
          ERRNZ  TP.F_P-P2.F_P
          ERRNZ  TP.F_L-P2.F_L
  
          MX0    -TP.MODEL
          LX2    -TP.MODEP
          BX1    -X0*X2      OPERAND MODE 
          LX2    TP.MODEP    RESTORE OPERAND
          BX6    X3*X2       FIELDS TO BE PRESERVED FOR PASS 2
          MX0    -1 
          SX1    X1-M.DBL    0 OR 1 IMPLIES LONG
          CLAS=  X3,TP,(GL) 
          BX1    X0*X1       ZERO IMPLIES LONG
          LX0    P2.LONGP 
          NZ     X1,TIL10    IF NOT DOUBLE OR COMPLEX 
          BX6    -X0+X6      P2.LONG = 1
  
 TIL10    BX1    X3*X2
          LX1    P2.PFXP-TP.GLP 
          ERRNZ  K=GL-1 
          BX6    X6+X1       P2.PFX = TP.GL 
          HX2    P2.INTR
          PL     X2,TIL20    IF NOT INTERMEDIATE OPERAND
          MX0    P2.TAGL
          MX2    P2.TAGL+P2.BIASL 
          BX1    X0*X6       EXTRACT TAG
          BX6    -X2*X6      CLEAR TAG AND BIAS 
          LX1    P2.BIASP-P2.TAGP 
          BX6    X1+X6       P2.BIAS = TP.TAG         P2.TAG = 0
  
 TIL20    BX2    X6 
          SA6    A2          RESET OPERAND WORD 
          EQ     EXIT.
 TIU      SPACE  4,20 
**        TIU -  TRANSFORM INTERMEDIATE LANGUAGE AND INSERT 
*                USE COUNT. CALLED FROM DUC TO REFORMAT 
*                OPERANDS REQUIRING USE COUNTS. AS IN TIL 
*                TP. FORMAT GIVES WAY TO THE P2. FORMAT.
* 
*         ENTRY  (A2) _ OPERAND WORD
*                (X2) = OPERAND WORD P2. FORMAT 
*                (X4) = NEXT TURPLE HEADER ORDINAL
*                (B4) = T.PAR 
*                (B5) = FWA INTERMEDIATE LANGUAGE 
* 
*         EXIT   (A2) _ PRESERVED 
*                (X2) = OPERAND IN P2. FORMAT 
*                (X4) - PRESERVED 
*                (X5) = OPERAND IN TP. FORMAT 
*                (B4) - PRESERVED 
* 
*         USES   A1,A3,A5,A6,A7,  X0,X1,X2,X3,X5,X6,X7,  B5,B7
*                FWA AND LENGTH POINTER WORDS FOR MANAGED TABLES
* 
*         CALLS ADDWD,SCAN AND TIL
* 
*         NOTE - NEITHER ADDWD NOR SCAN CAN DESTROY X4,X5,B4 OR B5
  
 TIU      SUBR               ENTRY/EXIT 
          SB7    X4+Z=TURP+OR.1OP 
          SB7    B7+B5
          SB7    A2-B7
          MX6    0
          NZ     B7,TIU1  IF NOT PROCESSING 1OP 
          SB7    B5+X4
          SA3    B7+Z=TURP
          HX3    OP.SKEL
          AX3    -OP.SKELL   EXTRACT SKELETON ORDINAL 
          BX1    -X3
          SB7    X1+V=SUBST 
          NZ     B7,TIU1     IF NOT SUBSTRING OPERAND 
          MX6    1
  
 TIU1     SA6    =STIUA 
          SA5    TIU.TP      PRESET A5
          RJ     TIL         REFORMAT TO P2.
          BX6    X5 
          SA6    A5          STORE TP. WORD 
          BX1    X2 
          SBIT   X1,P2.INTRP
          MI     X1,TIU8     IF INTERMEDIATE
          ZR     X6,EXIT.    IF NULL ARG. OF TWOARG 
  
**        OPERAND IS A SYMBOL 
  
**        (A2) _ P2 OPERAND 
*         (X2) = P2 OPERAND 
*         (B5) = FWA I. L.
  
 TIU5     =B5    A2-B5       (B5) = OPERAND ORDINAL IN I. L.
          =X6    1           SET USE COUNT INCREMENT FOR POS
          RJ     POS         PREPARE OPERAND AND STATUS WORD
          SA3    B4          GET FWA I. L.
          SA5    TIU.TP      PLACE TP. FORM IN (X5) 
          SA1    TIUA 
          SA2    X3+B5       RESTORE OPERAND
          MI     X1,EXIT.    IF SUBSTRING 1OP 
          SA6    A2          STORE NEW OPERAND
          EQ     EXIT.
  
**        INTERMEDIATE CASE:  HERE USE COUNTING MUST
*         BE MORE ACCURATE.  THE USE COUNT IS ACUMULATED
*         IN THE STATUS WORD FOR THE INTERMEDIATE.  WE
*         INCREMENT USE COUNT AS FOLLOWS: 
  
*         1) INC = 1:  FOR OPERANDS OF NON DEFERED TURPLES
*         2) INC = USE(CURRENT OPERATOR):  FOR DEFERED TURPLES
*         3) INC = TWICE 2): FOR CPLX/DBL DEFERED TURPLES 
* 
*         THERE ARE 2 OPERATERS INPORTANT TO ANY INTERMEDIATE:  
*         THE *CURRENT OPERATOR* - THE OPERATOR OF THE TURPLE CON-
*         TAINING THE INTERMEDIATE,  AND
*         THE *ASSOCIATE OPERATOR* - THE OPERATOR OUR INTERMEDIATE
*         POINTS TO.  THE ASSOCIATE IS USED TO CARRY A POINTER TO THE 
*         STATUS WORD,  AND IS LATER USED TO CARRY THE USE TOTALS.
* 
*         (X4)+Z=TURP = I. L. ORDINAL OF THE CURRENT OPERATOR 
*         (X2) = P2.WORD (BIAS = I. L. ORDINAL OF THE ASSOC OPERATOR) 
*         (X5) = TP. WORD 
*         (B4) = T.PAR
*         (B5) = FWA(I. L.) 
  
  
 TIU8     SB7    X4+Z=TURP   (B7)= I. L. ORDINAL OF THE CURRENT OPERATOR
          MX6    -OP.2MODL   SET MODE MASK
          SA3    B5+B7       GET CURRENT OPERATOR 
          BX1    -X3         GET NEGATIVE OF SKELETON ORD 
          HX1    TH.SKEL
          AX1    -TH.SKELL   EXTRACT (SIGN EXTEND) NEGATIVE SKEL ORDINAL
          SB7    X1+V=ARY    *FTN4* ONLY...WILL CHANGE FOR NEW TURPLES
          MX0    -OP.1ORDL   SET MASK FOR STATUS WORD ORDINAL IN OUS
          =X7    1           SET INITIAL USE COUNT INCREMENT
          NZ     B7,TIU9     IF NOT DEFERED TURPLE
  
**        HERE WE COMPUTE THE USE COUNT INCREMENT FOR DEFERED TURPLE
*         OPERANDS
*         (X7) = 1           A BIT-0 MASK FOR MODE CHECKING 
  
          LX3    -OP.2MODP   POSITION MODE OF CURRENT OPERATOR
          BX6    -X6*X3      EXTRACT MODE 
          MX5    -OP.USEL    SET MASK FOR USE COUNT INCREMENT 
          LX3    OP.2MODP-OP.1ORDP POSITION ORD OF CUR OPERATOR'S ST WD 
          SX6    X6-M.DBL    (X6) = 0 OR 1 IF MODE = DBL OR CPLX RESP.
          ERRNZ  M.DBL-M.CPLX+1 
          BX3    -X0*X3      (X3) = OUS ORD OF THE CUR. OPERATOR ST WORD
          BX6    -X7*X6      CLEAR BIT 0 FROM MODE DIFFERENCE 
          SB7    X3 
          SA3    T.OUS       GET OUS FWA
          SA3    X3+B7       GET STATUS WORD FOR CURRENT OPERATOR 
          BX7    -X5*X3      (X7) = USE INC IF OPERAND^OPERATOR NOT DBL 
          NZ     X6,TIU9     IF CURRENT OPERATOR MODE NOT DBL/CPLX
          LX7    1           TWICE INCREMENT IF OPETATOR DOUBLE/COMPLEX 
  
**        (X0) = MASK FOR OUS ORDINAL 
*         (X2) = OPERAND SHIFTED
*         (X7) = USE COUNT INCREMENT
*         (B5) = FWA I. L.
  
 TIU9     LX2    -P2.BIASP   POSITION I. L. ORDINAL OF ASSOC OPERATOR 
          SA3    B5+X2       GET ASSOCIATE OPERATOR 
          BX5    -X0*X3      (X5) = ORD OF STATUS WORD FOR ASSOCIATE
          LX2    P2.BIASP    RESET OPERAND
          SB5    A2-B5       IL ORD OF CURRENT OPERAND
          NZ     X5,TIU11    IF STATUS WORD ALREADY IN TABLE
  
**        MUST ENTER NEW STATUS WORD WITH INITIAL USE COUNT.
*         ALSO ORDINAL TO STATUS WORD MUST BE PLACED IN THE 
*         ASSOCIATE OPERATOR. 
  
          SA5    T=OUS       GET OUS ORDINAL
          IX6    X2+X7       ADD INITIAL USE COUNT INTO STATUS WORD 
          BX7    X3+X5       ADD ORDINAL INTO OPERATOR
          ERRNZ  OP.1ORDP 
          SA7    A3          RESET ASSOCIATE OPERATOR WITH ORDINAL SET
          ADDWD  T.OUS
          SA2    B4          GET FWA I. L.
          SA2    X2+B5       RESET OPERAND POINTER
          EQ     TIU12       WRAP IT UP 
  
**        OPERAND IN TABLE. MUST INCREMENT USE COUNT
  
 TIU11    SA3    T.OUS       GET FWA OUS
          SB7    X5          (B7) = OUS ORD 
          IX6    X2+X7       INSERT DUMMY USE IN OPERAND
          SA3    B7+X3       GET STATUS WORD OF OPERAND 
          IX7    X7+X3       INCREMENT USE TOTAL IN STATUS WORD 
          SA7    A3          RESET STATUS WORD
  
 TIU12    LX5    P2.TAGP     POSITION OUS ORDINAL 
          BX6    X6+X5       INSERT OUS ORDINAL IN TAG FIELD
          SA5    TIU.TP      RESTORE TP WORD
          LX2    X6          (X2) = CURRENT VALUE OR OPERAND
          SA1    TIUA 
          MI     X1,EXIT.    IF SUBSTRING 1OP 
          SA6    A2          RESET OPERAND
          EQ     EXIT.
  
 TIU.TP   BSS    1           SAVE AREA FOR TP. WORD 
          TITLE  QCG SUPPORT ROUTINES.
 DPT      SPACE  4,10 
**        DPT -  DEFINE PROGRAM TAG.
* 
*         ENTRY  (X6) = ENTRY FOR *T.GL*, (WC) FORMAT 
* 
*         USES   A1,A2,A6  X0,X7
* 
*         CALLS ALC 
  
  
 DPT      SUBR   =           ...ENTRY/EXIT... 
          SA1    N.GL 
          SA2    T=GL 
          SA6    DPTA        SAVE (X6)
          =X3    X1+1 
          IX0    X3-X2
          IFEQ   TEST,ON,1
          MI     X0,"BLOWUP" IF (N.GL) .LT. (T=GL)
          ALLOC  T.GL,X0     INSURE TABLE LARGE ENOUGH FOR ALL GLS
          SA2    DPTA 
          BX6    X2 
          SA6    X1+B3       STORE ENTRY IN GL TABLE
          EQ     EXIT.
  
 DPTA     BSS    1           SAVE (X6)
 QCP      SPACE  4,10 
**        QCP - QUICK CODE PRESETS. 
* 
*         SETS UP CELLS FOR QCG.
  
  
 QCP      SUBR   =           ENTRY/EXIT...
          SX6    0
          SA6    DRITE
          SX7    WINOC
          SA7    PSTAB       SET WIN JUMP TABLE TO OC$XXX 
          =X6    0
          ADDWD  T.IOI       ADD ZERO WORD AT START OF TABLE
          ADDWD  T.API       ADD ZERO WORD AT START OF TABLE
          ADDWD  T.GL        ADD ZERO WORD AT START OF TABLE
          SA6    ENT.EGL     PRESET ENTRY GENERATED LABEL 
          SA6    A6+1        PRESET ENTRY SYM TAB ORDINAL(ENT.STO)
          SA6    A6+1        PRESET AD SUB COUNTER (ENT.SUB)
          =A6    A6+B1       PRESET SUB0 COUNTER (ENT.SB0)
          SA6    A6+1        PRESET VAR DIM FLAG(ENT.VD)
          SA6    A6+B1       PRESET N.ALTEN - ALTERNATE ENTRY COUNTER 
          SA1    CO.CS
          SA2    CO.DOOT
          BX6    X1          INITIALIZE WORKING QCG COPY OF OPTIONS 
          LX7    X2 
          SA6    WQ.CS
          =A7    A6-WQ.CS+WQ.DOOT 
          SX6    I.LOO
          SA6    OCIOL       INITIALIZE 
          EQ     EXIT.       EXIT...
 SMB      SPACE  4,10 
**        SMB - SET MAT BIT FOR VARIABLES.
*         SINCE QCG DOES NOT SET THE MAT BIT IN THE SYMBOL TABLE
*         FOR LOCAL VARIABLES, THIS ROUTINE IS CALLED FROM *REC*
*         TO SET MAT[WB.] = 1 , IF VAR[WB.] = 1.
  
  
 SMB      SUBR   =           ENTRY/EXIT.
          SA3    MOD
          HX3    MO.BLK 
          MI     X3,EXIT.    IF BLOCK DATA
          SA3    T.SYM
          SA2    T=SYM
          SB6    X2 
          CLAS=  X4,WB,(VAR)
          SB3    Z=SYM
          =A3    X3+WB.W
          CLAS=  X2,WB,(MAT)
  
 SMB10    SA3    A3+B3       WBI = WB ENTRY OF T.SYM
          SB6    B6-B3
          ZR     B6,EXIT.    IF END OF T.SYM
          BX0    X3 
          SBIT   X0,WB.LABP 
          MI     X0,SMB10    IF STATEMENT LABEL 
          SBIT   X0,WB.SFAP/WB.LABP 
          MI     X0,SMB10    IF STATEMENT FUNCTION DUMMY ARGUMENT 
          BX1    X4*X3       VARI = VAR[WBI]
          BX6    X3+X2
          ZR     X1,SMB10    IF VARI .EQ. 0 
          SA6    A3          MAT[WBI] = 1 
          EQ     SMB10
*CALL     COMFWIN            WRITE INSTRUCTIONS TO PREBINARY
          ENTRY  WIN
          ENTRY  WTE
  
 PARCEL   BSSZ   1
 ORG      BSSZ   1
*CALL     COMFITS            ISSUE TEMP STORAGE 
          ENTRY  ITS
*CALL     COMFUSE            PROCESS USE PSEUDO INSTRUCTION 
  
 END      SPACE  4,10 
          LIST   D
          END 
