*DECK TSDATA
          IDENT  TSDATA 
 TSDATA   SECT   (PROCESS *D A T A* STATEMENTS),1 
  
          SST    A,B,D,E,F,Z,EXIT.
          NOREF  A,B,D,E,F,Z,EXIT.
  
 B=TSDAT  RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  CFC,DATA2,DAT.Z
  
*         IN TABLES 
          EXT    LASTCOL,REFVAR,TS.SYM,TI=DAT,TI.DAT,TL=DAT,TL.DAT
          EXT    TA.NAM,TP.DIM,TS.CON,TS=DAT,TS.DAT 
  
*         IN ERRORS 
          EXT    E.DAA,E.DABC,E.DAVC,E.DAR,E.DAUC,E.DACV
          EXT    E.DCE,E.DIL,E.DIL1,E.DIL2,E.DIL3,E.DMT,E.DNA,E.DNA2
          EXT    E.DHC,E.DSE,E.DTC,E.DVL1,E.DVL2,E.DVL21,E.DVL22,E.DVL23
          EXT    E.DVL24,E.DVL25,E.DVL26,E.DVL3,E.DVL4,E.DVL5,E.DVL6
          EXT    E.DVL7,E.DVL8,E.DVL9,FILL. 
  
*         IN END
          EXT    DDS.O,DDS.S,DDS.R,DDS.W
  
*         IN ALLOC
          EXT    ADW
  
*         IN MAIN 
          EXT    PSP.C
  
*         IN LEX
          EXT    DEC,TRV
  
*         IN INIT 
          EXT    ADWT,BIAS,CLOSREP,CON1,CON2,DA,DATEMP,DATEMPL,DIM,DLEN 
          EXT    DIM.MUL,DVT,INDX,INC,I.DIT,LI,LL,LPINF,MP,NONANSI
          EXT    N.DIMS,N.ITEM,N.SUBS,N.VSUB,ORD,ORGI,PL,RL,SDPF,SELIST 
          EXT    SCR2,SIGN,SST1,SSTL,SUBN,REPFLAG,TMP,UL
  
 DAT      SPACE  4,8
**        AUTHOR - S.I. JASIK - CDC/SUNNYVALE - JUNE/70 
  
  
 DAT      SPACE  4,8
***       DATA INITIALIZATION STATEMENTS. 
* 
*         SYNTAX: 
*                DATA <DIL>,...,<DIL> 
*                 WHERE DIL IS A DATA INITIALIZATION LIST 
*                <DIL> := <DVL> / <DIL> / OR ( <DVL> = <DIL> )
*                 WHERE <DVL> IS A DATA VARIABLE LIST 
*                 AND   <DIL> IS A DATA ITEM LIST ( CONSTANTS ) 
*                 THE SECOND SYNTAX WHICH IS NOT ANSI STANDARD IS 
*                 REFERED TO AS THE ALTERNATE SYNTAX .
* 
*         THE SYNTAX OF THE DATA ITEM LIST ( CONSTANTS ) IS 
* 
*                <DIL> := <DIG>,...,<DIG> 
*                <DIG> := <CONL> OR <RF>*(<CONL>) OR <RF>(<CONL>) 
*                OR (<CONL>) OR <RF>*<CON>
*                <CONL> := <CON>,,,<CON>
*                <CON> := <CONSTANT> OR (<REAL CON>,<REAL CON>) 
*                NOTES: 
*                 (1.,2.) IS A COMPLEX CONSTANT 
*                 2*(1.,2.) # 1.,2.,1.,2. 
*                 2*((1.,2.)) IS 2 COMPLEX CONSTANTS
* 
*         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
*                 OF THE FORM C1,C2,C3
*                 <DOLIST> IS A NEST OF DO LOOPS HAVING THE 
*                 SAME SYNTAX AS THOSE APPEARING IN AN I/O LIST, EXCEPT 
*                 THAT SUBSCRIPTS ARE LIMITED TO THE FORM C1*IVAR+C2
*                 AND ONLY 1 NAME MAY APPEAR IN THE GROUP.
* 
 ANSI     SPACE  4,20 
***              NON-ANSI EXTENSION TO THE DATA STATEMENT --
* 
*         DO LOOPS AND SUBSCRIPTS OF THE FORM C1*I+C2 
* 
*         A, WHERE "A" IS AN ARRAY IS EQUIVALENT TO (A(I),I=1,PI DIMS)
* 
*         HOLLERITH CONSTANTS MAY BE LONGER THAN ITEM LENGTH ( 1 OR 2 
*         WORDS ).
* 
*         ( VARLIST = DATALIST )  SYNTAX
* 
*         RF*(C1,...,CN) FOR REPETITION OF A LIST OF ITEMS
* 
*         VARIABLES IN LABELED COMMON MAY BE INITIALIZED OUTSIDE A
*         BLOCK DATA SUBPROGRAM.
* 
*         THE RANGE OF AN ARRAY MAY BE EXTENDED BY EQUIVALENCING
*         TO THE LENGTH OF THE EQUIVALENCE CLASS - THE ARRAY BIAS . 
 MACROS   EJECT  LOCAL MACROS 
**        MACROES LOCAL TO THE *DATA* PROCESSOR.
  
  
 SCANTO   MACRO  DELIM
 X        BITMIC (DELIM)
          SA5    ="X" 
          RJ     STD
 SCANTO   ENDM
 PARSEM   SPACE  4,8
**        PARSEM - ELIST MANIPULATION MACROS. 
*         REGISTER USAGE -- 
*                X1,B2 LOWER 48 BITS AND E-LIST CODE
*                B3 IS USED TO HOLD E-LIST CODE FOR TESTS 
*                A4,X4 = E-LIST ADDRESS AND CURRENT ELEMENT 
*                A5,X5 = SELIST,(SELIST)
  
  
 NEXTE    MACRO  R                 GETE NEXT E-LIST ITEM
 Z        SET    R 4
          SA.Z   A.Z+B1 
          SB2    X.Z
 NEXTE    ENDM
  
  
 IF.EQ    MACRO  ECODE,LABEL       IF( B2 .EQ. ECODE ) GO TO LABEL
 .1       IF     -MIC,ECODE 
          R=     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 
          R=     B3,ECODE 
          NE     B2,B3,LABEL
 .1       ELSE
          NE     B2,"ECODE",LABEL 
 .1       ENDIF 
 IF.NE    ENDM
 DAT.FMT  EJECT  4,20        STORAGE AND FLAGS
  
 DIT.CMPX BSS    0           REP-TABLE SKELETON FOR COMPLEX CONSTANT
          POS    P.DINDX+L.DINDX
          VFD    L.DINDX/2+1
          VFD    L.DIWC/2 
 DIT.HOL  BSS    0           REP-TABLE SKELETON FOR HOLLERITH CONSTANT
          POS    P.DIHOL+1
          VFD    1/1
          POS    P.DINDX+L.DINDX
          VFD    L.DINDX/2
          VFD    L.DIWC/**
 DAT.Z    SPACE  4,20 
**        DATA.E - FE ERROR EXIT. 
* 
*         ENTRY  B6 = ERROR NUMBER
*                X4 = ELIST ITEM
* 
  
 DATA.E   WARN   B6 
  
 DAT.Z    SA1    NONANSI     ** MOST ERRORS RETURN TO HERE ** 
          SHRINK TI=DAT,0 
          ZR     X1,PSP.C    IF NO NON-ANSI USAGES
          EQ     E.DNA2 
 DATA     EJECT              MAIN LOOP
          HEREIF DATA 
  
          =X6    CR.DAT 
          SA6    REFVAR      SET UP REFERENCE TYPE
          RJ     RAS               REMOVE ALTERNATE SYNTAX  (V=C) 
*                                  AND INITIALIZE 
  
 DATA1    =X7    1
          BX6    0
          SA1    TL.DAT 
          SA7    DIM.MUL
          SHRINK TI=DAT,X6
          SB5    DATEMPL
          SB5    -B5
          SX7    B5+DATEMP
          SA6    DATEMP 
  
 DATA15   SA6    A6+B1
          SX7    X7+B1
          MI     X7,DATA15
  
**        CONVERT THE ITEM LIST TO INTERNAL FORM. 
  
          SA2    TL=DAT 
          IX3    X1+X2             TOP OF STACK + 1 
          SA5    X3-1              VAR AND CON LIST POINTERS
          SA4    X5                INITIALIZE FOR CON LIST PROCESSING 
          AX5    P.DLVAR
          SX6    X5 
          SA6    TMP               SAVE VAR LIST POINTER
          SA5    SELIST 
          RJ     BIT               BUILD DATA ITEM ( CON ) TABLE
  
**        PROCESS THE VARIABLE LIST AND MATCH IT UP WITH THE ITEM LIST. 
  
          SA3    TMP
          SA5    SELIST 
          SA4    X3          INITIALIZE POINTERS
          BX6    0
          SA6    I.DIT
          RJ     BVT               PROCESS VARIABLE LIST
  
**        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    SA1    TL=DAT 
          SX6    X1-1              N.DIL = N.DIL-1
          SA6    A1 
          NZ     X6,DATA1          IF MORE DIL"S TO GO
          EQ     DAT.Z
 RAS      EJECT              RAS - REMOVE ALTERNATE SYNTAX
**        RAS -  REMOVE ALTERNATE SYNTAX. 
*                SCAN DATA STMT BACKWARD AND FORM TABLE OF FWA OF DIL 
*                AND DVL"S. CHANGE DATA INITIALIZATION LISTS OF THE 
*                FORM "( DVL = DIL )" TO "DVL / DIL /" .
*                INITIALIZE TABLE POINTERS, ETC FOR FURTHER PROCESSING. 
* 
*         NOTE:  THIS SUBROUTINE IS A MISTAKE. I ORIGINALLY THOUGHT 
*         THAT ONE COULD FIND THE BEGINNING OF THE CON AND VAR LISTS BY 
*         A SIMPLE BACKWARDS SCAN OF THE STMT. TO SEE THAT THIS IS NOT
*         TRUE CONSIDER:  DATA (A=1),B/2/ . 
*         HENCE THE PRESENT VERSION DISALLOWS INTERMIXING SYNTAXS.
  
  
 RAS      SUBR               ENTRY/EXIT...
          SHRINK TL=DAT,0 
          SA6    NONANSI           CLEAR NON ANSI USEAGE FLAG 
          SA3    LASTCOL
          SX6    B4+B1
          SA6    SELIST 
          =X7    O.BOS
          SA7    B4-B1             (SELIST-1) = BEGIN OF STMT OPERATOR
          SB2    X3 
          SA4    B2+A0       A4,X4 = NEXT ITEM POINTER AND CONTENTS.
  
 RAS1     SA4    A4-B1
          SB2    X4                NEXTE
          IF.NE  O.SLASH,RAS3      IF NOT A / 
  
*         STANDARD SYNTAX 
  
          SCANTO O.SLASH           FIND BEGINNING OF CON LIST 
          SX7    A4 
          SCANTO (O.BOS,O.SLASH)     SCAN PAST BEGINNING OF VAR LIST
          SB6    B2          REMEMBER WHAT STOPPED SCAN 
          SX1    A4 
          LX1    P.DLVAR
          BX6    X7+X1             ADD FWA OF DVL TO DIL STACK
          ADDWD  TL.DAT 
          SA4    A4+B1             BACKE  1 
          SB2    X4 
          EQ     B6,"O.BOS",RAS1   IF BOS STOPPED SCAN
          IF.EQ  O.COMMA,RAS1      LOOP IF A ,
          EQ     E.DSE             SYNTAX ERROR 
  
 RAS3     IF.NE  O.),RAS4          IF NO )
  
*         ALTERNATE SYNTAX - CONVERT TO STANDARD SYNTAX 
  
          ANSI   E.DNA
  
          =X6    O.SLASH
          SA6    A4                REPLACE ) WITH / 
          SCANTO (O.=,O.SLASH)
          IF.EQ  O.SLASH,E.DSE     IF SLASH STOPPED SCAN
          =X6    O.SLASH
          SX7    A4 
          SA6    A4                REPLACE = WITH / 
          SCANTO O.LP              FIND BEGINNING OF VAR LIST 
          SX1    A4 
          LX1    P.DLVAR
          BX6    X7+X1             SAVE POINTER TO START OF VAR LIST
          ADDWD  TL.DAT 
          SA4    A4-B1
          SB2    X4                NEXTE
          IF.EQ  O.COMMA,RAS1      LOOP IF A COMMA
          IF.EQ  O.BOS,EXIT.
  
 RAS4     IF.NE  O.BOS,E.DSE       ERROR IF NOT BOS 
          SA2    TL=DAT 
          NZ     X2,EXIT.    IF NOT AN EMPTY DATA STATEMENT 
          EQ     E.DMT
 STD      SPACE  4,8
**        STD - SCAN TO DELIMITER, PERFORM A PARENTHESIS CHECK. 
* 
*         ENTRY  (X5) = DELIMITER BIT MASK
*                (A4) _ FWA+1 OF LIST.
* 
*         EXIT   (A4) _ TO DELIMITER
*                (B2) = ELIST OPCODE OF DELIMITER 
  
  
 STD      SUBR               ENTRY/EXIT...
 Z        BITMIC (O.HOLL,O.CONS,O.VAR,O.PERIOD,O.PL,O.MIN)
          SA1    ="Z" 
          SB3    O.(
          SB4    O.)
          SB5    B0                B5 = PAREN COUNT 
  
 STD1     SA4    A4-B1
          SB2    X4 
          LX3    X1,B2
          MI     X3,STD1     SKIP CONS AND VARS 
          NE     B2,B4,STD2        IF NOT A ) 
          SB5    B5+B1             PC = PC+1
          EQ     STD1 
  
 STD2     LX3    B2,X5             POSITION DELIMITER MASK
          NE     B2,B3,STD3        IF NOT A ( 
          SB5    B5-B1             PC = PC-1
          PL     B5,STD1           LOOP IF PC \ 0 
          MI     X3,EXIT.    IF *(* IS A DELIMITER
          EQ     E.DSE             SYNTAX ERROR ( NEGATIVE PAREN COUNT )
  
 STD3     PL     X3,STD4           IF NOT THE DELIM WE WANT 
          ZR     B5,EXIT.    IF PAREN COUNT IS ZERO 
          EQ     E.DSE             SYNTAX ERROR 
  
 STD4     IF.NE  O.BOS,STD1        LOOP IF NOT BOS
          EQ     E.DSE             SYNTAX ERROR 
 BIT      EJECT              BIT - BUILD DATA ITEM TABLE
**        BIT - BUILD DATA ITEM TABLE.
*                SCAN THE ITEM LIST AND CONVERT IT INTO INTERNAL FORMAT 
* 
*                CONSTANTS ARE REPRESENTATED AS 
* 
*         1/0,1/HOL FLAG,16/0,6/CTYP,18/INDEX,18/WORD COUNT 
* 
*                 FOLLOWED BY WC WORDS OF DATA FOR NON HOLLERITH CONSTAN
*                 FOR HOL CONSTANTS, THE NEXT WORD CONTAINS THE ELIST.
*                 CTYP = CONSTANT TYPE FOR NON-HOLLERITH CONSTANTS. 
* 
*                REPETITION COUNTS ARE REPRESENTED AS 
*                 1/1,5/CIF,18/RL,18/INDEX TO NEXT GROUP,18/REP COUNT 
*                 CIF = 1 OR 2 IF ALL ITEMS ARE THE SAME LENGTH, AND
*                 LENGTH IS 1 OR 2 WORDS , ELSE 0 
*                 RL = NUMBER OF ITEMS IN THE REP LIST
* 
  
 BIT      SUBR               ENTRY/EXIT...
  
 BIT.L    NEXTE                    NEXT ELIST ITEM
          SA3    ="M.CON" 
          LX7    B2,X3
          =B5    O.CONS 
          PL     X7,E.DIL    IF NOT  CON HOLL + - . OR (
          IF.EQ  O.HOLL,BIT1
          EQ     B2,B5,BIT2  IF NUMBER
          =B7    B2-O.TRUE
          SB3    O.(
          ZR     B7,BIT8     IF *.TRUE.*
          IFNE   O.TRUE+1,O.FALSE,1 
          =B7    B2+O.TRUE+1-O.FALSE
          EQ1    B7,BIT8     IF *.FALSE.* 
          EQ     B2,B3,BIT6        IF A ( 
          SX2    B2-O.MIN 
  
**        HERE WITH + OR - SIGN, OR PERIOD. 
  
          BX7    0
          IF.EQ  O.PERIOD,BIT1     IF FLOATING PT. CONSTANT 
          AX3    X2,B1            -0 IF + , +0 IF - SIGN
          BX7    -X3
          NEXTE 
          IF.EQ  O.PERIOD,BIT1     IF FLOATING PT. CONSTANT 
          EQ     B2,B5,BIT1  IF NUMBER
          IF.NE  O.HOLL,E.DIL1     IF NOT HOLL
  
 BIT1     RJ     ADC         ADD CONSTANT TO TABLE
          EQ     BIT9 
  
*         CONSTANT
  
 BIT2     SB4    A4                LOOK AHEAD 
          SX5    A4 
          RJ     DEC         DUMMY KLUDGE TO SKIP OVER CONSTANT 
          SA4    X5 
          SA2    B4+B1
          SA5    SELIST      RESTORE (A5) 
          SA3    ="M.SEP" 
          SB2    X2 
          BX7    0
          LX6    B2,X3
          MI     X6,BIT1           IF NEXT IS , ) OR /
          SA3    REPFLAG
          NZ     X3,E.DIL2         IF WE ARE WITHIN A REP LOOP
  
          SX7    B1                SET TO CLOSE ON )
          IF.NE  O.STAR,BIT3       IF NOT CON*
  
          NEXTE  2                 LOOK PAST *
          IF.EQ  O.(,BIT4          IF A ( 
          SX7    -B1               SET FOR SINGLE ELEMENT REP 
          EQ     BIT5 
  
 BIT3     IF.NE  O.(,E.DIL         SYNTAX ERROR IF NOT A (
 BIT4     ANSI   E.DAR
  
 BIT5     SX6    A2-B1       BACKOFF AND SAVE ELIST POINTER 
          SA6    A5 
          SA7    CLOSREP
          RJ     CSC               CHECK CONSTANT AND CONVERT 
  
          MX0    1
          BX6    X0+X6             CONSTRUCT ENTRY FOR ADIT 
          SB5    B0 
          RJ     ADIT 
  
          SA1    N.ITEM 
          LX1    P.DINDX
          BX6    X1+X2
          SA6    REPFLAG           SAVE ITEM COUNT AND POINTER
          MX7    0
          SA7    A1                CLEAR ITEM FLAG
          SA5    SELIST      RESTORE (A5) 
          SA4    X5          RESTORE (A4) 
          EQ     BIT.L             AND LOOP TO PROCESS REP LIST 
  
*         ( - START OF A REPEATED DATA LIST OR A COMPLEX CONSTANT 
  
 BIT6     SA1    PL                PARENTHESIS LEVEL
          SA2    CLOSREP
          SX7    X1+B1             PL = PL+1
          SA7    A1 
          IX3    X2-X7
          ZR     X3,BIT.L          IF ( IS A REP BRACKET
  
*         CHECK FOR A COMPLEX CONSTANT
  
          RJ     CFC               CHECK FOR COMPLEX CONSTANT 
          ZR     X0,BIT7           IF IT IS 
          SA1    PL 
          AX2    B1,X1
          ZR     X2,BIT.L          IF A MEANINGLESS PAREN 
          EQ     E.DIL2            ERROR - 2 NESTED PAREN GROUPS
  
 BIT7     SA3    DIT.CMPX          DIT HEADER WORD
          SA4    PL 
          BX6    X3 
          SX7    X4-1              DECREMENT PAREN COUNT
          SA7    A4 
          SB5    B1+B1
          RJ     ADIT              ADD CONSTANT TO DIT
          SA1    N.ITEM 
          SX6    X1+B1             N.ITEM = N.ITEM+1
          SA6    A1 
          SA5    SELIST 
          SA4    X5 
          SB2    X4 
          EQ     BIT.S       PROCESS SEPARATOR
  
  
**        HANDLE LOGICAL CONSTANTS HERE.
*                (B7) = 0 IF .TRUE. 
*                     = 1 IF .FALSE.
  
 BIT8     =X0    1+1         INDEX = WORD COUNT + 1 
          =X1    B7-1 
          =X2    1           WORD COUNT = 1 
          =X7    A4+1 
          LX0    P.DINDX
          SA7    SELIST 
          =B5    2-1         ADD (X6, X1) 
          BX6    X0+X2
          RJ     ADIT        ADD LOGICAL CONSTANT TO DATA ITEM TABLE
          SA5    SELIST 
          SA4    X5          RESTORE SOME REGISTERS 
          SB2    X4 
  
 BIT9     SA3    N.ITEM 
          =X6    X3+1        (N.ITEM) = (N.ITEM) + 1
          SA6    A3 
*         EQ     BIT.S             PROCESS SEPERATOR
  
*         PROCESS SEPERATOR AFTER CONSTANT
  
  
 BIT.S    SA1    CLOSREP
          PL     X1,BIT.S1         IF NO SINGLE ELEMENT REP OUTSTANDING 
          RJ     CRL
  
 BIT.S1   IF.EQ  O.COMMA,BIT.L     LOOP IF A ,
          IF.EQ  O.SLASH,EXIT.
          IF.NE  O.),E.DIL3        IF NOT A RPAREN, ERR.. 
          MX7    0
          SA7    PL                CLEAR PAREN LEVEL
          SA1    CLOSREP
          ZR     X1,BIT.S2         IF NO REP LIST TO CLOSE
          RJ     CRL               CLOSE IT 
  
 BIT.S2   NEXTE                    NEXT ELEMENT 
          EQ     BIT.S
 CRL      EJECT 
**        CRL - CLOSE OUT REP LIST. 
* 
*         ENTRY  A1,X1 = CLOSREP
  
  
 CRL2     SX0    B4 
          LX0    54                POSITION ITEM LENGTH 
          BX6    X0+X6
          SA6    A6                STORE UPDATED REP WORD IN DIT
  
 CRL      SUBR               ENTRY/EXIT...
          SA2    REPFLAG
          MX7    0
          SA7    A1                CLEAR FLAGS
          SA7    A2 
  
          SA3    TI.DAT 
          IX6    X3+X2
          =A1    X6-1        WORD 1 OF REP ENTRY IN *DIT* 
          SA3    N.ITEM            NUMBER OF ITEMS IN REP LIST
          AX2    P.DINDX
          SB6    X3                B6 = NUMBER OF ITEMS IN LIST 
          SX0    X1                REMOVE REP FLAG BIT
          IX6    X0*X3             RF * N.ITEMS 
          IX7    X6+X2
          SA7    A3 
          LX3    P.DIRL 
          BX6    X3+X1             ADD NUMBER OF ITEMS TO WORD 1
          SA2    TI.DAT 
          SA3    TI=DAT            L.DIT
          IX2    X2+X3
          SX0    A1 
          IX7    X2-X0
          LX7    P.DINDX           INDEX TO NEXT FEOUP
          BX6    X7+X6
          SA6    A1                UPDATE WORD 1
  
**        SEARCH FOR AND MARK REP LISTS WHERE ALL ITEMS ARE THE SAME
*         LENGTH AND LENGTH = 1 OR 2 .
  
          SA2    A1+B1
          SB4    X2                NUMBER OF WORDS IN FIRST ITEM
          SB3    B4-B1
          GT1    B3,EXIT.    IF WC .GT. 2 
  
 CRL1     AX2    P.DINDX
          SB6    B6-B1
          ZR     B6,CRL2           IF END OF REP LIST 
          SB3    X2 
          SA2    A2+B3
          SB3    X2 
          EQ     B3,B4,CRL1        LOOP IF ITEMS HAVE THE SAME LENGTH 
          EQ     EXIT.
 CFC      SPACE  4,60 
**        CFC -  CHECK FOR COMPLEX DATA ITEM. 
* 
*         ENTRY  (A4) _ POINTS TO ( 
* 
*         EXIT   X0 = 0 IF A COMPLEX CON IS DETECTED AND
*                X1,X2 = REAL AND IMAGINARY PARTS OF CONVERTED CONSTANT 
*                SELIST POINTER UPDATED TO POINT PAST ) 
*                X0 " 0 IF NOT AND A4,X4 UNTOUCHED
  
*         USES   A1-A7,X0-X7,B2-B4,B7 
  
  
 CFCN     MX0    1           INDICATE FAILURE 
          SA4    X5          RESTORE A4 
  
 CFC      SUBR               ENTRY/EXIT...
          SA3    A4+B1
          SB2    X3 
          MX7    0                 SET FOR + SIGN 
          SX5    A4          SAVE A4 IF NOT A COMPLEX CONSTANT
          IF.EQ  O.PERIOD,CFC25 
          SB4    B2-O.PL
          ZR     B4,CFC1     IF PLUS
          NE     B4,B1,CFC2  IF NOT MINUS 
          MX7    60 
 CFC1     NEXTE  3
 CFC2     IF.EQ  O.PERIOD,CFC25 
          IF.NE  O.CONS,CFCN
 CFC25    SB4    A3 
          SA7    SCR2        SAVE SIGN
          RJ     DEC         CONVERT CONSTANT 
          SX2    X1-M.REAL
          NZ     X2,CFCN     IF NOT A REAL CONSTANT 
          SA3    B4+B1       ADVANCE (A3) 
          SB2    X3 
          IF.NE  O.COMMA,CFCN 
          SA2    SCR2 
          =A3    A3+1 
          BX6    X6-X2
          SB2    X3 
          MX7    0
          SA6    A2          SAVE REAL PART 
          IF.EQ  O.PERIOD,CFC45 
          IF.EQ  O.PL,CFC3   IF PLUS SIGN 
          IF.NE  O.MIN,CFC4        IF NOT - 
          BX7    -0 
 CFC3     NEXTE  3
 CFC4     IF.EQ  O.PERIOD,CFC45 
          IF.NE  O.CONS,CFCN
 CFC45    SB4    A3 
          SA7    SCR2+1 
          RJ     DEC               CONVERT IMAGINARY PART 
          SX2    X1-M.REAL
          NZ     X2,CFCN     IF NOT A REAL CONSTANT 
          SA3    B4+B1             ADVANCE (A3) 
          SB2    X3 
          IF.NE  O.RP,CFCN
          SA2    SCR2+1      RETRIEVE SIGN OF IMAGINARY PART
          =A1    A2-1        RETRIEVE REAL PART 
          BX2    X6-X2
          =X6    A3+1 
          =A4    A3+1 
          MX0    0           INDICATE SUCCESS 
          SA6    SELIST 
          EQ     EXIT.
 CSC      SPACE  4,25 
**        CSC -  CHECK SUBSCRIPT CONSTANT.
*                CHECKS CONSTANT FOR PROPER TYPE (INTEGER OR OCTAL )
*                AND MAGNITUDE ( 0 < CON < 2**17 )
* 
*         ENTRY  X4 = ELIST FOR CONSTANT
* 
*         EXIT   X6 = CONVERTED CONSTANT
  
  
 CSC      SUBR               ENTRY/EXIT...
          SB4    A4 
          RJ     DEC         CONVERT CONSTANT 
          BX3    X6 
          ZR     X6,E.DCE    IF = ZERO
          AX3    17 
          SB2    X1-M.INT 
          NZ     X3,E.DVL9   IF .GT. 2**17 1
          ZR     X1,EXIT.    IF UNIVERSAL TYPE
          NZ     B2,E.DCE    IF NOT TYPE INTEGER, ERR.. 
          EQ     EXIT.
 ADC      SPACE  4,8
**        ADC -  ADD CONSTANT TO =DIT=. 
* 
*         ENTRY  X1,X4,A4,A5 SET UP TO CONSTANT BY MACRO "NEXTE"
*                X7 = -0 IF CON PRECEEDED BY - SIGN , ELSE 0
* 
*         EXIT   X1,X4,A4,A5 RESTORED BY A CALL TO MACRO "GETE" 
  
  
 ADC2     BX5    X7          SAVE CONSTANT SIGN 
          SB4    A4 
          RJ     DEC         CONVERT TO BINARY
          BX0    X1 
          SX7    B4+B1
          AX1    P.LONG 
          =X4    1
          BX3    X4*X1       ISOLATE *LONG* BIT.
          SA7    SELIST 
          BX7    X2 
          SX2    X3+B1       WC = 1 OR 2
          IX4    X2+X4       INDEX = WC + 1 
          SB5    X3+B1
          BX1    X6-X5       (X1) = SIGN * (UPPER HALF) 
          LX4    P.DINDX
          LX0    P.CTYP 
          IX6    X4+X2       INDEX + WORD COUNT 
          BX2    X7-X5       (X2) = SIGN * (LOWER HALF) 
          BX6    X0+X6       CONSTANT TYPE + INDEX + WORD COUNT 
  
 ADC4     RJ     ADIT        ADD  X6, X1 AND X2 TO DIT
          SA5    SELIST 
          SA4    X5 
          SB2    X4 
  
 ADC      SUBR               ENTRY/EXIT...
          SB3    X4-O.HOLL
          NZ     B3,ADC2     IF NOT HOLLERITH CONSTANT
  
          MX0    59 
          =X6    A4+1 
          SA6    SELIST      SAVE STRING BUFFER ADDRESS 
          BX1    X4          PROCESS WHEN HOLLERITH 
          AX4    P.LCON 
          SA3    DIT.HOL     DIT HEADER WORD
          BX7    -X0*X7      X7 = 1 IFF PRECEEDED BY A MINUS SIGN 
          MX0    -L.LCON
          BX4    -X0*X4 
          LX7    P.DNEGH
          SX2    X4          X2 = WC
          BX6    X3+X2
          =B5    1
          BX6    X6+X7       SET DNEGH FIELD
          EQ     ADC4 
 ADIT     SPACE  4,8
**        ADIT - ADD WORDS TO DIT TABLE.
* 
*         ENTRY  X6,X1,X2 = WORDS TO BE ADDED 
*                B5 = NUMBER OF WORDS - 1 TO BE ADDED 
*                X6 IS ALWAYS ADDED 
*         EXIT   (X2) = NEW LENGTH OF ITEM TABLE (TI.DAT).
  
  
 ADIT     SUBR               ENTRY/EXIT...
          SA6    ADWT 
          BX5    X1 
          LX4    X2 
          ALLOC  TI.DAT,B5+1
          SA3    ADWT 
          SB2    B5+B1
          IX1    X1+X2
          BX6    X3 
          SB2    -B2
          SA6    X1+B2             STORE FIRST WORD 
          BX7    X5 
          ZR     B5,EXIT.    IF ONLY 1 WORD 
          SA7    A6+B1
          EQ1    B5,EXIT.    IF TWO IS ALL
          BX6    X4 
          SA6    A7+B1
          EQ     EXIT.
 BVT      EJECT  BVT - PROCESS DATA VARIABLE LIST 
**        BVT - PROCESS DATA VARIABLE LIST. 
* 
*         ENTRY  (A4) _ FWA DATA VARIABLE LIST. 
*                (X4) = ((A4))
* 
*                SCANS DATA VARIABLE LIST AND BUILDS A "DVT" ENTRY FOR
*                ITEM, FORMAT 
* 
*         1/0,1/SDPF,1/ORGF,1/DDD,14/0,6/CTYP,18/SYMORD,18/EQUIV BIAS 
*         24/0,18/LENGTH,18/ITEM COUNT
* 
*                WHERE: 
*                 SDPF = 0 IF SINGLE PRECISION , ELSE 1 
*                 DDD = 1 IF PREVIOUS APPEARENCES IN A DATA STMT
*                 LENGTH = AMOUNT OF STORAGE ASSIGNED TO THE VAR
*                 ITEM COUNT = NUMBER OF ITEMS
* 
*                IN THE CASE THAT EXPLICIT DO LOOPS APPEAR, THEY ARE
*                REDUCED TO THE FORM: 
*                (((A(M1*I1,M2*I2,M3*I3),I = 1,T1),J = 1,T2),K = 1,T3)
*                WHERE I1 I2 I3 IS SOME PERMUTATION OF I,J AND K .
*                THE ADDITIONAL BIAS IS STORED IN THE BIAS FIELD
*                AND SUBSCRIPT WORDS OF THE FORM: 
*                 6/ P,  18/ M(P),  18/ T(I),  18/ DIM(P) 
*                ARE APPENDED, WHERE: 
*                 P = ORDER OF APPEARENCE IN SUBSCRIPT EXPR 
*                 M(P) = MULTIPLIER 
*                 T(I) = UPPER LIMIT = TRIP COUNT FOR LOOP
*                 DIM(P) = P"TH DIMENSION OF THE ARRAY
* 
*         USES   ALL BUT A0 
*         CALLS  MDL, PDV, PSS
  
  
 BVT      SUBR               ENTRY/EXIT...
          SB2    X4-O.SLASH 
        NZ       B2,BVT1     IF AN INITIAL LIST 
          =A4    A4+1        SKIP OVER ANY COMMA
  
 BVT1     NEXTE                    NEXT ELEMENT 
          MX6    0
          SA6    BIAS 
          SA6    N.VSUB 
          IF.NE  O.VAR,BVT3        IF NOT A NAME
          RJ     PDV               PROCESS NAME 
          SA3    ="M.SEP1"
          LX7    B2,X3
          PL     X7,E.DVL1         IF ILLEGAL ITEM FOLLOWING NAME 
          IF.EQ  O.(,BVT1A         IF NAME( 
          SA3    N.DIMS 
          ZR     X3,BVT2           IF A SIMPLE VARIABLE 
          ANSI   E.DAA
          EQ     BVT2 
  
**        PROCESS A(C1,C2,C3) 
  
 BVT1A    RJ     PSS               PROCESS SUBSCRIPT LIST 
          NZ     B7,E.DVL5         IF VARIABLE SUBS APPEARED
  
**        COMPUTE BIAS OF A(C1,C2,C3) 
  
          SA2    N.SUBS 
          SA1    CON2 
          SB5    X2 
          SB3    -B1               B3 = -1
          SX6    X1+B3             C1-1 
          EQ     B5,B1,BVT1B       IF ONLY 1 SUBSCRIPT
          SA1    A1+B1             C2 
          SA2    DIM.MUL+1         DIM1 
          SB5    B5-B1
          SX1    X1+B3             C2-1 
          IX3    X2*X1             DIM1*(C2-1)
          IX6    X3+X6
          EQ     B5,B1,BVT1B       IF 2 SUBS
          SA1    A1+B1             C3 
          SA2    A2+B1             DIM1*DIM2
          SX1    X1+B3
          IX3    X2*X1             DIM1*DIM2*(C3-1) 
          IX6    X3+X6
 BVT1B    SA3    SDPF 
          SB3    X3 
          LX6    B3,X6             *2 IF 2 WORDS /ENTRY 
          SA6    BIAS 
  
 BVT1C    SA2    DVT+1             ADJUST SECOND WORD OF DVT ENTRY
          AX2    18                WORD LENGTH OF ARRAY 
          IX2    X2-X6             REDUCE BY BIAS 
          MI     X2,E.DVL6   IF LOCF(A(C1,C2,C3))IS OUT OF RANGE
          ZR     X2,E.DVL6   IF OUT OF RANGE
          LX2    18                (FOR PROPER HANDLING OF HOLLERITH CON
          SX0    B1                SET ITEM COUNT = 1 
          BX6    X0+X2
          SA6    A2 
          SA5    SELIST 
          SA4    X5          FETCH SEPARATOR
          SB2    X4 
          IF.EQ  O.COMMA,BVT2      IF A , 
          IF.NE  O.SLASH,E.DVL1    IF NO SLASH
  
 BVT2     SX5    B0 
          RJ     MDL               MATCH UP LISTS 
          SA5    SELIST 
          SA4    X5          RESTORE SEPARATOR
          SB2    X4 
          IF.NE  O.SLASH,BVT1      LOOP IF NOT END OF VAR LIST
          EQ     EXIT.
  
**        PROCESS EXPLICIT DO LOOPS 
  
 BVT3     IF.NE  O.(,E.DVL3        IF NO LPAREN 
          SX7    B0 
 BVT4     NEXTE                    NEXT ELIST ELEMENT 
          SX7    X7+B1             INCREMENT PAREN COUNT
          EQ     B2,B3,BVT4        LOOP IF A (
          IF.NE  O.VAR,E.DVL3      IF NEXT IS NOT A NAME
          SA7    PL                SAVE PAREN LEVEL 
          SA7    NONANSI           SET NON ASNI USEAGE FLAG 
          RJ     PDV               PROCESS ARRAY NAME 
          IF.NE  O.(,E.DVL2        ERROR IF NOT NAME( 
          RJ     PSS               PROCESS SUBSCRIPT LIST 
          SA1    PL 
          SB6    X1 
          GT     B7,B6,E.DVL2      ERR IF MORE VARIABLE SUBS THEN LOOPS 
  
**        SYNTAX CHECK DO INDICES AND CONVERT LOOP TO CANONICAL FORM
  
          SB5    B0                LOOP INDEX 
          MX6    0
          SA6    N.VSUB            CLEAR LOOP COUNTER 
  
 BVT5     SA5    SELIST 
          SA4    X5 
          SB2    X4 
          IF.NE  O.COMMA,E.DVL2    IF NO ,
          NEXTE 
          IF.NE  O.VAR,E.DVL2      IF NO INDEX VARIABLE 
  
**        SEARCH SUBSCRIPT TABLE FOR MATCH OF INDEX VARIABLE
  
          SA2    N.SUBS 
          SB2    B0                INDEX
          SB3    X2                LIMIT
 BVT6     SA3    INDX+B2           SUBSCRIPT VARIABLE 
          SB2    B2+B1             P = P+1
          IX5    X4-X3
          ZR     X5,BVT7           IF A MATCH 
          LT     B2,B3,BVT6        IF MORE SUBS TO GO 
          EQ     E.DVL4            IF LOOP INDEX DOESN"T MATCH SUBSC VAR
  
 BVT7     SX6    B5+B1
          SA6    A3                INDX(P) = I
          SX7    B2-B1
          SA7    SUBN              SUBN = P 
  
**        SYNTAX CHECK AND CONVERT THE LOOP PARAMETERS. 
  
          NEXTE 
          IF.NE  O.=,E.DVL21  IF NO = SIGN
  
          NEXTE 
          IF.NE  O.CONS,E.DVL22  IF LOWER LIMIT NOT CONSTANT
          RJ     CSC         CONVERT LOWER LIMIT
          =A4    B4+1 
          SA6    LL 
  
          SB2    X4 
          IF.NE  O.COMMA,E.DVL23   IF NO COMMA
  
          NEXTE 
          IF.NE  O.CONS,E.DVL24    IF UPPER LIMIT NOT CONSTANT
          RJ     CSC         CONVERT UPPER LIMIT
          =A4    B4+1 
          SA6    UL 
  
          =X7    1
          SB2    X4 
          SA7    INC
          IF.NE  O.COMMA,BVT8      IF INCREMENT OMITTED 
  
          NEXTE 
          IF.NE  O.CONS,E.DVL25    IF INCREMENT NOT CONSTANT
          RJ     CSC         CONVERT INCREMENT
          =A4    B4+1 
          SA6    INC
          SB2    X4 
  
 BVT8     IF.NE  O.RP,E.DVL26      IF NO TERMINAL *)* 
          =X7    A4+1 
          SA7    SELIST      SAVE STRING BUFFER POINTER 
  
**        TEST FOR LOWER LIMIT OF SUBSCRIPT OUTSIDE OF DIM RANGE
  
          SA5    SUBN 
          SB2    X5                B2 = J 
          SA1    CON1+B2           CON1(J)
          SA2    LL 
          SA3    CON2+B2           CON2(J)
          IX0    X1*X2
          IX7    X0+X3             X7 = V = C1*LL+C2
          SX6    X7-1 
          MI     X6,E.DVL6         IF SUBSC VALUE < 1 
  
**        TEST FOR DEGENERATE LOOP ( A 1 TRIP LOOP )
  
          SA5    N.VSUB 
          SA1    UL 
          SB5    X5                B5 = LOOP NUMBER 
          SX2    X2                LL 
          IX0    X2-X1             LL-UL
          PL     X0,BVT10          IF DEGENERATE ( LL \ UL )
  
          SA3    INC
          IX0    X3-X0             UL-LL+INC
          IX6    X0/X3             TRIP COUNT = X0/INC
          SB6    X6 
          NE     B6,B1,BVT11       IF NOT DEGENREATE
  
**        1 TRIP LOOP - CHANGE TO CONSTANT SUBSCRIPT
  
 BVT10    MX6    0
          SA6    INDX+B2           INDX(J) = 0
          SA7    CON2+B2           CON2(J) = V
          EQ     BVT12
  
**        NORMAL CASE - ADJUST C1 AND C2  SO LOOP TAKES THE FORM
*                ( A( ,C1*I+C2, ) , I = 1,TC )
  
 BVT11    SA1    INC
          SA2    CON1+B2
          SA3    CON2+B2
          SA4    LL 
          IX5    X4-X1
          IX6    X1*X2
          SA6    A2                C1 = C1*INC
          IX4    X2*X5
          IX7    X3+X4
          SA7    A3                C2 = C2+C1*(LL-INC)
  
**        COMBINE AND STORE P, C1(P) , TC AND DIM(P) IN LPINF(I)
  
          LX6    36                C1 
          SA4    DIM+B2 
          BX6    X4+X6
          SX0    B2                P
          LX0    54 
          BX6    X0+X6
          SX7    B6                TC 
          LX7    18 
          BX6    X7+X6
          SA6    LPINF+B5          SAVE SUBSCRIPT INFO
          SX7    B5+B1
          SB5    B5+B1
          SA7    N.VSUB            ADVANCE INDEX AND SAVE 
  
**        ADJUST BIAS TO ELIMINATE CONSTANT ADDEND ( C2(J) )
  
          SA1    BIAS 
          SA2    DIM.MUL+B2        DIM.MUL(J) 
          SA3    CON2+B2
          SA5    SDPF 
          SB4    X5 
          IX4    X2*X3
          LX5    B4,X4             *2**SDPF 
          IX6    X5+X1             BIAS = BIAS+DIM.MUL(J)*C2(J)*2**SDPF 
          SA6    A1 
  
 BVT12    SA5    PL 
          SX6    X5-1 
          SA6    A5                PL = PL-1
          NZ     X6,BVT5           LOOP IF MORE TO GO 
  
**        ADD TO THE BIAS THE CONTRIBUTION DUE TO CONSTANT SUBSCRIPTS 
*         I.E. - A( ,C2, )
  
          SA2    N.SUBS 
          SA3    SDPF 
          SA5    BIAS 
          SB5    B0                INDEX
          SB2    X2                LIMIT
          SB4    X3                SDPF 
          SB3    -B1               -1 
          BX6    X5 
  
 BVT13    SA1    INDX+B5
          NZ     X1,BVT14          IF A DO INDEXED SUBSCRIPT
          SA2    CON2+B5
          SA3    DIM.MUL+B5 
          SX2    X2+B3
          IX4    X3*X2
          LX5    B4,X4
          IX6    X5+X6             BIAS = BIAS+DM(I)*(C2(I)-1)*2**SDPF
 BVT14    SB5    B5+B1
          LT     B5,B2,BVT13       IF MORE TO GO
          SA6    A5                UPDATE BIAS
  
**        COLLAPSE INNERMOST LOOPS IF THE SUBSCRIPTS ARE IN STANDARD
*         ORDER ( IJK ) 
  
          SA2    N.VSUB            NUMBER OF LOOPS
          ZR     X2,BVT1C          IF ALL LOOPS ARE DEGENERATE
          SB5    B0                INDEX
          SB2    X2                LIMIT
          EQ     B2,B1,BVT18       IF ONLY 1 LOOP 
  
 BVT15    SA1    LPINF+B5          LOOP INFORMATION WORD
          SX4    X1                DIM(P) 
          AX1    18 
          SX3    X1                TC 
          AX1    18 
          SB3    X1                M
          AX1    18 
          SB4    X1                P
          NE     B4,B5,BVT18       IF NOT IJK ORDER 
          NE     B3,B1,BVT17       IF M " 1 
          IX5    X3-X4
          SB5    B5+B1
          MI     X5,BVT17          IF TC < DIM
          LT     B5,B2,BVT15
  
**        SUCCESS - REDUCE TO A SINGLE LOOP 
  
 BVT16    SA1    LPINF-1+B2        LAST LOOP INFO WORD
          SA2    DIM.MUL-1+B2 
          AX1    18 
          SX1    X1                TC FOR LAST LOOP 
          IX3    X1*X2
          SA4    DVT+1
          SX4    X4                PI DIMS
          SX7    B1 
          SA7    N.VSUB            NUMBER OF LOOPS
          LX3    18 
          BX6    X3+X4
          LX7    36                M = 1
          IX7    X7+X6
          SA7    LPINF             UPDATE LOOP INFO WORD
          EQ     BVT18
  
**        PARTIAL SUCCESS - COLLAPSE INNERMOST LOOPS
  
 BVT17    LE     B5,B1,BVT18       IF WE CAN"T COLLAPSE AT LEAST 2 LOOPS
          EQ     B5,B2,BVT16       IF COMPLETE REDUCTION
  
          SA1    LPINF             MERGE FIRST AND SECOND LOOPS 
          SA2    A1+B1
          AX1    18 
          SX1    X1 
          AX2    18 
          SX2    X2 
          IX3    X1*X2             TC1*TC2
          SX7    B1 
          LX7    36                M = 1
          SA4    DIM.MUL+2         DIM1*DIM2
          LX3    18 
          BX6    X3+X4
          IX7    X7+X6
          SA7    A1                UPDATE FIRST LOOP INFO WORD
          SX6    B2-B1
          SA6    N.VSUB            UPDATE N.VSUB
          SA5    A2+B1
          BX7    X5                MOVE LAST LOOP INFO WORD DOWN
          SA7    A2 
  
**        COMPUTE A(M1*T1,M2*T2,M3,T3) AND SEE IF IT IS WITHIN
*         THE ARRAY BOUNDS
  
 BVT18    SA5    N.VSUB            NUMBER OF LOOPS
          SB5    B0                INDEX
          SB2    X5                LIMIT
          SA4    SDPF 
          SB3    -B1               B3 = -1
          SB4    X4                B4 = SDPF
          SA3    BIAS 
          AX6    B4,X3
  
 BVT19    SA4    LPINF+B5 
          AX4    18 
          SX1    X4                T(I) 
          AX4    18 
          SX2    X4                M(I) 
          AX4    18                P
          SA3    DIM.MUL+X4        DM(P)
          IX0    X1*X2
          SX1    X0+B3             M*T-1
          IX2    X3*X1             DM*( M*T-1 ) 
          IX6    X2+X6
          SB5    B5+B1
          LT     B5,B2,BVT19       IF MORE TO GO
          LX6    B4,X6             *2**SDPF 
          SA2    DVT+1
          AX2    18                ARRAY LENGTH 
          IX3    X6-X2             BIAS - LEN 
          PL     X3,E.DVL6   IF OUT OF RANGE
          ZR     X3,E.DVL6   IF OUT OF RANGE
  
 BVT20    RJ     MDL               MATCH UP LISTS 
          SA5    SELIST 
          SA4    X5          FETCH NEXT SEPARATOR 
          SB2    X4 
          IF.EQ  O.COMMA,BVT1      LOOP FOR NEXT IF A , 
          IF.EQ  O.SLASH,EXIT.
          EQ     E.DVL1 
 PSS      EJECT  4,40 
**        PSS -  PROCESS SUBSCRIPTS.
* 
*         PROCESSES SUBSCRIPTS ON DATA VARIABLES.  THE PERMISSIBLE FORMS
*         ARE -- (CON = CONSTANT, IVAR = INTEGER VARIABLE) -- 
*                          CON2 
*                         +CON2    (NON-ANSI) 
*                         -CON2    (NON-ANSI) 
*                     IVAR         (NON-ANSI) 
*                CON1*IVAR         (NON-ANSI) 
*                CON1*IVAR+CON2    (NON-ANSI) 
*                CON1*IVAR-CON2    (NON-ANSI) 
*                     IVAR+CON2    (NON-ANSI) 
*                     IVAR-CON2    (NON-ANSI) 
*         THE NUMBER OF SUBSCRIPTS MAY NOT EXCEED THE NUMBER OF 
*         DIMENSIONS OF THAT ARRAY (N.DIMS).
* 
*         ENTRY  (A4) _ *(* IN FRONT OF SUBSCRIPTS. 
*                (N.DIMS) = NUMBER OF DIMENSIONS OF THIS ARRAY. 
*                (DIM.MUL) = DIMENSION MULTIPLIERS AS SET BY *PDV*
* 
*         EXIT   (B7) = NUMBER OF VARIABLE SUBSCRIPTS ENCOUNTERED.
*                (A4-1) _ *)* TERMINATING THE SUBSCRIPT.
*                (X4) = ((A4))
*                (B2) = (X4) LOWER 18 
*                (N.SUBS) = NUMBER OF SUBSCRIPTS. 
*                (N.VSUB) = (B7)
*                (CON1) = THE MULTIPLIERS (= 1 IF ABSENT) 
*                (INDX) = THE INTEGER VARIABLES (= 0 IF CONSTANT SUB) 
*                (CON2) = THE ADDENDS (= 0 IF ABSENT) 
* 
*         USES   ALL BUT A0 
*         CALLS  CSC
  
  
 PSS      SUBR               ENTRY/EXIT...
          SA1    N.DIMS 
          ZR     X1,E.DVL7         IF NAME IS NOT DIMENSIONED 
  
          SB5    X1          (B5) = N.DIMS
          SB6    B0          (B6) = VARIABLE SUBSCRIPT FLAG 
          BX7    0
          SB4    B0          (B4) = NUMBER OF SUBSCRIPTS
          SB7    SSTL 
          SB7    -B7
          SB7    B7+SST1
          SA7    SST1 
  
 PSS20    SA7    A7+B1             CLEAR OUT CONTROL CELLS
          =B7    B7+1 
          MI     B7,PSS20 
  
**        SYNTAX CHECK AND SAVE SUBSCRIPT LIST
  
 PSS30    NEXTE                    NEXT ITEM
          IF.NE  O.CONS,PSS32      IF NOT A CONSTANT
          RJ     CSC         CHECK/CONVERT SMALL CONSTANT 
          SA1    N.SUBS 
          =A4    B4+1        FETCH NEXT ELEMENT 
          SB4    X1 
          SB2    X4 
          SA6    B4+CON2
  
          IF.NE  O.STAR,PSS36      IF NO *
          NEXTE 
          BX7    0
          SA7    A6          CLEAR ADDEND 
          SA6    B4+CON1     SAVE AS MULTIPLIER 
  
 PSS32    IF.NE  O.VAR,E.DVL8      IF NO VARIABLE 
          SB6    B6+B1             INCREMENT NUMBER OF VARS 
          BX7    X4 
          NEXTE 
          SA7    B4+INDX
  
**        PROCESS SIGN OF CONSTANT (OPTIONAL IF ADDEND) 
  
          IF.EQ  O.PL,PSS34      IF A + 
          IF.NE  O.MIN,PSS36     IF NOT A - 
 PSS34    SX7    X4-O.PL
          NEXTE 
          SA7    B4+SIGN
  
**        PROCESS ADDEND
  
          IF.NE  O.CONS,E.DVL8     IF NOT A CONSTANT
          RJ     CSC         CHECK/CONVERT SMALL CONSTANT 
          SA1    N.SUBS 
          SA4    B4+B1       ADVANCE SB PTR 
          SB2    X4          SET UP FOR SYNTAX CHECK
          SB4    X1 
          SA6    B4+CON2
  
 PSS36    =X7    B4+1        INCREMENT NUMBER OF SUBS 
          =B4    B4+1 
          SA7    N.SUBS 
          EQ     B5,B4,PSS40       IF IT MUST BE A )
          IF.EQ  O.COMMA,PSS30     IF COMMA, LOOP FOR NEXT SUBSCRIPT
  
 PSS40    IF.NE  O.),E.DVL8        IF NO RPAREN, ERR..
          =X7    A4+1 
          SX6    B6 
          SA7    SELIST            SAVE ELIST POINTER 
          SA6    N.VSUB            SAVE NUMBER OF VARIABLE SUBS 
  
**        PROCESS C1"S - CONSTANT MULTIPLIERS 
*                SET TO 1 IF UN-SPECIFIED 
  
          SA2    N.SUBS 
          SB3    B0 
          SB6    X2 
 PSS60    SA4    B3+CON1     CON1 (I) 
          SX6    B1 
          ZR     X4,PSS65    IF NOT PRESENT 
          BX6    X4 
 PSS65    SA6    A4 
          =B3    B3+1 
          LT     B3,B6,PSS60 IF MORE SUBSCRIPTS 
  
**        PROCESS C2"S - CONSTANT ADDENDS 
*                COMPLEMENT IF PREFIXED BY MINUS
  
          SB3    B0 
 PSS80    SA4    B3+CON2     CON2 (I) 
          BX6    0
          ZR     X4,PSS84    IF NO ADDEND 
          BX6    X4 
 PSS84    ZR     X6,PSS86    IF ADDEND NOT PRESENT
          SA3    B3+SIGN     SIGN (I) 
          ZR     X3,PSS85    IF THE SIGN IS + 
          MX4    1           SET REG TO COMPLEMENT NUMBER 
          AX4    73B
          EQ     PSS87
 PSS85    AX4    B1,X3       MAP SIGN ONTO +0 OR -0 
 PSS87    BX6    X4-X6
          SA6    A4 
 PSS86    =B3    B3+1 
          LT     B3,B6,PSS80 IF MORE SUBSCRIPTS 
  
**        ELIMINATE MULTIPLE APPEARENCES OF AN INDEX VARIABLE 
  
          SA5    N.VSUB 
          SB7    X5          (B7) = (N.VSUB)
          LE1    B7,EXIT.    IF LESS THAN 2 VARIABLE SUBS 
          MX0    60-3 
          SX5    213231B           A(IIJ) , A(JII) , A(IJI) 
  
 PSS90    BX3    -X0*X5            J       ( SMALLER )
          AX5    3
          BX4    -X0*X5            I       ( I > J )
          AX5    3
          SA1    INDX-1+X3
          SA2    INDX-1+X4
          IX6    X1-X2
          SB4    X4 
          NZ     X6,PSS94          IF NO MATCH
  
          SA6    A2                INDX(I) = 0
          NE     B4,B6,PSS92       IF( I = N.SUB ) N.SUB = N.SUB-1
          =B6    B6-1 
 PSS92    =B7    B7-1        DECREMENT (N.VSUB) 
          SB3    X3 
          SA1    B3+CON1-1
          SA2    B4+CON1-1
          SA3    B4+DIM.MUL-1 
          IX4    X2*X3
          IX6    X1+X4             C1(J) = C1(J)+DIM.MUL(I)*C1(I) 
          SA6    A1 
  
          SA2    B4+CON2-1
          SA1    B3+CON2-1
          SX2    X2-1 
          IX4    X3*X2
          IX6    X4+X1             C2(J) = C2(J)+DIM.MUL(I)*(C2(I)-1) 
          SA6    A1 
          SX7    B1 
          SA7    A2                C2(I) = 1
  
 PSS94    EQ     B7,B1,PSS96       IF ONLY 1 VARIABLE SUB LEFT
          NZ     X5,PSS90          IF MORE COMBINATIONS TO TEST 
  
 PSS96    SX6    B6 
          SX7    B7 
          SA6    N.SUBS            UPDATE N.SUB AND N.VSUB
          SA7    A5 
          EQ     EXIT.
 MDL      EJECT  MDL - MATCH DATA LISTS 
**        MDL - MATCH DATA LISTS. 
*                MATCHS A VARIABLE TO DATA ITEM LIST
* 
*         ENTRY  (X5) = NUMBER OF EXPLICIT LOOPS. 
*                     "DVT" AND SUBSCRIPT INFO BLOCK SET UP BY "BVT". 
  
  
 MDLY     =B7    DDS.S       OUTPUT A *DATA 0* TO PROPERLY MAINTAIN THE 
          BX5    0                 ORIGIN COUNTER 
          PX6    X5,B7
          ADDWD  TS.DAT 
  
 MDL      SUBR               ENTRY/EXIT...
          SA4    N.ITEM            NUMBER OF ITEMS LEFT IN DATA LIST
          SX6    X4-1 
          PL     X6,MDL1           IF > 0 
          SA6    A4 
          EQ     EXIT.
  
 MDL1     SA2    DVT+1
          SA1    SDPF              X1 = SDPF
          MX7    0
          SB2    X2                NUMBER OF VARS TO BE INITIALIZED 
          SA7    ORGI              ORGI = 0 
          NZ     X5,MDL4           IF EXPLICIT LOOPS
          GT     B2,B1,MDL2        IF NOT A SINGLE ITEM 
  
**        PROCESS A SINGLE ELEMENT
  
          SA3    BIAS 
          SA6    A4                UPDATE N.ITEM
          RJ     ODV               OUTPUT ORG FOR FWA 
          RJ     GNI               GET NEXT DATA ITEM 
          SA1    DVT+1
          AX1    18 
          SB5    X1                WORD LIMIT 
          RJ     ODI               OUTPUT IT
          EQ     EXIT.
  
**        PROCESS REFERENCE TO WHOLE ARRAY - A # (A(I),I = 1,PI DIMS) 
  
 MDL2     SX6    X1+B1             ADDRESS DIFFERENCE 
          SX7    X2                TRIP COUNT 
          SA5    BIAS 
 MDL3     RJ     OIC               OUTPUT INITIALIZATION CODE 
          EQ     EXIT.
  
**        PROCESS EXPLICIT DO INDEXING
  
 MDL4     SB4    X5                B4 = NUMBER OF LOOPS 
          GT     B4,B1,MDL5        IF MORE THAN 1 LOOP
          SB5    X1                SDPF 
          SA2    LPINF             LOOP INFO WORD 
          AX2    18 
          SX7    X2                TRIP COUNT 
          AX2    18 
          SX3    X2                M
          AX2    18                P
          SA4    DIM.MUL+X2 
          SA5    BIAS 
          LX4    B5,X4
          IX6    X3*X4             ADDRESS DIFF = DM(P)*M(P)*2**SDPF
          SX4    X4 
          IX0    X6-X4             DM(P)*( M(P)-1 )*2**SDPF 
          IX5    X0+X5
          EQ     MDL3 
  
 MDL5     BSS    0
  
**        IRREDUCEABLE NEST OF LOOPS
  
 MDL10    SA2    LPINF
          SA1    SDPF 
          SB5    X1 
          AX2    36 
          SX3    X2                M(P) 
          AX2    18                P
          SA4    DIM.MUL+X2 
          LX4    B5,X4             DM(P)*2**SDPF
          IX7    X3*X4
          SA7    DA                SAVE ADDRESS DIFFERENCE
          UX4    X4 
          SA5    BIAS 
          IX0    X7-X4
          IX7    X0+X5             BIAS = BIAS+DA-DM(P)*2**SDPF 
          SA7    A5 
          SX6    B1 
          SA6    LI+1              LI(2) = 1
          SA6    A6+B1             LI(3) = 1
  
**        CALCULATE BIAS
  
 MDL11    SA4    N.VSUB 
          SA5    BIAS 
          SA3    SDPF 
          SB5    B1                INDEX
          SB2    X4                LIMIT
          SB3    X3                SDPF 
          MX7    0
          SA7    ORGI              ORGI = 0 
  
 MDL12    SA1    LPINF+B5          LPINF(J) 
          AX1    36 
          SX2    X1                M(P) 
          AX1    18                P
          SA3    LI+B5             LI(J)
          SA1    DIM.MUL+X1        DM(P)
          IX4    X2*X3
          SX6    X4-1 
          IX0    X1*X6             DM(P)*(M(P)*LI(J)-1) 
          LX7    B3,X0
          IX5    X5+X7
          SB5    B5+B1
          LT     B5,B2,MDL12
  
          SA1    DA 
          SA2    LPINF
          BX6    X1                ADDRESS DIFFERENCE 
          AX2    18 
          SX7    X2                TC(1)
          RJ     OIC               MATCH UP LISTS 
  
**        INCREMENT INDICES 
  
          SA4    N.VSUB 
          SB5    B1 
          SB2    X4 
  
 MDL13    SA1    LI+B5             LI(J)
          SA2    LPINF+B5 
          SX6    X1+B1             LI(J) = LI(J)+1
          AX2    18 
          SX3    X2                TC(J)
          SA6    A1 
          IX0    X1-X3             I - L
          MI     X0,MDL14          IF LI(J) @ TC(J) 
          SX6    B1                LI(J) = 1
          SA6    A6 
          SB5    B5+B1
          LT     B5,B2,MDL13       LOOP IF J @ N.VSUB 
          EQ     EXIT.
  
 MDL14    SA1    N.ITEM 
          SX2    X1-1 
          PL     X2,MDL11          IF MORE ITEMS TO GO
          EQ     EXIT.
 OIC      EJECT  OIC - OUTPUT INITIALIZATION CODE 
**        OIC - OUTPUT INITIALIZATION CODE FOR A SEQUENCE OF ELEMENTS.
*         OF AN ARRAY WITH A CONSTANT ADDRESS DIFFERENCE BETWEEN THEM.
*         THAT IS, THIS SUBROUTINE OUTPUTS THE INITIALIZATION CODE FOR
*         THE STATEMENT 
*                ( A(M*I),I = 1,T) / DATA ITEM LIST / 
*         THE ADDRESS DIFFERENCE BETWEEN THE ELEMENTS IS: 
*         A(M*(I+1))-A(M*I) = DM(J)*M*2**SDPF 
* 
*         ENTRY  (X5) = ANY ADDITIONAL BIAS 
*                (X6) = DA - THE ADDRESS DIFFERENCE 
*                (X7) = T - TRIP COUNT
  
  
 OIC      SUBR               ENTRY/EXIT...
          SA6    DA                SAVE PARAMETERS
          SA7    OICT 
          BX6    X5 
          SA6    OICB 
  
 OIC1     SA3    REPFLAG
          SA5    I.DIT
          SA2    TI.DAT 
          IX1    X2+X5       NEXT ITEM TABLE ADDRESS
          ZR     X3,OIC2           IF NOT IN THE MIDDLE OF A REP
  
**        IN THE MIDDLE OF A REP , ADJUST REP COUNT DECREMENT ( DEC ) 
  
          BX2    X3 
          AX2    36 
          SB4    X2                RL 
          MX7    0                 DEC = 0
          EQ     B4,B1,OIC3        IF RL = 1
          SA4    I.DIT+2     ORDINAL OF START OF DATA IN REP LIST 
          IX5    X4-X5
          =X0    -1 
          AX5    59 
          BX7    X5*X0             DEC = 0 IF AT THE START
          EQ     OIC3 
  
 OIC2     SA3    X1                DIT WORD 
          PL     X3,OIC12          IF NOT THE START OF A REP
          BX7    0                 DEC = 0
  
**        REP LIST ENCOUNTERED - SEE IF WE CAN OUTPUT "REPI" MACROS 
*         A3,X3 - REP LIST INFO WORD - DO NOT DESTROY UNTIL UPDATED 
  
 OIC3     LX4    B1,X3
          AX4    54+1              POSITION CONSTANT ITEM LENGTH FLAG 
          ZR     X4,OIC12          IF ALL ITEMS ARE NOT THE SAME LENGTH 
  
**        N = MIN(RF+DEC,T/RL) = NUMBER OF TIMES WE CAN REP THE DATA
  
          SA5    OICT 
          SB4    X4                B4 = CIL FLAG
          SX0    X3                X0 = RF
          BX2    X3 
          AX2    36 
          SX6    X2                RL 
          SB2    X2                B2 = RL
          SA6    RL 
          IX0    X0+X7             RF+DEC 
          IX5    X5/X6             T/RL 
          MX6    X5-X0             MIN OF THE 2 
          SB6    X6 
          LE     B6,B1,OIC12       IF WE CAN"T REP IT AT LEAST 2 TIMES
          SA5    SDPF 
          SB3    X5+B1             WORDS/ELEMENT
          GT     B4,B3,OIC12       IF DATA ITEMS LONGER THAN VAR ELEMENT
  
          SA6    OICN              SAVE REP COUNT 
          SX5    X6-1              DECREMENT REP LIST COUNT BY N-1 FOR
          IX6    X3-X5             GNI SINCE WE WILL CALL IT ONLY ONCE
          SA6    A3                TO OUTPUT THE DATA ITEMS N TIMES 
  
          SA1    DA 
          SX2    B2                RL 
          SB6    B4-B1             CIL FLAG - 1 
          LX7    B6,X2             RL*CIF 
          IX5    X7-X1
          IX6    X1*X2
          SA6    MP                MP = DA*RL 
          NE     B3,B4,OIC7        IF 1 WORD ITEMS AND 2 WD/ELE VARS
          EQ     B2,B1,OIC5        IF RL = 1
          SB7    X1                DA 
          NE     B7,B4,OIC7        IF DA " CIL
  
**        RL = 1 OR DA = CIL - OUTPUT THE DATA AND A SINGLE REPI
  
 OIC5     SA7    DLEN              SAVE LENGTH OF DATA LIST ( *CIL )
          SA3    OICB 
          RJ     ODV               OUTPUT ORG TO SET DATA PLACEMENT ADDR
          SA1    RL 
          BX6    -X1
  
 OIC6     SA6    LI 
          RJ     GNI               GET NEXT ITEM
          SA1    SDPF 
          SB5    X1+B1             WORD LIMIT 
          RJ     ODI               OUTPUT DATA ITEM 
          SA1    LI 
          SX6    X1+B1             DECREMENT INDEX
          NZ     X6,OIC6
  
          SA1    OICN              REP COUNT
          SA2    MP                FWA INCR 
          SA4    DLEN              NUMBER OF DATA WORDS 
          LX3    X2                DESTIN OFFSET
          BX6    X4 
          RJ     ORP               OUTPUT REPI MACRO CALL 
          EQ     OIC9 
  
**        RL > 1 AND DA " CIL - PUT OUT A REP FOR EACH DATA ITEM
  
 OIC7     SA3    OICB 
          SX7    -B2
          BX6    X3 
          SA7    TMP
          SA6    A7+B1             AND COPY OF BIAS 
  
 OIC8     RJ     ODV               OUTPUT ORG TO SET DATA PLACEMENT ADDR
          RJ     GNI               GET DATA LIST POINTER
          SA1    SDPF 
          SB5    X1+B1             SET WORD LIMIT 
          RJ     ODI               OUTPUT DATA STMT 
          SA1    OICN              REP COUNT + 1
          SA2    MP                I
          BX3    X2                D
          SX6    B5                B
          RJ     ORP               OUTPUT REPI MACRO
          SA1    TMP               LOOP INDEX 
          SA2    DA 
          SA3    A1+B1             BIAS 
          IX6    X2+X3             B = B+DA ( ADVANCE BIAS )
          SA6    A3 
          BX3    X6 
          SX7    X1+B1             DECREMENT LOOP INDEX 
          SA7    A1 
          MI     X7,OIC8
  
**        END OF REP OUTPUT - UPDATE COUNTERS ( N.ITEM,T AND B )
  
 OIC9     SA1    OICN 
          SA2    RL 
          SA3    OICB 
          SA4    N.ITEM 
          IX0    X1*X2             N*RL = NUMBER OF ELEMENTS PROCESSED
          SA2    DA 
          SA5    OICT 
          BX7    0
          SA7    ORGI              ORGI = 0 
          IX1    X0*X2
          IX7    X3+X1             B = B+DA*(N*RL)
          SA7    A3 
          UX0    X0 
          IX6    X4-X0             DECREMENT NUMBER OF ITEMS LEFT 
          SA6    A4 
          IX7    X5-X0             AND NUMBER OF VARS LEFT
          SA7    A5 
          ZR     X6,OIC10          IF DATA LIST IS EXHAUSTED
          NZ     X7,OIC1           IF MORE VARIABLES TO GO
  
 OIC10    IX6    X6-X7             N.ITEM = N.ITEM-T
          SA6    A6                FORCE AN INFORMATIVE ERROR IF T " 0
          EQ     EXIT.
  
**        NOT AT THE START OF A REP OR CANNOT REP WITH THIS ITEM LIST 
*         OUTPUT ITEMS UNTIL WE HIT THE START OF THE NEXT REP OR
*         T = 0 OR N.ITEM = 0 
  
 OIC12    SA2    DVT+1
          AX2    18 
          SX7    X2                SAVE WORD LIMIT
          SA7    TMP
  
 OIC14    SA1    DA 
          SA2    ORGI 
          IX0    X1-X2
          ZR     X0,OIC15          IF WE DON"T NEED AN ORG
          SA3    OICB 
          RJ     ODV               SET DATA PLACEMENT ADDRESS 
 OIC15    RJ     GNI               GET NEXT DATA ITEM 
          SA1    TMP
          SA2    OICB 
          SA4    DA 
          IX3    X1-X2
          SB5    X3                WORD LIMIT FOR THIS ELEMENT
          IX7    X4+X2             B = B+DA ( ADVANCE BIAS  ) 
          SA7    A2 
          RJ     ODI               OUTPUT A DATA ITEM 
          SX6    B6 
          SA6    ORGI              SAVE ORG COUNTER INCREMENT 
  
          MX0    59 
          SA4    N.ITEM 
          SA5    OICT 
          IX6    X4+X0             DECREMENT NUMBER OF ITEMS LEFT 
          SA6    A4 
          IX7    X5+X0             AND NUMBER OF VARIABLES LEFT 
          SA7    A5 
          ZR     X6,OIC10          IF NO MORE DATA ITEMS LEFT 
          ZR     X7,EXIT.    IF FINISHED WITH THE VARS
  
          SA2    TI.DAT 
          SA1    I.DIT
          IX1    X1+X2
          SA3    X1                NEXT DIT WORD
          BX7    0
          PL     X3,OIC14          IF NOT THE START OF A REP
          EQ     OIC3 
  
 OICB     BSS    1           LOCAL COPY OF BIAS 
 OICN     BSS    1           NUMBER OF TIMES WE CAN TRAVERSE A REP LIST.
 OICT     BSS    1           TRIP COUNT 
 ODV      EJECT   OUTPUT ROUTINES 
**        ODV - OUTPUT DATA VARIABLE ADDRESS. 
*         OUTPUTS AN "ORG" MACRO CALL TO SET THE FWA FOR DATA PLACEMENT 
* 
*         ENTRY  X3 = ANY ADDITIONAL BIAS DUE TO SUBSCRIPT CALCULATIONS,
  
  
 ODV      SUBR               ENTRY/EXIT...
          SA1    DVT
          SX2    X1                SAVE BIAS DUE TO EQUIVALENCING 
          AX1    18 
          SX6    X1 
          LX6    P.DTAG 
          =B7    DDS.O       *ORG* OPERATOR 
          IX3    X3+X2
          BX1    X6+X3
          PX6    X1,B7
          ADDWD  TS.DAT 
          EQ     EXIT.
 ORP      SPACE  4,8
**        ORP - OUTPUT "REPI" MACRO CALL. 
* 
*         ENTRY  X6 = DATA BLOCK LENGTH ( NUMBER OF WORDS TO BE REPPED )
*                X1 = REP COUNT + 1 
*                X2 = FWA INCREMENT BETWEEN REPS
*                X3 = DESTINATION ADDRESS OFFSET
  
  
 ORP      SUBR               ENTRY/EXIT...
          LX6    P.DTAG 
          BX0    X6+X1
          LX2    P.DTAG 
          =B7    DDS.R       *REPI* OPERATOR
          PX6    X0,B7
          BX4    X2+X3
          ADDWD  TS.DAT 
          BX6    X4 
          ADDWD  A1 
          EQ     EXIT.
 ODI      EJECT 
**        ODI - OUTPUT DATA ITEM. 
* 
*         ENTRY  B5 = MAX NUMBER OF DATA WORDS THAT MAY BE ISSUED 
*                A5,X5 = FWA OF DIT ENTRY 
* 
*         EXIT   (B6) = NUMBER OF DATA WORDS THAT WE ISSUED.
*                     ( ORG COUNTER INCREMENT ) 
  
  
 ODI.S    =B7    DDS.S       INDICATE SMALL CONSTANT (LESS 2**48-1) 
          PX6    X5,B7
          ADDWD  A1 
 ODI.T    SA2    SDPF 
          ZR     X2,ODI.E    IF NOT COMPLEX VAR 
          =B7    DDS.S       INITIALIZE SECOND WORD OF COMPLEX VAR
          SA1    TS.DAT 
          SX5    0
          PX6    X5,B7
          ADDWD  A1          OUTPUT SECOND WORD OF COMPLEX VAR
ODI.E     SX7    0
          SA7    SDPF 
  
 ODI      SUBR               ENTRY/EXIT...
          LX0    X5,B1
          SB6    X5          (B6) = NUM WORDS IN DATA ITEM
          MI     X0,ODI1     IF HOLLERITH 
          SA1    DVT         CHECK CONSTANT TYPE
          MX0    L.TYPE 
          BX6    X1-X5
          LX0    P.CTYP+L.TYPE     POSITION MASK
          BX6    X0*X6
          ZR     X6,ODI0     IF NO TYPE CONFLICT
  
          ANSI   =XE.DVL10
  
 ODI0     SA5    A5+B1
          SA1    TS.DAT 
          MX3    -47
          NE     B6,B1,ODI.D  IF DOUBLE-WORD ITEM 
          BX2    X3*X5
          AX2    47 
          ZR     X2,ODI.S    IF SMALL CONSTANT
  
 ODI.D    SA4    A5+B1       FETCH (POSSIBLE) SECOND WORD 
          ALLOC  A1,B6+1
          IX3    X1+X2
          SX0    B6-B1       WC - 1 
          =B7    DDS.W
          SB2    -B6
          BX7    X5 
          PX6    X0,B7
          SA7    X3+B2       (1ST WORD) _ (LWA(TABLE)+1-WC) 
          SA6    A7-B1
          EQ1    B6,ODI.T 
          BX7    X4 
          SA7    A7+B1       (2ND WORD) _ (LWA(TABLE))
          GT1    B5,EXIT.    IF DOUBLE-WORD VARIABLE
          WARN   E.DTC
          EQ     EXIT.
  
*         OUTPUT HOLLERITH CONSTANT 
  
 ODI1     SA2    SDPF 
          SB3    X2+B1
          LE     B6,B3,ODI2  IF HOL CON .LT. ELEMENT LENGTH 
          ANSI   E.DHC
 ODI2     LE     B6,B5,ODI3  IF CON LEN .LE. WORD LIMIT 
          SB6    B5 
          WARN   E.DTC
 ODI3     SA4    TS=DAT      CURRENT TABLE LENGTH 
          AX5    P.DNEGH
          =X3    B1 
          BX5    X3*X5
          SB3    X5          1 IFF PRECEEDED BY MINUS SIGN
          SA5    A5+B1
          ALLOC  TS.DAT,B6+1
          SA3    TS.CON 
          AX5    P.TAG
          =B7    DDS.W
          SB2    X5-C.CON 
          SX2    X3+B2       SOURCE = (TS.CON) + CON-TAG
          IX4    X1+X4       START OF EMPTY REGION OF TS.DAT
          SX0    B6-B1       WC (FOR DDS.) = (B6)-1 
          SX1    B6          WC (FOR MOVE) = (B6) 
          PX6    X0,B7
          SX3    X4+B1       DEST = START + 1 
          SA6    X4          ENTER CONTROL WORD 
          NZ     B3,ODI4     IF NEG HOLL
          MVE    X1,X2,X3 
          EQ     EXIT.
  
 ODI4     SA2    X2          MOVE *X1* WORDS FROM LOC(X2) TO LOC(X3)
*                            AND ALTER THEIR SIGNS
          =B3    X1-1 
          BX6    -X2
          SA6    X3          MOVE FIRST WORD
 ODI5     ZR     B3,EXIT.    IF MOVE DONE 
          =A3    A2+1        GET NEXT WORD
          BX7    -X3
          EQ1    B3,ODI6     IF LAST WORD 
          =A2    A3+1 
          SB3    B3-2 
          BX6    -X2
          =A7    A6+1 
          =A6    A7+1 
          EQ     ODI5        GET NEXT TWO WORDS 
  
 ODI6     =A7    A6+1 
          EQ     EXIT.       EXIT.. 
 GNI      SPACE  4,8
**        GNI -  GET ADDRESS OF NEXT DATA ITEM. 
* 
*         EXIT   A5,X5 = ADDRESS AND CONTENTS OF FIRST WORD OF NEXT 
*                DATA ITEM FROM "DIT" 
  
  
 GNI      SUBR               ENTRY/EXIT...
          SA1    I.DIT
          SA2    TI.DAT 
          IX6    X1+X2
          SA5    X6          NEXT WORD
          SA2    A1+B1             REP COUNT REMAINDER
          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 
          AX6    36 
          BX7    -X6
          SA7    A2                SET REMAINDER = -N.ITEMS IN REP LIST 
          BX2    X7 
          SA5    A5+B1             GET FIRST DATA WORD
          SX1    X1+B1             ADVANCE INDEX PAST REP WORD
  
**        ADVANCE I.DIT TO POINT TO NEXT ITEM AND SEE IF WE ARE IN A
*         REP LIST. 
  
 GNI1     BX0    X5 
          AX0    18 
          IX7    X0+X1             UPDATE INDEX 
          SA7    A1 
          ZR     X2,EXIT.    IF NO REPETITION 
          SX7    X2+B1
          SA7    A2                UPDATE REMAINDER 
          NZ     X7,EXIT.    IF MORE TO GO
  
**        DECREMENT REP COUNT AND START BACK AT START OF REP LIST IF RC 
  
          SA3    REPFLAG
          SX0    B1 
          IX7    X3-X0             DECREMENT REP COUNT
          SA7    A3 
          SB7    X7 
          ZR     B7,GNI2           IF FINISHED
          AX3    36 
          BX7    -X3               RESET REMAINDER
          SA7    A2 
          SA4    A2+B1             ADDRESS OF FIRST DATA ITEM IN REP LIS
          BX7    X4 
          SA7    A1                RESET I.DIT FOR NEXT ENTRY 
          EQ     EXIT.
  
 GNI2     BX7    0
          SA7    A7                REPFLAG = 0
          EQ     EXIT.
 PDV      SPACE  4,8         PROCESS DATA VARIABLE. 
**        PDV -  PROCESS DATA VARIABLE. 
*         PROCESS"S VARIABLE NAME MENTIONED IN A DATA STMT
* 
*         ENTRY  (A4) _ *SB* ENTRY. 
* 
*         EXIT   SEMANTICS CHECK FOR LEGAL NAME PERFORMED 
*                REGISTERS RESTORED BY A CALL TO MACRO "GETE" 
  
  
 PDV9     SA5    SELIST      RESTORE (A4) 
          SA4    X5 
          SB2    X4 
  
 PDV      SUBR               ENTRY/EXIT...
          =X7    A4+1 
          SA7    SELIST      SAVE STRING BUFFER ADDRESS 
          BX7    X4 
          SB4    A4 
          SA7    FILL.
          RJ     TRV         TRANSLATE VARIABLE 
          =X7    B4+1 
          SA7    SELIST      IN CASE TRUNCATION HAS OCCURRED
          CLAS=  X3,(FP,EXT,ENT,NLST,NVAR)
          LX4    X6 
          BX3    X3*X6
          NZ     X3,E.DAUC   IF USEAGE CONFLICT 
          SB2    B0                B2 " 0 IF VARIABLE IS IN COMMON
          SX7    B7 
          SA7    ORD               SAVE SYMTAB ORDINAL
          LX7    P.SYMORD          X7 = WORD 1 OF DVT ENTRY 
          =X0    1
          AX6    P.LONG 
          SB5    B7          (B5) = SYMTAB ORDINAL
          BX6    X0*X6       0 IF SINGLE, 1 IF 2 WORDS/ELEM 
          LX1    P.CTYP      POSITION CONSTANT TYPE 
          SA6    SDPF 
          SB7    X6                B7 = SDPF
          BX7    X7+X1
          LX6    P.SDPF 
          BX7    X6+X7
  
**        CHECK FOR VARIABLE IN BLANK COMMON. 
  
          BX0    X4 
          IFBIT  X0,-COMM,PDV2   IF NOT IN COMMON 
          SA3    TA.NAM 
          SX0    B5 
          AX0    1           HALF-ORDINAL 
          IX3    X0+X3
          SA3    X3 
          AX3    P.BLOCK
          SA2    =XBLNKCOM
          SX0    X3 
          IX0    X0-X2
          NZ     X0,PDV3     IF NOT // COMMON 
          FATAL  E.DALV 
          EQ     PDV3 
  
 PDV2     SA2    =XMOD
          SBIT   X2,PBLK
          PL     X2,PDV3     IF NOT BLOCKDATA 
          FATAL  =XE.DALV 
 PDV3     BX3    X4 
          MX0    -L.PNT 
          AX3    P.PNT
          BX1    -X0*X3 
          SB6    X1          (B6) = INDEX TO DIM TABLE
          SA7    DVT         SAVE WORD 1 OF DVT ENTRY 
  
**        SET DEFINED AND VAR BITS IN SYMTAB ENTRY
  
          SA2    TS.SYM 
          CLAS=  X0,(DEF,VAR) 
          BX6    X0+X4       SET DEFINED BIT
          SA6    X2+B5
          BX6    0
          =B4    1           B4 = ITEM COUNT
          SA6    N.DIMS 
          SA3    TP.DIM 
          SB6    X3+B6             ADDRESS OF DIM PARAMETERS
  
**        SAVE DIMENSION INFO 
  
          BX0    X4 
          IFBIT  X0,-ARY,PDV7      IF NO DIMENSIONS 
          SA3    B6                WORD 1 OF DIM ENTRY
          MX0    L.NDIM 
          BX6    X0*X3
          AX3    P.DIMLG
          SB4    X3          (B4) = ITEM LENGTH OF ARRAY
          SA3    B6+B1
          LX6    L.NDIM 
          SA6    N.DIMS 
          AX3    P.DIM
          SX0    X6-3 
          MX1    -L.DIM 
          BX6    -X1*X3      ISOLATE DIM1 
          SA3    A3+B1
          SA6    DIM.MUL+1
          SA6    DIM
          BX7    -X1*X3      DIM2 
          AX3    P.DIM
          SA7    A6+B1
          BX1    -X1*X3      DIM3 
          MI     X0,PDV7           IF < 3 DIMS
          IX6    X6*X7             DIM1*DIM2
          BX7    X1 
          SA6    DIM.MUL+2
          SA7    A7+B1             STORE DIM3 
  
 PDV7     SA1    DVT
          BX0    X1 
          AX0    P.SDPF 
          SB7    X0 
          SX6    B4          NUMBER OF ELEMENTS 
          LX5    X6,B7       NUMBER OF WORDS
          LX5    18 
          BX6    X5+X6
          SA6    A1+B1             SAVE SECOND WORD OF DVT
 PDV8     EQ     PDV9        EXIT.. 
  
  
  
          LIST   D
          END 
