*DECK     DATA - TRANSLATE *DATA* STATEMENTS. 
          IDENT  DATA 
 DATA     SECT   (TRANSLATE DATA STATEMENTS.) 
 DATA     SPACE  4,10 
***       DATA - TRANSLATE DATA STATEMENTS. 
* 
*         S. I. JASIK        70/06/01.
*         P. H. MCQUESTEN    71/06/01.   78/12/31.
*         A. T. HSIAO        78/05/08.
  
  
*         IN ALLOC
          EXT    ADW,ALC
  
*         IN CONRED 
          EXT    DEC,KCV,NBC,SED,TNK
  
*         IN FEC
          EXT    DATFLG,ERT,FEC=EXU,FEC.RTN,NCM,OIL,REFVAR,SCT,SSY
          EXT    STAGE,TLV,T=CONB 
  
*         IN FERRS
          EXT    E.AT01,E.AT03,E.AT08,E.AT13,E.DACV,E.DAR,E.DAVC,E.DCE
          EXT    E.DC7,E.DC10,E.DIL,E.DIL1,E.DIL2,E.DIL3,E.DIL4,E.DSE 
          EXT    E.DVL1,E.MDE2,FILL.
  
*         IN FSNAP
          EXT    DMT=,SN.PAR
  
*         IN FTN
          EXT    CO.SNAP
  
*         IN IDP
          EXT    IDP=SVB,IDP=SVX,REG=,SNP=
  
*         IN IO 
          EXT    CVL,IODOIND,VAI
  
*         IN PAR
          EXT    C=ERR,DATARM,DVLOP,EMT,IOL.RTN 
  
*         IN PEM
          EXT    ANSI=,MDERR=,PDM 
  
*         IN PUC
          EXT    CONONE,E=TOTAL,MOD,T=CON,T=DAR,T=DATI,T=DATL,T=DATS
          EXT    T.CON,T.DAR,T.DATI,T.DATL,T.DATS,T.DIM,T.PAR,T.SYM 
  
*         IN QCGLINK/FLINK
          EXT    PDI
  
*         IN QSKEL/FSKEL
          EXT    V=DATA,V=DVI 
  
*         IN UTILITY
          EXT    MVE=,SBM=
 DATA     SPACE  4,10 
***       DATA INITIALIZATION STATEMENTS. 
* 
*         SYNTAX: 
*                DATA <DIL>,...,<DIL> 
*                 WHERE DIL IS A DATA INITIALIZATION LIST 
*                <DIL> := <DVL> / <DIL> / 
*                 WHERE <DVL> IS A DATA VARIABLE LIST 
*                 AND   <DIL> IS A DATA ITEM LIST ( CONSTANTS ) 
* 
*         THE SYNTAX OF THE DATA ITEM LIST ( CONSTANTS ) IS 
* 
*                <DIL> := <DIG>,...,<DIG> 
*                <DIG>  :=  <CON>  OR  <RF>*<CON> 
*                           OR  <RF>(<CONL>)         /* NON-ANS 
*                <CONL> := <CON>,,,<CON>
*                <CON> := <CONSTANT> OR (<REAL CON>,<REAL CON>) 
* 
*         THE SYNTAX OF A DATA VARIABLE LIST IS 
*                <DVL> := <DVG>,...,<DVG> 
*                <DVG> := <VARNAME> OR <ARRAY>(<CON SUBSC>) 
*                OR <ARRAY> OR <DOLIST> 
*                WHERE: 
*                 <VARNAME> IS THE NAME OF A SIMPLE VARIABLE
*                 <ARRAY> IS THE NAME OF AN ARRAY 
*                 <CON SUBSC> IS A CONSTANT SUBSCRIPT EXPRESSION
*                <DOLIST> IS A NEST OF IMPLIED LOOPS
 ANSI     SPACE  4,20 
***       THE DATA STATEMENT IS DESCRIBED IN ANSI CHAPTER 9.
* 
*         EXTENSION -- VARIABLES IN LABELED COMMON MAY BE INITIALIZED 
*                OUTSIDE OF A BLOCK DATA SUBPROGRAM.
* 
*         EXTENSION -- REPEATED LIST OF CONSTANTS.  SEE ERS.
*                RF ( CONLIST ) 
* 
*         USAGE NOTE -- IMPLIED LOOPS WITH HUGE TRIP COUNTS CAN CONSUME 
*                MUCH COMPILE TIME IF THEY MUST BE SIMULATED.  TO AVOID 
*                INORDINATELY LONG COMPILATION TIME, WRITE LOOPS SUCH 
*                THAT THEY ARE COLLAPSIBLE. 
 MACROS   TITLE  LOCAL MACROS.
 PARSEM   SPACE  4,10 
**        PARSEM - ELIST MANIPULATION MACROS. 
* 
*         REGISTER USAGE -- 
*                (A4,X4) -> CURRENT TOKEN.
*                (B2) = TOKEN TYPE. 
*                USES        B3.
  
  
 NEXTE    MACRO  R           FETCH NEXT TOKEN 
          ERRNZ  R  0        OBSOLETE PARAMETER 
          SA4    A4+B1
          SB2    X4 
 NEXTE    ENDM
  
  
 IF.EQ    MACRO  ECODE,LABEL       IF( B2 .EQ. ECODE ) GO TO LABEL
 .1       IF     -MIC,ECODE 
          =B3    ECODE
          EQ     B2,B3,LABEL
 .1       ELSE
          EQ     B2,"ECODE",LABEL 
 .1       ENDIF 
 IF.EQ    ENDM
  
  
 IF.NE    MACRO  ECODE,LABEL       IF( B2 .NE. ECODE ) GO TO LABEL
 .1       IF     -MIC,ECODE 
          =B3    ECODE
          NE     B2,B3,LABEL
 .1       ELSE
          NE     B2,"ECODE",LABEL 
 .1       ENDIF 
 IF.NE    ENDM
  
  
 ARICON   MICRO  1,, O.HOLL,O.QHOLL,O.RLCON,O.CONS,O.PERIOD,O.OCT,O.HEX 
 M.CON    BITMIC (O.LP,O.MIN,O.PL,"ARICON",O.CHAR,O.TRUE,O.FALSE,O.VAR) 
 UNSIGNC  BITMIC (O.HOLL,O.QHOLL,O.RLCON,O.CHAR,O.OCT,O.HEX)
 M.SEP    BITMIC (O.EOS,O.COMMA,O.RP) 
 M.BCON   BITMIC (O.HOLL,O.QHOLL,O.RLCON,O.OCT,O.HEX) 
          TITLE  STORAGE CELLS AND DATA STRUCTURES. 
*         STORAGE.
 TEMP     OPSYN  BSS
  
  
 F.GRUP   TEMP   0           FWA OF CONTROL CELLS FOR A DATA GROUP
 REPFLAG  TEMP   1           REP FLAG (SEE CRL) 
 CLOSREP  TEMP   1           CLOSE REP FLAG 
 N.ITEM   TEMP   1           NUMBER OF DATA ITEMS 
 PL       TEMP   1           PAREN LEVEL
 I.DIT    TEMP   3           1 - ORDINAL OF NEXT ITEM IN T.DATI 
*                            2 - NUM OF ITEMS REMAINING IN REP LIST 
*                            3 - ORDINAL OF 1ST DATA ITEM IN REP LIST 
 Z.GRUP   EQU    *-F.GRUP    ...   ABOVE CLEARED FOR EACH DATA GROUP
  
 DVI      TEMP   Z=SYM       DATA VAR INFO WORDS (V1.,WB.,V3. FORMAT) 
 BIAS     TEMP   1           ACCUMULATED BIAS DUE TO SUBSC CALC 
 ORGN     TEMP   1           NEW ORG NEEDED FLAG
 DA       TEMP   1           ADDRESS DIFFERENCE 
 LI       TEMP   2           LOOP INDEX        /* IN NIC
 MP       TEMP   1           MULTIPLIER ( DA*RL ) 
 RL       TEMP   1           NUMBER OF ITEMS IN A REPLIST 
 DVLT     TEMP   1           -> FWA CURRENT VARLIST 
 DILT     TEMP   1           -> FWA CURRENT CONLIST 
 SELIST   TEMP   1           SAVES CURRENT *TB* CURSOR
 ASIA     TEMP   1           SAVE CELL FOR ASI
 OSHA     EQU    ASIA        SAVE CELL FOR OSH
 OVIA     TEMP   1           SAVE CELL FOR OVI
 DL.      SPACE  4,10 
**        DL. - FORMAT FOR T.DATL (DATA INITIALIZATION LIST POINTER 
*                TABLE), BUILT BY *BDL*.
  
  
          DESCRIBE DL.,60 
          DEFINE 24          0
 VAR      DEFINE 18          FWA OF DATA VARIABLE LIST
 CON      DEFINE 18          FWA OF DATA CONSTANT LIST
 DVI      SPACE  4,20 
**        DVI - DATA VARIABLE INFO. 
* 
*         WORDS SETUP BY *BVT* TO USE IN MATCHING A DATA CONSTANT ITEM
*         LIST WITH A VARIABLE OR LOOP. 
*         (DVI+0) FORMAT = (V1.)
*         (DVI+1)        = (WB.)
*         (DVI+2)        = (V3.)
  
  
          DESCRIBE V1.,60,,WA.W 
  
 SDPF     DEFINE 1           SINGLE/DOUBLE PRECISION FLAG 
          DEFINE 5
 BASE     DEFINE WB.BASEL    ORDINAL OF BASE MEMBER 
          DEFINE 24 
 ORD      DEFINE 18          ORDINAL INTO (T.SYM) 
  
  
          DESCRIBE V3.,60,,WC.W 
  
 ELS      DEFINE 18          ELEMENT SIZE (IN STORAGE UNITS)
 SSU      DEFINE 18          SUBSTRING SIZE (IN STORAGE UNITS)
 ABU      DEFINE 24          ADDITIONAL BIAS (IN STORAGE UNITS) 
 S.       SPACE  4,10 
**        (S.) - OUTPUT BLOCK CONSTRUCTION CONTROL WORDS. 
  
  
 S.DHW    BSS    2           HEADER WORDS BEING CONSTRUCTED 
 S.POP    CON    -1          .PL. WHEN BLOCK STARTED
 S.FEA    BSS    1           FIRST ELEMENT ADDRESS (= FWA)
 S.LEN    BSS    1           STORAGE UNITS OUTPUT SO FAR
 S.NCH    BSS    1           NR OF CHAR IN LAST OUTPUT WORD 
 S.PAD    BSS    1           .ZR. IF CAN BLANK PAD BY REP 
 S.BLEN   BSS    1           BLOCK LENGTH ON ORH CALL 
 DAT.Z    SPACE  4,10 
**        DATA.E - FE ERROR EXIT. 
* 
*         ENTRY  (B7) = DIAGNOSTIC. 
  
  
 DATA.E   FATAL  B7          (SEVERITY ACTUALLY CONTROLLED BY FERRS)
  
 DAT.Z    BSSENT 0           ...RETURN FROM ERROR PROCESSOR 
          SHRINK T=DATI,0 
          SHRINK T=DATS,X6
          SA2    T=CONB 
          SHRINK T=CON,X2    RESET CONSTANT TABLE LENGTH
          EQ     FEC.RTN     RETURN TO FRONT END CONTROLLER...
          TITLE  MAIN LOOP. 
***       TRANSLATE DATA STATEMENT. 
  
  
          HEREIF DATA 
  
          RJ     BDL         BUILD DATA LIST POINTERS 
          CALL   OIL         OUTPUT I.L.       /* FLUSH (T.PAR) 
  
*         RESET T=CONB TO T=CON IF IN EXUCUTABLES, SINCE
*         QCG MAY HAVE ADDED CONSTANTS. 
  
          SA1    STAGE
          SX6    FEC=EXU
          BX0    X1-X6
          NZ     X0,DATA1    IF NOT PROCESSING EXUCUTABLES
          SA1    T=CON
          BX6    X1 
          SA6    T=CONB 
  
*         MAIN LOOP.  FOR EACH DATA VARLIST/CONLIST/ GROUP, FIRST CALL
*         BIT TO CONVERT THE ITEM LIST TO INTERNAL FORM.  THEN PVL
*         PARSES THE VARIABLE LIST, AND ISSUES THE MATCHING CONS. 
  
 DATA1    MX6    0
          SHRINK T=DAR,X6 
          SHRINK T=DATI,X6
          SHRINK T=DATS,X6
          SETMEM F.GRUP,Z.GRUP,X6 
  
          SA1    T.DATL 
          SA2    T=DATL 
          IX3    X1+X2
          SA5    X3-1        DLI = T.DATL( (T=DATL)-1 ) 
          LX5    -DL.CONP 
          SA4    X5          A4 -> CON[DLI] 
          ERRNZ  18-DL.CONL 
          LX5    DL.CONP-DL.VARP
          SX6    A4 
          SX7    X5 
          ERRNZ  18-DL.VARL 
          SA6    DILT        SAVE LIST POINTERS 
          =A7    A6-DILT+DVLT 
          RJ     BIT         BUILT ITEM (DATA CONSTANT) TABLE 
  
          RJ     PVL         PARSE/TRANSLATE VARIABLE LIST
          NZ     X5,DATA2    IF PROBLEM WITH VARLIST
          SA4    T=DATS 
          MX5    0
          LX4    TP.BIASP    BIAS[1OP] = LENGTH OF DATA TABLE 
          EMIT   V=DATA 
          CALL   PDI         PUBLISH DATA TO IL 
  
**        ISSUE INFORMATIVE DIAGNOSTICS IF LISTS NOT THE SAME LENGTH. 
  
          SA1    N.ITEM 
          MI     X1,E.DAVC   IF MORE VARIABLES THAN CONSTANTS 
          NZ     X1,E.DACV   IF MORE CONSTANTS THAN VARIABLES 
  
 DATA2    BSSENT 0           ...RETURN FROM ERROR PROCESSOR 
          SA1    T=DATL 
          SX6    X1-1        (T=DATL) -= 1
          SHRINK A1,X6
          NZ     X6,DATA1    IF MORE DATA GROUPS IN STATEMENT 
          EQ     DAT.Z       RETURN TO FRONT END CONTROLLER 
  
          TITLE  BDL - INITIALIZE DATA LIST POINTERS. 
**        BDL - BUILD DATA LIST POINTERS. 
*                T.DATAL - TABLE OF FWA'S OF DIL(DATA ITEM LIST) AND
*                DVL(DATA VARIABLE LIST) IS BUILT FROM FORWARD SCANNING 
*                OF THE DATA STATEMENT, FORMATTED AS DL. .
*                ALSO PERFORMS SYNTAX CHECKING. 
* 
*         ENTRY  B4 _ BEGINNING OF DATA STATEMENT 
*         CALLS  STD, ADDWD 
*         USES   ALL
  
  
 BDL      SUBR               ENTRY/EXIT.
          SHRINK T=DATL,0 
          SX7    O.COMMA
          LX7    TB.TOTP
          SA7    B4-B1       STORE A COMMA AT BEGINNING OF LIST 
          SA4    B4-B1
          SB2    X4 
  
*         BEGINNING OF DATA VARIABLE LIST.
*         (B2) _ TOKEN TYPE 
  
 BDL10    IF.EQ  O.COMMA,BDL15     IF COMMA 
          IF.EQ  O.LP,BDL11  IF ( 
          IF.NE  O.VAR,BDL20 IF NOT VARIABLE
 BDL11    =A4    A4-1 
 BDL15    SX7    A4 
          LDBIT  X5,59-O.SLASH
          RJ     STD         FIND BEGINNING OF CON LIST 
          SX6    A4 
          IX5    X6-X7
          LX7    DL.VARP
          =X5    X5-1 
          ZR     X5,BDL30    IF VARIABLE LIST OMITTED 
          LX6    DL.CONP
          BX6    X6+X7
          MX7    0           MARK END OF VAR-LIST 
          ERRNZ  O.EOS
          SA7    A4 
          ADDWD  T.DATL      ADD FWA'S OF DVL AND DIL 
          LDBIT  X5,59-O.SLASH
          RJ     STD         FIND END OF CON LIST 
          SA4    A4+B1
          MX7    0           MARK END OF CON-LIST 
          ERRNZ  O.EOS
          SA7    A4-B1
          SB2    X4 
          EQ     BDL10
  
 BDL20    IF.NE  O.EOS,BDL30 IF NOT END OF STATEMENT
          SA2    T=DATL 
          NZ     X2,EXIT.    IF NOT EMPTY DATA STATEMENT
 BDL30    FATAL  E.DSE       ** DATA SYNTAX ERROR 
          EQ     DAT.Z
 STD      SPACE  4,20 
**        STD - SCAN TO DELIMITER, PERFORM A PARENTHESIS CHECK. 
* 
*         ENTRY  (X5) = BIT MASK OF DELIMITER TO SCAN TO. 
*                (A4) -> ONE TOKEN BEFORE SCAN START. 
* 
*         EXIT   (A4) -> DELIMITER TOKEN. 
*                (B2) = TOKEN TYPE OF DELIMITER.
* 
*         USES   A1,A3,A4  B2-B5  X1,X3,X4
  
  
 STD      SUBR               ENTRY/EXIT...
 .T       IFEQ   TEST,ON
 Z        BITMIC (O.LP) 
          SA1    ="Z" 
          BX6    X1*X5
          NZ     X6,"BLOWUP" IF ILL TOKENS IN STOPPER SET 
 .T       ENDIF 
 Z        BITMIC ("ARICON",O.CHAR,O.VAR,O.PL,O.MIN) 
          SA1    ="Z" 
          SB3    O.LP 
          =B4    B3-O.LP+O.RP 
  
 STD1     SA4    A4+B1
          SB2    X4+
          LX3    X1,B2
          MI     X3,STD1     IF CONST OR VAR -- SKIP
          NE     B2,B3,STD2  IF NOT A LPAREN
          LX4    -TB.IOCPP
          SA4    X4          SWOOP TO MATCHING RP, IGNORING IT
          ERRNZ  18-TB.IOCPL
          EQ     STD1 
  
 STD2     LX3    B2,X5
          MI     X3,EXIT.    IF THIS IS A SELECTED DELIMITER
          EQ     B2,B4,STD5  IF RP ** SYNTAX ERR (NEGATIVE PAREN COUNT) 
          IF.NE  O.BOS,STD1  IF NOT BOS -- LOOP 
 STD5     FATAL  E.DSE       ** SYNTAX ERROR (MISSING DELIMITER)
          EQ     DAT.Z
          TITLE  BIT - BUILD DATA ITEM TABLE. 
 BIT      SPACE  4,10 
**        BIT - BUILD DATA ITEM TABLE.
*                SCAN THE ITEM LIST AND CONVERT IT INTO INTERNAL FORMAT.
*                CONSTANT ENTRIES ARE OF ONE WORD EACH, FORMATTED AS
*                FORM 2 OF (DI.). ACTUAL CONSTANTS ARE STORED INTO
*                CONSTANT TABLE, WITH PNT[DL.] POINTING TO THAT ENTRY.
* 
*                REPETITION HEADER ENTRIES ARE FORMATTED AS FORM 1
*                OF (DI.).
* 
*         ENTRY  (A4) -> TOKEN IN FRONT OF CONSTANT LIST. 
  
  
 BIT      SUBR               ENTRY/EXIT...
  
*         PROCESS NEXT CONSTANT.
  
 BIT10    NEXTE                    NEXT ELIST ITEM
          SA3    ="M.CON" 
          BX7    0           SIGN = +0
          LX6    X3,B2
          =B5    O.CONS 
          =B6    O.VAR
          PL     X6,E.DIL    IF NOT A CONSTANT BEGIN TOKEN
          SA3    ="UNSIGNC" 
          LX6    X3,B2
          MI     X6,BIT20    IF UNSIGNED SIMPLE CONSTANT
          EQ     B2,B5,BIT40 IF NUMBER
          EQ     B2,B6,BIT30 IF VARIABLE
          =B7    B2-O.TRUE
          SB3    O.LP 
          ZR     B7,BIT70    IF *.TRUE.*
          IFNE   O.TRUE+1,O.FALSE,1 
          =B7    B2+O.TRUE+1-O.FALSE
          EQ     B7,B1,BIT70 IF .FALSE. 
          EQ     B2,B3,BIT60 IF A LEFT PAREN
          SX2    B2-O.MIN 
  
**        HERE WITH + OR - SIGN, OR PERIOD. 
  
          IF.EQ  O.PERIOD,BIT20    IF FLOATING PT. CONSTANT 
          AX3    X2,B1            -0 IF PLUS, +0 IF MINUS SIGN
          BX7    -X3
          NEXTE 
          IF.EQ  O.PERIOD,BIT20    IF FLOATING PT. CONSTANT 
          EQ     B2,B5,BIT20 IF NUMBER
          IF.EQ  O.HOLL,BIT20      IF HOLLERITH 
          IF.EQ  O.QHOLL,BIT20     IF "" STRING 
          IF.EQ  O.RLCON,BIT20     IF R OR L CONSTANT 
          IF.EQ  O.LP,BIT60  IF POSSIBLE COMPLEX CONSTANT 
          EQ     E.DIL1      INVALID SIGNED CONSTANT
  
 BIT20    SA3    ="M.BCON"
          LX3    X3,B2
          PL     X3,BIT25    IF NOT BOOLEAN CONSTANT
          MDERR  E.MDE2 
  
 BIT25    RJ     ADC         ADD CONSTANT TO TABLE
          EQ     BIT80
  
*         CHECK FOR SYMBOLIC CONSTANT.
*                (A4) _ O.VAR TOKEN 
  
 BIT30    SX6    A4+B1
          SB4    A4 
          SA6    SELIST      SAVE (SELIST) = TOKEN BUFFER POINTER 
          MX6    TB.TOCL
          BX6    X6*X4       EXTRACT NAME 
          SA6    FILL.       SAVE FOR POSSIBLE DIAGNOSTIC 
          RJ     CSC         CHECK FOR SYMBOLIC CONSTANT
          MI     B7,E.DIL4   IF NOT SYMBOLIC CONSTANT 
          BX5    X6          REMEMBER (X5) = CONSTANT VALUE 
          SB6    B3          (B6) = INDEX OF CONSTANT VALUE 
          SA4    A3          PRESERVE PARAMETER *WC*
          SB5    X1          PRESERVE MODE
          LX0    XR.TAGP
          SA1    REFVAR 
          ADDREF X0,X1
          SX1    B5          RESTORE MODE 
          LX3    X4          RESTORE *WC* 
          =A2    SELIST 
          SA2    X2+
          SA4    ="M.SEP" 
          SB2    X2 
          LX6    X4,B2
          PL     X6,BIT45    IF NEXT NOT SEPARATOR
  
*         ADD SYMBOLIC CONSTANT TO DATA TABLE.
*         (B6) = PNT TO CONSTANT TABLE
*         (X1) = MODE OF CONSTANT 
*         (X3) = T.SYM *WC* WORD OF SYMBOLIC CONSTANT 
  
          RJ     ASC         ADD SYMBOLIC CONSTANT TO DATA TABLE
          EQ     BIT80
  
*         REGULAR CONSTANT. 
  
 BIT40    SB4    A4                LOOK AHEAD 
          SX5    A4          SAVE A4
          MX6    1
          SA6    DATAFLG     INDICATE ERRORS TO BE SUPPRESSED 
          CALL   DEC         SKIP OVER CONSTANT 
          MX7    0           CLOSE = 0      SIGN = +0 
          SA7    DATAFLG     TURN OFF THE FLAG
          SA4    X5          RESTORE A4 
          SA2    B4+B1       TOKEN AFTER CONSTANT 
          BX5    X6          REMEMBER (X5) = CONVERTED CONSTANT 
          SA3    ="M.SEP" 
          SB2    X2 
          LX2    B2,X3
          MI     X2,BIT20    IF FOLLOWER IN [COMMA, RP, EOS]
  
*         ENTERING A REPETION GROUP.
*         (A2,X2) = TOKEN FOLLOWING CONSTANT
*         (X5) = CONSTANT VALUE 
*         (X1) = MODE OF CONSTANT 
*         (B2) = TOKEN VALUE FOLLOWING CONSTANT 
  
 BIT45    SA3    REPFLAG
          NZ     X3,E.DIL2   IF ALREADY WITHIN A REP LOOP 
          MX7    -1          CLOSE = -1        /* SINGLE ITEM REP 
          IF.EQ  O.STAR,BIT50  IF CON FOLLOWED BY STAR
          SA3    PL 
          SX7    B1          CLOSE = +1        /* REPEATED LIST 
          IX6    X3+X7       PL = PL + 1
          SA6    A3 
          IF.NE  O.LP,E.DIL  IF NO LPAREN -- SYNTAX ERROR 
          ANSI   E.DAR       ** REPEATED LIST NON-ANSI
  
 BIT50    SX6    A2          SAVE (SELIST) -> FIRST TOKEN OF LIST 
          SA6    SELIST 
          SA7    CLOSREP     (CLOSREP) = CLOSE
          RJ     CRC         CHECK REPEAT CONSTANT
          CLAS=  X3,DI,(REP)
          BX6    X3+X6       ADD REP ENTRY TO DATA ITEM TABLE 
          ADDWD  T.DATI 
  
          SA1    N.ITEM 
          SX6    X2          HDRI = INDEX OF REP HEADER 
          SA5    SELIST 
          LX1    18          OLDN = PREVIOUS (N.ITEM) 
          BX6    X1+X6       (REPFLAG) =  42/ OLDN,  18/ HDRI 
          SA6    REPFLAG
          MX7    0           (N.ITEM) = 0      /* COUNT THIS LIST 
          SA7    A1 
          SA4    X5          RESTORE (A4) 
          EQ     BIT10       LOOP..  TO PROCESS REP LIST
  
  
**        RAW LPAREN = START OF A COMPLEX CONSTANT. 
  
 BIT60    RJ     CFC         CHECK FOR COMPLEX CONSTANT 
          SB7    E.DC7       ** ILL-FORMED COMPLEX CONSTANT 
          NZ     X0,DATA.E   IF NOT A COMPLEX CONSTANT
          BX6    X1 
          LX7    X2 
          =X1    M.CPLX 
          EQ     BIT75
  
  
**        HANDLE LOGICAL CONSTANTS HERE.
*                (B7) = 0 IF .TRUE. 
*                     = 1 IF .FALSE.
  
 BIT70    SX7    A4+B1       SAVE TOKEN BUFFER POINTER
          SX6    B7-B1       (X6) = -1 IFF TRUE,  = 0 IFF FALSE 
          =X1    M.LOG
          SA7    SELIST 
  
 BIT75    RJ     ASI         ADD SCALAR ITEM
  
 BIT80    ADDWD  T.DATI      ADD ITEM DESCRIPTOR
          SA5    SELIST 
          SA3    N.ITEM 
          SA4    X5          RESTORE TOKEN SCAN REGISTERS 
          =X6    X3+1        (N.ITEM) = (N.ITEM) + 1
          SB2    X4 
          SA6    A3 
*         EQ     BIT85
  
*         PROCESS SEPERATOR AFTER CONSTANT
  
  
 BIT85    SA1    CLOSREP
          PL     X1,BIT90          IF NO SINGLE ELEMENT REP OUTSTANDING 
          RJ     CRL
  
 BIT90    IF.EQ  O.COMMA,BIT10     LOOP IF A COMMA
          ZR     B2,EXIT.    IF END OF CONSTANT LIST
          ERRNZ  O.EOS
          IF.EQ  O.STAR,E.DCE      IF '*' 
          IF.NE  O.RP,E.DIL3 IF NOT A RPAREN, ERR.. 
          MX7    0
          SA7    PL                CLEAR PAREN LEVEL
          SA1    CLOSREP
          ZR     X1,BIT95          IF NO REP LIST TO CLOSE
          RJ     CRL               CLOSE IT 
  
 BIT95    NEXTE                    NEXT ELEMENT 
          EQ     BIT85
  
 DATAFLG  BSZENT 1
          TITLE  PARSE DATA VARIABLE LIST.
 PVL      SPACE  4,10 
**        PVL - PARSE DATA VARIABLE LIST. 
* 
*  1.     CALLS I/O LOOP/LIST COMPILER, *CVL*, TO ATTEMPT COLLAPSE, 
*         AND GENERATE TURPLES FOR THIS DATA STATEMENT SEGMENT. 
*         EACH LIST ITEM IS PROCESSED BY *C=DVL*, BELOW, WHICH
*         EMITS A *V=DVI* TURPLE. 
*  2.     AFTER THE DATA SEGMENT IS SUCCESSFULLY SCANNED, WE
*         CALL CONRED/SED TO SIMULATE EXECUTION OF (T.DAR).  FOR
*         EACH V=DVI TURPLE SIMULATED, IT WILL CALL *EDI*, IN THE 
*         OUTPUT SECTION CODE BELOW, TO MAKE (T.DATS) ENTRIES 
*         REPRESENTING THE FINAL TRANSLATION. 
* 
*         EXIT   (X5) .NZ. = ERROR IN VARIABLE LIST.
* 
*         USES   ALL. 
*         CALLS  CVL, SED.
  
  
 PVL      SUBR   0           ENTRY/EXIT...
          SA3    DILT 
          =A2    A3-DILT+DVLT 
          BX6    O.EOS
          =X7    O.COMMA
          SB4    X2          (B4)+1  ->  DATA VARIABLE LIST 
          SA6    X3+B1       MARK END OF VARLIST WITH EXTRA EOS 
          SA1    DATARM 
          SA2    DVLOP
          SA7    B4          PRECEDE VARLIST WITH COMMA 
          =X6    PM=DATA
          SA6    DATFLG 
          CALL   CVL         COMPILE VARIABLE LIST
          SA2    DVLT 
          MX7    -1 
          BX6    0
          SA6    I.DIT       (I.DIT) = 0
          SA6    DATFLG      INDICATE DATA-KLUDGE OVER
          ERRNZ  O.EOS
          SA6    X2          RESTORE EOS AT END OF PREV CONLIST 
          SA7    S.POP       INDICATE NO INCOMPLETE OUTPUT BLOCK
          MX5    1           SET ERROR FLAG 
          SA1    E=TOTAL
          NZ     X1,PVL9     IF FATAL IN LIST, SKIP SED 
  
 .T       IFEQ   TEST,ON
          SA1    CO.SNAP
          BX2    X1 
          LX1    1RO
          LX2    1R9
          BX3    X1+X2
          PL     X3,PVL6     IF NO SNAP SELECTED
          CALL   SN.PAR 
 PVL6     SB2    T.PAR
          SB3    T.DAR
          NE     B2,B3,"BLOWUP"    NEED CODE FOR DISTINCT (T.DAR) 
 .T       ENDIF 
  
          CALL   SED         SIMULATE EXECUTION OF DATA 
  
 .T       IFEQ   TEST,ON
          SA1    CO.SNAP
          LX1    1R9
          PL     X1,PVL9     IF SNAP=9 NOT SELECTED 
 PVL9     DUMPT  (DATS) 
 .T       ENDIF 
 PVL9     BSS 
          SHRINK T=DAR,0
          EQ     EXIT.
 C=DVL    SPACE  4,20 
**        C=DVL - EMIT DATA VARIABLE TURPLES. 
* 
*         EXIT   TO IOL.RTN 
* 
*         CALLS  DOA, EMT.
  
  
 C=DVL    BSSENT 0           ENTRY... 
          SB3    E.DVL1 
          MX4    1
          CALL   VAI         VALIDATE ADDRESSABILITY
  
*         OPERAND IS LEGAL.  NOW DETERMINE IT'S LENGTH, AS EITHER 
*         SINGLE ELEMENT, COLLAPSED LOOP, OR ENTIRE ARRAY.
  
          LX0    X5 
          BX4    X5 
          SA5    CONONE 
          HX0    TP.INTR
          PL     X0,DVL24    IF ITEM NOT INTERMEDIATE 
          LX0    TP.INTRP-TP.ARRP 
          PL     X0,DVL30    IF ITEM NOT SUBSCRIPTED ARRAY
                             (MUST BE SUBSTRING)
          SA3    IODOIND
          ZR     X3,DVL30    IF I/O DO COLLAPSE NOT INVOLVED
          HX3    TP.BIAS
          AX3    -TP.BIASL   ISOLATE OFFSET 
          ZR     X3,DVL21    IF NO OFFSET TO ADD TO BIAS
          SA1    T.PAR
          LX2    X4 
          HX2    TP.ORD 
          AX2    -TP.ORDL    ISOLATE INTERMEDIATE POINTER 
          =B2    X2+OR.1OP   THE ARRAY OPERAND
          SA1    X1+B2       FETCH ARRAY-LOAD ARRAY OPERAND 
          MX0    TP.BIASL 
          LX2    X1 
          HX1    TP.BIAS
          AX1    -TP.BIASL   ISOLATE (SIGN EXTEND) BIAS 
          IX3    X1+X3       ADD IN COLLAPSE OFFSET 
          LX3    TP.BIASP    TO BIAS FIELD
          LX0    TP.BIASL+TP.BIASP
          BX3    X3*X0       ISOLATE NEW BIAS 
          BX2    -X0*X2      CLEAR OLD BIAS 
          BX6    X2+X3       REPLACE WITH NEW BIAS
          SA6    A1          RESTORE TO T.PAR 
 DVL21    =A5    A3+1        FETCH PARTIAL COLLAPSE SIZE
          =X6    0
          SA6    A5 
          =A6    A5-1        CLEAR COLLAPSE INDICATORS
          EQ     DVL30
  
 DVL24    BX0    X4 
          SBIT   X0,TP.AREP 
          PL     X0,DVL30    IF SINGLE ELEMENT
          SA2    T.SYM
          LX0    1+TP.AREP   RESTORE X0 TO NOMINAL POSITION 
          HX0    TP.ORD 
          AX0    -TP.ORDL    EXTRACT SYMORD 
          SB3    X0+WB.W
          LX0    1
          SB3    X0+B3       CONVERT TO *WB* INDEX
          SA2    X2+B3       X2 = *WB*
 .T       IFEQ   TEST,ON
          BX3    X2 
          HX3    WB.ARY 
          PL     X3,"BLOWUP" IF NOT ARRAY, PAR GOOF 
 .T       ENDIF 
  
          SA3    T.DIM
          LX2    -WB.PNTP 
          MX0    -WB.PNTL 
          BX5    -X0*X2      ISOLATE T.DIM ORD
          SB3    X5 
          MX0    -DH.PSL
          SA1    X3+B3       FETCH DIMENSION PARAMETERS 
          LX1    -DH.PSP
          BX5    -X0*X1      ARRAY LENGTH 
          LX5    TP.BIASP 
          CLAS=  X2,TP,(SHRT),INT 
          BX5    X5+X2       MAKE INTO SHORT CONSTANT 
 .T       IFEQ   TEST,ON
          SBIT   X1,DH.ASP/DH.PSP-1 
          BX2    X1 
          SBIT   X1,DH.VDP/DH.ASP 
          BX2    X1+X2
          MI     X2,"BLOWUP" IF ASSUMED OR ADJUSTABLE ARRAY 
 .T       ENDIF 
  
*         (X4) = (1OP) = LIST ITEM (TP. FORMAT) 
*         (X5) = (2OP) = LENGTH INDICATOR (TP. FORMAT)
  
 DVL30    SX1    V=DVI       SKEL = DATA VARIABLE INITIALIZATION
          MX0    -TP.MODEL
          LX4    -TP.MODEP
          LX1    SP.SKELP 
          BX0    -X0*X4      EXTRACT MODE OF 1OP
          LX0    SP.MODEP 
          BX6    X1+X0       MERGE MODE INTO TURPLE HEADER
          SA6    DVLA 
          LX4    TP.MODEP 
          EMIT   DVLA,* 
          EQ     IOL.RTN     EXIT..      (THRU POPPER)
  
 DVLA     BSS    1           SAVE OPERAND 
          TITLE  OUTPUT ROUTINES
 EDI      SPACE  4,10 
**        EDI - EMIT DATA INITIALIZATIONS.
* 
*         WHEN CONRED/SED IS SIMULATING THE I.L. DATA TRANSLATIONS, 
*         A *V=DVI* TURPLE BECOMES A CALL TO THIS ROUTINE.
* 
*         ENTRY  (X6) = NUMBER OF ELEMENTS TO ISSUE.
*                (X1) = ADDRESS OF FIRST ELEMENT, (WC.) FORMAT. 
*                (B6) = SYMORD OF ORIGINAL VARIABLE.
*                (B7) = SYMORD OF EQUIV-CLASS BASE. 
* 
*         CALLS  SDV, NIC.
*         USES   ALL. 
  
  
 EDI      SUBR   =           ENTRY/EXIT...
 .T       IFEQ   TEST,ON
          SA3    CO.SNAP
          LX3    1R9
          PL     X3,EDI1     IF (SNAP=9) NOT SELECTED 
 EDI      REG    (X1,X6,B6,B7)
 EDI1     BSS 
 .T       ENDIF 
  
          MX7    0           SET INTERNAL DATA BIAS = ZERO
          BX4    X1 
          SA7    BIAS 
          SA6    NICT        SAVE TRIP COUNT
          CALL   SDV         SETUP DATA VARIABLE
          SX6    B1          INDEX DIFFERENCE = 1, FOR NOW
          SA5    BIAS 
          CALL   NIC         EMIT LINEAR PROGRESSION
          EQ     EXIT.
 NIC      SPACE  4,20 
 NIC      SPACE  0,0
**        NIC - OUTPUT LINEAR INDEX PATTERN.
* 
*         INITIALIZE AN ARITHMETIC PROGRESSION OF INDICIES. 
*         THAT IS, THIS SUBROUTINE OUTPUTS DATA INITIALIZATION FOR -- 
*                ( ARY (M*I +BIAS), I = 1,TC )   /"DATA ITEM LIST"/ 
* 
*         THE INDEX DIFFERENCE BETWEEN SUCCESSIVE ELEMENTS IS --
*                DA = ARY(M*(I+1)) - ARY(M*I) 
*                   = M * SPAN(J) 
* 
*         ENTRY  (X5) = BIAS - ANY ADDITIONAL BIAS. 
*                (X6) = DA - THE INDEX DIFFERENCE.
* 
*         EXIT   (N.ITEM) = DECREMENTED TO ACCOUNT FOR ITEMS CONSUMED.
*                            NOTE THAT EXACTLY (TC) ITEMS WILL BE USED, 
*                            UNLESS ENTIRE CONSTANT LIST IS PREMATURELY 
*                            EXHAUSTED. 
* 
*         CALLS  GNI, OVI, OSH, ORH, UPH. 
  
  
 NIC      SUBR               ENTRY/EXIT...
          SA3    N.ITEM 
          SX7    X3-1 
          SA6    DA 
          PL     X7,NIC10    IF CONSTANTS REMAINING 
          SA7    A3+         FLAG CONSTANT/VARIABLE COUNT MISMATCH
          EQ     EXIT.
  
 NIC10    BX6    X5 
          SA6    NICB        (NICB) = BIAS
  
 NIC20    SA3    REPFLAG
          SA5    I.DIT
          ZR     X3,NIC24    IF NOT IN THE MIDDLE OF A REP
  
*         IN THE MIDDLE OF A REP , ADJUST REP COUNT DECREMENT ( DEC ) 
*                DEC = 0,  IFF AT START OF REPEATED CON LIST, 
*                DEC = -1, IF NOT AT START. 
  
          BX2    X3 
          LX2    -DI.RLP
          SB4    X2          (B4) = RL         /* (N.ITEMS) IN REP LIST 
          ERRNZ  18-DI.RLL
          MX7    0           DEC = 0
          EQ     B4,B1,NIC26 IF RL = 1
          SA4    I.DIT+2     T.DATI ORDINAL OF FIRST ITEM IN REP LIST 
          IX5    X4-X5
          =X0    -1 
          AX5    59 
          BX7    X0*X5       DEC = -1 IF NOT AT THE START OF REP
          EQ     NIC26
  
 NIC24    SA2    T.DATI 
          SB7    X5          (B7) = NEXT ITEM TABLE INDEX 
          SA3    B7+X2       FETCH (X3) = DATA ITEM DESCRIPTOR
          HX3    DI.REP 
          PL     X3,NIC60    IF NOT THE START OF A NEW REP LIST 
          BX7    0           DEC = 0
          LX3    1+DI.REPP
  
*         REP LIST ENCOUNTERED - SEE IF WE CAN OUTPUT "REPI" MACROS.
*         ENTRY  (A3, X3) = REP LIST INFO.  UPDATE BEFORE DESTROYING IT.
*                (X7) = DEC 
*         COMPUTE NUMBER OF TIMES WE CAN REP THE DATA --
*                N = MIN (RC+DEC, TC/RL)
  
 NIC26    SA5    NICT        (X5) = TC
          LX3    -DI.RCP
          MX0    -DI.RCL
          BX0    -X0*X3      (X0) = RC
          LX3    DI.RCP-DI.RLP
          SX2    X3          (X2) = RL
          ERRNZ  18-DI.RLL
          SX6    X2          SAVE (RL) = (DI.RL)
          SB2    X2          (B2) = RL
          SA6    RL 
          IX0    X0+X7       RC + DEC 
          IX5    X5/X6       TC / RL
          LX3    DI.RLP 
          MX6    X5-X0       N = MIN OF THE TWO 
          SB6    X6 
          LE     B6,B1,NIC60  IF WE CAN'T REP IT AT LEAST TWICE 
  
*         LIST CAN BE REPPED (N) TIMES.  SINCE GNI WILL BE CALLED ONLY
*         ONCE TO OUTPUT THE DATA ITEMS (N) TIMES, THE REPEAT COUNT (RC)
*         MUST BE DECREMENTED BY (N-1). 
*                (A3,X3) = ITEM TABLE ENTRY.
*                (X6) = N 
*                (B2) = RL
  
          SA6    NICN        SAVE (NICN) = N
          SX5    X6-1 
          SA1    DA 
          LX5    DI.RCP      (DI.RC) = (DI.RC) - (N-1)
          IX6    X3-X5
          SX7    B2          DLEN = RL
          SA6    A3 
          MX2    -1 
          IX5    X7-X1       INITIAL BIAS = RL - DA 
          IX6    X1*X7       MP = DA * RL 
          IX2    X1+X2       DA - 1 
          SA6    MP 
          EQ     B2,B1,NIC30 IF RL .EQ. 1 -- TRIVIAL CONTIGUITY 
          NZ     X2,NIC40    IF DA .NE. 1 -- NON-CONTIGUOUS BLOCK 
  
  
**        CASE 1.  CONTIGUOUS BLOCK.
*                (DA = 1) OR (RL = 1) 
*         ISSUE A SINGLE REP HEADER, AND EACH ITEM, ONCE. 
***       FOR NOW, PROCESS CHARACTER ITEMS, RL .NE. 1 USING***
***       CASE 2.                                          ***
  
 NIC30    SA1    DVI+WB.W 
          MX0    -WB.MODEL
          LX1    -WB.MODEP
          BX1    -X0*X1      MODEI = MODE[DVI+ WB.W]
          SB7    X1-M.CHAR
          NZ     B7,NIC32    IF NOT MODE CHARACTER
          NE     B2,B1,NIC40 IF RL .NE. 1 
 NIC32    SA1    NICN        N = (NICN)  */REP COUNT
          SA2    MP          I = (MP)          /* INCREMENT 
          BX6    X7          B = (DLEN)        /* BLOCK LENGTH
          SA3    NICB        FB = (NICB)       /* FWA BIAS
          RJ     ORH         OUTPUT REPI HEADER 
  
          SA1    RL 
          BX6    -X1         SET LOOP COUNTER FOR (RL) ITEMS
 NIC34    SA6    LI 
          RJ     GNI         GET NEXT ITEM
          RJ     OVI         OUTPUT VALUE OF ITEM 
          SA1    LI 
          SX6    X1+B1       DECREMENT LOOP INDEX 
          NZ     X6,NIC34    IF LI .LT. 0, LOOP 
          RJ     UPH         UPDATE PREVIOUS HEADER 
          EQ     NIC50
  
  
**        CASE 2.  NON-CONTIGUOUS PATTERN.
*                (RL .GT. 1)  OR  (DA .NE. 1) 
*         ISSUE (RL) REPS, ONE FOR EACH DATA ITEM.  THE FWA BIAS OF 
*         THE (J)TH REP TABLE IS:  JB = BIAS0 + J * DA. 
* 
*         ENTRY  (B2) = RL. 
*                (NICB) = BIAS0.
  
 NIC40    SA3    NICB 
          SX7    -B2         SET TO LOOP (RL) TIMES 
          BX6    X3          JB = BIAS0        /* ITEM BIAS 
          SA7    LI 
          SA6    A7+B1
  
 NIC44    SA1    NICN        N = (NICN)  */REP COUNT
          SA2    MP          I = (MP)          /* INCREMENT 
          SX6    B1          B = 1             /* BLOCK LENGTH
*         X3                 FB = JB           /* FWA BIAS
          RJ     ORH         OUTPUT REPI HEADER 
          RJ     GNI         GET NEXT ITEM
          RJ     OVI         OUTPUT VALUE OF ITEM 
          RJ     UPH         UPDATE PREVIOUS HEADER 
          SA1    LI 
          SA2    DA 
          SA3    A1+B1
          IX6    X2+X3       JB = JB + DA       /* ADVANCE BIAS 
          SA6    A3 
          BX3    X6 
          SX7    X1+B1       DECREMENT LOOP INDEX 
          SA7    A1 
          MI     X7,NIC44    IF LOOP NOT SATISFIED
  
  
**        END OF REP OUTPUT - UPDATE COUNTERS (N.ITEM, TC, AND BIAS), TO
*         PROPERLY ACCOUNT FOR WHAT HAS BEEN ISSUED.
  
 NIC50    SA1    NICN        N
          SA2    RL 
          SA3    NICB        BIAS 
          SA4    N.ITEM 
          IX0    X1*X2       NEP = N * RL   /* NUMBER OF ELEMENTS ISSUED
          SA2    DA 
          SA5    NICT        TC 
          IX1    X0*X2
          IX7    X3+X1       BIAS = BIAS + DA * NEP 
          SA7    A3 
          IX6    X4-X0       (N.ITEM) = (N.ITEM) - NEP
          SA6    A4 
          IX7    X5-X0       TC = TC - NEP
          SA7    A5 
          ZR     X6,NIC56    IF ITEM LIST IS EXHAUSTED
          NZ     X7,NIC20    IF TRIP COUNT NOT EXHAUSTED
  
 NIC56    IX6    X6-X7       (N.ITEM) -= T
          SA6    A6          FORCE AN INFORMATIVE ERROR IF T .NZ. 
          RJ     UPH         UPDATE PREVIOUS HEADER 
          EQ     EXIT.
  
  
**        CASE 3.  NO EXPLOITABLE PATTERN.
*                (RL .GT. 1) AND (DA .NE. 1), 
*                OR (RC .LE. 1) 
*         NOT AT THE START OF A REP OR CANNOT REP WITH THIS ITEM LIST.
*         ISSUE ITEMS UNTIL THE START OF THE NEXT REP, OR UNTIL THIS
*         REQUEST IS SATISFIED (TC=0), OR NO ITEMS ARE LEFT (N.ITEM=0). 
*         IF (DA .EQ. 1) THEN AN ORG IS ONLY NEEDED THE FIRST TIME. 
  
 NIC60    SA1    DA 
          MX2    -1 
          IX6    X1+X2       (ORGN) = 0  ->  DA .EQ. 1
          SA6    ORGN 
** FV            FOLLOWING KLUDGE FOR CHARACTER FORCES ORG ALWAYS.
 .FIX     EQU    --  REMOVE KLUDGE WHEN OVI USES MOVEB. 
 .KLUDGE  IFEQ   ON,ON       **** REMOVE WHEN OVI FIXED 
          MX0    -WB.MODEL
          SA1    DVI+WB.W 
          LX1    -WB.MODEP
          BX3    -X0*X1 
          SB7    X3-M.CHAR
          NZ     B7,NIC63    IF NOT TYPE CHARACTER
          MX6    -1 
          SA6    A6          FORCE ALL ORGS 
 .KLUDGE  ELSE   1           ...END KLUDGE
          EQ     NIC63       FORCE INITIAL ORG
  
 NIC62    SA2    ORGN 
          ZR     X2,NIC64    IF NO ORG NEEDED 
 NIC63    SA3    NICB 
          RJ     OSH         OUTPUT SCALAR HEADER 
 NIC64    RJ     GNI         GET NEXT DATA ITEM 
          RJ     OVI         OUTPUT VALUE OF ITEM 
          SA3    NICB        BIAS 
          SA4    DA 
          IX7    X4+X3       BIAS = BIAS + DA        /* ADVANCE BIAS
          MX0    -1 
          SA7    A3 
          SA4    N.ITEM 
          SA5    NICT        TC 
          IX6    X4+X0       (N.ITEM) -= 1     /* DECREMENT CONS LEFT 
          SA6    A4 
          IX7    X5+X0        TC = TC - 1      /* DECREMENT VARS LEFT 
          SA7    A5 
          ZR     X6,NIC56    IF NO MORE DATA ITEMS LEFT -- QUIT 
          ZR     X7,NIC68    IF FINISHED WITH THE VARS
          SA2    T.DATI 
          SA1    I.DIT
          IX1    X1+X2
          SA3    X1          FETCH (X3) = NEXT DATA ITEM DESCRIPTOR 
          HX3    DI.REP 
          PL     X3,NIC62    IF NOT THE START OF A REP -- LOOP
  
          RJ     UPH         UPDATE PREVIOUS HEADER 
          SA5    I.DIT
          EQ     NIC24
  
 NIC68    RJ     UPH         UPDATE PREVIOUS HEADER 
          EQ     EXIT.
  
 NICB     BSS    1           BIAS  LOCAL COPY OF BIAS 
 NICN     BSS    1           N     TIMES REP LIST CAN BE TRAVERSED
 NICT     BSS    1           TC    TRIP COUNT 
 OSH      SPACE  4,20 
**        OSH - OUTPUT SCALAR HEADER. 
* 
*         SET UP OUTPUT CONTROL WORDS (S. CELLS) FOR THE BEGINNING OF A 
*         DATA SUB-TABLE.  IF THE LAST SUB-TABLE IS STILL OPEN, IT MUST 
*         BE TERMINATED FIRST.
* 
*         NOTE THAT ALL HIGHER LEVEL BIAS AND LENGTH CALCULATIONS HAVE
*         BEEN PERFORMED IN TERMS OF NUMBER OF ELEMENTS.  AT THIS POINT 
*         (ALSO ORH) THEY ARE TRANSFORMED INTO NUMBER OF STORAGE UNITS. 
* 
*         ENTRY  (X3) = FB = FWA BIAS (IN ELEMENTS).
*                (DVI+V1.W) = SYMORD OF FWA.
* 
*         EXIT   (A6, X6) = SKELETAL (DA.) HEADER.
* 
*         CALLS  ADDWD, UPH.
  
  
 OSH      SUBR               ENTRY/EXIT...
          SA2    S.POP
          MI     X2,OSH20    IF NO UNTERMINATED BLOCK 
          BX6    X3 
          SA6    OSHA 
          RJ     UPH         UPDATE PREVIOUS HEADER 
          SA3    OSHA        RESTORE (X3) = FB
  
 OSH20    SA4    DVI+V1.W    V1I = (DVI+V1.W) 
          SA2    A4-V1.W+WB.W      V2I = (DVI+WB.W) 
          BX7    0
          MX0    -WB.MODEL
          MX6    -V1.BASEL
          LX4    -V1.BASEP
          SA7    S.LEN       (S.LEN) = 0
          LX2    -WB.MODEP
          BX6    -X6*X4      BASEI = BASE[V1I]
          =A7    A7-S.LEN+S.NCH    (S.NCH) = 0
          BX0    -X0*X2      MODEI = MODE[V2I]
          =A7    A7-S.NCH+S.PAD    (S.PAD) = 0
          LX6    DA.ORDP     (X6) = SKELETAL (DA.) HEADER 
  
*         CONVERT BIAS FROM ELEMENTS TO STORAGE UNITS.
  
          SA1    A2-WB.W+V3.W      V3I = (DVI+2)
          SB7    X0-M.CHAR
          ZR     B7,OSH40    IF TYPE CHARACTER
          LX4    V1.BASEP-1-V1.SDPFP
          AX4    -0 
          BX2    X4*X3       (X2) = FB * SDPF 
          IX3    X3+X2       FEA = FB * 2**SDPF 
          EQ     OSH80
  
 OSH40    CLAS=  X7,(DA),CH 
          MX0    -V3.ELSL 
          LX1    -V3.ELSP 
          IX6    X6+X7       INDICATE CHARACTER SUB-TABLE 
          BX2    -X0*X1      ELSI = ELS[V3I]
          IX3    X2*X3       FEA = FB * ELSI
          LX1    V3.ELSP
  
 OSH80    MX0    -V3.ABUL 
          SA6    S.DHW+DA.W 
          LX1    -V3.ABUP 
          BX2    -X0*X1      ABUI = ABU[V3I]
          IX7    X3+X2       (S.FEA) = FEA + ABUI 
          SA7    S.FEA
          ADDWD  T.DATS 
          SX7    X2-1        (S.POP) = INDEX OF (DA.) HEADER
          SA7    S.POP
          EQ     EXIT.
 ORH      SPACE  4,20 
**        ORH - OUTPUT REPLICATION HEADER.
* 
*         CALLS OSH TO DO SCALAR INITIALIZATION, AND TRANSFORM (FB).
*         THEN UPGRADES THE CONTROL BLOCK FOR REPLICATION.  THE 
*         INCREMENT MUST ALSO BE CONVERTED INTO STORAGE UNITS.
* 
*         ENTRY  (X6) = B - BLOCK LENGTH, NUMBER OF VARIABLE ELEMENTS TO
*                           BE REPEATED.
*                (X1) = N - REP COUNT, NUMBER OF TIMES THE DATA IS TO 
*                           BE STORED, COUNTING THE ORIGINAL. 
*                (X2) = I - INCREMENT BETWEEN COPIES, IN ELEMENTS.
*                (X3) = FB - FWA BIAS, IN ELEMENTS. 
* 
*         CALLS  ALLOC, OSH.
  
  
 ORH      SUBR               ENTRY/EXIT...
 .T       IFEQ   TEST,ON
          SA4    S.POP
          PL     X4,"BLOWUP"  IF INCOMPLETE BLOCK 
          SA6    S.BLEN      (S.BLEN) = B 
 .T       ENDIF 
          SA4    DVI+V3.W 
          MX0    -V3.ELSL 
          SX7    B1 
          LX4    -V3.ELSP 
          BX0    -X0*X4      ELS = ELEMENT SIZE, IN STORAGE UNITS 
          IX1    X1-X7       (DB.CNT) = N - 1 
          IX2    X0*X2       (DB.INC) = I * ELS 
          LX1    DB.CNTP
          LX2    DB.INCP
          BX7    X1+X2
          SA7    S.DHW+DB.W 
          RJ     OSH         OUTPUT SCALAR HEADER (FB)
  
          CLAS=  X0,DA,(RP) 
          SA1    S.DHW+DB.W 
          BX6    X0+X6       INDICATE REPLICATED BLOCK
          MX7    -1 
          =A6    A1-DB.W+DA.W 
          BX6    X1 
          SA7    S.PAD       INDICATE INNER REP NOT POSSIBLE
          ADDWD  T.DATS 
          EQ     EXIT.
 OVI      SPACE  4,30 
**        OVI - OUTPUT VALUE OF ITEM. 
* 
*         OVI COERCES THE CONSTANT INTO THE MODE OF THE ELEMENT, AND
*         THEREFORE ALWAYS ISSUES ENOUGH DATA TO EXACTLY COVER ONE
*         ELEMENT.  WHENEVER THE CONSTANT ITEM IS MODE-CONVERTED, THE 
*         DESCRIPTOR IS UPDATED TO THE NEW CONSTANT.  THIS PREVENTS 
*         CONVERSION OVERHEAD FOR AN UN-REPLICATIBLE REPEATED CONSTANT. 
* 
*         ENTRY  (A5, X5) = DATA CONSTANT ITEM DESCRIPTOR.
*                (DVI) = DATA VARIABLE ELEMENT DESCRIPTOR.
* 
*         EXIT   (S.LEN) ADVANCED BY NUMBER OF STORAGE UNITS IN THIS
*                            ELEMENT. 
*                ITEM DESCRIPTOR CHANGED IF CONSTANT WAS CONVERTED. 
* 
*         CALLS  ALLOC, CMV, MOVE.
  
  
 OVI      SUBR               ENTRY/EXIT...
          SA1    T.DATI 
          SA4    DVI+V3.W    V3I = (DVI+V3.W) 
          SA3    S.LEN
          SB2    X1 
          SX6    A5-B2       DITIND = (A5) - FWA(T.DATI)
          SA6    OVIA        SAVE (OVIA) = DITIND 
          MX1    -V3.SSUL 
          LX4    -V3.SSUP 
          =A2    A4-V3.W+WB.W      V2I = (DVI+WB.W) 
          BX4    -X1*X4      SSUI = SSU[V3I], STORAGE DESIRED 
          IX7    X3+X4       (S.LEN) = (S.LEN) + SSUI 
          LX2    -WB.MODEP
          SA7    A3          (S.LEN) = (S.LEN) + SSUI 
          RJ     CMV         CONVERT MODE OF VALUE
          LX5    -DI.PNTP 
          SB2    X5          PNTI = PNT [CON DESCRIPTOR]
          ERRNZ  18-DI.PNTL 
          LX5    DI.PNTP-DI.DLENP 
          ZR     B3,OVI5     IF TYPE CHARACTER ELEMENT
          SB6    X5          LEN = DLEN [CON DESCRIPTOR]
          ERRNZ  18-DI.DLENL
          ALLOC  T.DATS,B6   ALLOCATE SPACE FOR ITEM
          SA1    T.CON
          SB2    B2+B1       PNTI = PNTI + 1
          SA3    X1+B2       FETCH 2ND WORD OF CON (OR GARBAGE) 
          SA2    A3-B1       FETCH 1ST WORD OF CON
          BX7    X3 
          LX6    X2 
          SA7    B7-B1       (2ND WORD) => (LWA(TABLE)) 
          SA6    B7-B6       (1ST WORD) => (LWA(TABLE)+1-WC)
          EQ     EXIT.
  
  
*         OUTPUT CHARACTER ELEMENT. 
*         TRUNCATION OF CONSTANT IS AUTOMATIC, SINCE WE ONLY ISSUE
*         THE NUMBER OF CHARS IN THE VARIABLE.  BLANK PADDING MUST HAVE 
*         ALREADY BEEN DONE.
*                (B2) = PNTI, POINTER INTO T.CHAR 
*                (X5) = DI.PNT, UPPER BITS JUNK 
  
 OVI5     SX2    X5          LEN = DLEN [CON DESCRIPTOR]
          CW     X4,X2       LEN = LEN / 10 
          ALLOC  T.DATS,X4   ALLOCATE SPACE FOR ITEM
          SX7    B7          LAST = LWA+1 OF (T.DATS) 
          SA1    T.CON
          IX3    X7-X4       DEST = LAST - WC 
          SX2    X1+B2       SOURCE = (T.CHAR) + INDEX
          SX1    X4          WC = (X4)
          MOVE   X1,X2,X3 
 .FIX     EQU    --  USE MOVEB, CAUSE CHAR AIN'T WORD ALIGNED.
          EQ     EXIT.
 SDV      SPACE  4,10        SETUP DATA VARIABLE. 
**        SDV -  SETUP DATA VARIABLE. 
* 
*         BUILD (DVI) ENTRY DESCRIBING THE DATA TARGET -- 
*                (DVI+0) = (V1.) FORMAT.
*                (DVI+1) = (WB.) FORMAT.
*                (DVI+2) = (V2.) FORMAT.
* 
*         ENTRY  (B6) = SYMORD OF ORIGINAL. 
*                (B7) = SYMORD OF EQUIV BASE. 
*                (X4) = FWA BIAS, (WC.) FORMAT, RELATIVE TO RA[BASE]. 
* 
*         EXIT   (DVI AREA)  SET UP.
  
  
 SDV      SUBR   0           ENTRY/EXIT...
          SA2    T.SYM
          SX1    B6+B6
          SX5    B6 
          =B2    X2+WB.W
          SX7    X1+B6       (X7) = INDEX OF SYMTAB (WB.) 
          ERRNZ  3-Z=SYM
          SA2    X7+B2
          SX3    B7 
          LX3    V1.BASEP 
          LX5    V1.ORDP     SAVE SYMTAB ORDINAL
          BX6    X2 
          SA6    DVI+WB.W 
          BX5    X5+X3
  
*         EXAMINE MODE TO DETERMINE PHYSICAL MAPPING OF SYMBOL -- 
*         LET    WCS = (WC.) OF ORIGINAL SYMBOL.
*                WCE = (WC.) OF EFFECTIVE OPERAND (X4). 
*         SET    (SDPF) = LOG2 OF WORDS-PER-ELEMENT.
*                (ELS) = STORAGE UNITS PER ELEMENT. 
*                (SSU) = ELS. 
*                (ABU) = RA[WCE]
*         WHEN TYPE CHARACTER --
*                (SDPF) = 0.
*                (ELS) = CLEN[WCS]
*                (SSU) = CLEN[WCE]
*                (ABU) = 10*RA[WCE] + BCP[WCE]
  
          MX0    -WB.MODEL
          LX6    -WB.MODEP
          BX0    -X0*X6      MODEI = MODE[V2I]
          SX7    B1          UNIT = 1 
          SB5    X0-M.DBL 
          EQ     B5,B0,SDV4  IF MODE DOUBLE 
          EQ     B5,B1,SDV4  IF MODE COMPLEX
          ERRNZ  M.DBL+1-M.CPLX 
          SX7    +           UNIT = 0 
 SDV4     SX3    X7+B1       ELS = UNIT + 1 
          LX7    V1.SDPFP 
          BX7    X5+X7       FORM (V1.) 
          =A7    A6-WB.W+V1.W 
  
*         COMPUTE ADDITIONAL BIAS FROM WC[OPERAND] -- 
  
          LX4    -WC.RAP
          MX7    -WC.RAL
          BX6    -X7*X4      RAI = RA[WCE]
          BX0    X3          SSU = ELS
          LE     B5,B1,SDV7  IF NOT MODE CHARACTER
          ERRNZ  M.CPLX+1-M.CHAR
          MX0    -WC.BCPL 
          LX4    WC.RAP-WC.BCPP 
          BX1    -X0*X4      BCPI = BCP[WCE]
          LX4    WC.BCPP-WC.CLENP 
          WC     X7,X6       (X7) = 10 * RAI
          MX3    -WC.CLENL
          IX6    X7+X1       ABUI = 10 * RAI + BCPI 
          BX0    -X3*X4      SSU = CLEN[WCE]
          =A1    A2-WB.W+WC.W      WCS
          LX1    -WC.CLENP
          BX3    -X3*X1      ELS = CLEN[WCS]
  
 SDV7     LX3    V3.ELSP
          LX0    V3.SSUP
          BX7    X3+X0
          LX6    V3.ABUP
          BX7    X6+X7
          =A7    A6-WB.W+V3.W 
 .T       IFEQ   TEST,ON
          SA1    CO.SNAP
          LX1    1R9
          PL     X1,EXIT.    IF (SNAP=9) NOT SELECTED 
 SDVX     CORE   DVI,3
 .T       ENDIF 
          EQ     EXIT.
 UPH      SPACE  4,10 
**        UPH - UPDATE PREVIOUS HEADER. 
* 
*         DOES NOTHING IF NO BLOCK IN PROGRESS ON ENTRY.
* 
*         ENTRY  (S. CELLS) DESCRIBE CURRENT BLOCK. 
* 
*         EXIT   (S.POP) INDICATES NO BLOCK IN PROGRESS.
*                HEADER WORDS UPDATED IN THE SUB-TABLE. 
* 
*         USES   ALL BUT A0  B4,B5,B6.
  
  
 UPH      SUBR   0           ENTRY/EXIT...
          SA3    S.LEN
          SA4    S.DHW+DA.W 
          LX3    DA.WCP 
          SA5    S.POP
          MI     X5,EXIT.    IF NO BLOCK IN PROGRESS
          SA2    T.DATS 
          BX6    X3+X4       (DA.WC) = (S.LEN)
          IX5    X2+X5
          SA3    S.FEA
          LX3    DA.BIASP 
          BX6    X6+X3       (DA.BIAS) = FEA
          MX7    -1          INDICATE NO INCOMPLETE BLOCK 
          =A6    X5+DA.W
          SA7    A5 
          EQ     EXIT.
          TITLE  CONSTANT LIST SCANNING AND CONVERSION. 
 ADC      SPACE  4,10 
**        ADC -  ADD CONSTANT TO DATA ITEM TABLE. 
* 
*         ENTRY  (A4, X4) -> FIRST TOKEN OF CONSTANT. 
*                (X7) = -0 IF CON PRECEEDED BY - SIGN , ELSE 0. 
*                FIRST TOKEN IS ONE OF O.(CONS, PERIOD, CHAR, HOLL, 
*                            OCT, HEX). 
* 
*         EXIT   (X6) = ITEM DESCRIPTOR (DI. FORMAT). 
*                (SELIST) = ADVANCED OVER THE CONSTANT TOKENS.
* 
*         CALLS  ADDWD, ASI, ANSI, WARN.
  
  
 ADC      SUBR               ENTRY/EXIT...
          SB2    X4 
          ERRNZ  18-TB.TOTL 
          =X6    A4+1 
          SA6    SELIST      SAVE STRING BUFFER ADDRESS 
 .T       IFEQ   TEST,ON
 ADCA     BITMIC (O.CONS,O.PERIOD,O.CHAR,O.HOLL,O.QHOLL,O.RLCON,O.OCT,__
,O.HEX) 
          SA1    ="ADCA"
          LX1    B2 
          PL     X1,"BLOWUP" IF NOT A LEGAL TOKEN FOR US
 .T       ENDIF 
          IF.EQ  O.HOLL,ADC2 IF HOLLERITH CONSTANT
          IF.EQ  O.QHOLL,ADC2      IF "" STRING 
          IF.EQ  O.RLCON,ADC2      IF R OR L CONSTANT 
          IF.NE  O.CHAR,ADC4       IF NOT CHARACTER CONSTANT
  
*         CHARACTER CONSTANT. 
  
          MX0    -TB.CLCNL
          =X6    M.CHAR 
          LX4    -TB.CLCNP
          MI     X7,E.DIL1   IF CHAR PRECEDED BY MINUS SIGN 
          BX1    -X0*X4      CLEN = NUMBER OF CHARACTERS IN CONSTANT
 .FIX     EQU    --  CANNOT CON LEN BE ROUNDED UP 10 ?? 
          IFNE   TB.CLCNL,TB.SHCL,1 
          MX0    -TB.SHCL 
          LX4    TB.CLCNP-TB.SHCP 
          BX2    -X0*X4      INDX = INDEX OF CONSTANT IN (T.CHAR) 
          EQ     ADC3 
  
  
*         HOLLERITH CONSTANT. 
  
 ADC2     MI     X7,E.DIL1   IF HOLLERITH PRECEDED BY MINUS SIGN
          ANSI   E.AT08      HOLLERITH IS NON ANSI
          MX0    -TB.LCONL
          LX4    -TB.LCONP
          BX3    -X0*X4      (B7) = WORD LENGTH OF HOLLERITH
          MX0    -TB.SHCL 
          LX4    TB.LCONP-TB.SHCP 
          BX2    -X0*X4      (X2) = INDEX IN (T.CON)
          =X6    M.BOOL 
          SB7    X3 
          =X1    1           LENGTH = 1 
          EQ     B7,B1,ADC3  IF SINGLE-WORD HOLLERITH 
          WARN   E.AT03      HOLLERITH EXCEEDS 10 CHARACTERS
  
*         ADD ITEM DESCRIPTOR (DI.) TO DATA ITEM TABLE (T.DATI).
*                (X1) = CONSTANT LENGTH.
*                (X2) = CONSTANT TABLE INDEX. 
*                (X6) = MODE OF CONSTANT. 
  
 ADC3     LX6    DI.MODEP    (DI.MODE) = X6 
          LX1    DI.DLENP    (DI.DLEN) = X1 
          IX7    X6+X1
          LX2    DI.PNTP     (DI.PNT) = X2
          BX6    X2+X7
          EQ     EXIT.
  
*         NUMERIC CONSTANT.  CONVERT AND ADD TO (T.CON).
  
 ADC4     BX5    X7          SAVE CONSTANT SIGN 
          SB4    A4 
          CALL   TNK         TRANSLATE NUMERIC CONSTANT 
          SX7    B4+B1
          SA7    SELIST 
          BX6    X6-X5       (X6) = SIGN * (UPPER HALF) 
          BX7    X2-X5       (X7) = SIGN * (LOWER HALF) 
          RJ     ASI         ADD SCALAR ITEM
          EQ     EXIT.
 ASC      SPACE  4,10 
**        ASC -  ADD SYMBOLIC CONSTANT TO DATA TABLE. 
* 
*         ENTRY  (B6) = CONSTANT POINTER
*                (X1) = MODE OF CONSTANT
*                (X3) = WC WORD OF SYMBOLIC CONSTANT
*         EXIT   (X6) = ITEM DESCRIPTOR (DI. FORMAT). 
*         USES   A - NONE 
*                X - 0,1,2,3,6
*                B - 2,3,5
  
  
 ASC      SUBR               ENTRY/EXIT.
          SB2    X1-M.CHAR
          SX6    B6 
          LX6    DI.PNTP
          MX0    -WC.CLENL
          NZ     B2,ASC10    IF NOT TYPE CHARACTER
  
*         TYPE CHARACTER, GET LENGTH FROM WC.CLEN.
  
          LX3    -WC.CLENP
          BX2    -X0*X3      DLEN = CLEN[WCI] 
          LX3    WC.CLENP 
          EQ     ASC20
  
 ASC10    =B3    X1-M.DBL 
          =X2    2           DLEN = 2 
          EQ     B3,ASC20    IF DOUBLE
          EQ     B3,B1,ASC20 IF COMPLEX 
          ERRNZ  M.DBL+1-M.CPLX 
          =X2    1           DLEN = 1 
  
 ASC20    LX1    DI.MODEP 
          LX2    DI.DLENP 
          BX6    X6+X1
          BX6    X6+X2
          EQ     EXIT.
 ASI      SPACE  4,10 
**        ASI - ADD SCALAR ITEM.
* 
*         ENTRY  (X1) = MODE OF CONSTANT. 
*                (X6) = UPPER HALF OF CONSTANT. 
*                (X7) = LOWER HALF OF CONSTANT, IF DBL OR CPLX. 
* 
*         EXIT   (X6) = ITEM DESCRIPTOR (DI. FORMAT). 
  
  
 ASI      SUBR               ENTRY/EXIT...
          SB2    X1-M.DBL 
          SB5    X1+         REMEMBER (B5) = MODE OF CONSTANT 
          EQ     B2,B0,ASI4  IF MODE DOUBLE 
          EQ     B2,B1,ASI4  IF MODE COMPLEX
          ERRNZ  M.DBL+1-M.CPLX 
  
          SCAN   T.CON,SCT
          SX4    B1          INDICATE SINGLE-WORD CONSTANT
          SX2    B7+B1
          PL     B7,ASI2     IF CONSTANT ALREADY IN TABLE 
          ADDWD  A1 
  
*         CONSTANT IN (T.CON) -- CONSTRUCT DESCRIPTOR.
*                (B5) = MODE
*                (X4) = WORD COUNT
*                (X2) = INDEX + 1 
  
 ASI2     SX6    B5          (X6) = MODE OF CON 
          SX2    X2-1        (X2) = INDEX OF CON
          LX4    DI.DLENP 
          LX2    DI.PNTP
          LX6    DI.MODEP 
          BX7    X4+X2
          BX6    X7+X6       ADD ITEM DESCRIPTOR TO (T.DATI)
          EQ     EXIT.
  
*         DOUBLE WORD CONSTANT. 
  
 ASI4     CALL   NBC         ENTER BINARY OF CONSTANT 
          HX6    TP.BIAS
          SX4    B1+B1       INDICATE DOUBLE-WORD CONSTANT
          AX6    -TP.BIASL
          SX2    X6+B1
          EQ     ASI2 
 CFC      SPACE  4,20 
**        CFC - CHECK FOR COMPLEX CONSTANT. 
* 
*         SEE ANSI 4.6.1, NO CDC EXTENSIONS.
* 
*         ENTRY  (A4,X4) -> LPAREN TOKEN BEGINNING SUSPECTED CONSTANT.
* 
*         EXIT   IF COMPLEX CONSTANT WAS PRESENT -- 
*                (X0) .ZR.
*                (X1,X2) = (REAL, IMAGINARY) OF CONVERTED CONSTANT. 
*                (SELIST) -> AFTER TERMINATING RPAREN.
* 
*         ELSE   LPAREN WAS NOT A COMPLEX CON BEGIN TOKEN --
*                (X0) .NZ.
*                (A4,X4) PRESERVED. 
* 
*         USES   A1-A7,  B2-4,B7,  X0-X7. 
* 
*         CALLS  CHC, CPR 
  
  
 CFC9     MX0    1           INDICATE FAILURE 
          SA4    X5          RESTORE A4 
  
 CFC      SUBR   =           ENTRY/EXIT...
          SA3    A4+B1
          SX5    A4          REMEMBER (X5) = ORIGINAL (A4)
          RJ     CHC         CONVERT REAL HALF OF COMPLEX 
          SA6    CFCA 
          SA1    B4+B1       CHECK TOKEN FOLLOWING CON
          SB2    X1-O.COMMA 
          SA3    A1+B1       ADVANCE (A3) 
          SB4    A3 
          NZ     B2,CFC9     IF NO COMMA
          ZR     B7,CFC1     IF REAL HALF NOT PARAMETER 
          ANSI   B7 
          RJ     CPR         OUTPUT PARAMETER REFERENCE 
  
 CFC1     RJ     CHC         CONVERT IMAGINARY HALF OF COMPLEX
          ZR     B7,CFC2     IF IMAGINARY HALF NOT PARAMETER
          ANSI   B7 
          BX4    X6          PRESERVE BINARY OF IMAGINARY 
          RJ     CPR         OUTPUT PARAMETER REFERENCE 
          LX6    X4          RESTORE BINARY 
  
 CFC2     =A3    B4+1 
          SB2    X3-O.RP
          BX2    X6          RETURN (X2) = VALUE OF IMAGINARY HALF
          NZ     B2,CFC9     IF NO TERMINAL RIGHT PAREN 
          SA1    CFCA        RETURN (X1) = VALUE OF REAL HALF 
          =X6    A3+1 
          =A4    A3+1 
          MX0    0           INDICATE SUCCESS 
          SA6    SELIST 
          EQ     EXIT.
  
 CFCA     BSS    1           SAVE REAL PART 
 CHC      SPACE  4,10 
**        CHC - CONVERT HALF OF COMPLEX.
* 
*         NOTE THAT CHC IS REALLY A PART OF CFC, AND CAN ONLY 
*         BE CALLED FROM THERE. 
* 
*         ENTRY  (A3,X3) -> FIRST TOKEN OF SUSPECTED CON. 
* 
*         EXIT   IF LEGITIMATE COMPLEX HALF FOUND --
*                (B4) -> LAST TOKEN OF CONSTANT.
*                (B7) = DIAGNOSTIC ADDR IF PARAMETER USED, 0 ELSE 
*                (X1) = SYMTAB ORDINAL OF PARAMETER, IF PRESENT 
*                (X6) = SIGNED FLOATING POINT VALUE OF CONSTANT.
* 
*         ELSE   TO *CFC9* -- 
*                TOKENS FOUND CANNOT BE PART OF A COMPLEX CON.
* 
*         USES   A1-7,  B2-4,B7,  X0-4,X6-7.
*         CALLS  CSC, DEC, KCV. 
  
  
 CHC      SUBR   0           ENTRY/EXIT...
          SB2    X3 
          MX7    0           SET FOR PLUS SIGN
          SA7    CHCB        PARAMETER FLAG 
          SB3    B2-O.PL
          EQ     B3,B0,CHC2  IF PLUS SIGN 
          NE     B3,B1,CHC3  IF NOT MINUS SIGN
          ERRNZ  O.PL+1-O.MIN 
          MX7    -0 
  
 CHC2     SA3    A3+1        ADVANCE OVER SIGN TOKEN
          SB2    X3+
  
 CHC3     SB7    O.PERIOD 
          SB3    O.CONS 
          SA7    CHCA        REMEMBER (CHCA) = SIGN 
          EQ     B7,B2,CHC5  IF DECIMAL POINT 
          EQ     B3,B2,CHC5  IF DIGIT 
          SB7    O.VAR
          NE     B7,B2,CFC9  IF NOT *VAR*                  ...FAIL
          SA4    A3 
          SB4    A3 
          RJ     CSC         CONVERT SYMBOLIC CONSTANT
          MI     B7,CFC9     IF NOT A PARAMETER NAME       ...FAIL
          SX7    E.DC10 
          SA7    CHCB        PARAMETER FLAG 
          LX7    X0 
          =A7    A7+1        SAVE SYMTAB ORDINAL
          EQ     CHC6 
  
 CHC5     SB4    A3 
          CALL   DEC         CONVERT DECIMAL CONSTANT 
  
 CHC6     =X0    M.INT
          IX3    X1-X0
          NZ     X3,CHC7     IF NOT INTEGER CONSTANT
          =X1    X0-M.INT+M.REAL
          CALL   KCV         CONVERT CONSTANT VALUE 
  
 CHC7     SX3    X1-M.REAL
          NZ     X3,CFC9     IF NOT REAL OR INTEG.  NOT COMPLEX CON 
          SA1    CHCB 
          SB7    X1          PARAMETER FLAG 
          =A1    A1+1        SYMTAB ORDINAL 
          SA2    CHCA 
          ZR     X6,EXIT.    IF VALUE = 0, AVOID COMPLEMENT 
          BX6    X6-X2       RETURN (X6) = SIGNED VALUE OF CON
          EQ     EXIT.
  
 CHCA     BSS    1           REMEMBER SIGN
 CHCB     BSS    1           PARAMETER AS CONSTANT PART FLAG
          BSS    1           PARAMETER SYMTAB ORDINAL 
 CMV      SPACE  4,10 
**        CMV - COERCE MODE OF VALUE. 
* 
*         ENTRY  (A5,X5) = CONSTANT DESCRIPTOR. 
*                (X4) = ELS, STORAGE UNITS DESIRED. 
*                (X2) = DM, DESIRED MODE (LEADING GARBAGE OKAY).
* 
*         EXIT   (X5) = NEW CONSTANT DESCRIPTOR WORD
*                (B3) .ZR. = DM IS TYPE CHARACTER.
*                NEW CONSTANT VALUE IS INCLUDED IN (T.CON). 
* 
*         USES   ALL BUT A0,  B4. 
*         CALLS  ALLOC, ASI, FATAL, KCV, MOVE, NCM. 
  
*         CONSTANT NOT IN TABLE.
  
  
 CMV      SUBR   =           ENTRY/EXIT.
          MX0    -WB.MODEL
          LX5    -DI.DLENP
          BX6    -X0*X2      (X6) = MODE OF VARIABLE
          SB7    -M.CHAR
          SB3    X6+B7       (B3) = 0 IFF CHARACTER VARIABLE
          IFNE   WB.MODEL,DI.MODEL,1
          MX0    -DI.MODEL
          SB6    X5          CONLEN = DLEN[DATI]
          ERRNZ  18-DI.DLENL
          LX5    DI.DLENP-DI.MODEP
          BX2    -X0*X5      (B2) = 0 IFF CHARACTER CONSTANT
          BX5    X0*X5
          SB2    X2+B7
          BX5    X5+X6       (X5) = RMD 
          LX5    DI.MODEP-DI.PNTP 
          SB7    X5          PNTI = PNT[DITI] 
          LX5    DI.PNTP
          ZR     B3,CMV30    IF TYPE CHARACTER VARIABLE 
  
*         DESIRED MODE IS SCALAR (NON-CHARACTER). 
  
          EQ     B2,B3,EXIT. IF CONMODE SAME AS VARMODE 
          ZR     B2,CMV60    IF CHAR AND SCALAR MIXED 
          SA1    T.CON
          BX0    X2          (X0) = OLD MODE
          SA2    X1+B7       (X6,X7) = OLD VALUE
          SA3    A2+B1
          BX1    X6          (X1) = DESIRED MODE
          LX7    X3 
          BX6    X2 
          CALL   KCV         CONVERT CONSTANT VALUE 
          PL     B2,CMV10    IF NO CONVERSION ERROR 
          FATAL  E.AT01      MIXED LOGICAL AND NON LOGICAL
  
 CMV10    RJ     ASI         ADD SCALAR ITEM
          BX5    X6          (X5) = NEW CONSTANT DESCRIPTOR 
          SB3    B1          INDICATE SCALAR MODE 
          EQ     EXIT.
  
*         CONVERT CHARACTER CONSTANT. 
*                IF CONSTANT LONGER THAN VAR, LEAVE IT ALONE. 
*                IF CONSTANT SHORTER THAN VAR -- BLANK PAD IT.
*         REPLACE (T.DATI) ENTRY WITH THE LONGER (NEW) CONSTANT, SO THAT
*         THE PADDING PROCESS WILL NOT BE REPEATED OFTEN. 
*         NOTE ALSO THAT CHAR CONSTANTS WHICH ARE NOT A FULLWORD
*         MULTIPLE ARE ALWAYS (ALREADY) BLANK FILLED TO NEXT WORD 
*         BOUNDARY. 
*         (X5) = NEW CONSTANT DESCRIPTOR
*                (B6) = CONLEN -  CHAR LEN OF OLD CON.
*                (X4) = ELS   -  CHAR LEN OF VAR. 
*         (B7) =PNTI
  
 CMV30    NZ     B2,CMV60    IF CONSTANT NOT TYPE CHARACTER 
          SX3    B6 
          LX5    -DI.DLENP
          MX0    -DI.DLENL
          BX7    X0*X5       CLEAR DLEN FIELD 
          BX5    X7+X4       DLEN[DITI] = VARLEN
          LX5    DI.DLENP 
          CW     X1,X4       NWLEN = VARLEN / 10
          CW     X2,X3       OWLEN = CONLEN / 10
          IX7    X2-X1
          SB6    X1          ELS = NWLEN
          PL     X7,EXIT.    IF OWLEN .GE. NWLEN
          BX7    -X7
          SB5    X7          NWBLNK = NWLEN - OWLEN 
          SB6    X2          REMEMBER (B6) = OWLEN
          SB3    X1          REMEMBER (B3) = NWLEN
          SX4    B7          PNTI = PNT[DITI] 
          ALLOC  T.CON,B3    ALLOCATATE FOR NEW CHAR CON
  
          SB2    B7-B3       DEST = LWA(T.CHAR) - NWLEN 
          IX2    X1+X4       SOURCE = FWA(T.CHAR) + PNTI
          MOVE   B6,X2,B2    COPY OVER THE OLD CONSTANT 
          SA1    =10H 
          SETMEM B2+B6,B5,X1 BLANK FILL 
  
          SA1    T.CON
          SB7    X1          SET (B7) .NE. 0
          SB6    B2-B7       NEWORD = DEST - FWA(T.CHAR)
          SA2    T=CON
          SX3    B3 
          IX6    X2-X3
          SA6    A2          (T=CHAR) = (T=CHAR) - NWLEN
          SB5    B3          REMEMBER (B5) = NWLEN
          SB3    B2+B5       (B3) = DEST + NWLEN
          CALL   NCM
          MI     B7,CMV40    IF NOT ALREADY IN TABLE
          SB6    B7          NEW ORD = (B7) 
          EQ     CMV50
  
 CMV40    SA1    T=CON
          SX6    X1+B5
          SA6    A1          (T=CHAR) = (T=CHAR) + NWLEN
  
*         (B2) = NEW T.CHAR ORDINAL.
  
 CMV50    SX1    B6 
          MX0    -DI.PNTL 
          LX5    -DI.PNTP 
          BX5    X0*X5       CLEAR PNT FIELD
          BX5    X5+X1
          LX5    DI.PNTP
          =B3    0           INDICATE CHARACTER 
          EQ     EXIT.
  
*         CHARACTER AND SCALAR MIXED.  DO NOT CHANGE DESCRIPTOR.
  
 CMV60    FATAL  E.AT13      ** CHAR AND OTHER MIXED
          BX5    0           PNT = 0     /* FAKE UP RETURN
          EQ     EXIT.
 CPR      SPACE  4,10 
**        CPR -  COMPLEX PARAMETER REFERENCE OUTPUT 
* 
*         ENTRY  (X1) = SYMTAB ORDINAL
* 
*         USES   X0,X1,X2,X5,X6  A1 
* 
*         CALLS  ERT
  
  
 CPR      SUBR               ...ENTRY/EXIT... 
          LX0    X1 
          LX0    XR.TAGP
          SA1    REFVAR 
          SX2    B4 
          IX5    X5-X2       CONVERT ORIGINAL POSITION TO DIFFERENCE
          ADDREF X0,X1
          SA3    B4          PROTECTION FOR TABLE MOVE IF IN STMT-FUN 
          SX5    X5+B4       ORIGINAL POSITION (MAY BE UPDATED) 
          EQ     EXIT.
 CRL      SPACE  4,10 
**        CRL - CLOSE OUT REP LIST. 
* 
*         ENTRY  (A1, X1) = CLOSREP.
*                (REPFLAG) = 18/0, 24/OLDN, 18/HDRI 
*                OLDN = PREVIOUS (N.ITEM), BEFORE THIS REP BEGAN. 
*                HDRI = INDEX OF REP HEADER IN (T.DATI).
* 
*         EXIT   REP HEADER UPDATED.
*                (N.ITEM) = TOTAL DATA ITEMS SO FAR, INCLUDING (OLDN),
*                           PLUS THE NUMBER OF CONSTANTS GENERATED BY 
*                           THIS REP LIST.
*                (CLOSREP) = 0. 
*                (REPFLAG) = 0. 
*         USES   A1,A2,A3,A6,A7  B3,B5,B7  X0,X1,X2,X3,X5,X6,X7 
* 
*         CALLS  ALC, MVE=
  
  
 CRL      SUBR               ENTRY/EXIT...
          SA2    REPFLAG
          SA3    T.DATI 
          MX7    0
          SA7    A1          (CLOSREP) = (REPFLAG) = 0
          SA7    A2 
          IX6    X3+X2       HDRA = HDRI + (T.DATI) 
          SA1    X6-1        HDRA = DATI(HDRI)
          SA3    N.ITEM      NI = NUMBER OF ITEMS IN REP LIST 
          LX1    -DI.RCP
          AX2    18          OLDN 
          MX0    -DI.RCL
          BX0    -X0*X1      RC = (DI.RC) 
          IX6    X0*X3
          IX7    X6+X2       (N.ITEM) = RC * NI + OLDN
          SA7    A3 
          LX3    DI.RLP 
          BX6    X3+X1       (DI.RL) = NI 
          SA6    A1 
          LX3    -DI.RLP
          BX5    X0 
          =B3    X3+1        NUMBER OF ITEMS + REPL HEADER
  
*                (X5)    = RC 
*                (B3)    = RL 
*                (A6,X6) = REPL HEADER (DI. FORMAT 1) 
  
 CRL1     SX1    MAX.REPL 
          IX0    X1-X5
          PL     X0,EXIT.    IF LOADER REPLICATION LIMIT NOT EXCEEDED 
  
*         MUST SPLIT REPLICATION GROUP.  DUPLICATE THE GROUP (INCLUDING 
*         HEADER), EXCEPT DECREMENT RC-MAX.REPL.  LOOP UNTIL ALL GROUPS 
*         REPEAT COUNT .LE. MAX.REPL. 
  
          MX0    -DI.RCL
          LX6    -DI.RCP
          BX6    X0*X6       CLEAR RC 
          BX6    X6+X1       INSERT MAXIMUM VALUE 
          LX6    DI.RCP 
          SA6    A6+
          IX5    X5-X1       DECREMENT FOR NEXT REP GROUP 
          ALLOC  T.DATI,B3
          SX1    B3          COUNT
          SX3    B7-B3       DESTINATION
          SB7    B7-B3
          SX2    B7-B3       SOURCE 
          SB5    B7          (B5) _ HEADER WORD (NOT YET COPIED)
          SX0    A4          SAVE A4
          MOVE   X1,X2,X3 
          SA4    X0          RESTORE A4 
          SA1    B5          FETCH NEW HEADER 
          MX0    -DI.RCL
          LX1    -DI.RCP
          BX1    X1*X0       CLEAR DI.RC
          BX6    X1+X5       MERGE IN REMAINDER COUNT 
          LX6    DI.RCP 
          SA6    A1          UPDATE 
          EQ     CRL1 
 CRC      SPACE  4,10 
**        CRC -  CHECK REPEAT CONSTANT. 
* 
*                CHECKS CONSTANT FOR PROPER TYPE (INTEGER OR OCTAL )
*                AND MAGNITUDE ( 0 < CON < 2**24 )
* 
*         ENTRY  (X5) = CONSTANT
*                (X1) = MODE OF CONSTANT
* 
*         EXIT   (X6) = CONVERTED CONSTANT VALUE. 
*         USES   X5,B2
  
  
 CRC      SUBR               ENTRY/EXIT...
          BX6    X5 
          ZR     X5,E.DCE    IF .EQ. 0
          AX5    24 
          SB2    X1-M.INT 
          NZ     X5,E.DCE    IF .GT. 2**24-1
          ZR     B2,EXIT.    IF INTEGER TYPE
          EQ     E.DCE       ILLEGAL TYPE 
 CSC      SPACE  4,10 
**        CSC -  CHECK FOR SYMBOLIC CONSTANT. 
* 
*         ENTRY  (B4) _ O.VAR TOKEN 
*                (X4) = O.VAR TOKEN 
* 
*         EXIT   (B7) .MI. = VAR IS NOT A SYMBOLIC CONSTANT.
*                (B4) _ LAST TOKEN OF SUPPOSED SYMBOLIC CONSTANT
* 
*         ELSE   (B7) .PL. = VAR IS A SYMBOLIC CONSTANT.
*                (X0) = SYMORD OF THE SYMBOLIC CONSTANT (S.C.). 
*                (X1) = MODE OF CONSTANT. 
*                (X6) = VALUE OF SYMBOLIC CONSTANT (S.C.) 
*                (A3) _ T.SYM (WC.) OF (S.C.) 
*                (B3) = CONSTANT TABLE POINTER OF S.C.
* 
*         USES   A1-3,6-7  X0-3,6-7  B2-3,7 
* 
*         CALLS  SSY, TLV 
  
  
 CSC      SUBR   =           ENTRY/EXIT.
          SA1    A4+1 
          SX1    X1-O.VAR 
          NZ     X1,CSC1     IF NOT LONG NAME 
          CALL   TLV         TRUNCATE LONG NAME 
          SX6    B4+1 
          SA6    SELIST      UPDATE TO REFLECT LONG NAME
  
 CSC1     MX1    TB.TOCL
          BX6    X1*X4
          CALL   SSY         SCAN SYMBOL TABLE
          MI     B7,EXIT.    IF NOT IN TABLE
          HX2    WB.PARM
          SB7    -B1         INDICATE FAILURE 
          PL     X2,EXIT.    IF NOT PARAMETER 
          LX2    1+WB.PARMP-WB.MODEP
          SB7    B0          INDICATE SUCCESS 
          =A3    A2-WB.W+WC.W      WCI = WC ENTRY OF T.SYM
          MX1    -WB.MODEL
          BX1    -X1*X2      MODEI = MODE[WBI]
          LX3    -WC.RAP
          SB3    X3          PNT = RA[WCI]
          ERRNZ  18-DI.PNTL 
          SA2    T.CON
          SA2    B3+X2       VALUE = T.CON(PNT) 
          BX6    X2 
          EQ     EXIT.
 GNI      SPACE  4,10 
**        GNI - GET NEXT ITEM.
* 
*         EXIT   (A5, X5) = ADDRESS AND CONTENTS OF NEXT ITEM DESCRIPTOR
*                            FROM (T.DATI). 
*         (REPFLAG), (I.DIT) UPDATED. 
  
  
 GNI      SUBR               ENTRY/EXIT...
          SA1    I.DIT
          SA2    T.DATI 
          IX6    X1+X2
          SA5    X6          NEXT WORD
          SA2    A1+B1       REP COUNT REMAINDER
          HX5    DI.REP 
          PL     X5,GNI1     IF NOT THE START OF A REP LIST 
  
**        INITIALIZE REP LIST PROCESSING
  
          BX6    X5 
          SX7    X1+B1
          SA6    REPFLAG
          SA7    A2+B1       SAVE ORDINAL OF REP LIST START 
          LX6    -DI.RLP
          SX7    X6 
          ERRNZ  18-DI.RLL
          BX7    -X7         SET REMAINDER = - (N.ITEMS IN REP LIST)
          SA7    A2 
          BX2    X7 
          SA5    A5+B1       FETCH (X5) = FIRST DATA ITEM DESCRIPTOR
          SX1    X1+B1       INDEX += 1    /* ADVANCE PAST REP WORD 
  
*         ADVANCE (I.DIT) TO POINT TO NEXT ITEM, AND THEN SEE IF WE 
*         ARE IN A REP LIST.
  
 GNI1     SX0    B1 
          IX7    X0+X1       INDEX += 1 
          SA7    A1 
          ZR     X2,EXIT.    IF NO REPETITION 
          SX7    X2+B1       REMAINDER += 1 
          SA7    A2 
          NZ     X7,EXIT.    IF MORE TO GO
  
*         DECREMENT REP COUNT, GO BACK TO START OF REP LIST 
*         IF RC NOT EXHAUSTED.
  
          SA3    REPFLAG
          SX0    B1 
          LX3    -DI.RCP
          IX7    X3-X0       RC -= 1
          MX0    -DI.RCL
          BX0    -X0*X7 
          LX7    DI.RCP 
          SA7    A3 
          ZR     X0,GNI2     IF (DI.RC) = 0 THEN FINISHED 
          LX3    DI.RCP-DI.RLP
          SX7    X3 
          ERRNZ  18-DI.RLL
          BX7    -X7         REMAINDER = - (DI.RL)
          SA7    A2 
          SA4    A2+B1       OF = ORDINAL OF FIRST DATA ITEM IN REP LIST
          BX7    X4 
          SA7    A1          (I.DIT+0) = OF    /* RESET FOR NEXT ENTRY
          EQ     EXIT.
  
 GNI2     BX7    0
          SA7    A7          (REPFLAG) = 0     /* INDICATE REP LIST OVER
          EQ     EXIT.
 MDL      EJECT  MDL - MATCH DATA LISTS 
**        MDL - MATCH DATA LISTS. 
* 
*         MATCHS A (SET OF) ELEMENT(S) TO DATA ITEM LIST. 
* 
*         ENTRY  (X5) = NUMBER OF EXPLICIT LOOPS. 
*                (DVI) AND SUBSCRIPT INFO BLOCK SET UP BY BVT.
*                (BIAS) = CONSTANT SUBSCRIPT CONTRIBUTION.
*                LOOP AND SUBSCRIPT INFO SET UP.
* 
*         CALLS  GNI, NIC, OSH, OVI, UPH. 
  
  
          LIST   -F 
 .MDL     SKIP               **** FOLLOWING OBSOLETE **** 
  
 MDL      SUBR               ENTRY/EXIT...
          SA4    N.ITEM      NUMBER OF ITEMS LEFT IN DATA LIST
          SX6    X4-1 
          PL     X6,MDL10    IF (N.ITEM) .GT. 0 
          SA6    A4 
          EQ     EXIT.
  
 MDL10    SA2    DVI+V1.W 
          MX3    -V1.NELL 
          MX7    0
          SA7    ORGN        ORGN = 0          /* INDICATE ORG NEEDED 
          LX2    -V1.NELP 
          BX7    -X3*X2      NELI = NUMBER OF ELEMENTS TO BE INITIALIZED
          =X3    2
          IX3    X7-X3
          NZ     X5,MDL40    IF EXPLICIT LOOPS
          PL     X3,MDL20    IF NOT A SINGLE ELEMENT
  
*         PROCESS A SINGLE ELEMENT
  
          SA3    BIAS 
          SA6    A4          UPDATE N.ITEM
          RJ     OSH         OUTPUT SCALAR HEADER 
          RJ     GNI         GET NEXT ITEM
          RJ     OVI         OUTPUT VALUE OF ITEM 
          RJ     UPH         UPDATE PREVIOUS HEADER 
          EQ     EXIT.
  
*         PROCESS REFERENCE TO ARRAY SLICE -- 
*                (ARY (I + BIAS), I=1, TC)
*         ENTRY  (X7) = TC
  
 MDL20    SX6    B1          DA = 1      /* ADDRESS DIFFERENCE
          SA5    BIAS 
 MDL30    RJ     NIC         OUTPUT INITIALIZATION CODE 
          EQ     EXIT.
  
**        PROCESS EXPLICIT DO INDEXING. 
  
  
 MDL40    SB4    X5          B4 = NUMBER OF LOOPS 
          GT     B4,B1,MDL50 IF MORE THAN 1 LOOP
          SA2    LPINF       LPI = (LPINF)
          LX2    -LP.TCP
          SX7    X2          TRIP COUNT = TC[LPI] 
          ERRNZ  18-LP.TCL
          LX2    LP.TCP-LP.MP 
          SX3    X2          M = M[LPI] 
          ERRNZ  18-LP.ML 
          LX2    LP.MP-LP.PP
          SB2    X2          P = P[LPI] 
          ERRNZ  18-LP.PL 
          SA4    B2+DPROD    PROD = DPROD(P)
          SA1    B2+DLOB     LB = DLOB(P) 
          SA5    BIAS 
          IX6    X3*X4       DA = M * PROD
          IX4    X4*X1       = PROD*LB
          IX0    X6-X4       = DA - PROD*LB 
          IX5    X0+X5       BIAS = BIAS + DA - PROD*LB 
          EQ     MDL30
  
  
**        IRREDUCEABLE NEST OF LOOPS
  
 MDL50    SA2    LPINF       LPF = (LPINF)
          LX2    -LP.MP 
          SX3    X2          M = M[LPF] 
          ERRNZ  18-LP.ML 
          LX2    LP.MP-LP.PP
          SB2    X2          P = P[LPF] 
          ERRNZ  18-LP.PL 
          SA4    B2+DPROD    PROD = DPROD(P)
          SA1    B2+DLOB     LB = DLOB(P) 
          IX7    X3*X4       DA = DM(P) * M(P)
          IX1    X4*X1       = PROD*LB
          SA7    DA          (DA) = DA
          SA5    BIAS 
          IX0    X7-X1       = DA - PROD*LB 
          IX7    X0+X5
          SA7    A5          (BIAS) = BIAS + DA - PROD*LB 
          =X6    1
          SETMEM LI,MAX.DIM,X6     INITIALIZE LOOP INDEXES
  
*         CALCULATE BIAS. 
  
 MDL60    SA4    N.VSUB 
          SA5    BIAS 
          SB5    B1          J = 1
          SB2    X4          (B2) = (N.VSUB)
          MX7    0
          SA7    ORGN        (ORGN) = 0  */INDICATE ORG NEEDED
  
 MDL70    SA1    LPINF+B5    LPJ = LPINF(J) 
          LX1    -LP.MP 
          SX2    X1          M = M[LPJ] 
          ERRNZ  18-LP.ML 
          LX1    LP.MP-LP.PP
          SB3    X1          P = P[LPJ] 
          SA3    LI+B5       LIJ = LI(J)
          SA1    B3+DPROD    PROD = DPROD(P)
          SA4    B3+DLOB     LB = DLOB(P) 
          IX3    X2*X3       = M*LIJ
          IX2    X1*X4       = PROD*LB
          IX6    X1*X3       = PROD * M * LIJ 
          IX0    X6-X2       = PROD* (M*LIJ - LB) 
          SB5    B5+B1       J = J + 1
          IX5    X5+X0       BIAS = BIAS + PROD* (M*LIJ -LB)
          LT     B5,B2,MDL70 IF MORE VARIABLE SUBSCRIPT TO GO 
  
          SA1    DA 
          SA2    LPINF       LPF = (LPINF)
          BX6    X1          DA = ADDRESS DIFFERENCE
          AX2    LP.TCP 
          SX7    X2          TRIP COUNT = TC[LPF] 
          ERRNZ  18-LP.TCL
          RJ     NIC         MATCH UP LISTS 
  
*         INCREMENT INDICES.
  
          SA4    N.VSUB 
          SB5    B1          J = 1
          SB2    X4          LIMIT = (N.VSUB)        /* NUMBER OF LOOPS 
  
 MDL80    SA1    LI+B5       LIJ = LI(J)
          SA2    LPINF+B5    LPJ = LPINF(J) 
          SX6    X1+B1
          AX2    LP.TCP 
          SX3    X2          TCJ = TC[LPJ]
          ERRNZ  18-LP.TCL
          SA6    A1          (LIJ) = (LIJ) + 1
          IX0    X1-X3       = LIJ - TCJ
          MI     X0,MDL90    IF LIJ .LT. TCJ
          SX6    B1 
          SA6    A6          (LIJ) = 1
          SB5    B5+B1       J = J + 1
          LT     B5,B2,MDL80 IF J .LT. (N.VSUB) -- LOOP 
          EQ     EXIT.
  
 MDL90    SA1    N.ITEM 
          SX2    X1-1 
          PL     X2,MDL60    IF MORE ITEMS TO GO
          EQ     EXIT.
  
 .MDL     ENDIF 
          LIST   *
          SPACE  4,10 
          LIST   D
  
 .FIX     EQU    --  TEMP SCAFFOLD FOR NEW MCQ CODE.
 .MQ      IF     -DEF,C=DVL 
 C=DVL    BSSENT 0
 EDI      BSSENT 0
          EQ     "BLOWUP" 
 .MQ      ENDIF 
          END 
