*DECK     TYPE
          IDENT  TYPE 
 TYPE     SECT   (EXPLICIT / IMPLICIT TYPE DECLARATIONS.) 
 TYPE     SPACE  4
*         IN CONRED 
          EXT    DEC
  
*         IN DECL 
          EXT    DIR
  
*         IN FEC
          EXT    ASK,ERT,ESY,FEC=1ST,FEC.RTN,NAT.LEN,NAT.TYP,PARAMC 
          EXT    REFVAR,SSY,STAGE,STY,TLV 
  
*         IN FERRS
          EXT    E.ANS,E.MDE2,E.TY,E.TY0,E.TY1,E.TY2,E.TY3,E.TY4,E.TY5
          EXT    E.TY6,E.TY8,E.TY9,E.TYI,E.TYI1,E.TYI2,E.TYI3,E.TYI4
          EXT    E.TYI5,E.TYI6,E.TYI7,E.TYI8,E.TYI9,E.VA09,FILL.,FILL.3 
          EXT    E.TY10 
  
*         IN HEADER 
          EXT    KW=FUNC,PSF
  
*         IN LEX
          EXT    CAK
  
*         IN PAR
          EXT    PARNOW,PIX 
  
*         IN PEM
          EXT    ANSI=,MDERR=,PDM 
  
*         IN PUC
          EXT    CHARDCL,IDENT,MOD,S=ENTRY,T=FPI,T=SYM,T.FPI,T.SYM
  
*         IN QSKEL/FSKEL
          EXT    F.INTF 
          TITLE  EXPLICIT 
 TYPE-KEY SPACE  4,8
**        TYPE KEY WORDS. 
* 
*         EXIT   TO *TYP* WITH
*                (X4) = APPROPRIATE TYPE INDICATION.
  
  
          HEREIF BOOLEAN
          ANSI   E.ANS
          MDERR  E.MDE2      ** USE OF BOOLEAN IS MACHINE DEPENDENT 
          =X4    M.BOOL 
          EQ     TYP
  
          HEREIF LOGICAL
          =X4    M.LOG
          EQ     TYP
  
          HEREIF INTEGER
          =X4    M.INT
          EQ     TYP
  
          HEREIF REAL 
          =X4    M.REAL 
          EQ     TYP
  
          HEREIF DOUBLEPRECISION
          =X4    M.DBL
          EQ     TYP
  
          HEREIF COMPLEX
          =X4    M.CPLX 
          EQ     TYP
  
          HEREIF CHARACTER
          MX7    1
          =X6    1           DEFAULT CHARACTER LENGTH 
          LX6    WC.CLENP 
          SA7    CHARDCL     INDICATE CHARACTER TYPE PRESENT
          SA2    B4+
          SB2    X2-O.COMMA 
          ZR     B2,E.VA09   IF PREMATURE COMMA 
          RJ     CCL         CHECK CHARACTER LENGTH 
          SA6    TYPC 
          =X4    M.CHAR 
          SA1    B4 
          SB2    X1-O.COMMA 
          NZ     B2,TYP      IF NOT OPTIONAL COMMA
          =B4    B4+1        SKIP OPTIONAL COMMA
 TYP      SPACE  4,15 
**        TYP -  PROCESS TYPE-LIST. 
* 
*         ENTERED FROM THE VARIOUS *TYPE* PROCESSORS, TO DIGEST THE 
*                VARIABLE-LIST OF THE STATEMENT.
* 
*         ENTRY  (X4) = TYPE TO BE SET. 
*                (B4) _ FWA OF THE VARIABLE LIST. 
*         IF A *FIRST CARD* IS EXPECTED, TYP WILL CHECK FOR A *FUNCTION*
*                STATEMENT, AND EXIT TO THERE, OR TO *PSF*. 
* 
*         USES   ALL
* 
*         CALLS  ASK, DIR, ERT, ESY, ETF, PSF, SSY, TLV 
  
  
 TYP      SA1    STAGE
          IFNE   TEST,,2
          SB7    FEC=1ST
          NZ     B7,"BLOWUP" IF NOT EXPECTED VALUE
          NZ     X1,TYP4     IF NOT IN *1ST CARD* PROCESSING. 
          SA1    B4 
          SA2    B4+B1
          AX2    9*CHAR 
          LX2    2*CHAR 
          SA3    TYPB 
          BX2    X1+X2
          IX1    X3-X2
          NZ     X1,TYP2     IF NOT *FUNCTION*
          SX1    X4-M.CHAR
          NZ     X1,TYP1     IF NOT TYPE CHARACTER
          SA1    TYPC        FETCH CHARACTER LENGTH 
          BX4    X4+X1       MERGE IN WITH MODE 
  
 TYP1     CLAS=  X6,MO,(TYP)
          BX6    X6+X4
          SA6    MOD         INDICATE FUNCTION EXPLICITLY TYPED 
          SX5    1+=0 
          SX3    8*CHAR-1 
          LX3    KW.LENP
          BX5    X3+X5       PSEUDO *SATTR* FOR ASK 
          RJ     ASK         ADJUST STATEMENT KEYWORD 
          EQ     KW=FUNC
  
 TYP2     BX6    X4 
          SA6    TYPA        SAVE TYPE
          CALL   PSF         PROCESS DUMMY HEADER STATEMENT 
          SA4    TYPA 
  
 TYP4     CLAS=  X6,WB,(TYP)
          LX4    WB.MODEP 
          BX6    X4+X6       MERGE TYPE-DECL BIT AND MODE 
          LX4    X6 
          SA6    TYPA        SAVE TYPE
          =X7    CR.DEC 
          SA7    REFVAR 
  
 TYP5     SA2    B4 
          MX0    MAX.VAR*CHAR 
          SB7    X2-O.VAR 
          BX6    X0*X2
          SA6    FILL.
          LX6    CHAR 
          SB6    X6-1R0 
          PL     B6,E.VA09   IF FIRST CHARACTER NOT LETTER
          LX6    -CHAR       RESTORE
          NZ     B7,E.VA09   IF NOT SYMBOL
          CALL   SSY         SCAN SYMBOL TABLE
          MI     B7,TYP10    IF NO ENTRY
          =X7    B7-WB.W+WC.W 
          SA7    TYPE        SAVE *WC* INDEX
          MX7    -WB.MODEL
          BX5    X6 
          SBIT   X6,WB.TYPP 
          LX7    WB.MODEP 
          HX5    WB.PARM
          MI     X5,TYP9     IF TYPING SYMBOLIC CONSTANT
          SB7    E.TY10      ** NON-CONFIRMING PREVIOUS TYPING
          PL     X6,TYP5.1   IF NOT PREVIOUSLY TYPED
          SA1    TYPA        CURRENT TYPE 
          BX2    -X7*X2      EXTRACT PREVIOUS TYPE
          BX1    -X7*X1 
          IX1    X1-X2
          NZ     X1,TYP8     IF NON CONFIRMING TYPE 
          SX1    X2-M.CHAR
          SB7    E.TY1
          NZ     X1,TYP8     IF NOT CHARACTER, CONFIRMING TYPE
          EQ     TYP8.1 
  
 TYP5.1   =A5    A2-WB.W+WC.W 
          SBIT   X6,WB.INTFP/WB.TYPP
          MI     X6,TYP7     IF INTRINSIC FUNTION 
          BX6    X7*X2       CLEAR IMPLICIT MODE
          IX6    X4+X6       ADD IN NEW MODE + TYP BIT
          SA6    A2          RESET INTO T.SYM 
          MX3    WC.CLIFL 
          LX3    WC.CLIFL+WC.CLIFP
          BX6    -X3*X5      CLEAR CHARACTER LENGTH INFORMATION 
          SA6    A5 
  
*         IF TYPING MAIN ENTRY POINT, ALSO TYPE MOD 
  
          SA1    S=ENTRY
          IX1    X1-X0
          NZ     X1,TYP12    IF NOT TYPING THE MAIN ENTRY POINT 
          SA1    MOD
          SBIT   X1,MO.SUBP 
          PL     X1,TYP6     IF NOT SUBROUTINE
          SB7    E.TY0       **SUBROUTINE MAY NOT BE TYPED
          EQ     TYP8 
  
 TYP6     LX1    1+MO.SUBP
          BX1    -X3*X1      CLEAR CHARACTER LENGTH INFORMATION 
          ERRNZ  MO.CLIFL-WC.CLIFL+MO.CLIFP-WC.CLIFP
          BX4    -X7*X4      EXTRACT THE NEW MODE 
          BX6    X7*X1       CLEAR IMPLICIT MODE
          BX6    X6+X4       ADD IN NEW MODE
          ERRNZ  MO.MODEL-WB.MODEL
          SA6    A1          RESET MOD
          EQ     TYP12
  
 TYP7     BX1    X2 
          MX3    -WB.JPFL 
          LX1    -WB.JPFP 
          BX1    -X3*X1      EXTRACT INTF ORDINAL 
          SA1    X1+F.INTF
          SBIT   X1,IT.GNOP 
          PL     X1,TYP7.1   IF NOT GENERIC ONLY INTRINSIC
          WARN   E.TY9
          EQ     TYP12
  
 TYP7.1   BX3    -X7*X2      EXTRACT INTRINSIC MODE 
          BX4    -X7*X4      ISOLATE DECLARED MODE
          IX3    X4-X3
          ZR     X3,TYP12    IF CONFIRMING MODE 
          WARN   E.TY2
          EQ     TYP12
  
 TYP8     WARN   B7 
  
 TYP8.1   SA1    TYPE 
          MX7    1
          BX7    X7+X1       INDICATE THIS TYPE NOT USED
          SA7    A1 
          EQ     TYP12
  
 TYP9     BX3    -X7*X2 
          BX4    -X7*X4 
          IX3    X4-X3
          NZ     X3,TYP9.1   IF NOT CONFIRMING TYPE 
          PL     X6,TYP12    IF NOT PREVIOUSLY TYPED
          SX3    X4-M.CHAR
          ZR     X3,TYP12    IF TYPE CHARACTER
          SB7    E.TY1       **PREVIOUSLY TYPED 
          EQ     TYP8        OUTPUT DIAGNOSTIC
  
 TYP9.1   FATAL  E.TY8       **CANT CHANGE TYPE OF PARAMETER
          EQ     TYP12
  
 TYP10    BX7    X4          SET TYPE-DECL BIT AND MODE 
          MX2    0           *WC* 
          ADSYM  A1 
          =X7    B7-WB.W+WC.W 
          SA7    TYPE        SAVE *WC* INDEX
  
*         (X0) = SYMTAB ORDINAL OF TYPED ITEM 
  
 TYP12    SA1    B4+B1
          SB7    X1-O.VAR 
          SX5    X0          REMEMBER (X5) = SYMTAB ORDINAL 
          NZ     B7,TYP14    IF NOT LONG NAME 
          CALL   TLV         TRUNCATE NAME
          =A1    B4+1 
  
 TYP14    SX2    X1-O.( 
          ZR     X2,TYP16    IF DIMENSIONED 
          SX6    X5          CONSTRUCT ORD FOR XREF 
          LX6    XR.TAGP
          ADDREF X6,CR.DEC,TYP18
  
 TYP16    SA1    TYPA 
          SX1    X1-M.CHAR
          NZ     X1,TYP17    IF NOT TYPE CHARACTER
          SA1    T.SYM
          SA2    TYPE        *WC* INDEX 
          MX0    WC.CLIFL 
          SB2    X2 
          LX0    WC.CLIFL+WC.CLIFP
          SA2    X1+B2       *WC* 
          BX6    X0*X2
          =X1    1
          SA6    TYPF        SAVE ACROSS DIR CALL 
          BX6    -X0*X2      CLEAR WC.CLIF
          LX1    WC.CLENP 
          BX6    X6+X1       DUMMY LENGTH 1 (FOR ERROR RECOVERY)
          SA6    A2 
  
 TYP17    CALL   DIR         PROCESS DIMENSIONED VARIABLE 
          SA1    TYPA 
          SX1    X1-M.CHAR
          NZ     X1,TYP18    IF NOT TYPE CHARACTER
          SA1    T.SYM
          SA2    TYPE        *WC* INDEX 
          MX0    WC.CLIFL 
          SB2    X2 
          LX0    WC.CLIFL+WC.CLIFP
          SA2    X1+B2       *WC* 
          BX6    -X0*X2      CLEAR TEMPORARY LENGTH 
          SA1    TYPF        SAVED LENGTH INFORMATION 
          BX6    X6+X1
          SA6    A2          RESTORE
  
 TYP18    SA1    TYPA 
          SB4    B4+1 
          SX1    X1-M.CHAR
          NZ     X1,TYP20    IF NOT TYPE CHARACTER
          SA1    TYPC        FETCH DEFAULT CHARACTER LENGTH 
          BX6    X1 
          RJ     CCL         CHECK CHARACTER LENGTH 
          SA1    TYPE        FETCH *WC* INDEX 
          SB7    X1 
          SA3    T.SYM
          SA4    X3+B7       FETCH *WC* ENTRY 
          =A2    A4+WB.W-WC.W 
          HX2    WB.PARM
          BX0    X2          SAVE EXPOSED PARAMETER BIT 
          BX7    X6-X4
          CLAS=  X2,WC,(CLIF) 
          BX7    X2*X7
          MI     X1,TYP18.1  IF PREVIOUS CONFLICT NOTED 
          PL     X0,TYP19    IF NOT SYMBOLIC CONSTANT 
          SB7    E.TY1       ** CONFIRMING TYPE 
          ZR     X7,TYP18.2  IF CONFIRMING TYPE 
          SB7    E.TY8       ** NON CONFIRMING TYPE 
          EQ     TYP18.2
  
 TYP18.1  MI     X0,TYP20    IF SYMBOLIC CONSTANT, ALREADY DIAGNOSED
          SB7    E.TY1
          ZR     X7,TYP18.2  IF CONFIRMING TYPE 
          SB7    E.TY10 
  
 TYP18.2  FATAL  B7 
  
 TYP19    BX7    X6+X4
          SA7    A4          UPDATE 
          AX1    18 
          SB7    X1          *WC* INDEX OF VALUE. (IF THIS IS ENTRY)
          ZR     B7,TYP20    IF NOT ENTRY.
          SA2    X3+B7       FETCH VALUE. *WC* ENTRY
          BX7    X6+X2       MERGE IN CHARACTER LENGTH INFORMATION
          SA7    A2          UPDATE 
          SA1    MOD
          BX7    X6+X1       MERGE IN CHARACTER LENGTH INFORMATION
          SA7    A1 
  
 TYP20    SA1    B4 
          SA4    TYPA        RESTORE (X4) = TYPE CODE 
          =B4    A1+1        POINT TO NEXT ITEM 
          SX2    X1-O.COMMA 
          ZR     X1,FEC.RTN  IF *EOS* 
          ERRNZ  O.EOS
          ZR     X2,TYP5     IF *COMMA* 
          =B4    B4-1 
          FATAL  E.TY        ISSUE NON-COMMA ERROR MESSAGE
          =B4    B4+1 
          EQ     FEC.RTN
  
 TYP26    SA1    B4          ATTEMPT TO RESUME SCAN 
          SB7    X1-O.COMMA 
          ZR     B7,TYP20    IF *COMMA* 
          SB4    B4+B1
          NZ     X1,TYP26    IF NO *EOS*
          ERRNZ  O.EOS
          EQ     FEC.RTN     EXIT TO FRONT END CONTROLLER...
  
 TYPA     BSSENT 1           TEMP CELL FOR TYPE 
 TYPB     CON    8LFUNCTION+O.VAR 
 TYPC     BSS    1           CHARACTER LENGTH (WC. FORMAT)
 TYPD     CONENT 0           LETTERS SELECTED ON IMPLICIT STATEMENT 
 TYPE     BSS    1           *WC* INDEX OF DECLARED SYMBOL
 TYPF     BSS    1           WC.CLIF SAVE ACROSS DIR CALL 
          TITLE  IMPLICIT 
 IMP      SPACE  4,20 
**        IMP -  PROCESS IMPLICIT TYPE DECLARATION. 
* 
*         ENTRY  FROM FRONT END CONTROLLER
*                CAN ALSO BE REENTERED IF FURTHER <TYPE-WORDS> ARE FOUND
* 
*                (B4) _ A <TYPE-WORD> IN *TB* 
* 
*         EXIT   TO FRONT END CONTROLLER
  
  
          HEREIF IMPLICIT 
  
 IMP      RJ     CSK         CHECK *IMPLICIT* SUB-KEYWORD 
  
*                (X4) = TYPE CODE FOR THIS SUB-KEYWORD
*                (X6) = CHARACTER LENGTH, IF TYPE CHARACTER 
  
          SA5    B4 
          SA3    A5+B1
          SB7    X5-O.( 
          NZ     B7,E.TYI1   MISSING BEGINNING LPAREN 
          MX7    0           CLEAR LETTER MASK FOR THIS TYPE
          HX6    WC.CLEN
          LX6    WC.CLENL 
          SA6    TYPC        SAVE CHARACTER LENGTH
          =B4    B4+1 
          LX6    WC.CLENP 
          SBIT   X6,WC.CTYPP
          PL     X6,IMP1     IF NOT ASSUMED LENGTH
          FATAL  E.TYI9 
          =X6    1
          SA6    A6          RESET TO DEFAULT CHARACTER LENGTH
  
  
*         ADD LETTER(S) TO THE RANGE MASK ACCUMULATING. 
*                (X7) = RANGE MASK -- LETTER BITS ACCUMULATED SO FAR. 
  
 IMP1     SX6    X3 
          BX6    X3-X6
          SB2    X3-O.VAR 
          MX0    MAX.VAR*CHAR-CHAR
          SA6    FILL.       SAVE FOR POSSIBLE ERROR MESSAGE
          =A6    A6+1        SAVE FOR POSSIBLE ERROR MESSAGE
          LX0    -CHAR
          NZ     B2,E.TYI2   LETTER IS REQUIRED 
          BX1    X0*X6
          =A2    B4+1 
          =B4    B4+1 
          ZR     X1,IMP3     IF SINGLE CHARACTER ONLY 
          MX5    CHAR 
          SA1    FILL.
          BX6    X1*X5
          SA6    FILL.3 
          WARN   E.TYI3 
  
 IMP3     AX3    -CHAR
          SB7    X2-O.MIN 
          BX5    0
          NZ     B7,IMP10    IF NOT A RANGE 
          =A5    B4+1 
          =B4    B4+1 
          SX6    X5 
          BX6    X5-X6
          SB2    X5-O.VAR 
          BX1    X0*X5
          SA6    FILL.       SAVE FOR POSSIBLE ERROR MESSAGE
          NZ     B2,E.TYI2   LETTER IS REQUIRED 
          AX5    -CHAR
          ZR     X1,IMP5     IF SINGLE CHARACTER
          SA1    FILL.
          MX0    CHAR 
          BX6    X0*X1
          SA6    FILL.3 
          WARN   E.TYI3 
  
 IMP5     IX5    X5-X3
          =A2    B4+1 
          =B4    B4+1 
          NZ     X5,IMP7
          WARN   E.TYI5      LAST = FIRST, WARN 
  
 IMP7     PL     X5,IMP10 
          BX5    0           TRUNCATE RANGE TO 1ST LETTER ONLY
          FATAL  E.TYI4      LAST .GT. FIRST
  
 IMP10    MX0    1
          SB7    X5 
          SB3    X3-60
          AX0    B7          MASK AS WIDE AS RANGE
          SB2    X2-O.COMMA 
          AX0    B3          POSITION MASK WHERE RANGE STARTS 
          BX7    X0+X7       ACCUMULATE MASK FOR THIS TYPE
          SB7    X2-O.) 
          =A3    B4+1 
          =B4    B4+1 
          ZR     B2,IMP1     IF *COMMA* 
  
  
**        CURRENT <TYPE> RANGE HAS BEEN ASSIMILATED.
*         ENTRY  (X4) = <TYPE>. 
*                (X7) = ITS NEW LETTER BITS.. 
*         EXIT   TO *IMP.EOS* IF STATEMENT IS ENDED, OR 
*                TO *IMP.KEY* TO BEGIN PROCESSING THE NEXT <TYPE-WORD>. 
*         NOW WE PROCEED TO ALTER NATURAL TYPE TABLE AS REQUESTED.
  
          SB2    N.TYPE-1 
          SA1    TYPD 
          BX6    X1+X7       SET SELECTED LETTERS 
          BX5    X7*X1
          SA6    A1 
          ZR     X5,IMP15    IF LETTERS NOT PREVIOUSLY MENTIONED
          SB3    B7          SAVE B7
          WARN   E.TYI8 
          SB7    B3          RESTORE B7 
          BX7    X7-X5       REMOVE BAD LETTERS 
  
 IMP15    SA1    B2+NAT.TYP 
          SB2    B2-B1
          BX6    -X7*X1      CLEAR SELECTED LETTERS FOR ALL TYPES 
          SA6    A1 
          PL     B2,IMP15    LOOP THROUGH ALL TYPES 
          SA1    X4+NAT.TYP 
          BX6    X1+X7       SET SELECTED LETTERS FOR SPECIFIED TYPES 
          SA6    A1 
          SX4    X4-M.CHAR
          NZ     X4,IMP19    IF NOT TYPE CHARACTER
          SA1    TYPC 
          SB2    26+1 
          =B3    0
          SB6    X1 
  
 IMP16    PL     X7,IMP18    IF LETTER NOT SELECTED 
          SX2    B3-1 
          MX0    30 
          LX2    -1 
          SX6    B6 
          SA5    X2+NAT.LEN  FETCH CHARACTER LENGTH PAIR
          MI     X2,IMP17    IF LOWER HALF
          BX5    -X0*X5      CLEAR UPPER HALF 
          LX6    30          CHARACTER LENGTH TO UPPER
          BX6    X6+X5       NEW LENGTH PAIR
          SA6    A5 
          EQ     IMP18
  
 IMP17    BX5    X0*X5       CLEAR LOWER HALF 
          BX6    X5+X6       NEW LENGTH PAIR
          SA6    A5 
  
 IMP18    =B2    B2-1 
          =B3    B3+1 
          LX7    1
          NZ     B2,IMP16    IF MORE TO CHECK 
  
 IMP19    NZ     B7,E.TYI6   IF MISSING ENDING *)*
          SB3    X3-O.COMMA 
          =B4    B4+1 
          ZR     X3,IMP20    IF *EOS* 
          ZR     B3,IMP      IF MORE TYPES TO SET 
          SB4    A3 
          EQ     E.TYI7 
  
  
**        HERE WHEN STATEMENT FULLY DIGESTED.  ANY FUNCTION NAME AND
*         FORMAL PARAMETERS ARE GIVEN THE PROPER IMPLICIT TYPE, AS PER
*         THE CURRENT DECLARATION.
  
 IMP20    SA3    MOD
          SA1    IDENT
          SA5    T.SYM
          MX0    -WB.MODEL
          SBIT   X3,MO.FUNP 
          PL     X3,IMP25    IF NOT FUNCTION SUBPROGRAM 
          SBIT   X3,MO.TYPP/MO.FUNP 
          MI     X3,IMP25    IF EXPLICITLY TYPED
          BX6    X1 
          LX3    MO.TYPP+1   RESTORE X3 
          RJ     STY         GET (NEW) IMPLICIT TYPE
          HX2    WC.CLEN
          LX2    WC.CLENL 
          SB3    X2          SAVE CHARACTER LENGTH
          SA2    S=ENTRY
          SB2    X2 
          SX6    B2+B2
          SX2    B2+X6       (X2) = INDEX = Z=SYM * ORDINAL 
          ERRNZ  3-Z=SYM
          IX2    X2+X5
          =A2    X2+WB.W
          BX2    X0*X2       DELETE FORMER MODE 
          IX7    X2+X1       INSERT NEW MODE
          SA7    A2          RESET (ENTRY.-TAG) 
          SX6    B3          CHARACTER LENGTH 
          LX6    WC.CLENP 
          =A6    A7-WB.W+WC.W 
          BX3    X0*X3       DELETE FORMER MODE 
          IX3    X3+X1       INSERT NEW MODE
          BX6    X6+X3       MERGE WITH CHARACTER LENGTH
          SA6    A3          UPDATE (MOD) 
  
 IMP25    SA2    T=FPI
          ZR     X2,IMP30    IF NO FORMAL PARAMETERS
          SA1    T.FPI
          MX3    -FP.PNTL 
          SA4    X1          INITIALIZE (T.FPI) FETCH 
          =B3    X5+WA.W
          SB6    X2          (B6) = NUMBER OF FORMALS 
  
 IMP27    LX4    -FP.PNTP 
          BX2    -X3*X4      (X2) = SYMORD OF FP
          LX6    X2,B1
          IX7    X6+X2       (X7) = SYMTAB INDEX
          ERRNZ  3-Z=SYM
          SA5    B3+X7       FETCH (X5) = (WA.) 
          HX5    WA.SYM 
          SX2    X5 
          ERRNZ  18+WA.SYML-60
          BX6    X5-X2       ISOLATE NAME = (WA.SYM)
          CALL   STY         GET (NEW) IMPLICIT TYPE
          =A5    A5-WA.W+WB.W 
          LX7    X2          CHARACTER LENGTH 
          SA4    A4+B1       FETCH NEXT (T.FPI) 
          BX2    X0*X5       CLEAR FORMER TYPE
          IX6    X1+X2
          =A7    A5-WB.W+WC.W 
          SB6    B6-B1
          SA6    A5 
          GT     B6,IMP27    IF TABLE NOT EXHAUSTED 
  
**        ANY PARAMETERS (SYMBOLIC CONSTANTS) WHICH MAY HAVE BEEN 
*         AFFECTED BY THE CURRENT IMPLICIT STATEMENT ARE DIAGNOSED. 
  
 IMP30    SA1    PARAMC      PARAMETER (SYMBOLIC CONSTANT) COUNT
          ZR     X1,FEC.RTN  IF NONE
          SA5    T.SYM
          SA2    T=SYM
          SB2    X2+WB.W
          SB3    X1          PARAMETER COUNT
          MX0    -WB.MODEL
  
 IMP31    SB2    B2-Z=SYM 
          ZR     B3,FEC.RTN  IF ALL PARAMETERS CHECKED
          SA4    X5+B2       FETCH WB.W 
          LX4    -WB.MODEP
          BX1    -X0*X4 
          SB6    X1 
          LX4    WB.MODEP 
          SB6    -B6         FOR CONFIRMING TYPE TEST 
          SBIT   X4,WB.LABP 
          MI     X4,IMP31    IF STATEMENT LABEL 
          SBIT   X4,WB.PARMP/WB.LABP
          PL     X4,IMP31    IF NOT PARAMETER 
          =A1    A4-WB.W+WA.W 
          =B3    B3-1 
          MX6    WA.SYML
          BX6    X6*X1
          SA6    FILL.
          CALL   STY         CHECK IMPLICIT TYPE
          SX1    X1+B6
          ZR     X1,IMP31    IF TYPE NOT MODIFIED 
          FATAL  E.TY8
          EQ     IMP31       CONTINUE...
  
  
**        IMP.ER - RETURN HERE FROM ERRORS TO ATTEMPT RECOVERY. 
*                LOOK FOR  ")," TO RESUME PROCESSING. 
*         ENTRY  (B4) _ CURRENT *SB* POSITION.
* 
* 
*         EXIT   TO *IMP* IF A ")," IS FOUND, OR
*                TO *IMP20* IF RECOVERY IS NOT SUCCESSFUL.
  
 IMP.ER   BSSENT 0           ...RETURN FROM ERROR PROCESSING
          SA1    B4+B1
          SB4    B4+B1
          SB2    X1-O.) 
          ZR     X1,IMP20    IF *EOS* 
          NZ     B2,IMP.ER   IF NO RPAREN 
          SA1    B4+B1
          SB4    B4+B1
          SB2    X1-O.COMMA 
          ZR     X1,IMP20    IF *EOS* 
          NZ     B2,IMP.ER   IF NO COMMA
          SB4    B4+B1       FOUND  COMMA FOLLOWED BY COMMA 
          EQ     IMP         TRY ANOTHER KEYWORD
          TITLE  SUBROUTINES
 CCL      SPACE  4,8
**        CCL -  CHECK CHARACTER LENGTH 
* 
*         ENTRY  (B4) _ * OF CHARACTER LENGTH SPECIFIER (IF PRESENT)
*                (X6) = DEFAULT CHARACTER LENGTH (WC. FORMAT) 
* 
*         EXIT   IF CHARACTER LENGTH SPECIFICATION PRESENT
* 
*                (B4) _ TOKEN FOLLOWING LENGTH SPECIFICATION
*                (X6) = LENGTH SPECIFIED (WC. FORMAT) 
* 
*                IF CHARACTER LENGTH SPECIFICATION ABSENT 
* 
*                (B4) _ UNCHANGED 
*                (X6) = UNCHANGED 
* 
*         USES   ALL
* 
*         CALLS  DEC, PAR 
  
  
 CCL      SUBR               ENTRY/EXIT 
          SA1    B4+
          SB7    X1-O.STAR
          NZ     B7,EXIT.    IF NO CHARACTER LENGTH SPECIFICATION 
          =A1    B4+1 
          =B4    B4+1 
          SB3    X1-O.LP
          SB2    X1-O.CONS
          ZR     B3,CCL2     IF *(* 
          SB7    E.TY3
          NZ     B2,CCL4     IF NOT CONSTANT
          SX6    PM=ICE      INDICATE 3D0 NOT CONSTANT
          SA6    PARNOW 
          CALL   DEC
          SX1    X1-M.INT 
          SB7    E.TY3
          NZ     X1,CCL4     IF NOT INTEGER 
          SB7    E.TY6
          ZR     X6,CCL4     IF ZERO
          SX2    X6-MAX.CL-1
          SB7    E.TY4
          PL     X2,CCL4     IF LENGTH SPECIFIER TOO LARGE
          LX6    WC.CLENP 
          =B4    B4+1 
          EQ     EXIT.
  
 CCL2     =A1    B4+1 
          =B4    B4+1 
          SB2    X1-O.STAR
          NZ     B2,CCL3     IF NOT ASSUMED LENGTH
          CLAS=  X6,WC,(CTYP) 
          =A1    B4+1 
          =B4    B4+1 
          SB2    X1-O.RP
          =B4    B4+1 
          ZR     B2,EXIT.    IF NO ERROR
          =B4    B4-1 
          EQ     E.TY5
  
 CCL3     CALL   PIX         PARSE INTEGER CONSTANT EXPRESSION
          SA1    B4 
          SB2    X1-O.RP
          NZ     B2,E.TY5    IF NOT RIGHT PAREN FOLLOWING LENGTH
          SB7    E.TY3
          MI     X6,CCL4     IF NEGATIVE CONSTANT 
          SB7    E.TY6
          ZR     X6,CCL4     IF ZERO
          SX2    X6-MAX.CL-1
          SB7    E.TY4
          SB4    B4+B1       ADVANCE TB POINTER TO SEPARATOR
          LX6    WC.CLENP 
          MI     X2,EXIT.    IF LENGTH SPECIFIER NOT TOO LARGE
  
 CCL4     FATAL  B7 
          SA1    B4+
          =X6    1           DEFAULT LENGTH 
          LX6    WC.CLENP 
          ZR     X1,EXIT.    IF *EOS* 
          SB7    X1-O.COMMA 
          ZR     B7,EXIT.    IF *,* 
          SB4    B4+1 
          EQ     EXIT.
 CSK      SPACE  4,10 
**        CSK - CHECK SUB-KEYWORD.
* 
* 
*         THIS ROUTINE CHECKS A SUB-KEYWORD ON AN *IMPLICIT*
*         STATEMENT AND RETURNS A SUB-KEYWORD TYPE CODE.
* 
*         ENTRY  (B4) = ADDR OF SUB-KEYWORD IN *T.TB*.
* 
*         EXIT   (B4) = ADDR OF TOKEN FOLLOWING SUB-KEYWORD.
*                (X4) = SUB-KEYWORD TYPE CODE.
*                (X6) = CHARACTER LENGTH (WC. FORMAT, IF TYPE CHARACTER)
* 
*         USES   ALL
* 
*         CALLS  CAK, CCL, CDP
  
  
 CSK      SUBR               ** ENTRY/EXIT ** 
          SB6    FW.TYSK     (B6) = FWA OF *TYPE* SUB-KEYWORD TABLE 
          SB7    L.TYSK      (B7) = LEN OF *TYPE* SUB-KEYWORD TABLE 
          CALL   CAK         CHECK FOR AND ADJUST KEYWORD 
          ZR     B7,E.TYI    IF NO SUB-KEYWORD
          MI     B7,E.TYI    IF MISSPELLED KEYWORD
          LX6    0-KW.INFOP 
          SX4    X6 
          ERRNZ  18-KW.INFOL
          MX6    0           RETURN (X6) = 0 WHEN NOT CHAR
          SX7    X4-M.CHAR
          NZ     X7,EXIT.    IF NOT CHARACTER 
          MX7    1
          SA7    CHARDCL
          =X6    1           DEFAULT CHARACTER LENGTH 
          LX6    WC.CLENP 
          RJ     CCL         CHECK CHARACTER LENGTH 
          =X4    M.CHAR      RESTORE (X4) = CHAR
          EQ     EXIT.
 FW.TYSK  SPACE  4,10 
**        FW.TYSK - *TYPE/IMPLICIT* SUB-KEYWORD TABLE.
* 
* 
  
 FW.TYSK  BSS    0           FWA OF *IMPLICIT* SUB-KEYWORD TABLE
          SUBKEY BOOLEAN,M.BOOL 
          SUBKEY CHARACTER,M.CHAR 
          SUBKEY COMPLEX,M.CPLX 
          SUBKEY DOUBLEPRECISION,M.DBL
          SUBKEY INTEGER,M.INT
          SUBKEY LOGICAL,M.LOG
          SUBKEY REAL,M.REAL
 L.TYSK   =      *-FW.TYSK
          SPACE  4,10 
          LIST   D
          END 
