*DECK     FTN5TXT - FRONT END ASSEMBLY TEXT.
          IDENT  FTN5TXT
          STEXT 
          SYSCOM
          LIST   F,X
 FTN5TXT  TITLE  FTN5TXT - FORTRAN 5 ASSEMBLY/INSTALLATION TEXT.
          COMMENT          FORTRAN 5 ASSEMBLY/INSTALLATION TEXT.
 FTN5TXT  SPACE  4
***       FTN5TXT - FORTRAN 5 ASSEMBLY/INSTALLATION TEXT. 
* 
*                FTN5TXT IS THE GLOBAL TEXT FOR ASSEMBLY/INSTALLATION 
*         OF THE FORTRAN 5 COMPILER.  IT CONTAINS DEFINITIONS OF
*         MACROS, MICROS, SYMBOLS AND OPDEFS, ORGANIZED AS FOLLOWS ...
* 
*         (OPTIONS)  COMPILER INSTALLATION OPTIONS. 
*                    ASSEMBLY CONSTANTS.
*         (FA=DEFS)  I/O MACROS (FOR UPPER AND LOWER CYBER).
*         (COMADEF)  STRUCTURED WORD DECLARATION MACROS.
*         (COMAIDP)  IDP ACCESS MACROS (TEST MODE ONLY).
*         (COMACPU)  GENERAL CPU MACROS.
*         (COMAMGM)  MORE (LESS) GENERAL MACROS.
*                    COMPILER-SPECIFIC MACROS.
*                    SYMBOL AND MICRO DEFINITIONS.
*         (COMSIOC)  I/O CONTROL CODE DEFINITIONS.
*         (COMSPSU)  PSEUDO INSTRUCTION DEFINITIONS.
*         (COMSPBD)  PREBINARY STRUCTURE DECLARATIONS.
*         (COMSSYM)  SYMBOL TABLE STRUCTURE DECLARATIONS. 
*                    STRUCTURE DECLARATIONS AND TABLE DESCRIPTIONS. 
*CALL     OPTIONS            COMPILER INSTALLATION OPTIONS. 
          TITLE  ASSEMBLY CONSTANTS.
 CONSTS   SPACE  4,10 
**        ASSEMBLY CONSTANTS. 
  
  
          COL    30          COLUMN FOR COMMENT FIELD.
  
 FLSZ     EQU    10          SAFETY ZONE BET. CURRENT FL AND CP.NFLS
 IN.LCM   EQU    30000B      INITIAL LCM FL REQUEST 
 MAX.DIM  EQU    7           MAXIMUM NUMBER OF DIMENSIONS PERMITTED 
 MAX.SPAN EQU    23          BIT COUNT - MAXIMUM DIMENSION SPAN SIZE
 MAX.SPCM EQU    1S17-1      MAXIMUM DIMENSION SPAN - SCM 
 MAX.SPLC EQU    1S20-8      MAXIMUM DIMENSION SPAN - LCM 
 MAX.REPL EQU    77777B      MAXIMUM REPLICATION COUNT (DATA CONSTANTS) 
  
 ANS.CONT EQU    19D         MAX. NO. OF CONTIN. CARDS PERMITTED BY ANSI
 MAX.CDL  EQU    10          MAXIMUM INPUT LINE (WORDS) 
  
 MAX.BLK  =      500D        MAXIMUM NUMBER OF COMMON BLOCKS
  
 MAX.SARG   =    500         MAXIMUM NUMBER OF ARGUMENTS TO A SUBPROGRAM
 MAX.PARG EQU    49          MAXIMUM NUMBER OF FILES ON *PROGRAM* STMT
  
 MAX.STN  EQU    5           NUMBER OF DIGITS TO ASSEMBLE FOR STMT. NO. 
 MAX.VAR  EQU    7           NUMBER OF CHARACTERS TO ASSEMBLE FOR 
                             TABBING PROCESS. 
 MAX.LFN  EQU    7           NUMBER OF CHARACTERS ALLOWED IN LOGICAL
                             FILE NAME
 BUFL.SM  EQU    1003B       DEFAULT BUFL (STATIC MODE) 
 BUFL.DM  EQU    2003B       DEFAULT BUFL (DYNAMIC MODE)
 BUFL.ADD EQU    3           BUFFER LENGTH ADDENDUM 
 MAX.BUFL EQU    360000B
 MAX.RECL EQU    1S17-1 
 NOR.RECL EQU    137D        NOROMAL RECORD LENGTH
  
 MAX.CL   EQU    1S15-1      MAXIMUM CHARACTER LENGTH (TYPE CHARACTER)
  
 MAX.SDL  EQU    1S17-1      MAXIMUM SHORT DO LOOP TRIP COUNT 
 MEM.GOFL EQU    34000B      MEM DOWN FL FOR *GO* MODE
 MIN.TABS =      3000B
 NOM.INC  EQU    3000B       NOMINAL FL INCREMENT 
  
 EXT      MICRO  1,, .       SUFFIX FOR LIBRARY EXTERNALS 
 XBYNAM   MICRO  1,, =       SUFFIX FOR CALL BY NAME EXTERNAL INTRINSIC 
 XBYVAL   MICRO  1,, .       SUFFIX FOR CALL BY VALUE EXTERNAL INTRINSIC
 XUPNAM   MICRO  1,, $       SUFFIX FOR CALL BY NAME EXPONENTATION
  
  
 CHAR     =      6           BITS PER CHARACTER 
 ON       =      1           CONDITIONAL SWITCH 
 OFF      =      0           CONDITIONAL SWITCH 
 BLOWUP   MICRO  1,, *O+4S15       OUT OF BOUNDS JUMP ADDRESS 
  
**        ERROR LEVEL OPTION TRANSFORMATIONS
  
          LOC    2
          IFEQ   TEST,ON,1
 EL=D     BSS    1           DEBUG
 EL=T     BSS    1           TRIVIAL
 EL=W     BSS    1           WARNING
 EL=F     BSS    1           FATAL
 EL=C     BSS    1           CATASTROPHIC 
          LOC    *O 
 RA.      SPACE  4,10 
**        USAGE OF CELLS IN JOB COMMUNICATIONS AREA.
  
  
 RA.LDP   =      RA.SSW+17B - 21B  3 WORDS FOR LOADER CALL PARAM LIST 
 RA.JOT   =      66B         JOB ORIGIN TYPE BITS 24-35 OF RA+66
 L54      SPACE  4,10 
**        LOADER 54 TABLE OFFSETS.
  
  
 L54.00   =      11B         LENGTH OF (0,0) 54 TABLE 
 L54.NN   =      5           LENGTH OF (N,N) 54 TABLES
 L54.HDR  =      0           54 TABLE HEADER WORD 
 L54.HHA  =      4           HIGHEST HIGH ADDRESS, BITS 0-17
 ALLOC    SPACE  4,10 
**        MEMORY MANAGEMENT CONSTANTS.
  
  
 .CMLOD   EQU    0           NO COMPILE TO CORE 
 FUDGE    EQU    1           AMOUNT OF SLOP SPACE BETWEEN TABLES
 FLSLOP   =      4           AMOUNT OF SLOP FOR MANAGER = 
*                            (1/2**N)*(WIDTH OF TABLE AREA) 
 FLSLUP   =      1000B       AMOUNT OF SLOP (INITIAL FIELD LENGTH)
 FLSLUP2  =      1400B       AMOUNT OF SLOP (AFTER *ALLOC* MEM) 
*                            (THRESH) = FLSLUP +  SLOP[PER FLSLOP]
 INC.LTN  =      2000B       FIELD LENGTH INCREMENT WHEN FL .LT. NOM.FL 
 INC.GTN  =      4000B       FIELD LENGTH INCREMENT WHEN FL .GT. NOM.FL 
  
 N.OPSTK  EQU    240B        NUM WORDS RESERVED FOR OPERAND STACK 
 N.ELSTK  EQU    240B        NUM WORDS RESERVED FOR ELEMENT STACK 
  
 #ECS     IFNE   CT.ECS,0 
 CT.EC    MICRO  1,, ON 
 #ECS     ELSE
 CT.EC    MICRO  1,, OFF
 #ECS     ENDIF 
*CALL     FA=DEFS            I/O MACROS FOR UPPER AND LOWER CYBERS. 
*CALL     COMADEF            STRUCTURED FIELD DECLARATION MACROS. 
          TITLE  DEBUG MACROS.
 .TEST    IFEQ   TEST,OFF    IF NOT TEST MODE 
  
  
**        SNAP MACROS  - IF NO SNAP REQUESTED 
  
  
 BREAK    OPSYN  NIL
 CORE     OPSYN  NIL
 DUMPT    OPSYN  NIL
 REG      OPSYN  NIL
 REGS     OPSYN  NIL
 SNAP     OPSYN  NIL
 STRING   OPSYN  NIL
  
 .TEST    ELSE               IF TEST MODE 
  
  
 CORE     SPACE  4,10 
**        CORE - MACRO TO SNAPSHOT CORE.
* 
* 
* LABEL   CORE   FWA,LENGTH 
* 
*         USES   NONE (OR IT WOULDNT BE ANY GOOD).
*         CALLS  SNP= 
  
  
          MACRO  CORE,NAM,FWA,LNG 
 NAM      SNAP   FWA,,LNG,NR
 CORE     ENDM
 DUMPT    SPACE  4,10 
**        DUMPT- MACRO TO DUMP COMPILER TABLES. 
* 
*         CALLS THE *SNAP* PACKAGE TO DUMP SPECIFIED TABLES.
* 
* NAME    DUMPT  (P1,P2,...,PN) 
* 
*                EACH PARAMETER IS THE NAME OF A TABLE. 
* 
*  EXAMPLE -- 
*         DUMPT  (DO,REF,SYM) 
* 
*         USES   NONE (OR IT WOULDNT BE ANY GOOD).
*         CALLS  DMT= 
  
  
          MACRO  DUMPT,NAME,TAB,LL,UL,INC,NUSE
          LOCAL  RTN
          LOCAL  APL
* 
 +        RJ     =XDMT= 
 -        VFD    30/APL 
* 
 #NUSE    IFC    EQ,/NUSE// 
          USE    DEBUG
* 
 #NUSE    ELSE
          EQ     RTN
 #NUSE    ENDIF 
* 
 APL      BSS    0
          FRK=   (NAME),LL,UL,INC 
          IRP    TAB
 A        MICRO  1,,/TAB /
 B        MICRO  1,2,/"A"  /
          IFC    EQ,/"B"/=X/,2
 A        MICRO  3,,/"A"   /
 B        MICRO  1,2,/"A"  /
          IFC    EQ,/"B"/T./,1
 A        MICRO  3,,/"A"   /
 A        MICRO  1,7,/"A"       / 
          VFD    42/7L"A",18/0
          IRP 
          VFD    60/0 
* 
 #NUSE    IFC    EQ,/NUSE// 
          USE    *
* 
 #NUSE    ELSE
 RTN      BSS    0
 #NUSE    ENDIF 
* 
 DUMPT    ENDM
 STRING   SPACE  4,10 
**        STRING - FORMATTED SNAPSHOT OF STRING BUFFER. 
* 
* 
* NAME    STRING LL,UL,INC
* 
*         ENTRY  NAME =  DISPLAY CODE (DPC) MESSAGE TO BE PRINTED WITH
*                          EACH SNAP. (NR CHARS.LE.8) 
*                LL   =  LOWER LIMIT (DEFAULT=1)
*                UL   =  UPPER LIMIT (DEFAULT=100)
*                INC  =  INCREMENT   (DEFAULT=1)
*                          SEE *FRK=* MACRO.
*                NUSE =  USE BLOCK FLAG. IF *NUSE* IS NULL, THE PARA- 
*                          METER LIST EXISTS IN *USE DEBUG*, ELSE IS
*                          ASSEMBLED AFTER *RJ* 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  FRK=,SBD 
  
  
          PURGMAC STRING
  
          MACRO  STRING,NAME,LL,UL,INC,NUSE 
          LOCAL  RTN
          LOCAL  APL
* 
 +        RJ     =XSBD
 -        VFD    30/APL 
* 
 #NUSE    IFC    EQ,/NUSE// 
          USE    DEBUG
* 
 #NUSE    ELSE
          EQ     RTN
 #NUSE    ENDIF 
* 
 APL      BSS    0
          FRK=   (NAME),LL,UL,INC 
* 
 #NUSE    IFC    EQ,/NUSE// 
          USE    *
* 
 #NUSE    ELSE
 RTN      BSS    0
 #NUSE    ENDIF 
* 
 STRING   ENDM
  
 .TEST    ENDIF 
 PRINT    SPACE  4,20 
**        PRINT - PRINT THE CONTENTS OF A LIST OF LOCATIONS.
* 
* 
*         PRINT  LAB,FMT,(LIST) 
* 
*         LAB - STATEMENT PRINTED IF *LAB* MENTIONED ON A *TRACER* LIST 
*                IF BLANK, THEN UNCONDITIONALLY PRINT.
*         FMT - PARENTHESIED FORTRAN FORMAT 
*         LIST - PARENTHESIZED LIST OF NAMES AND OR REGISTERS TO BE 
*                PRINTED. 
* 
*         SAMPLE CALL --
*         PRINT XXX,(* SIP,IIP =*,2I6),(SIP,IIP)   WILL PRODUCE - 
*         XXX SIP,IIP = NNNNNN NNNNNN 
* 
*         THIS MACRO IS FOR INTERNAL DEBUGGING ONLY ( TEST MODE ).
  
  
          PURGMAC PRINT 
  
 PRINT    MACRO  LAB,FMT,LIST 
          LOCAL  APL,LFMT 
 .P       IFC    NE,/LAB//,2
 .P       IF     -DEF,)LAB,1
 .P       IF     DEF,/DEBUG/LAB 
* 
          USE    DEBUG
 APL      CON    =XOUTPUT#
          CON    LFMT 
          IRP    LIST 
          IF     REG,LIST,4 
 L        MICRO  1,1,/LIST/ 
 N        MICRO  2,1,/LIST/ 
          VFD    12/2,30/1S6,18/=XSV="L"+"N"
          SKIP   1
          VFD    12/2,30/1S6,18/LIST
          IRP 
* 
 LFMT     CON    0
          DIS    ,$(* LAB *,FMT)$ 
          USE    *
* 
          RJ     =XSVR= 
          SA1    APL
          RJ     =XOUTCI. 
          RJ     =XRSR= 
 .P       ENDIF 
 PRINT    ENDM
  
 USF=     SPACE  4,8
**        USF= - GENERATE USER FLAG PARAMETER CELL
* 
*         USED BY REG AND SNAP MACROS.
*         USO= AND/OR URO= MUST ALSO BE DEFINED FOR *COMCIDP* CODE. 
* 
*         USF=   (ABCDEFG)
* 
*         ENTRY  (ABCDEFG) = STRING OF *SNAP=* CHARACTERS.
* 
*         EXIT   USER SNAP/IDP PARAMETER WORD GENERATED.
* 
*         USES   NONE 
* 
*         CALLS  LETMIC 
  
  
          PURGMAC USF=
  
 USF=     MACRO  USF
 '?ID#001 IFC    NE, USF
 '?IDCS01 LETMIC (USF)
          CON    "'?IDCS01" 
 '?ID#001 ELSE
          CON    0
 '?ID#001 ENDIF 
 USF=     ENDM
*CALL     COMAIDP            IDP ACCESS MACROS
  
*CALL     COMACPU            GENERAL CPU MACROS.
  
*CALL     COMAMGM            MORE (LESS) GENERAL MACROS.
  
          TITLE  COMPILER-SPECIFIC MACROS.
 ACTTAB   SPACE  4,10 
**        ACTTAB - ACTIVATE A TABLE.
* 
* 
*         ACTTAB TAB,PHASE
*         (TAB) = TABLE TO BE ACTIVATED.
*         (PHASE) = PHASE WHERE TABLES ARE TO BE ACTIVATED. 
* 
*         USES   A2,A7
*         USES   X2,X3,X7 
*         USES   B7 
* 
  
 ACTTAB   MACRO  TAB,PHASE
          SX3    B0 
          IRP    TAB
          SA2    =XT.TAB
          SB7    =XBASES
          SX2    B1 
          SB7    A2-B7
          LX2    B7,X2
          BX3    X2+X3
          IRP 
          IRP    PHASE
          SA2    =XTV=_PHASE
          BX7    X3+X2
          SA7    A2 
          IRP 
 ACTTAB   ENDM
 ADDREF   SPACE  4,10 
**        ADDREF - ADD REFERENCE TO TABLE.
* 
* 
*         ADDREF TAG,TYPE,RETURN
*         (TAG) = X-REGISTER CONTAINING THE TAG (X6)
*                18/TAG,42/IGNORED
* 
*         (TYPE) = TYPE OF REFERENCE (X1).
*                1R FORMAT CHARACTERS.  CALL SHOULD USE ONE OF THE
*                CR.XXX SYMBOLS.
* 
*         (RETURN) = RETURN ADDRESS (B7). 
*                *+1 IF OMITTED.
  
  
 ADDREF   MACRO  TAG,TYPE,RETURN
          =X6    TAG
          =X1    TYPE 
          =B7    RETURN  *+2-*P/60D 
          EQ     =XERT
 ADDREF   ENDM
 ADSYM    SPACE  4,10 
**        ADSYM - ADD ENTRY TO SYMBOL TABLE.
* 
*         ADSYM  T.SYM
* 
*         ENTRY  (X6) =  42/ SYMBOL TO ENTER,  12/ 0
*                (X7) =  SECOND WORD OF ENTRY 
*                (T.SYM) = ADDRESS OF T.SYM REQUIRED
*         CALLS  ESY
  
  
 ADSYM    MACRO  TABL 
          =A1    TABL 
          RJ     =XESY
 ADSYM    ENDM
 ADDWD    SPACE  4,10 
**        ADDWD- ADD WORD TO MANAGED TABLE
* 
*         ADDWD  TNAM 
* 
*         ENTRY  (X6) = WORD TO ADD.
*         CALLS  ADW. 
  
  
 ADDWD    MACRO  TNAM 
          =A1    TNAM 
          RJ     =XADW
 ADDWD    ENDM
 ALLOC    SPACE  4,10 
**        ALLOC - ALLOCATE ROOM FOR TABLE.
* 
* 
*         ALLOC  TNAM,ROOM         SCM TABLE
*         ALLOX  TNAM,ROOM         LCM TABLE
* 
*         *TNAM* _ ORIGIN WORD OF TABLE TO BE ALLOCATED.
*         *ROOM* = NUMBER OF WORDS TO EXPAND (OR SHRINK, IF NEGATIVE).
  
  
 ALLOC    MACRO  T,R
          =A1    T
          =X0    R
          RJ     =XALC
 ALLOC    ENDM
  
 ALLOX    MACRO  T,R
          =A1    T
          =X0    R
          RJ     =XALE
 ALLOX    ENDM
  
**        INATAB - INACTIVATE A TABLE.
* 
* 
*         INATAB TAB,PHASE
* 
*         (TAB) = TABLE TO BE DEACTIVATED.
*         (PHASE) = PHASES WHERE DEACTIVATION WILL TAKE PLACE.
* 
*         USES   A2,A7
*         USES   X2,X3,X7 
*         USES   B7 
* 
  
 INATAB   MACRO  TAB,PHASE
          SX3    B0 
          IRP    TAB
          SA2    =XT.TAB
          SB7    =XBASES
          SX2    B1 
          SB7    A2-B7
          LX2    B7,X2
          BX3    X2+X3
          IRP 
          IRP    PHASE
          SA2    =XTV=_PHASE
          BX7    -X3*X2      TURN OFF BIT 
          SA7    A2 
          IRP 
 INATAB   ENDM
  
 ANSI     SPACE  4,10 
**        ANSI - MACRO TO PROCESS *ANSI* DIAGNOSTICS. 
* 
*         ANSI   ARG
* 
*         *ARG*  = ADDRESS OF ERROR.
  
  
 ANSI     MACRO  ARG
* 
 A MICRO 1,, =X 
  IF -REG,ARG,2 
 B MICRO 1,2, ARG 
  IFC EQ, "B" =X ,1 
 A MICRO
* 
          =B7    "A"ARG 
          RJ     =XANSI=
 ANSI     ENDM
 CLAS=    SPACE  4,20 
***       CLAS= - LOAD "CLASS" BITS INTO A REGISTER.
* 
*         CLAS=  REG,PFX,(BITS),TYPE
* 
*         ENTRY  REG = REGISTER TO BE LOADED. 
*                PFX = BIT FIELD PREFIX CHARACTERS WITH NO PERIOD.
*                BITS = NAMES OF BITS TO BE SET.
*                TYPE = (OPTIONAL) TYPE TO SET INTO (PFX.MODE) FIELD. 
  
  
 CLAS=    MACRO  REG,PFX,(BITS),TYPE
 T        MICRO  1,, 0
          IFC    NE, TYPE  ,3 
          ERRNZ  PFX.MODEP   ["SEQUENCE"]_____________________
          ERRMI  7-M.TYPE    ["SEQUENCE"]_____________________
 T        OCTMIC M.TYPE,1 
*                            COUNT NUMBER OF BITS TO BE SET.
 A        SET 
          IRP    BITS 
 A        SET    A+1
          IF     -DEF,PFX.BITS_P,2
          ERR    (PFX.BITS) NOT DECLARED.    ["SEQUENCE"]_______________
 A        SET    100
          IRP 
 .1       IFLT   A,100
*                            CHECK FOR SIMPLE LOAD STYLE. 
          IFEQ   A,0,2
          =REG   M.TYPE 
 .1       SKIP
          IFEQ   "T",,4 
          IFEQ   A,1,3
          IFEQ   PFX.BITS_L,1,2 
          LDBIT  REG,PFX.BITS_P 
 .1       SKIP
*                            BIG VALUE, EVALUATE BITSTRING AND LOAD.
 C        BFMIC  PFX,(BITS) 
          IFC    NE, TYPE  ,2 
 C        MICRO  1,19, "C"
 C        MICRO  1,, "C""T"B
          LDX    REG,"C"
 .1       ENDIF 
 CLAS=    ENDM
 EMIT     SPACE  4,10 
**        EMIT - EMIT TURPLE TO IL. 
* 
*         EMIT   V=SKEL,USE,TAB        OR,
*         EMIT   SETOP,*,TAB
* 
*                SKEL = NAME OF A SKELETON. 
*                SETOP = ADDRESS OF A SETOP WORD. 
*                USE = DUCABILITY OF OPERANDS.  PICK ONE OF --
*                            [NONE, 1ST, 2ND, BOTH] 
*                TAB = TABLE TO EMIT TO.  IF OMITTED, (T.PAR) ASSUMED.
* 
*         CALLS  EMT. 
  
  
 EMIT     MACRO  SK,DU,TABLE
          IFC    NE,/TABLE//,3
 .A       SET    2S15 
          =A1    TABLE
          SKIP   1
 .A       SET 
* 
          IFC    EQ,/DU/*/,2
          SB3    4S15+.A+SK 
          SKIP   1
          SB3    DUC=DU*1S12+.A+=X_SK 
* 
          RJ     =XEMT
          ENDM
 FATAL    SPACE  4,10 
**        FATAL - MACRO TO PRINT FATAL ERROR MESSAGES 
* 
*         FATAL  E.ERR
* 
*         *ERR*  = THE NAME OF THE ERROR TO BE PRINTED. 
* 
*         WILL PRINT THE SPECIFIED ERROR AND RETURN, WITHOUT CLOBBERING 
*                MANY REGISTERS, PROVIDED THE EXIT ADDRESS FOR THAT 
*                ERROR IS *PWE1*.  CALLS *PWE*. 
*         SEE *PWE* FOR DETAILS.
  
  
 FATAL    MACRO  ADDR 
* 
 A MICRO 1,, =X 
  IF -REG,ADDR,2
 B MICRO 1,2, ADDR
  IFC EQ, "B" =X ,1 
 A MICRO
* 
          =B7    "A"ADDR
          RJ     =XPDM
 FATAL    ENDM
 HEREIF   SPACE  4,10 
**        HEREIF - DECLARE ENTRY TO KEYWORD STATEMENT SCANNER.
  
  
          MACRO  HEREIF,LOCN,KEY
 .1       IFC    NE,/LOCN// 
 KW=LOCN  BSSENT
 .1       ELSE
 A        MICRO  1,2,/KEY   / 
 .2       IFC    EQ,/"A"/C$/
 B        MICRO  3,4,/KEY   / 
 K$="B"   BSSENT
 .2       ELSE
 B        MICRO  1,4,/KEY   / 
 KW="B"   BSSENT
 .2       ENDIF 
 .1       ENDIF 
 HEREIF   ENDM
 INTF=    SPACE  4,10 
**        INTF= - MACRO TO CREATE INTRINSIC TABLE ENTRY.
* 
*         ENTRY  ".D" = (IT.JPAD) FIELD.
  
  
 INTF=    MACRO  NAME,ARGTYP,FUNTYP,NOARGS,FLAGS
 .A       SET    2
 .B       SET    NOARGS 
          IFC    EQ, NOARGS  ,1 
 .B       SET    -0 
* 
          IRP    FLAGS
 .E       MICRO  1,3,/FLAGS/
 .G       SET    7777B
 .1       ECHO   ,KY=(,PAR,NON,NAN,EXT,GEN,BYN,CHA,GNO),VL=(,1,-2,-2,4,_
,1S3,1S4,1S5,1S6) 
          IFC    EQ,/".E"/KY/,2 
 .G       SET    VL 
 .1       STOPDUP 
 .1       ENDD
          IFNE   .G,7777B,2 
 .A       SET    .A+.G
          SKIP   1
          ERR    NAME (FLAGS) ILLEGAL FLAG. 
          IRP 
* 
 .C       MICRO  1,,$NAME$
          VFD    IT.DPCL/0L".C",7/.A,3/.B,8/".D",3/M.ARGTYP,3/M.FUNTYP
* 
*                            RESERVE SLOT FOR GENERIC MODE SELECTOR 
 .G       SET    .A/1S3 
          BSS    .G-.G/2*2
 INTF=    ENDM
 JPQ      SPACE  4,10 
**        JPQ -  REDEFINE *JP* AS A *FAST JUMP* (04)
  
  
 JPQ      CPSYN  EQQ
 LITKEY   SPACE  4,10 
**        LITKEY - GENERATE KEYWORD LITERAL.
* 
* 
* LAB     LITKEY
* 
*         ENTRY  '?KWCKEY = MICRO CONTAINING KEYWORD. 
*                '?KWSKEY = LEN OF '?KWCKEY (IN CHARS, I.E. *MICCNT*).
*                LAB      = LABEL FIELD FOR THIS KEYWORD. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  NONE 
  
  
          PURGMAC LITKEY
  
          MACRO  LITKEY,LAB 
          LOCAL  '?KW#001 
* 
 '?KWCS02 MICRO 1,, 0L
 '?KWS001 SET    '?KWSKEY/7+1 
 '?KWS002 SET    1
* 
 '?KW#001 DUP    '?KWS001 
 '?KWCS01 MICRO  '?KWS002,7, "'?KWCKEY" 
 '?KWCS02 MICRO  1,, "'?KWCS02",0L"'?KWCS01"
 '?KWS002 SET    '?KWS002+7 
* 
 '?KW#001 ENDD
* 
 LAB LIT "'?KWCS02" 
* 
 LITKEY   ENDM
 LOVER    SPACE  4,10 
**        LOVER - LOAD FTN OVERLAY. 
* 
*         FORMS 3-WORD LOADER CALL AND EXITS TO LOAD REQUEST ROUTINE. 
* 
* 
*         LOVER  (P,S),LDA
*         LOVER  XR,LDA      LEVELS IN X-REG
* 
*         ENTRY  P = OVERLAY PRIMARY LEVEL NUMBER 
*                S = OVERLAY SECONDARY LEVEL NUMBER 
*                LDA = FWA TO LOAD OVERLAY
*                XR = P*64+S       LEVELS IN X-REG
*                (CP.NFLS) = LWA+1 OF LOAD
*                (FTNLFN) = LIBRARY OR FILE NAME 0L FORMAT
*                (FTNLDR) = LOADER REQUEST FLAGS
* 
*         EXIT   TO *LOVER* WITH -- 
*                (X2) = P*64+S = OVERLAY LEVELS.
*                (X7) = FWA LOAD. 
  
  
          PURGMAC LOVER 
  
 LOVER    MACRO  PS,LDA 
          LOCAL  P,S
 P        MICRO  1,,,PS,
 A        MICCNT P
 S        MICRO  A+2,,/PS/
 .1       IFC    EQ,//"S"/   IF PS CONTAINED NO COMMA 
          =X2    PS 
 .1       ELSE
          SX2    0"P"0"S"B
 .1       ENDIF 
*                            SET (X7) = FWA OF LOAD 
          =X7    LDA
          IFC    EQ,/LDA//,1
 8        ERR    LOAD ADDRESS REQUIRED ON LOVER CALL
          EQ     =XLOVER
 LOVER    ENDM
 MDERR    SPACE  4,10 
**        MDERR - MACRO TO PROCESS MACHINE DEPENDENT DIAGNOSTICS. 
* 
*         MDERR  ARG
* 
*         *ARG* = ADDRESS OF ERROR. 
  
 MDERR    MACRO  ARG
* 
 A        MICRO  1,, =X 
          IF     -REG,ARG,2 
 B        MICRO  1,2, ARG 
          IFC    EQ, "B" =X ,1
 A        MICRO 
* 
          =B7    "A"ARG 
          RJ     =XMDERR= 
 MDERR    ENDM
 PIA      SPACE  4,10 
**        PIA -  MACRO TO CONVERT INSTRUCTION ADDRESS FOR LISTING.
* 
*         PIA    FROM,TO
* 
*         FROM   = ADDRESS OF VALUE TO BE CONVERTED.
*                  *SA1 FROM* GENERATED IF NOT NULL 
*         TO     = ADDRESS OF CELL TO RECEIVE RESULT
*                  *SA6 TO* GENERATED IF NOT NULL 
*         ENTRY  X1 = VALUE, @ 2**17-1
*         EXIT   X6 = DPC CONVERSION, SUITABLE FOR LISTING, LEADING 
*                     ZEROES SUPPRESSED,
*                     FORMAT  " 123456B  "
*         CALLS PIA 
  
  
          PURGMAC PIA 
  
 PIA      MACRO  F,T
          IFC    NE,**F*,1
          SA1    F
          RJ     =XPIA
          IFC    NE,**T*,1
          SA6    T
 PIA      ENDM
 PLINE    SPACE  4,10 
**        PLINE- PRINT CODED LINE ON OUTPUT FILE. 
* 
*         PLINE  ADDR,L,N 
* 
*         *ADDR* = FWA OF LINE IN *C* FORMAT. 
*         *L*    = NUMBER OF WORDS TO BE PRINTED
*         *N*    = NUMBER OF BLANK LINES BEFORE LINE. 
* 
*         CALLS  WBL, WOF.
  
  
 PLINE    MACRO  ADDR,L,N 
          =X1    ADDR 
          =X2    L
          =B5    N+1
          RJ     =XWOF
 PLINE    ENDM
 PLUG     SPACE  4,40 
**        PLUG - MODIFY COMPILER CODE DURING EXECUTION. 
* 
*         SELF-MODIFYING (PLUGGING) CODE MAY SEEMINGLY FAIL ON CYBER
*         74 / 6600 AND LARGER MODELS, DUE TO THE HARDWARE INSTRUCTION
*         STACK AND 1- OR 2-WORD INSTRUCTION LOOKAHEAD.  BECAUSE OF THIS
*         PROBLEM, AND THE UNREADABILITY OF PLUGGED CODE, THE TECHNIQUE 
*         IS NOT DESIRABLE FOR WIDE USAGE.  EFFICIENCY CONSIDERATIONS 
*         ARE OCCASIONALLY MORE IMPORTANT, HOWEVER, SO WE FORMALIZE 
*         PLUGGING WITH THE FOLLOWING MACRO.  IT INCLUDES A SAFEGUARD 
*         AGAINST THE STACK/LOOKAHEAD PROBLEM, AND IS PREFERABLE TO 
*         DIRECT CODE FOR READABILITY AND DEBUGGING EASE. 
* 
*         TWO FORMS OF *PLUG* ARE AVAILABLE ... 
* 
* 
*         FORM 1 - PLUGS A CALLER-PROVIDED WORD OF CODE.
* 
*         PLUG      AT=,FROM=,FREG=,SREG=,VOID= 
* 
* 
*         FORM 2 - FABRICATES AND PLUGS AN -EQ- JUMP. 
*         RESTRICTION - THE 1-REGISTER METHOD USED FOR FORMING THE -EQ- 
*         JUMP IS NOT VALID IF *TO* IS .GT. 177777B ABSOLUTE.  THIS IS
*         NOT A PROBLEM IN FTN, SINCE ALL ADDRESSES ARE .LT. 100000B. 
* 
*         PLUG      AT=,TO=,SREG=,VOID= 
* 
* 
*         ENTRY  *AT*   = ADDRESS WHERE PLUG TO BE STORED.
*                *FREG* = (FORM 1 ONLY) (OPTIONAL)  NUMBER OF A,X REG 
*                         TO USE FOR FETCHING CODE WORD.  MUST BE 1-5.
*                         USES A1 AND X1 IF OMITTED.  IGNORED IF *FROM* 
*                         SPECIFIES AN X-REGISTER.
*                *FROM* = (FORM 1 ONLY)  SOURCE OF CODE WORD TO PLUG. 
*                         MAY BE AN X-REGISTER CONTAINING THE CODE WORD 
*                         ( E.G., FROM=X3 ), OR AN ADDRESS EXPRESSION.
*                *SREG* = (OPTIONAL)  NUMBER OF A,X REG TO USE FOR
*                         STORING PLUG.  MUST BE 6 OR 7.  USES X6 AND A6
*                         IF OMITTED. 
*                *TO*   = (FORM 2 ONLY)  -EQ- JUMP ADDRESS. 
*                *VOID* = (OPTIONAL)
*                         *NO* = DO NOT GENERATE STACK-VOIDING CODE.
*                         ELSE OR OMITTED = GENERATE VOIDING CODE IF
*                            "MODEL" IS CYBER 74 / 6600 OR LARGER.
* 
*         CALLS  NONE 
* 
*         USES   AS ABOVE 
  
  
          PURGMAC PLUG
  
 PLUG     MACROE AT,TO,FROM,FREG,SREG,VOID
          LOCAL  FN,SN
 SN       SET    SREG  6
          IFLT   SN,6,1 
          ERR    STORE REG MUST BE 6 OR 7.   ["SEQUENCE"]_______________
 .F1      IFC    EQ, TO 
 .F1A     IF     REG,FROM 
*                            FORM 1A - CODE WORD IN AN X-REGISTER.
 SN       OCTMIC SN,1 
 SN       MICRO  1,, X"SN"
          IFC    NE, FROM "SN" ,1 
          BX.SN  FROM 
 .F1A     ELSE
*                            FORM 1B - FETCH CODE WORD FROM *FROM*. 
 FN       SET    FREG  1
          IFGE   FN,1,2 
          IFLE   FN,5,1 
          SKIP   1
          ERR    FETCH REG NOT 1-5.  ["SEQUENCE"]____________________ 
          SA.FN  FROM 
          BX.SN  X.FN 
 .F1A     ENDIF 
 .F1      ELSE
*                            FORM 2 - FABRICATE -EQ- JUMP TO *TO*.
          SX.SN  TO 
          LX.SN  2+30D
*                            2000BS48+*JPADR*S32
          PX.SN  X.SN,B0
*                            0400BS48+*JPADR*S30
          LX.SN  -2 
 .F1      ENDIF 
*                            STORE THE PLUG.
          SA.SN  AT 
*                            GENERATE STACK-VOIDING CODE. 
          IFC    NE, VOID NO ,3 
          RJ     *+1
          EQ     *+1S17 
          BSS    0
 PLUG     ENDM
 SCAN     SPACE  4,10 
**        SCAN - MACRO TO CALL SCAN ROUTINES
* 
*         SCAN   TABLE,TYPE 
* 
*         ENTRY  TABLE = ORIGIN WORD OF TABLE TO BE SCANNED.
*                TYPE = TYPE OF SCAN TO PERFORM (NAME OF ROUTINE).
* 
*         FOR EXAMPLE,       SCAN   TS.NAM,BTR
*         GENERATES --       SA1    TS.NAM
*                            RJ     =XBTR 
  
  
 SCAN     MACRO  TABLE,TYPE 
          =A1    TABLE
          RJ     =X_TYPE
 SCAN     ENDM
 SECT     SPACE  4,10 
**        SECT - MACRO TO FORM COMMON GROUP 1 INSTRUCTIONS. 
* 
*                SEE MACRO FOR GROUP 1 INSTRUCTIONS GENERATED.
* 
* NAM     SECT   (HEAD),RNAM,NOB1 
* 
*         *NAM*  NAME OF THIS DECK
*         *HEAD* TITLE FOR THIS DECK AND FOR LOADER COMMENT 
*         *RNAM* RPVDEF NAME IF DIFFERENT FROM DECK NAME
*         *NOB1* IF NOT NULL, B1=1 WILL NOT BE DEFINED
  
  
 RPVDEF.  OPSYN  RPVDEF 
          PURGMAC SECT
  
          MACRO  SECT,NAM,HEAD,RNAM,NOB1
          IFC    NE,/NOB1//,2 
          SYSCOM
          SKIP   1
          SYSCOM B1 
          LIST   F,X
 NAM      TITLE  NAM - HEAD 
          COMMENT  HEAD 
 NAM      RPVDEF. RNAM
          NOREF  A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z
          NOREF  ON,OFF 
 SECT     ENDM
 SHRINK   SPACE  4,10 
**        SHRINK - COLLAPSE TABLE TO GIVEN LENGTH.
* 
*         SHRINK TNAM,SIZE
* 
*         TNAM   _ LENGTH WORD FOR TABLE TO BE COLLAPSED. 
*         SIZE   = NEW SIZE.  (DISASTER IF SIZE .GT. CURRENT LENGTH.) 
  
  
 SHRINK   MACRO  TNAM,SIZE
          =X6    SIZE 
* 
 A MICRO 1,, =X 
  IF -REG,TNAM,2
 B MICRO 1,2, TNAM
  IFC EQ, "B" =X ,1 
 A MICRO
* 
          =A6 "A"TNAM 
 SHRINK   ENDM
 SUBKEY   SPACE  4,10 
**        SUBKEY - DEFINE SUB-KEYWORD.
* 
* 
*         THIS MACRO IS USED TO DEFINE ENTRIES IN THE VARIOUS 
*         SUB-KEYWORD TABLES. 
* 
*         EXAMPLES -- 
* 
*         SUBKEY REAL,TYP=REAL
*         SUBKEY INTEGER,TYP=INT
* 
*         FORM -- 
* 
*         SUBKEY KEY,INFO 
* 
*         ENTRY  KEY  = KEYWORD.
*                INFO = INFORMATION.  THE *INFO* FIELD CONTAINS 
*                       INFORMATION THAT CAN BE USED SOME WAY 
*                       TO UNIQUELY DISTINGUISH THIS SUB-KEYWORD, 
*                       E.G. A SUB-KEYWORD TYPE CODE, OR A PROCESSOR
*                       ADDRESS.  THAT IS TO SAY, THE MEANING OF THE
*                       *INFO* FIELD IS DETERMINED ARBITRARILY BY 
*                       ITS USER. 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  LITKEY 
  
  
          PURGMAC SUBKEY
  
 SUBKEY   MACRO  KEY,INFO 
          LOCAL  '?KW#001 
* 
 '?KWCKEY MICRO 1,, KEY 
 '?KWSKEY MICCNT '?KWCKEY 
* 
 '?KWS001 SET 60-KW.INFOP-KW.INFOL
 '?KWS002 SET KW.INFOP-KW.LENP-KW.LENL
* 
  VFD '?KWS001/0,KW.INFOL/INFO,'?KWS002/0,KW.LENL/'?KWSKEY*CHAR,________
,KW.KEYL/'?KW#001 
* 
 '?KW#001 LITKEY
* 
 SUBKEY   ENDM
 SYMASK   SPACE  4,10 
**        SYMASK - MACRO TO GENERATE MASKS OF SYMBOLIC FIELDS.
* 
* LOC     SYMASK (FIELD1,FIELD2,...,FIELDN) 
* 
*         *LOC*  = NAME OF THE LITERAL TO BE GENERATED. 
*                IF LOCATION FIELD IS BLANK, LITERAL WILL NOT BE CREATED
*                AND MICRO NAMED "E" CONTAINS THE 20-OCTAL DIGIT VALUE. 
*         FIELD(I) ARE SYMBOLIC NAMES OF FIELDS TO BE SET.
*                GENERATES A LITERAL WITH 1-BITS IN SPECIFIED FIELDS, 
*                AND 0-BITS ELSEWHERE.  THE DESIGNATED FIELDS MUST HAVE 
*                FIELD_P DEFINITIONS (SEE *DEFINE* MACRO).
  
  
          MACRO  SYMASK,LOC,FLD 
 C        MICRO  1,60, 0000000000_0000000000_0000000000_0000000000_00000
,00000_0000000000 
* 
          IRP    FLD
*                            NUMBER OF BITS IN THIS FIELD 
 A        SET    1
          IF     DEF,FLD_L,1
 A        SET    FLD_L
 A        MICRO  1,A, 1111111111_1111111111_1111111111_1111111111_111111
,1111_1111111111
*                            EXTRACT TRAILING BITS
 .1       IFEQ   FLD_P
 B        MICRO 
 .1       ELSE
 B        MICRO  61-FLD_P,, "C" 
 .1       ENDIF 
*                            EXTRACT LEADING BITS 
 .1       IFEQ   60-FLD_P-A 
 D        MICRO 
 .1       ELSE
 D        MICRO  1,60-FLD_P-A "C" 
 .1       ENDIF 
*                            MERGE NEW PIECES 
 C        MICRO  1,60, "D""A""B"
          IRP 
*                            CONVERT BINARY TO OCTAL
 E        MICRO 
 E        SET    0
 .1       DUP    60D/3
 E        SET    E+1
 F        MICRO  3*E-2,1, "C" 
 G        MICRO  3*E-1,1, "C" 
 H        MICRO  3*E-0,1, "C" 
 F        OCTMIC "F"*4+"G"*2+"H",1
 E        MICRO  1,, "E""F" 
 .1       ENDD
* 
          IFC    NE,  LOC ,1
 LOC      LIT    "E"B 
 SYMASK   ENDM
 TAGSEX   SPACE  4,10 
**        TAGSEX - TAG INVENTED EXTERNAL. 
* 
*         TAGSEX (=0LNAME"EXT") 
*         TAGSEX ADDR 
* 
*         ENTRY  ADDR = ADDRESS OF WORD CONTAINING NAME OF EXTERNAL 
*                            WITH THE "EXT" SUFFIX PRESENT. 
*                            (-L- FORMAT).
*                IF *ADDR* IS *A1*, THEN (X1) MUST CONTAIN THE NAME.
* 
*         TO BE USED FOR ENTERING ALL "INVISIBLE" EXTERNALS IN
*         THE SYMBOL TABLE. 
* 
*         CALLS  FEC/TSX. 
  
  
 TAGSEX   MACRO  ADDR 
          =A1    ADDR 
          RJ     =XTSX
 TAGSEX   ENDM
 TRIV     SPACE  4,10 
**        TRIV  - MACRO TO PRINT TRIVIAL ERROR MESSAGES 
* 
*         TRIV   E.ERR
* 
*         *ERR*  = THE NAME OF THE ERROR TO BE PRINTED. 
* 
*         SEE *FATAL* MACRO.
  
  
 TRIV     OPSYN  FATAL
 TRUBL    SPACE  4,20 
**        TRUBL - COMPILER MAL-FUNCTION FLAG. 
* 
*         TRUBL 
* 
*         GENERATES A JUMP OUT OF BOUNDS. 
  
  
 TRUBL    MACRO  NAM
          EQ     "BLOWUP" 
 TRUBL    ENDM
 WARN     SPACE  4,10 
**        WARN  - MACRO TO PRINT WARN ERROR MESSAGES
* 
*         WARN   E.ERR
* 
*         *ERR*  = THE NAME OF THE ERROR TO BE PRINTED. 
* 
*         SEE *FATAL* MACRO.
  
  
 WARN     OPSYN  FATAL
 WCODE    SPACE  4,10 
**        WCODE - WRITE CODE TO PREBIN. 
* 
*         WCODE  XR 
*         WCODE  XR,RETURN
* 
*         ENTRY  *XR* = AN *X* REGISTER IN (PB.) FORMAT.
*                       CAN ALSO BE ANY X-REG BOOLEAN EXPRESSION
*                       PERMITTED BY THE HARDWARE.
*                            (X7) IS NATURAL REGISTER.
*                *RETURN* = OPTIONAL RETURN ADDRESS.
*                *RETURN* OMITTED = CONTINUE IN LINE. 
*                            (B2) IS NATURAL REGISTER.
*         CALLS  WIN. 
  
  
 WCODE    MACRO  XR,RET 
          IFC    NE,/X7/XR/,1 
          BX7    XR 
          =B2    RET  *+2-*P/60D
          JP     =XWIN
 WCODE    ENDM
 =XLIB    SPACE  4,8
**        =XLIB - DEFINE EXTERNAL ROUTINE NAME
* 
*         APPENDS "EXT" TO  EXTERNAL ROUTINES THAT ARE USED BY GENERATED
*         OBJECT CODE TO PROCESS FORTRAN STATEMENTS, IN ORDER TO ELIM-
*         INATE RESERVED WORDS. 
  
  
          MACRO  =XLIB,LOC,NAME 
 LOC      DATA   L/NAME"EXT"/ 
 =XLIB    ENDM
          TITLE  SYMBOL DEFINITIONS.
 PASS=    SPACE  4,10 
**        PASS= - CONTROL ACTIONS OF TABLE MANAGER. 
  
  
          LOC    0
 PASS=FE  BSS    1           FRONT END PROCESSING 
 PASS=QCG BSS    1           CODE GENERATION WITH QUICK CODE GENERATOR
 PASS=CCG BSS    1           CODE GENERATION WITH CYBER CODE GENERATOR
 PASS=END BSS    1           RELOCATE SYMBOL TABLES 
 PASS=MAP BSS    1           DURING REFERENCE MAP PROCESSING
 PASS=FAS BSS    1           ASSEMBLING PREBINARY 
          LOC    *O 
 IC.      SPACE  4,10 
**        ICDEF - CREATE AN I/O CONTROL VALUE AND LABEL.
* 
*         ICDEF  ICN
* 
*         ENTRY  ICN = NAME OF I/O CODE TO BE DEFINED.
  
  
          MACRO  ICDEF,NAME,NULL
          IFC    EQ,  NAME ,2 
          BSS    1
          SKIP   1
 IC.NAME  BSS    1
 ICDEF    ENDM
  
*CALL     COMSIOC            DEFINE I/O CONTROL CODES 
  
 IC=LEN   EQU    IC.FMTA+1
 O.       SPACE  4,30 
**        ODEF - DEFINE TOKEN VALUES. 
* 
*         TOKENS ARE THE PRIMARY FORM OF INPUT TO THE FRONT END OF THE
*         COMPILER PROPER.  *LEX* READS SOURCE LINES AND GENERATES
*         THE TOKENS COMPRISING A STATEMENT INTO (T.TB), THE TOKEN
*         BUFFER.  SEE GID AND LEX IMS FOR DETAIL CONTENTS OF TOKENS. 
* 
*         NOTICE THAT NOT ALL TOKENS CORRESPOND DIRECTLY TO FORTRAN 
*         SOURCE LANGUAGE CONSTRUCTS.  SOME ARE INVENTED INTERNALLY,
*         BUT THEY ARE QUITE REAL TO THE PARSER.
* 
*         SEVERAL PARALLEL TABLES MUST BE KEPT IN SYNCH WITH THESE
*         VALUES:        (  LO  ..  HI  )         DECK -- 
*                CHARMAP (O.DEF .. O.ERR)         FEC 
*                F.CONO  (O.DEF .. O.ILL)         PAR 
*                F.POPNX (O.DEF .. O.ILL)         PAR 
*                F.PRIOR (O.SEP .. O.ILL)         PAR 
  
 MAX.ORD  EQU    42D         BITS AVAILABLE IN (F.CONO) 
  
  
          MACRO  ODEF,NAME,EQUATE 
          IFC    NE,  EQUATE ,2 
 O.NAME   EQU    O.EQUATE 
          SKIP   1
 O.NAME   BSS    1
 ODEF     ENDM
  
          LOC    0           INITIALIZE DEFINITION ORDINAL COUNTER
  
 DEF      ODEF               ---- BEGINNING OF TOKENS 
 EOS      ODEF   DEF
 BOS      ODEF   DEF
*                            FOLLOWING ARE OPERANDS 
 HOLL     ODEF               NH...       HOLLERITH CONSTANT 
 QHOLL    ODEF               "           QUOTE HOLLERITH CONSTANT 
 RLCON    ODEF               R"          RIGHT ZERO FILLED HOLLERITH
                             L"          LEFT ZERO FILLED HOLLERITH 
 CHAR     ODEF               '           CHARACTER CONSTANT 
 CONS     ODEF               0 .. 9      DECIMAL DIGITS 
 OCT      ODEF               O"          OCTAL DIGITS 
 HEX      ODEF               X"          HEXADECIMAL DIGITS 
 PERIOD   ODEF               .
 VAR      ODEF               A .. Z      ALPHABETIC 
 TRUE     ODEF               .TRUE.      LOGICAL CONSTANTS
 FALSE    ODEF               .FALSE.
  
 SEP      ODEF               ---- BEGINNING OF SEPARATORS 
*                            FOLLOWING ARE OPERATORS TO CONRED
 PL       ODEF   SEP
 MIN      ODEF
 STAR     ODEF
 MULT     ODEF   STAR 
 SLASH    ODEF
 DIV      ODEF   SLASH
 UMIN     ODEF               UNARY -
 EXP      ODEF               ** 
 LT       ODEF
 GE       ODEF
 EQ       ODEF
 NE       ODEF
 LE       ODEF
 GT       ODEF
 NOT      ODEF
 AND      ODEF
 XOR      ODEF
 NEQV     ODEF
 EQV      ODEF
 OR       ODEF
 CAT      ODEF               // 
  
*                            FOLLOWING DELIMIT EXPRESSIONS
 LP       ODEF
 (        ODEF   LP 
 RP       ODEF
 )        ODEF   RP 
 =        ODEF
 COMMA    ODEF
 SDEF     ODEF   COMMA
 COLON    ODEF               :  
 SLP      ODEF               SPECIAL LEFT PAREN 
 FLP      ODEF   SLP
 ILP      ODEF   SLP
 STFA     ODEF               FORMAL PARAMETER TO USER STATEMENT FUNCTION
 ILL      ODEF               ---- END OF SEPARATORS 
  
*         FOLLOWING TOKENS ARE NEVER PARSER INPUT, BUT CAN VALIDLY
*         APPEAR FOLLOWING A LEGAL INPUT TOKEN. 
  
 DOBI     ODEF               I/O DO BEGIN 
 ENDNX    ODEF   DOBI        ---- END OF VALID FOLLOWERS
  
*         FOLLOWING TOKENS ARE NEVER SEEN AS PARSER INPUT, NOR ON 
*         THE PARSING STACKS. 
  
 DOCI     ODEF               I/O DO CONCLUSION
 DCBI     ODEF               I/O DO COLLAPSE BEGIN
 DCCI     ODEF               I/O DO COLLAPSE CONCLUSION 
 SPACE    ODEF
 NONE     ODEF               (QCG) = NEITHER     OPERAND USE-COUNTED
 1ST      ODEF               (QCG) = ONLY FIRST  OPERAND USE-COUNTED
 2ND      ODEF               (QCG) = ONLY SECOND OPERAND USE-COUNTED
 BOTH     ODEF               (QCG) = BOTH       OPERANDS USE-COUNTED
 ARY      ODEF               SUBSCRIPTED ARRAY LOAD (PAR TO QCG)
 MODC     ODEF               MODE CONVERSION (INFERNAL TO PARSER) 
 MXP      ODEF               BOUNDARY MARKER (INTERNAL TO PARSER) 
 SQOT     ODEF               SINGLE QUOTE    (INTERNAL TO LEX)
 DQOT     ODEF               DOUBLE QUOTE    (INTERNAL TO LEX)
 ERR      ODEF               SOURCE PROGRAM FATAL ERROR 
                             ---- O.ERR MUST BE LAST TOKEN VALUE
          LOC    *O 
 .1       SET    O.ERR-O.DEF       TOTAL NUMBER OF TOKENS 
          ERRMI  60-.1       TOO MANY TOTAL TOKEN TYPES 
 .1       SET    O.ENDNX-O.DEF     NUMBER OF PARSABLE TOKENS
          ERRMI  MAX.ORD-.1  TOO MANY TOKEN TYPES 
 CH.      SPACE  4,10 
**        CHARMAP DESCRIPTORS 
* 
  
          DESCRIBE CH.
 DPC      DEFINE 7*CHAR      ALPHA DESCRIPTION OF CHARACTER 
 OPC      DEFINE 18          TOKEN TYPE 
 MICROS   SPACE  4,20 
**        ALL GLOBAL MICROS.
  
  
 CCROPS   BITMIC (O.PL,O.MIN,O.STAR,O.SLASH,O.UMIN) 
 C$*      LETMIC C$*         BIT MASK FOR CONTINUATION CARDS. 
 NUM09    LETMIC 0123456789  BIT MASK FOR NUMBERS *0 - 9* 
  
 INT      LETMIC IJKLMN 
 REAL     LETMIC ABCDEFGHOPQRSTUVWXYZ 
  
 IOSEP    BITMIC (O.EOS,O.COMMA)
 SPOP     BITMIC (O.SLP,O.LP) 
  
 O.BOS    MICRO  1,, B0 
          IFEQ   O.HOLL,1,1 
 O.HOLL   MICRO  1,, B1 
  
 M.SEP    BITMIC (O.COMMA,O.SLASH,O.RP) 
 M.SEP1   BITMIC (O.COMMA,O.SLASH,O.LP) 
  
 LEGT     BITMIC (O.LE,O.GT)
 DUC=     SPACE  4,10 
**        SOME SYMBOLS FOR EMIT MACRO.
  
  
 DUC=     =      0           DUC.NONE 
 DUC=NONE =      0           DUC.NONE 
 DUC=1ST  =      1           DUC.1ST
 DUC=2ND  =      2           DUC.2ND
 DUC=BOTH =      3           DUC.BOTH 
 PSUD     TITLE  PSEUDO-INSTRUCTION DEFINITIONS.
 PSUD     SPACE  4,10 
**        PSUD - CREATE A PSEUDO INSTRUCTION LABEL AND VALUE. 
* 
*         PSUD   PSN
* 
*         PSN -  NAME OF PSEUDO TO BE DEFINED.
* 
*         SAMPLE CALL --
* 
*         PSUD   APL         WILL PRODUCE   OC$APL, WHERE  0<OC$APL<77B.
  
  
          PURGMAC PSUD
  
 PSUD     MACRO  PSN
 OC$PSN   BSS    1
 PSUD     ENDM
  
 IPSUD    SPACE  4,10 
**        IPSUD -            CREATE A PSEUDO INSTRUCTION LABEL AND VALUE
* 
*         IPSUD  PSNAME 
* 
*         PSNAME -           NAME OF PSEUDO TO BE DEFINED.
* 
*         SAMPLE CALL-- 
* 
*         IPSUD  UJP         WILL PRODUCE   I.UJP, WHERE  0<I.UJP<77B.
  
  
          PURGMAC IPSUD 
  
 IPSUD    MACRO  PSNAME 
 I.PSNAME BSS    1
 IPSUD    ENDM
  
*CALL     COMSPSU            PSEUDO INSTRUCTION DEFINITIONS 
  
*CALL     COMSPBD            PREBINARY STRUCTURE DECLARATIONS.
  
*CALL     COMSSYM            SYMBOL TABLE STRUCTURE DECLARATIONS. 
  
          TITLE  TABLE AND STRUCTURE DECLARATIONS.
 TG.      SPACE  4,10 
**        TG. - GENERAL TAG FIELD LAYOUT. 
* 
*         ****   THIS FORMAT IS OBSOLETE (AS OF FRAG 4).  SEE (PB.) 
*                DEFINITION FOR TAG FIELD LAYOUT. 
*                THE (TG.) DEFINITIONS MAY BE REMOVED WHEN *QCG*
*                CONVERTS TO THE NEW WORLD. 
  
  
          DESCRIBE  TG.,18
 PFX      DEFINE 5
 ORD      DEFINE 13 
 TB.      SPACE  4,10 
**        T.TB - TOKEN BUFFER.
  
  
          DESCRIBE TB.
 TOC      DEFINE 42          TOKEN CHARACTER STRING 
 TOT      DEFINE 18          TOKEN TYPE (VALUE) 
  
*         FOR HOLLERITH CONSTANTS.
  
          REDEF 
 SHC      DEFINE 18          HOLLERITH CONSTANT TAG 
 CLCN     DEFINE 15          LENGTH (IN CHARACTERS) 
 LCON     DEFINE 9           LENGTH (IN WORDS)
 TOT      DEFINE 18          TOKEN TYPE (VALUE) 
  
*         FOR STATEMENT FUNCTION DUMMY ARG. TOKENS (O=STFA).
  
          REDEF 
 ORD      DEFINE 12          SYMORD OF FORMAL PARAMETER 
 DAC      DEFINE 12          DUMMY ARG. REFERENCE CHAIN 
 ACTE     DEFINE 18          ACTUAL PARAM. ADDRESS IN ESTACK
 TOT      DEFINE 18          TOKEN TYPE (= O.STFA)
  
*         FOR PARENTHESES.
*                'IOIX' ONLY ON I/O LOOP LPAREN.
*                'IOSP' ONLY ON I/O LOOP RPAREN.
*                RPAREN HAS ONLY 'IOSP' AND 'TOT'.
  
          REDEF 
 COL      DEFINE             THIS PAREN LEVEL INCLUDES A COLON
 EQL      DEFINE             THIS PAREN LEVEL INCLUDES AN EQUAL SIGN
 SBS      DEFINE             THIS IS AN ARRAY SUBSTRING LPAREN
          DEFINE 3
 IOCP     DEFINE 18          POINTER TO MATCHING PAREN
 LLP      DEFINE 18          POINTER TO NEXT OUTER LEFT PAREN 
 IOIX     DEQU   LLP         POINTER TO LOOP INDEX
 IOSP     DEQU   LLP         MARKS I/O LOOP RPAREN FOR PAR
 TOT      DEFINE 18          TOKEN TYPE (VALUE) 
  
*         FOR I/O DO-COLLAPSE BEGIN.
  
          REDEF 
          DEFINE 6
 IBCP     DEFINE 18          POINTER TO CLOSING RIGHT PAREN 
 IBCC     DEFINE 18          POINTER TO COLLAPSE CONCLUSION TOKEN 
 TOT      DEFINE 18          TOKEN TYPE (VALUE) 
  
*         FOR I/O DO-COLLAPSE CONCLUSION. 
  
          REDEF 
          DEFINE 6
 ICIX     DEFINE 18          INDEX (INTO TABLE OF CONTROL INDICIES) 
 ICCP     DEFINE 18          POINTER TO CLOSING RIGHT PAREN 
 TOT      DEFINE 18          TOKEN TYPE (VALUE) 
 T.COMM   SPACE  4,20 
**        T.COMM - COMMON TAG TABLE.
* 
*         CONTAINS TRANSLATED *COMMON* STATEMENTS.  VARIABLE TAGS ARE 
*         ENTERED INTO (T.COMM) IN THE SAME ORDER AS THEY OCCUR IN THE
*         *COMMON* STATEMENT(S).  AT CLOSE OF DECLARATIVES, THIS TABLE
*         IS PROCESSED (BY DECL/MCA) TO YIELD ADDRESSES OF VARIABLES IN 
*         COMMON, AND TO RESOLVE LEVEL INFO FOR BLOCKS.  IT IS THEN 
*         THROWN AWAY.
  
  
*         +-----------------+------+------------+----------------------+
*         +                 +//////+            +                      +
*         +   SYMBOL TAG    +//////+   LINK     +          RA          +
*         +                 +//////+            +                      +
*         +-----------------+------+------------+----------------------+
*                  18           6        12                 24
  
  
          DESCRIBE CT.
 TAG      DEFINE 18          SYMBOL TAG 
          DEFINE 6           MUST BE ZERO 
 LNK      DEFINE 12          POINTER TO NEXT MEMBER IN THIS BLOCK 
 RA       DEFINE WC.RAL      BLOCK REL ADDR 
 T.DIM    EJECT 
**        T.DIM - DIMENSION TABLE.
* 
*         FOR EACH UNIQUE DIMENSIONALITY DESCRIPTION, ONE HEADER WORD 
*         WILL BE PRODUCED. 
* 
*         FOR EACH DIMENSION OF A DESCRIPTOR, A PAIR OF DIMENSION WORDS 
*         WILL BE PRODUCED. 
* 
*         HEADER WORD 
* 
*         +-+-+-+-+--+----------------------+-------------------+-----+ 
*         +V+A+V+M+//+                      +                   +     + 
*         +D+S+P+A+//+   PRODUCT OF SPANS   +        RA         + DIM + 
*         + + + +T+//+                      +                   +     + 
*         +-+-+-+-+--+----------------------+-------------------+-----+ 
*          1 1 1 1 2             24                  24            6
* 
*         DIMENSION WORD ONE
* 
*         +-----------------------------+-+-----+---------------------+ 
*         +/////////////////////////////+T+/////+                     + 
*         +/////////////////////////////+D+/////+        SPAN         + 
*         +/////////////////////////////+M+/////+                     + 
*         +-----------------------------+-+-----+---------------------+ 
*                        30              1   5            24
* 
*         DIMENSION WORD TWO
* 
*         +-+-----+---------------------+-+-----+---------------------+ 
*         +T+/////+                     +T+/////+                     + 
*         +D+/////+     LOWER BOUND     +D+/////+     UPPER BOUND     + 
*         +M+/////+                     +M+/////+                     + 
*         +-+-----+---------------------+-+-----+---------------------+ 
*          1   5             24          1                 24 
 DIM/DH.  SPACE  4,10 
**        DIM/DH - HEADER WORD. 
  
  
          DESCRIBE  DH. 
  
 ATTR     DEFINE 6           DIMENSION TABLE ENTRY ATTRIBUTES 
 PS       DEFINE 24          PRODUCT OF SPANS 
 RA       DEFINE 24          RELATIVE ADDRESS OF RUN TIME DIM TABLE 
 DIM      DEFINE 6           NUMBER OF DIMENSIONS 
  
          REDEF  ATTR 
 VD       DEFINE             INDICATES ADJUSTABLE DIMENSION PRESENT 
 AS       DEFINE             INDICATES ASSUMED SIZE ARRAY 
 VP       DEFINE             INDICATES VARIABLE PRODUCT OF SPANS
 MAT      DEFINE             RUN TIME DIMENSION TABLE MUST MATERIALIZE
 DIM/D1.  SPACE  4,10 
**        DIM/D1 - DIMENSION WORD ONE.
  
  
          DESCRIBE  D1.,,,0 
  
          DEFINE 30 
 SPAN     DEFINE 30          UB-LB+1      (DI. FORMAT)
 DIM/D2.  SPACE  4,10 
**        DIM/D2 - DIMENSION WORD TWO.
  
  
          DESCRIBE  D2.,,,1 
  
 LB       DEFINE 30          LOWER BOUND  (DI. FORMAT)
 UB       DEFINE 30          UPPER BOUND  (DI. FORMAT)
 DIM/DI.  SPACE  4,10 
**        DI. - DIMENSION INFORMATION LAYOUT
  
  
          DESCRIBE  DM.,30
  
 TD       DEFINE             =1 IF THIS DIMENSION VARIABLE
                             =0 IF NOT
          DEFINE 5
 INF      DEFINE 24          DIMENSION INFORMATION
                             = CONSTANT IF TD=0 
                             = VD. BIAS POINTER IF TD=1 
  
 Z=DD     EQU    2           LENGTH OF DIMENSION DESCRIPTOR 
 T.BLST   SPACE  4,20 
**        T.BLST - BLOCK STRUCTURE TABLE (DO LOOPS AND BLOCK IFS) 
* 
*         T.BLST IS A PARTITIONED TABLE, EACH SEGMENT PERTAINING TO A 
*         BLOCK STRUCTURE, WITH NESTING DEFINED BY THIS TABLE.  EACH
*         SEGMENT CONSISTS OF THREE PARTS:  
* 
*         1. BLOCK DEFINITION TABLE (Z=BLST LENGTH) 
*         2. LABEL LIST (VARIABLE LENGTH. ONE WORD FOR EACH LABEL 
*            DEFINED OR REFERENCED WITHIN THE BLOCK)
*         3. COUNT/ORIGIN WORD (ONE WORD) 
  
  
*         BLOCK DEFINITION TABLE. 
  
*         DO LOOP INFORMATION TABLE.
*         (DOCI) MUST BE A SYMBOL TABLE ORDINAL.
*         (DORT) IS SYMBOL TABLE ORDINAL OF CGS "DO.NNN". 
*         (DOSI,DOLI AND DOII) ARE CGS TRIP COUNT SYMBOLS.
  
          LOC    0
 DOSI.W   BSS    1           (TP.)     M1  INITIAL VALUE
 DOLI.W   BSS    1           (TP.)     M2  LIMIT VALUE
 DOII.W   BSS    1           (TP.)     M3  INCREMENT VALUE, THEN (DI.N) 
 DOCI.W   BSS    1           (TP.)         CONTROL INDEX
 DORT.W   BSS    1           (TP.)         INVENTED LABEL OF LOOP-TOP 
 DO.W     BSS    1           (DO.)         DO TERMINATING LABEL 
 DOTC.W   BSS    1           (TP.)         TRIP COUNT 
 DP.W     BSS    1           (DP.)         DOXL / DOTI / TURC 
  
 Z=BLST   BSS                LENGTH OF BLOCK STRUCTION BASIC ENTRY
          LOC    *O 
  
  
  
*         EQUIVALENCED SYMBOLS FOR BLOCK IF USAGE 
  
 BLIB.W   EQU    DOSI.W      (TP.) INVENTED LABEL OF BLOCK BOTTOM 
                                   (ENDIF)
 BLIA.W   EQU    DOLI.W      (TP.) INVENTED LABEL OF NEXT FALSE BRANCH
                                   (ELSEIF, ELSE, ENDIF)
 BLIC.W   EQU    DO.W        USED TO ZERO THIS LOCATION FOR BLOCK *IFS* 
  
          DESCRIBE  DO.,,,DO.W
 FLG      DEFINE 18          DO BEGIN TURPLE RELATIVE ADDRESS 
          DEFINE 6
 TAG      DEFINE 18          DO TERMINATING LABEL, IF NOT I/O LOOP
 IOD      DEFINE 18          .NZ.,                 IF I/O LOOP
  
  
          DESCRIBE  DP.,,,DP.W
 DOXL     DEFINE 18          GL ORDINAL OF DO-EXIT, IF ZERO TRIP
          DEFINE 6
 DOTI     DEFINE 18          SYMORD OF TRIP COUNT VARIABLE
 TURC     DEFINE 18          CONCLUSION SKELETON
  
  
*         COUNT/ORIGIN WORD - LC. 
  
*         +-+----+----------------+-----------------+-----------------+ 
*         +G+////+                +                 +    SEGMENT      + 
*         +L+////+    DO INDEX    +   ORIGIN LINE   +      WORD       + 
*         +M+////+                +                 +     COUNT       + 
*         +-+----+----------------+-----------------+-----------------+ 
*          1   5        18                 18                18 
  
  
*         LABEL WORD - LA.
  
*         +-+-+-+-+---------------------------------+-----------------+ 
*         +D+R+E+E+/////////////////////////////////+                 + 
*         +E+E+X+N+/////////////////////////////////+  LABEL ORDINAL  + 
*         +F+F+T+T+/////////////////////////////////+                 + 
*         +-+-+-+-+---------------------------------+-----------------+ 
*          1 1 1 1              38                           18 
  
  
**        COUNT/ORIGIN WORD - LC. 
  
          DESCRIBE LC.
  
 GLM      DEFINE             GENERATED LABEL MATERIALIZE (BOTTOM) 
          DEFINE 5
 DO       DEFINE 18          DO LOOP HEADER LABEL INDEX 
 LINE     DEFINE 18          BLOCK ORIGIN SOURCE LINE 
 CNT      DEFINE 18          WORDS IN CURRENT SEGMENT 
                             (Z=BLST + 1 + NO. OF LABELS IN BLOCK)
  
**        LABEL WORD - LA.
  
          DESCRIBE LA.
  
 DEF      DEFINE 1           LABEL DEFINED IN STRUCTURE 
 REF      DEFINE 1           LABEL REFERENCED IN STRUCTURE
 EXT      DEFINE 1           LABEL IS EXIT FOR DO LOOP
 ENT      DEFINE 1           LABEL IS ENTRY FOR DO LOOP 
 ALRN     DEFINE 1           LABEL REFERENCED BY A *ALTERNATE RETURN* 
 GOTO     DEFINE 1           LABEL REFERENCED(NOT AN *ALTERNATE RETURN*)
          DEFINE 36 
 ORD      DEFINE 18          LABEL SYMBOL TABLE ORDINAL 
 T.EC     SPACE  4,10 
**        T.ECT - EQUIVALENCE CLASS TABLE.
* 
*         USED TO ACCUMULATE FINAL EQUIVALENCE CLASS INFORMATION DURING 
*         EQUIVALENCE PROCESSING AND KEPT UNTIL REFMAP TIME.
  
  
          DESCRIBE EC.,60 
 SYM      DEFINE 12          ORDINAL OF SYMTAB WORD B 
 BIAS     DEFINE WC.RAL      BIAS OF MEMBER FROM CLASS BASE 
 SPAN     DEQU   BIAS        SPAN OF EQUIVALENCE CLASS
 SIZE     DEFINE 24          LENGTH OF MEMBER 
 NM       DEQU   SIZE        NUMBER OF MEMBERS IN THIS CLASS
 T.EQUS   SPACE  4,10 
**        T.EQUS - EQUIVALENCE TAG TABLE. 
* 
*         USED TO ACCUMULATE EQUIVALENCE INFORMATION DURING DECLARATIVE 
*         PROCESSING.  THROWN AWAY AFTER IT IS PROCESSED INTO THE 
*         THE SYMTAB AT CLOSE OF DECLARATIVE STATEMENT PROCESSING.
  
  
          DESCRIBE EQ.,60 
 LINK     DEFINE 12          INDEX OF MEMBER IN SOURCE GROUP
 SUBS     DEFINE 48          ITH SUBSCRIPT OF THIS EQUIVALENCED ITEM
          REDEF  SUBS 
 STF      DEFINE WC.CLENL    SUBSTRING-FIRST (FOR CHARACTER ITEM) 
 ISUB     DEFINE 1           IF ITEM SUBSCRIPTED
 SYMI     DEFINE 29          SYMBOL TABLE WB INDEX
 T.ECT    SPACE  3,10 
**        T.ECT - TEMPORARY EQUIVALENCE CLASS TABLE 
*                 FOR REFMAP GENERATION.
  
          DESCRIBE  TE.,60
 EOI      DEFINE 12          INDEX TO T.EOT OA. 
          DEFINE 5           0
 NB       DEFINE 1           NON - BASE BIT, .EQ. 1 IF NOT BASE MEMBER
 BIAS     DEFINE WC.RAL      BIAS OF MEMBER FROM CLASS BASE 
 SYMI     DEFINE 18          INDEX OF SYMTAB WA 
 T.PAR    EJECT 
**        T.PAR - PARSED FILE (IL). 
* 
*         (T.PAR) ACCUMULATES THE INTERMEDIATE LANGUAGE TURPLES 
*         GENERATED BY THE FRONT END. 
  
  
**        PARSED FILE ENTRY ORDINAL DEFINITIONS.
*         ORDINALS ARE GIVEN RELATIVE TO EACH TURPLE. 
  
          LOC    0
 OR.OPR   BSS    1           (TH.)     OPERATOR 
 OR.1OP   BSS    1           (TP.)     (P1) = LEFT (OR ONLY) OPERAND
 OR.2OP   BSS    1           (TP.)     (P2) = RIGHT OPERAND 
  
 Z=TURP   BSS                LENGTH OF EACH TURPLE
          LOC    *O 
 TH.      SPACE  4,20 
**        TH. - TURPLE HEADER FORMAT. 
* 
*         THE HEADER WORD OF EACH TURPLE DESCRIBES THE OPERATOR.
  
  
          DESCRIBE  TH.,,,0 
 SKEL     DEFINE 14          SKELETON INDEX OR RELATIVE ADDRESS 
 LINE     DEFINE 18          LINE/SEQUENCE NO. (1ST TURPLE OF STATEMENT)
 QATR     DEFINE 4           ATTRIBUTES FOR QCG 
 CATR     DEFINE 2           ATTRIBUTES FOR BRIDGE
 MODE     DEFINE 4           TYPE OF RESULT 
          DEFINE 9
 OVAL     DEFINE 9           OPERATOR VALUE INDEX (O.DEF) 
  
          REDEF  LINE 
 DVAL     DEFINE 24          DATA CONSTANT REDUCTION VALUE (T.DAR)
 DDEF     DEFINE             DATA DEFINED 
  
          REDEF  CATR 
 PAP      DEFINE             FIRST TURPLE OF AN ARGUMENT
 PFP      DEFINE             FIRST PAP OF AN ARGUMENT LIST
  
          REDEF  QATR 
 NSTD     DEFINE             (SKEL) IS A ROUTINE, NOT AN EXPANSION
 PLC      DEFINE             OPERAND IS CONCAT OF PASSED LENGTH ITEM
 1DUC     DEFINE             (1OP) IS REGISTER ALLOCATED
 2DUC     DEFINE             (2OP) IS REGISTER ALLOCATED
 SP.      SPACE  4,20 
**        SP. - STACK (SETOP) TURPLE HEADER FORMAT. 
* 
*         SP. IS THE FORMAT OF THE HEADER WORD USED DURING PARSING. 
*         THE SP. FORMAT WORD IS TRANSFORMED TO TH. FORMAT WHEN A TURPLE
*         IS EMITTED. 
  
  
          DESCRIBE  SP.,,,0 
 SKEL     DEFINE 18          SKELETON INDEX OR RELATIVE ADDRESS 
 1ATR     DEFINE 14          PARSING ATTRIBUTES 
          DEFINE 6
 MODE     DEFINE 4           TYPE OF RESULT (FROM POPPER) 
 STPR     DEFINE 9           STACK PRIORITY 
 MODC     DEQU   STPR        MODE COERCION (IN POP) 
 TBPR     DEFINE 9           TOKEN BUFFER PRIORITY INDEX (O.DEF)
  
          REDEF  1ATR 
 NSQZ     DEFINE             TURPLE IS NOT SQUEEZABLE 
 UNAR     DEFINE             UNARY OPERATOR 
 MDLS     DEFINE             MODELESS OPERATOR
 DIS      DEFINE             ALGEBRAICALLY DISTRIBUTIVE 
 COM      DEFINE             ALGEBRAICALLY COMMUTATIVE
 AS       DEFINE             ALGEBRAICALLY ASSOCIATIVE
 MASK     DEFINE             MASKING/LOGICAL OPERATOR 
 CHAR     DEFINE             CHARACTER OPERANDS ALLOWED 
 SMD      DEFINE             SPECIFIC MODE DETERMINED 
 BND      DEFINE             TURPLE OK FOR DIMENSION BOUND EXPRESSION 
 TP.      SPACE  4,20 
**        TP. - TURPLE PARAMETER FORMAT.
* 
*         A (TP.) WORD IS THE REPRESENTATION OF AN OPERAND IN THE IL. 
  
  
          DESCRIBE  TP. 
 ORD      DEFINE 16          ORDINAL OF OPERAND 
 TAG      DEQU   ORD
 BIAS     DEFINE 24          CONSTANT ADDEND (CA) 
 IOC      DEQU   BIAS        I/O CONTROL CODE 
 ORBI     DEQU   BIAS,TP.ORDL+TP.BIASL
          ERRNZ  TP.BIASL+TP.BIASP-TP.ORDP
 ATTR     DEFINE 13          ATTRIBUTES XMITTED TO IL 
 1ATR     DEFINE 7           ATTRIBUTES DURING PASS 1    (SEE BELOW)
  
  
 TP.SHRTB EQU    18          NUMBER OF BITS ALLOWED IN A SHORT CONSTANT 
          ERRMI  TP.BIASL-TP.SHRTB
 TP.ATTR  SPACE  4,10 
**        TP.ATTR - ATTRIBUTES OF OPERANDS. 
* 
*         THESE ATTRIBUTES ARE TRANSMITTED TO THE INTERMEDIATE LANGUAGE 
*         FILE.  THEY SHOULD ALL BE DEFINED IN THE FTN 5 GID. 
  
          REDEF  ATTR 
  
 LCM      DEFINE             ECS/LCM RESIDENT 
 FP       DEFINE             FORMAL PARAMETER 
 EQV      DEFINE             OPERAND EQUIVALENCED 
 CPFX     DEFINE 3           TAG PREFIX FIELD 
 ARR      DEFINE             ARRAY REFERENCE
 ARY      DEQU   ARR         ARRAY REFERENCE FOR BRIDGE 
 SHRT     DEFINE             SHORT CONSTANT IN BIAS 
 ADDR     DEFINE             ADDRESS REFERENCE (E.G. LOCF)
 INTR     DEFINE             INTERMEDIATE OPERAND 
 CAT      DEFINE             CONCAT. OPERAND
 IODP     DEFINE 2
          REDEF  IODP 
 IOD      DEFINE             I/O DEFINITION (SET FOR INPUT) 
 IOP      DEFINE             POTENTIALLY DEFINED (NAMELIST READ, ETC) 
  
  
          REDEF  CPFX 
          DEFINE 2
 GL       DEFINE             GENERATED LABEL =  CPFX = 1
 TP.1ATR  SPACE  4,10 
**        TP.1ATR - PASS 1 ATTRIBUTES.
* 
*         THESE ARE DISCARDED AT *DUC* TIME, AND SO ARE NOT USED BY 
*         THE CODE GENERATOR PROPER.
  
  
          REDEF  1ATR 
 ARS      DEFINE             ARRAY SUBSCRIPT OPERAND
 ARE      DEFINE             REFERENCE TO ENTIRE ARRAY
 LCF      DEFINE             REFERENCE FOR *LOCF* INTRINSIC 
 EXPR     DEFINE             OPERAND WAS AN EXPRESSION (E.G., UNARY +)
 MODE     DEFINE WB.MODEL    MODE (TYPE) OF OPERAND 
 T.ASG    SPACE  4,10 
**        T.ASG - TABLE OF "ASSIGN"ED STATEMENT LABELS. 
* 
*         CONTAINS ONE ENTRY FOR EACH "ASSIGN" STATEMENT. 
*         USED IN OPT > 0 TO DETERMINE FLOW CONTROL --
*         MUST KNOW ALL POSSIBLE TARGETS OF AN ASSIGNED 
*         "GOTO" STATEMENT. 
  
  
          DESCRIBE  AG. 
 ORBI     DEFINE TP.ORBIL 
          ERRNZ  TP.ORBIP-AG.ORBIP
          REDEF  ORBI 
 ORD      DEFINE TP.ORDL     SYMORD OF ASSIGNED VARIABLE
          ERRNZ  TP.ORDP-AG.ORDP
 BIAS     DEFINE TP.BIASL    BIAS (FOR EQUIVALENCED VAR)
          ERRNZ  AG.ORBIP-AG.BIASP
          DEFINE 4
 LAB      DEFINE TP.ORDL     SYMORD OF LABEL ASSIGNED 
 T.NLST  SPACE  4,10
**        T.NLST - TABLE OF "NAMELIST" GROUPS.
  
*         NAMELIST GROUP DEFINITIONS ARE STORED IN HERE.
* 
*         THE (WB.PNT) FIELD OF THE SYMTAB ENTRY FOR A NAMELIST 
*         GROUP-NAME CONTAINS AN INDEX INTO THIS TABLE. 
* 
*         THE ENTRY FOR EACH GROUP CONSISTS OF A SEQUENCE OF
*         BYTES.  AFTER THE (NMEM AND GROP) BYTES, THERE FOLLOWS
*         A SYMORD PER MEMBER.  A NEW GROUP STARTS ON A WORD
*         BOUNDARY.  ANY UNUSED (NG.ORD) BYTES CONTAIN ZERO.
  
  
          DESCRIBE  NG. 
 NMEM     DEFINE 15          NUMBER OF MEMBERS
 GROP     DEFINE 15          SYMORD OF GROUP-NAME 
          DEFINE 15          SYMORD OF MEMBER 1 
          DEFINE 15          SYMORD OF MEMBER 2 
  
 NG.ORDL  EQU    NG.GROPL    LENGTH OF NAMELIST MEMBER SYMORDS
 T.APL    SPACE  4,10 
**        T.APL - TABLE OF ACTUAL PARAMETER LISTS.
*         ORDINALS OF *AL-TAGS* POINT INTO THIS TABLE.
  
  
*         TAG AND BIAS FIELDS MUST HAVE SAME POSITION RELATIVE TO EACH
*                OTHER AS THEY DO IN THE LONG FILE.  MUST ALSO BE SAME
*                LENGTH.
*         I/O  /  NON-I/O AP LIST FORMATS INPUT TO THE ASSEMBLER. 
* 
  
  
          DESCRIBE   IA.,60 
 TAG      DEFINE PB.TAGL     SYMBOL (*IH* + ORD)
 LEFT     DEQU   TAG         LEFT SIDE ARGUMENT OF RELATIONAL HEADER
 BIAS     DEFINE 24 
 RITE     DEQU   BIAS        RIGHT SIDE ARGUMENT OF RELATIONAL HEADER 
 ORBI     DEQU   BIAS,IA.TAGL+IA.BIASL   TAG+BIAS FIELD 
 MODE     DEFINE 6           MODE / I/O CONTROL CODE
 IOC      DEFINE 1           THIS ENTRY IS CONTROL ITEM 
 ST       DEFINE 1           FWA STORED TO THIS ITEM
 CHAR     DEFINE 1           GET (BCP,CLEN,BIAS) FROM T.CAC ENTRY 
 CRH      DEFINE 1           CHARACTER RELATIONAL HEADER INDICATOR
 ASG      DEFINE 1           ASSIGNED FORMAT SPECIFIER
 FP       DEFINE 1           ITEM IS F.P. 
 VAR      DEFINE 1           VAR BIT (DOTRIP INDICATOR) FOR I/O DATA
          DEFINE 5
 IO-APL   SPACE  4,10 
**        AN OBJECT-LIBRARY (I/O) AP-LIST ENTRY HAS THE FOLLOWING FORMAT
*                IN THE BINARY -- 
  
  
          DESCRIBE   OA.,60 
 LCM      DEFINE 1           ITEM IS LCM/ECS RESIDENT 
 FP       DEFINE 1           ITEM IS FORMAL PARAMETER 
 IND      DEFINE 1           LENGTH FIELD IS POINTER
 LST      DEFINE 1           ITEM IS CONTROL INFO SPECIFIER 
 VAR      DEFINE 1           INDICATION OF TYPE LOOP IN FORCE 
          DEFINE 1
 TYP      DEFINE 6           MODE/UNIT CODE OF ITEM 
 LEN      DEFINE 18          LENGTH OF ITEM (NUMBER OF ELEMENTS)
 ADDR     DEFINE 30 
  
          REDEF  ADDR        ---   IF TYP=CHAR
          DEFINE 2
 BCP      DEFINE 4           BEGINNING CHARACTER POSITION OF ITEM 
 ADR      DEFINE 24          ADDRESS OF ITEM
  
          REDEF  ADDR        ---   IF FP
 SUBS     DEFINE 21          OFFSET TO FORMAL PARAMETERS
 ARG      DEFINE 9           FORMAL PARAMETER NUMBER OF ITEM - 1
  
 OA.LEFTP EQU    OA.LENP
 OA.RITEP EQU    OA.ADDRP 
 T.DATS   SPACE  4,15 
**        T.DATS - DATA STATEMENT TABLE.
* 
*         THE ENTRIES IN THIS TABLE ARE DIRECTIVES TO PASS 3 TO 
*         OUTPUT THE NECESSARY LOADER TEXT. 
* 
*         EACH ENTRY CONSISTS OF A HEADER, FOLLOWED BY (WC) WORDS OF
*         DATA.  THE HEADER IS ONE OR TWO WORDS LONG.  ALWAYS A (DA.) 
*         WORD, AND THEN A (DB.) WORD IF (DA.RP)=1. 
  
  
          DESCRIBE DA.,,,0
  
 CH       DEFINE 1           IF CHARACTER FORMAT
 RP       DEFINE 1           IF REPLICATION NEEDED (DB. WORD PRESENT) 
 ORD      DEFINE 16          SYMTAB ORDINAL OF FWA
 BIAS     DEFINE 24          BIAS OF FWA (CHARS OR WORDS) 
 WC       DEFINE 18          WORD COUNT OF FOLLOWING DATA (NOT COUNTING 
                                   DB. WORD, CHARS OR WORDS)
  
          DESCRIBE DB.,,,1   ---   PRESENT WHEN RP=1
          DEFINE 6
 INC      DEFINE 24          INCREMENT (CHARS OR WORDS) 
          DEFINE 6
 CNT      DEFINE 24          NUMBER OF COPIES + 1 
 DI.      SPACE  4,10 
**        T.DATI -  DATA CONSTANT TABLE.
*                BUILT BY *BIT* IN DATA.
*                FORM (2) IS ALSO USED BY *PRM* OF DECL.
* 
*         FORM (1), (DI.REP) = 1  -  FOR REPLICATION HEADER.
*         FORM (2), (DI.REP) = 0  -  FOR DATA CONSTANT. 
  
  
          DESCRIBE DI.,60          FORM (1) 
  
 REP      DEFINE 1           1 = REPETITION FLAG ENTRY
          DEFINE 17 
 RL       DEFINE 18          REPETITION LIST LENGTH 
 RC       DEFINE 24          REPETITION COUNT 
  
  
          REDEF                    FORM (2) 
  
 REP      DEFINE 1           0 = CONSTANT ITEM ENTRY
          DEFINE 2           0
 MODE     DEFINE WB.MODEL    MODE OF CONSTANT 
          DEFINE 18          0
 PNT      DEFINE 18          POINTER INTO TABLE CONTAINING CONSTANT 
 DLEN     DEFINE 18          CONSTANT LENGTH (WORDS OR CHARACTERS)
 T.FPO    SPACE  4,20 
**        T.FPO -  TABLE OF SUB/ SUB0 ORGINS FOR FORMAL PARAMETERS. 
* 
*         CREATED IN PASS 3 OF REC, CATAINS FOR EACH FORMAL PARAMETER,
*         ITS POINTER INTO SUB/SUB0 TALBE.
*         FORMATTED AS FP. .
  
  
 T.ILI    SPACE  4,10 
**        T.ILI -  TABLE OF INPUT LIST ITEMS. 
* 
*         TP. OPERANDS OF INPUT ITEMS ARE REFORMATTED 
*         FOR ENTRY INTO THIS TABLE.
  
          DESCRIBE  II. 
 ORD      DEFINE  16         ORDINAL OF OPERAND 
 BIAS     DEFINE  24         BIAS OF OPERAND
          DEFINE  18
 CHAR     DEFINE  1          OPERAND IS TYPE CHARACTER
 ARY      DEFINE  1          OPERAND IS INDEXED ARRAY OR SUBSTRING
 T.REF    SPACE  4,30 
**        T.REF - CROSS REFERENCE TABLE.
  
  
          DESCRIBE XR.
 TAG      DEFINE 18 
 MEDF     DEFINE 1           MAP ENTRY POINT DEFINITION FLAG
          DEFINE 13 
 LINE     DEFINE 22          LINE NUM OF REF
 USE      DEFINE 6           USAGE LETTER 
  
**        POSSIBLE VALUES OF XR.USE 
  
*         STATEMENT LABELS
  
 CR.AGN   EQU    1RA
 CR.GOTO  EQU    1R 
 CR.DO    EQU    1RD
 CR.IFN   EQU    1R          CONDITIONAL USAGE
 CR.DECD  EQU    1RR         DECODE STATEMENT 
 CR.ENC   EQU    1RW         ENCODE STATEMENT 
 CR.CNTL  EQU    1R 
 CR.LAB   EQU    1RL         LABEL DEFINITION 
  
*         VARIABLES/FUNCTIONS 
  
 CR.REF   EQU    1R 
 CR.STR   EQU    1RS         STORE
 CR.PAR   EQU    1RA
 CR.CALL  EQU    1RA         CALL ARGUMENT. 
 CR.DEC   EQU    1R          DECLARATIVE STATEMENT
 CR.DAT   EQU    1RI         DATA INITIALIZED 
 CR.VGOTO EQU    1R          VARIABLE USED IN GOTO
 CR.INF   EQU    1RA         INSIDE FUNCTION. 
 CR.INP   EQU    1RR         INPUT  STATEMENT 
 CR.OUT   EQU    1RW         OUTPUT STATEMENT 
 CR.SUB   EQU    1R 
 CR.DOI   EQU    1RC         DO LOOP CONTROL
 CR.IF    EQU    1R 
 CR.IOU   EQU    1RU         I/O UNIT 
 CR.SRC   EQU    1RS         SOURCE LINE
 CR.DEF   EQU    1RD
 CR.RET   EQU    1RR         SUBROUTINE RETURN
 T.ENT    SPACE  4,10 
**        T.ENT - ENTRY POINT TABLE.
  
  
          DESCRIBE EP.
 NAME     DEFINE 42          ENTRY POINT NAME 
 ORD      DEFINE 18          ORDINAL IN SYMTAB
 T.ENTP   SPACE  4,20 
**        T.ENTP - ENTRY PARAMETER LISTS. 
* 
*         EACH UNIQUE PARAMETER LIST IN THE PROGRAM-UNIT IS 
*         REPRESENTED BY A (T.ENTP) ENTRY.  EACH ENTRY CONSISTS 
*         OF A HEADER WORD (EH.), FOLLOWED BY A SERIES OF (EF.) 
*         BYTES (4 PER WORD).  AN (EF.) BYTE CONTAINS THE SYMTAB
*         ORDINAL OF A FORMAL PARAMETER WHICH IS INCLUDED IN THIS 
*         PARAMETER LIST, IN ORDER.  THE LIST OF FP'S IS TERMINATED 
*         BY ZERO (EF.) BYTE(S).
  
  
          DESCRIBE EH.
 FPC      DEFINE 12          FORMAL PARAMETER COUNT 
 SUBI     DEFINE 15          *SUBI* (SUB INDEX TABLE) BIAS
 SB0I     DEFINE 15          *SB0I* (LEVEL 0 SUB INDEX TABLE) BIAS
 BIAS     DEFINE 18          CPL. BIAS OF THIS LIST 
  
  
          DESCRIBE EF.
 ORD      DEFINE 15          SYMORD OF FP(I)
          DEFINE 3*15 
 T.SUB    SPACE  4,10 
**        T.SUB - *SUB*  BLOCK TABLE. 
* 
*         BUILT BY THE ASSEMBLER.  CONTAIN  *SUB*  BLOCKS FOR THE 
*         CURRENT PROGRAM UNIT. 
  
  
          DESCRIBE SB.,60 
 POS      DEFINE 12          INSTRUCTION PARCEL SHIFT COUNT + 2000B 
*                            = $+2001B - $/59*61
*                            = POSITIVE FOR THE FIRST ENTRY FOR A PARAM,
*                              OR IF A *DELAY* PRECEDED THIS *SUB*. 
*                              OTHERWISE POSC = POSC * -1.
 FPNO     DEFINE WB.FPNOL    FORMAL PARAMETER NUMBER
          DEFINE 3
 BIAS     DEFINE PB.BIASL    BIAS ADDED 
 ORG      DEFINE 18          ADDRESS OF INSTRUCTION TO *ADDSUB* 
 T.SUB0   SPACE  4,10 
**        T.SUB0 - *SUB0* BLOCK TABLE.
* 
*         BUILT BY THE ASSEMBLER. CONTAIN *SUB0* BLOCKS FOR THE 
*         CURRENT PROGRAM UNIT. 
  
  
          DESCRIBE SZ.,60 
 POS      DEFINE 12          2036B + INSTRUCTION PARCEL SHIFT COUNT 
          DEFINE 3           0
 SLI      DEFINE 15          SCMI .XOR. LCMI
*                            SCMI = SCM LOAD/STORE INSTRUCTION (53IJ0)
*                            LCMI = LCM LOAD/STORE INSTRU.(014IJ ,015IJ)
          DEFINE 12          0
 ORG      DEFINE 18          ADDRESS OF INSTRUCTION 
 T.SBI    SPACE  4,10 
**        T.SBI - *SUB* BLOCK INDEX TABLE.
* 
*         BUILT BY THE ASSEMBLER.  CONTAINS INDICIES INTO THE *SUB* 
*         BLOCK FOR THE CURRENT PROGRAM UNIT. 
  
  
          DESCRIBE IS.,60 
 FPN      DEFINE 12          PACKED FPNO
 AD       DEFINE 48          ADDRESS (INDEX) OF  SUB  , THIS FP.
 F.LBT    SPACE  4,10 
**        F.LBT - LOCAL BLOCK TABLE (A FIXED TABLE).
* 
*         LB.ORG IS CALCULATED FROM  LB.PARC  AND  LB.BLEN  BY THE
*         ASSEMBLER.
*         ROUTINE  *PIG*  KEEPS *LB.BLEN* STORED IN *LB.TBLN/LB.ORG*. 
*         ROUTINE  *END*  MOVES *LB.TBLN*  TO *LB.BLEN* BEFORE MERGING
*         THE CALCULATED *LB.ORG* INTO THE WORD.
  
  
          DESCRIBE LB.,60 
 PARC     DEFINE 6           PARCEL COUNT 
          DEFINE 18 
 BLEN     DEFINE 18          LENGTH OF BLOCK
 ORG      DEFINE 18          PROGRAM RELATIVE ADDRESS / ORG COUNTER 
 TBLN     DEQU   ORG         TEMP BLEN STORAGE FOR PASS 2 (PIG) 
 F.PIK    SPACE  4,20 
**        F.PIK - MACHINE OPERATION DESCRIPTION TABLE.
* 
*         EACH ENTRY DESCRIBES HOW TO FORMAT THE OBJECT LISTING, AS 
*         WELL AS ATTRIBUTES OF THE INSTRUCTION.
** FV     ****   NOTE - DO NOT BE MISLEAD BY SYMBOLIC DESCRIPTION;
*                MANY HARD-NUMBER REFERENCES EXIST IN COMPILER. 
*         IN PARTICULAR, (Q, BJMP, FUPA) SHOULD BE INSIDE THE (OD.ATR)
*         FIELD, BUT THEY ARE NOT YET REFERRED TO SYMBOLICALLY. 
  
  
 OD.EDL   EQU    4           WIDTH OF EACH EDIT DESCRIPTOR
 OD.EDN   EQU    9           NUMBER OF EDIT DESCRIPTORS ALLOWED 
  
  
          DESCRIBE OD.             OPERATION DESCRIPTION
  
 Q        DEFINE             30-BIT INSTRUCTION 
 BJMP     DEFINE             B-REGISTER JUMP INST 
 FUPA     DEFINE             FORCE UPPER AFTER
          DEFINE OD.EDN*OD.EDL
 ATR      DEFINE 9           ATTRIBUTES      (SEE BELOW)
 GH       DEFINE 2*6         LETTERS FOR COL 11+12
          ERRNZ  OD.GHP 
  
  
          REDEF  ATR
 IM       DEFINE             INTEGER MULTIPLY INSTRUCTION 
 UP       DEFINE             UNPACK INSTRUCTION 
 PK       DEFINE             PACK INSTRUCTION 
 BJ       DEFINE             (J) IS A *B* REGISTER
 JKV      DEFINE             (JK) IS A 6-BIT VALUE
 KJ       DEFINE             NEEDS (K) AND (J) INTERCHANGED 
 DIV      DEFINE             DIVIDE:  (X.J) CANNOT BE ZERO
 FPA      DEFINE             FLOATING POINT ARITH (DO LEGVAR CHECK) 
 COPY     DEFINE             NEEDS (K) SET TO (J) 
          ERRNZ  OD.COPYP-OD.ATRP 
 MOD      SPACE  4,10 
**        MOD - MODE OF PROGRAM-UNIT BEING COMPILED.
* 
*         THE FOLLOWING ARE USED IN CONJUNCTION WITH THE CELL *MOD* AND 
*         REFER TO MODE OF COMPILATION FOR THE CURRENT PROGRAM UNIT.
  
  
          DESCRIBE  MO.,60
  
          DEFINE 12 
 CLIF     DEFINE 19          CHARACTER LENGTH INFORMATION 
          REDEF  CLIF 
 CLEN     DEFINE 18          CHARACTER LENGTH (CHARACTER FUNCTIONS ONLY)
 CTYP     DEFINE             CHARACTER LENGTH TYPE (AS PER WC.CTYP) 
          DEFINE 17 
 PTYP     DEFINE 3           PROGRAM TYPE 
 BLK      DEFINE 1           BLOCK DATA 
 TYP      DEFINE             EXPLICITLY TYPED FUNCTION
          DEFINE 4
 MODE     DEFINE WB.MODEL    MODE, IF FUNCTION
  
  
*         (MO.PTYP) HAS TO CONFORM TO PMDUMP INTERFACE SPEC.
*         SEE DAP S2762.  CODE IN FAS/DFD.
*                (BT.TYP) = (MO.PTYP) / 2 
  
          REDEF  PTYP 
 FUN      DEFINE 1           FUNCTION 
 SUB      DEFINE 1           SUBROUTINE 
 PRO      DEFINE 1           MAIN PROGRAM 
 PARMODE  SPACE  4,10 
**        PARMODE - SELECT SPECIAL PARSING MODE.
* 
*         PARSER ALWAYS RESETS THIS CELL = 'EXPR' BEFORE EXITING. 
  
  
          LOC    0
 PM=EXPR  BSS    1           NORMAL EXECUTABLE EXPRESSION 
 PM=ICE   BSS    1           INTEGER CONSTANT EXPRESSION
 PM=CXP   BSS    1           CONSTANT EXPRESSION
 PM=DIM   BSS    1           DIMENSION BOUND
 PM=IOD   BSS    1           PRE-SCAN OF IMPLIED LOOPS
 PM=DATA  BSS    1           DATA ITEM LIST 
 PM=DCON  BSS    1           DATA CONSTANT LIST 
 PM=PARM  BSS    1           *PARAMETER* STATEMENT PROCESSING 
          LOC    *O 
 ARGMODE  SPACE  4,30 
**        ARGMODE - PARSER CONTEXT STACK. 
* 
*         THE PARSER MAINTAINS THREE CELLS FOR CURRENT CONTEXT INFO.
*         ALL THREE ARE PUSHED AND POPPED ON T.PCS AS PARENS, 
*         ETC, ARE ENCOUNTERED. 
  
  
          LOC    0
          QUAL   PSTACK 
 ARGMODE  BSS    1
 ARGCOMA  BSS    1
 ARGMISC  BSS    1
          QUAL   *
 Z=PSTACK BSS                LENGTH OF PAREN STACK FRAME
          LOC    *O 
  
  
          DESCRIBE  AM.,,,/PSTACK/ARGMODE 
  
 REF      DEFINE 12 
 ATR      DEFINE 12          ATTRIBUTES (SEE BELOW) 
 COM      DEFINE 18 
 PAD      DEFINE 18 
  
          REDEF  ATR
          DEFINE 5
 ARE      DEFINE             ALLOW UNSUBSCRIPTED ARRAY NAME 
 LEV3     DEFINE             ALLOW LEVEL 3 NAME 
 COL      DEFINE             ALLOW COLON
 EQ       DEFINE             ALLOW *=*
 RP       DEFINE             INDICATE SPECIAL RIGHT PAREN PROCESSING
 EOS      DEFINE             ALLOW *EOS* TO UNSTACK LEFT PAREN
 FUN      DEFINE             ALLOW FUNCTION REFERENCE WITHOUT *(* 
  
  
          DESCRIBE  AC.,,,/PSTACK/ARGCOMA 
  
  
*                            -- WHEN PARSING ARRAY SUBSCRIPTS (C=ARRAY).
 VSUB     DEFINE 1           =1 IF ARRAY SUBSCR NOT CONST, =0 IF CONST
          DEFINE 5
 SYM      DEFINE 18          T.SYM ORDINAL OF ARRAY 
 DIMI     DEFINE 18          T.DIM INDEX OF ARRAY 
 CNT      DEFINE 18          COUNT OF SUBSCR EXPR PARSED IN ARRAY REF 
  
          REDEF              -- WHEN PARSING CALL OR FUNCTION ARG LIST, 
                                ( C=CALL, C=FUN ).
          DEFINE 24 
 MODE     DEFINE 18 
 CNT      DEFINE AC.CNTL     COUNT-1 OF ARGUMENTS 
  
          REDEF              -- WHEN PARSING INTRINSIC ARG LIST.
 BOOL     DEFINE 1           =1 IF BOOLEAN ARGUMENT OCCURRED
          DEFINE 5
 MAXM     DEFINE 18          MAXIMUM ARGUMENT MODE
 MODE     DEFINE AC.MODEL    MODE OF INTRINSIC
 CNT      DEFINE AC.CNTL     COUNT-1 OF ARGUMENTS 
  
          REDEF              -- WHEN PARSING ST. FUNCT. ARGS. 
  
          DEFINE 24 
 EARG     DEFINE 18          ADDRESS OF ACTUAL ARG ON ESTACK
 CNT      DEFINE AC.CNTL
  
          REDEF              -- WHEN PARSING ST. FUNCT. BODY
  
          DEFINE 42 
 TBR      DEFINE 18          B4 RESTORE 
  
          REDEF              -- WHEN PARSING *DO* LOOP INDICES  ( C=DO )
          DEFINE 42          MUST CONTAIN ZERO  (SEE *PAR.PL*)
 CNT      DEFINE AC.CNTL     *DO* PARAMETER INDEX  ( SEE *PAR/C=DO* ) 
  
          REDEF              -- WHEN PARSING CHARAC SUBSTRING  ( C=SBS )
          DEFINE 24 
 MODE     DEFINE AC.MODEL    MODE OF VARIABLE = M.CHAR
          DEFINE AC.CNTL
  
  
          DESCRIBE AS.,,,/PSTACK/ARGMISC
  
          REDEF              -- WHEN C=BIF -- 
 SYM      DEFINE 6*CHAR      NAME OF INTRINSIC
          DEFINE 1*CHAR 
 ORD      DEFINE 18          SYMTAB ORDINAL 
          ERRMI  AS.ORDL-TP.ORDL
  
          REDEF              -- WHEN PARSING ARRAY SUBSCRIPTS  (C=ARRAY)
 NAME     DEFINE WA.NAMEL    ARRAY NAME  ( -L- FORMAT ) 
          DEFINE 60-WA.NAMEL MUST =0 FOR *PAR/A=ARRAY*, *FERRS/OSE* 
 KW.      SPACE  4,10 
**        KW. - STATEMENT *KEYW* TABLE STRUCTURE DEFINITIONS. 
* 
* 
*         THE STATEMENT KEYWORD TABLE (DEFINED IN DECK *LEX* VIA
*         *KEYW* MACRO) CONTAINS INFORMATION THAT DEFINES ALL THE 
*         POSSIBLE TYPES OF STMTS THAT CAN OCCUR IN *FTN*, AND HOW
*         CERTAIN STMT TYPES RELATE TO ONE ANOTHER. 
* 
*         FIELDS WITHIN EACH INDIVIDUAL *KEYW* ENTRY ARE
*         DESCRIBE/DEFINED IN THE USUAL MANNER VIA SYMBOLS
*         OF THE FORM --
* 
*                KW.XXXL  AND  KW.XXXP
* 
*         WHERE *KW.* IS A COMMON PREFIX AND *XXX* IS A UNIQUE FIELD
*         NAME. 
* 
*         FIELDS *XXX* WITHIN *KW.* STRUCTURE ARE DESCRIBED BRIEFLY 
*         BELOW.  FOR MORE THOROUGH INFORMATION, SEE FTN KEYWORD
*         TABLE DEFINITION IN DECK *LEX* (AT ADDR *FW.KEYW*). 
* 
*         KEY  = ADDR OF *LITKEY* LITERAL STRING FOR THIS KEYWORD.
* 
*                NOTE THAT FOR SYNTACTICALLY DEFINED STMTS SUCH AS
*                *DO*, *IF*, AND REPLACEMENT, THAT A KEYWORD SEARCH 
*                IS MEANINGLESS.  THEREFORE, THE *KEY* FIELD IS SET TO
*                .MI. SO THAT INTERESTED PARTIES CAN KNOW THAT THIS IS
*                A SYNTACTICALLY DEFINED STMT.
* 
*         JMP  = ADDR OF THE STMT PROCESSOR THAT IS TO PROCESS A STMT 
*                DEFINED BY THIS *KEYW* ENTRY.
* 
*         FEC  = *FEC* (FRONT END CONTROLLER) STAGE THAT A STMT 
*                WITH THIS *KEYW* ENTRY CAN OCCUR IN. 
* 
*         INFO = SPECIAL INFORMATION FIELD FOR REFERENCES TO A *SUBKEY* 
*                KEYWORD TABLE.  THIS FIELD COEXISTS (DEQU) WITH THE
*                *JMP* FIELD, AND IS INTENDED FOR USE BY KEYWORD
*                PROCESSORS THAT REQUIRE MORE CONTROL OVER WHAT WE
*                WILL CALL THE *KEYWORD TYPE*.
* 
*         ATTR = ATTRIBUTES OF THIS STATEMENT.  *ATTR* FIELD CONSISTS 
*                OF A NUMBER OF BIT FLAGS THAT CONTAIN MISCELLANEOUS
*                INFORMATION ABOUT THIS STMT.  SEE BELOW. 
* 
* 
*         *ATTR* BIT FLAGS ARE -- 
* 
*         DON  = 1 IF THIS STMT MAY NOT BE A *DO* TERMINAL, ELSE 0. 
* 
*         NIF  = 1 IF THIS STMT MAY NOT BE THE OBJECT OF A LOGICAL
*                  *IF*, ELSE 0.
* 
*         LBL  = 1 IF THIS STMT MAY HAVE A REFERRABLE LABEL, ELSE 0.
* 
*         GEN  = 1 IF THIS STMT GENERATES CODE, ELSE 0. 
* 
*         BKD  = 1 IF THIS STMT IS LEGAL WITH A *BLOCKDATA* 
*                  SUBPROGRAM, ELSE 0.
* 
*         PWS  = 1 IF THIS STMT IS TO BE PROCESSED WHILE SKIPPING,
*                  (STAGE = FEC=BY), ELSE 0.
* 
*         IL   = 1 IF THIS STMT HAS IMPLIED LABEL (NOPATH INVALID), 
*                  ELSE 0.
* 
*         NBS  = 1 IF THIS STMT GENERATES TURPLES AND NO BOS IS TO BE 
*                  OUTPUT.  RELEVANT ONLY WHEN GEN=1. 
  
          DESCRIBE KW.
 JMP      DEFINE 18 
 INFO     DEQU   JMP
 ATTR     DEFINE 12 
 FEC      DEFINE 5
 LEN      DEFINE 7
 KEY      DEFINE 18 
  
          REDEF  ATTR 
 DON      DEFINE 1
 NIF      DEFINE 1
 LBL      DEFINE 1
 GEN      DEFINE 1
 BKD      DEFINE 1
 PWS      DEFINE 1
 IL       DEFINE 1
 NBS      DEFINE 1
 LF.      SPACE  4,10 
**        LF. - *LEXFLG* FIELD DEFINITIONS. 
* 
* 
*         *LF.* SYMBOLS DEFINE FIELDS WITHIN *LEXFLG*, THE LEXICAL
*         SCANNER MASTER CONTROL FLAG.  SEE *LEXFLG* IN DECK *LEX*. 
* 
*         FIELDS WITHIN *LEXFLG* ARE DESCRIBE/DEFINED VIA SYMBOLS 
*         OF THE FORM --
* 
*                LF.XXXP  AND  LF.XXXL
* 
*         SEE *LEXFLG* IN DECK *LEX* FOR A DESCRIPTION OF *LF.* 
*         FIELDS. 
  
  
          DESCRIBE LF.
 HDR      DEFINE 1
          DEFINE 2
 INI      DEFINE 1
          DEFINE 2
 LAC      DEFINE 1
          DEFINE 2
 CHR      DEFINE 1           'CHARACTER *' FLAG 
          DEFINE 2
 TDE      DEFINE 1           TERMINAL DELIMITER ENCOUNTERED 
          DEFINE 2
 FMT      DEFINE 1           FORMAT STATEMENT FLAG
 LM.      SPACE  4,10 
**        LM. - *LEXMODE* SYMBOL DEFINITIONS. 
* 
* 
*         *LM.* SYMBOLS DEFINE THE VARIOUS MODES THAT THE LEXICAL 
*         SCANNER, *LEX*, MAY BE PLACED IN.  A DESCRIPTION OF THESE 
*         MODES IS CONTAINED IN THE DECK *LEX*, AS IT WAS THOUGHT TO
*         BE MORE APPROPRIATE/USEFUL PLACED THERE.
  
  
 LM.NORM  =      0           *NORMAL* MODE
 LM.NTR   =      1           *NEED TO READ* MODE
 LM.1ST   =      2           *1ST LINE IN PROGRAM UNIT* MODE
 SF.      SPACE  4,10 
**        SF. - FORMAT OF STATEMENT FUNCTION HEADER.
  
  
          DESCRIBE SF.
          DEFINE 6
 PEAR     DEFINE 18          PREVIOUS ELIST BASE FOR ACTUAL ARGS. 
 DACP     DEFINE 18          DUMMY ARGUMENT REF. CHAIN HEAD 
 TOK      DEFINE 18          DUMMY TOKEN FOR PAR
 VS.      SPACE  4,10 
**        VS. - FORMAT OF SKELETON CONTROL TABLE. 
  
  
          DESCRIBE VS.
  
 NKIL     DEFINE             TURPLE NOT KILLABLE IN QCGC/*KUT*
 1DUC     DEFINE             USE COUNT 1OP
 2DUC     DEFINE             USE COUNT 2OP
          DEFINE 3
 SBI      DEFINE 18          SKELETON START INDEX (U=)
 DRA      DEFINE 18          DATA REDUCTION ADDRESS 
 CRA      DEFINE 18          CONSTANT REDUCTION ADDRESS (U=)
 IT.      SPACE  4,30 
***       IT. - INTRINSIC FUNCTION DEFINITION.
* 
*         TABLE INCLUDES BOTH INLINE AND EXTERNAL INTRINSICS. 
*         THERE IS ONE WORD PER NAME, IN (IT.) FORMAT --
* 
*         +----------------------------------+-------+---+-------+--+--+
*         +                                  +   A   + A +       +A + M+
*         +    F U N C T I O N     N A M E   +   T   + R +  JPAD +R + O+
*         +                                  +       + G +       +G + D+
*         +                                  +OCNGXAP+ C +       +M + E+
*         +----------------------------------+-------+---+-------+--+--+
*                        36                      7     3     8    3  3
* 
*         (NAME) = NAME OF FUNCTION (-L- FORMAT). 
*         (AT)   = 1/O, 1/C, 1/N, 1/G, 1/X, 1/A, 1/P
*                O = GENERIC INTRINSIC ONLY 
*                C = CHARACTER INTRINSIC (SUFFIX DEPENDING ON COLLATE)
*                N = ALWAYS CALL-BY-NAME
*                G = GENERIC NAME.
*                X = EXTERNAL INTRINSIC.
*                A = DEFINED IN ANS FORTRAN.
*                P = PARSER HAS SPECIAL PROCESSING. 
*         (ARGC) = NUMBER OF ARGUMENTS REQUIRED.
*                  OMITTED IF INDETERMINATE ( 0 MEANS NO ARGUMENTS).
*         (JPAD) = HOW (WHERE) FUNCTION IS DESCRIBED.  DEPENDS ON (AT). 
*                P -- INDEX OF PROCESSOR IN PARSER. 
*                G -- INDEX OF DMOD VECTOR               (UNLESS *P*).
*                X -- B REGS PRESERVED             (UNLESS *G* OR *P*). 
*         (ARGM) = REQUIRED MODE OF ARGUMENT. 
*         (MODE) = RESULT MODE OF SPECIFIC FUNCTION.
* 
*         A GENERIC FUNCTION HAS A SELECTOR WORD INSERTED IN THIS 
*         TABLE IMMEDIATELY FOLLOWING ITS ENTRY.
* 
*         THE TABLE ITSELF IS LOCATED IN PARSKEL. 
  
  
          DESCRIBE IT.
  
 DPC      DEFINE 6*6         NAME OF FUNCTION 
 ATTR     DEFINE 7           ATTRIBUTES OF FUNCTION  (SEE BELOW)
 ARGC     DEFINE 3           REQUIRED NUMBER OF ARGUMENTS (-0 = INDEF)
 JPAD     DEFINE 8           WHERE FUNC IS DEFINED
 ARGM     DEFINE WB.MODEL    REQUIRED MODE OF ARGS
 MODE     DEFINE WB.MODEL    RESULT MODE OF FUNCTION
  
  
          REDEF  ATTR 
 GNO      DEFINE             GENERIC ONLY 
 CHAR     DEFINE             CHAR OR ICHAR (SUFFIX F IFF COLLATE=FIXED) 
 BYN      DEFINE             ALWAYS CALL-BY-NAME
 GENF     DEFINE             GENERIC NAME 
 XTER     DEFINE             EXTERNAL INTRINSIC 
 ANSI     DEFINE             DEFINED IN ANS FORTRAN 
 PAR      DEFINE             PARSER HAS SPECIAL PROCESSING
          SPACE  4,10 
          END 
