*DECK     TYPE
          IDENT  TYPE 
 TYPE     SECT   (EXPLICIT / IMPLICIT T Y P E DECLARATIONS.),1
  
          SST    B,D
          NOREF  B,D
  
 B=TYPE   RPVDEF             DEFINE ROUTINE FWA FOR REPRIEVE UTILITY
  
          ENTRY  IMP.ER,TYPA,TYPC,TYP02 
          ENTRY  TYPD 
          ENTRY  TYPF 
  
*         IN TABLES 
          EXT    ENTRY.,ETF,IDENT,MOD,NARGS,REFVAR,STAGE,TS=SYM 
          EXT    TS.SYM,VALUE.
  
*         IN ERRORS 
          EXT    E.ADP,E.ANS,E.FM,E.TE5,E.TT,E.TY,E.TYA 
          EXT    E.TYH,E.TYIK,E.TYI1,E.TYI2,E.TYI3,E.TYI4,E.TYI5,E.TYI6 
          EXT    E.TYI7,E.ZA,FILL.,FILL.3,E.SU12
  
*         IN HEADER 
          EXT    PSF,PSFA 
  
*         IN ALLOC
          EXT    ERT,ESY,SSY
  
*         IN MAIN 
          EXT    CPM=1ST,CSK,PSP,ASK
  
*         IN LEX
          EXT    NAT.TYP,STY
  
*         IN KEY
          EXT    FUNCTI=
  
*         IN DECL 
          EXT    DIR
  
*         IN IO 
          EXT    LGR,PRECISI,FUNCTIO,TYPES
  
 TYPE-KEY SPACE  4,8
**        TYPE KEY WORDS. 
* 
*         HERE WHEN KEYWORD IS -- 
* 
*                L O G I C A L
*                I N T E G E R
*                R E A L
*                D O U B L E
*                D O U B L E   P R E C I S I O N
*                C O M P L E X
* 
*         EXIT   TO *TYP* WITH
*                (X4) = APPROPRIATE TYPE INDICATION.
  
  
          HEREIF LOGICAL
          =X4    M.LOG
          EQ     TYP
  
          HEREIF INTEGER
          =X4    M.INT
          EQ     TYP
  
          HEREIF REAL 
          =X4    M.REAL 
          EQ     TYP
  
          HEREIF DOUBLE 
          SA1    B4 
          SA2    DOUA 
          BX6    X1-X2
          NZ     X6,DOU2     IF NOT *PRECISI* 
          SA3    B4+B1
          SB7    -2RON
          AX3    8*CHAR 
          SB2    X3+B7
          NZ     B2,DOU2     IF NOT *PRECISION* 
          SX5    PRECISI
          SA5    X5+LGR 
          RJ     ASK         REMOVE KEYWORD AND ADJUST *SB* 
          ZR     X3,DOU4
          TRUBL  E.ZA 
  
 DOU2     ANSI   E.ADP       ANSI REQUIRES *PRECISION*
 DOU4     =X4    M.DBL
  
 CO.DTS   IF     DEF,CO.DTS        -- CHECK D.P. ELIMINATION OPTION --
          SA3    CO.DTS 
          PL     X3,TYP      IF D.P. ELIMINATION NOT SELECTED 
          =X4    M.REAL 
 CO.DTS   ENDIF 
  
          EQ     TYP         EXIT.. 
  
 DOUA     CON    7LPRECISI+O.VAR
          HEREIF PRECISION
          EQ     E.FM 
  
          HEREIF COMPLEX
          =X4    M.CPLX 
          EQ     TYP
 TYPE     SPACE  4,8
**        TYPE - PROCESS  " T Y P E "  KEYWORD. 
  
  
          HEREIF TYPE 
  
          ANSI   E.TYA       *TYPE* IS NON-ANSI 
  
          SB7    E.TYH
          SA1    TYPES
          SB5    L.TYPE 
          EQ     CSK         CHECK SUB-KEYWORD
  
  
 IMP      SPACE  4,20 
**        IMP -  PROCESS  " I M P L I C I T "  TYPE DECLARATION.
* 
*         ENTRY  FROM MASTER LOOP, OR 
*                FROM *TYPE* KEYWORD. 
*                CAN ALSO BE RE-ENTERED  (AT *IMP.KEY*) IF SUBSEQUENT 
*                     <TYPE-WORDS> ARE FOUND. 
*                (B4) _ A <TYPE-WORD> IN *SB*.
* 
*         EXIT   THRU *CSK* TO LOOK-UP THE <TYPE> KEYWORD.
*                (B4) UNCHANGED.
*                (TYPC) " 0 TO SIGNAL AN *IMPLICIT* STATEMENT.
*                THE <TYPE-WORD> PROCESSOR WILL GO TO *TYP* WHO WILL
*                     RETURN TO *IMP.(* WHEN HE SEES (TYPC) SET.
  
  
          HEREIF IMPLICIT 
  
          ANSI   E.ANS
          MX6    -1 
          SA6    TYPC        SIGNAL *IMPLICIT* PROCESSING 
          SA3    TYPF        FLAG ALLOWS ONE IMPLICIT STM PER PGM UNIT
          NZ     X3,=XE.MIJ  IF ONE IMPLICIT STM PROCESSED - WARNING
          =X7    1           SET TO DISALLOW MULTIPLE IMPLICIT STM-S
          SA7    A3 
  
 IMP.KEY  SB7    E.TYIK 
          SA1    TYPES
          SB5    L.TYPE-1 
          EQ     CSK         CHECK NEXT KEYWORD 
  
  
**        IMP.( - ENTERED FROM *TYP* WHEN IMPLICIT FLAG IS SET. 
*                (X4) = NEW TYPE
  
 IMP.(    SA5    B4 
          SA3    A5+B1
          SB7    X5-O.( 
          NZ     B7,E.TYI1   MISSING BEGINNING LPAREN 
          MX7    0           CLEAR LETTER MASK FOR THIS TYPE
          SB6    X4          SAVE TYPE
  
  
**        IMP.COMA - ADD LETTER(S) TO THE RANGE MASK WE ARE BUILDING. 
*                (X7) = RANGE MASK -- LETTER BITS ACCUMULATED SO FAR. 
  
 IMP.COMA SX6    X3 
          BX6    X3-X6
          SB2    X3-O.VAR 
          MX0    LG.VAR*CHAR-CHAR 
          SA6    FILL.       SAVE FOR POSSIBLE ERROR MESSAGE
          SA6    A6+B1        SAVE FOR POSSIBLE ERROR MESSAGE 
          LX0    -CHAR
          NZ     B2,E.TYI2   LETTER IS REQUIRED 
          BX1    X0*X6
          SA2    A3+B1
          ZR     X1,IMP3     IF SINGLE CHARACTER ONLY 
          MX0    CHAR 
          SA1    FILL.
          BX6    X1*X0
          SA6    FILL.3 
          WARN   E.TYI3 
 IMP3     AX3    -CHAR
          SB7    X2-O.MIN 
          BX5    0
          NZ     B7,IMP5     IF NOT A RANGE 
          SA5    A2+B1
          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,IMP35    IF SINGLE CHARACTER
          WARN   E.TYI3 
 IMP35    IX5    X5-X3
          SA2    A5+B1
          NZ     X5,IMP4
          WARN   E.TYI5      LAST = FIRST, WARN 
 IMP4     PL     X5,IMP5
          BX5    0           TRUNCATE RANGE TO 1ST LETTER ONLY
          FATAL  E.TYI4      LAST .GT. FIRST
 IMP5     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.) 
          SA3    A2+B1       (EXPECT COMMA OR EOS)
          ZR     B2,IMP.COMA IF A COMMA 
  
  
**        CURRENT <TYPE> RANGE HAS BEEN ASSIMILATED.
*         ENTRY  (B6) = <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    L.TYPE-1 
          SA1    TYPD 
          BX6    X1+X7       SET SELECTED LETTERS 
          BX5    X7*X1
          SA6    A1 
          ZR     X5,IMP6     IF LETTERS NOT PREVIOUSLY MENTIONED
          SB3    B7          SAVE B7
          WARN   =XE.TY1
          SB7    B3          RESTORE B7 
          BX7    X7-X5       REMOVE BAD LETTERS 
 IMP6     SA1    B2+NAT.TYP 
          SB2    B2-B1
          BX6    -X7*X1      CLEAR SELECTED LETTERS FOR ALL TYPES 
          SA6    A1 
          PL     B2,IMP6     LOOP THRU ALL TYPES
          SA1    B6+NAT.TYP-1 
          BX7    X1+X7       SET SELECTED LETTERS FOR SPECIFIED TYPES 
          SA7    A1 
  
          SB4    A2 
          NZ     B7,E.TYI6   IF MISSIN G ENDING ) 
          SB3    X3-O.COMMA 
          SB4    A3+B1
          ZR     X3,IMP.EOS  IF *EOS* 
          ZR     B3,IMP.KEY  IF MORE TYPES TO SET 
          SB4    A3 
          EQ     E.TYI7 
  
  
**        IMP.EOS - HERE WHEN STATEMENT FULLY DIGESTED. 
*                NATURAL TYPE TABLE HAS BEEN SET UP (PROPERLY), BUT WE
*                HAVE STILL TO INSURE THAT ANY FUNCTION NAME AND FORMAL 
*                PARAMETERS ARE INCLUDED IN THE SCOPE OF THE IMPLICIT 
*                STATEMENT. 
*         EXIT   TO *TYP10* TO CHECK/FLAG USEAGES OF THE NON-ANSI IBM 
*                     <*SIZE> CONSTRUCT.
  
 IMP.EOS  SA3    MOD
          SA2    ETF
          MX0    -L.MODE
          SA5    TS.SYM 
          IFBIT  X3,-PFNC,IMP7
          NZ     X2,IMP7     IF FUNCTION EXPLICITLY TYPED 
          SA1    IDENT
          BX6    X1 
          LX3    P.PFNC+1    RESTORE X3 
          RJ     STY         GET (NEW) IMPLICIT TYPE
          SA2    ENTRY. 
          SX2    X2 
          SA4    VALUE. 
          BX7    -X0*X3      ISOLATE FORMER TYPE
          IX2    X2+X5
          BX1    X1-X7
          SA2    X2 
          IX4    X4+X5
          BX6    X3-X1
          SA6    A3          RESET PROGRAM-UNIT MODE
          SA4    X4 
          BX7    X2-X1
          SA7    A2          RESET (ENTRY.-TAG) 
          BX6    X4-X1
          SA6    A4          RESET (VALUE.-TAG) 
  
 IMP7     SA4    NARGS
          SA2    TS=SYM 
          ZR     X4,PSP      IF NO ARGUMENTS
          =B2    2
          SA3    X5+B1
          SB6    X2          (B6) = LENGTH OF SYMBOL TABLE
 IMP74    SBIT   X3,FP
          SB6    B6-B2
          PL     X3,IMP76    IF NO FORMAL PARAMETER 
          SA1    A3-B1
          LX3    P.FP+1      RESTORE (X3) 
          SX2    X1 
          BX6    X1-X2       CLEAR OUT LINK 
          RJ     STY         GET (NEW) IMPLICIT TYPE
          BX2    X0*X3       CLEAR FORMER TYPE
          IX6    X1+X2
          SA6    A3 
 IMP76    SA3    A3+B2
          GT     B6,IMP74 
          EQ     PSP         EXIT 
  
  
**        IMP.ER - RETURN HERE FROM ERRORS TO ATTEMPT RECOVERY. 
*                LOOK FOR  ")," TO RESUME PROCESSING. 
*         ENTRY  (B4) _ CURRENT *SB* POSITION.
*         EXIT   TO *IMP.KEY* IF A ")," IS FOUND, OR
*                TO *IMP.EOS* IF RECOVERY IS NOT SUCCESSFUL.
  
 IMP.ER   SA1    B4+B1
          SB4    B4+B1
          SB2    X1-O.) 
          ZR     X1,IMP.EOS  IF *EOS* 
          NZ     B2,IMP.ER   IF NO RPAREN 
          SA1    B4+B1
          SB4    B4+B1
          SB2    X1-O.COMMA 
          ZR     X1,IMP.EOS  IF *EOS* 
          NZ     B2,IMP.ER   IF NO COMMA
          SB4    B4+B1       FOUND  COMMA FOLLOWED BY COMMA 
          EQ     IMP.KEY     TRY ANOTHER KEYWORD
 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  ADF, ASL, BTT, DIR, PWE, STY, TAB
  
  
 TYP      SA1    STAGE
          SA3    TYPC 
*         THE CONDITIONAL =X1-CPM=1ST WAS HERE. 
*         IF CPM=1ST IS EVER " 0, REPLACE 
          NZ     X1,TYP0     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,TYP01    IF NOT *FUNCTION*
          BX6    X4 
          SA6    ETF         INDICATE FUNCTION EXPLICITLY TYPED 
          SX5    FUNCTIO
          SA5    X5+LGR 
          RJ     ASK         ADJUST STATEMENT KEYWORD 
          ZR     X3,FUNCTI= 
          TRUBL  E.ZA 
  
  
 TYP01    BX6    X4 
          MX7    1
          SA6    TYPA        SAVE TYPE
          SA7    PSFA        INDICATE THAT RETURN FROM *PSF* SHOULD BE
*                            TO  TYP02
          EQ     PSF         PROCESS DUMMY HEADER CARD
  
 TYP02    SA4    TYPA        RETURN FROM PSF
          SA3    TYPC        RESTORE X3 + X4
 TYP0     BX6    X4 
          SA6    TYPA        SAVE TYPE
          SA2    B4 
          =X7    CR.DEC 
          SA7    REFVAR 
          NZ     X3,IMP.(    IF PROCESSING *IMPLICIT* 
 TYP1     SA2    B4 
          MX0    LG.VAR*CHAR
          SB7    X2-O.VAR 
          BX6    X0*X2
          SA6    FILL.
          LX6    CHAR 
          SB6    X6-1R0 
          PL     B6,TYP12    IF FIRST CHARACTER NOT LETTER
          LX6    -CHAR       RESTORE
          NZ     B7,TYP12    IF NOT SYMBOL
          SCAN   TS.SYM,SSY 
          MI     B7,TYP5     IF NO ENTRY
          NZ     X1,TYP2     IF NO CONFLICT BETWEEN FUNCT MODE & VAR MODE 
          FATAL  E.SU12 
 TYP2     MX0    -L.MODE
          MX0    -L.MODE
          BX5    X2 
          IFBIT  X5,TYP,TYP4  IF PREVIOUS TYPING
          BX6    X0*X2       CLEAR IMPLICIT MODE
          SX0    M.TYP
          IX6    X4+X6       ADD IN NEW MODE
          BX6    X0+X6       SET TYPE DECLARATION BIT 
          SA6    A2          RESET INTO TS.SYM
          EQ     TYP7 
  
 TYP4     WARN   E.TT        CURRENT TYPING IGNORED 
          EQ     TYP7 
  
 TYP5     SX0    M.TYP
          BX7    X0+X4       SET TYPE AND TYPE DECLARATION BIT
          ADSYM  A1 
  
 TYP7     SA1    B4+B1
          SB7    X1-O.VAR 
          NZ     B7,TYP75    IF NOT LONG NAME 
          RJ     =XTLV       TRUNCATE NAME
          =A1    B4+1 
 TYP75    SX2    X1-O.( 
          ZR     X2,TYP8     IF DIMENSIONED 
          ADDREF X6,CR.DEC,TYP9 
  
 TYP8     RJ     DIR         PROCESS DIMENSIONED VARIABLE 
  
 TYP9     =A1    B4+1        FETCH SEPARATOR
          SA4    TYPA        RESTORE (X4) = TYPE CODE 
          =B4    A1+1        POINT TO NEXT ITEM 
          SX2    X1-O.COMMA 
          ZR     X1,PSP 
          ZR     X2,TYP1     IF COMMA 
          SA2    X1+=XCHARMAP 
          MX0    L.CDPC 
          NZ     X2,TYP9A    IF NOT VARIABLE OR CONSTANT
          LX2    X1 
 TYP9A    BX6    X0*X2
          SA6    FILL.
          EQ     E.TY        ISSUE NON-COMMA ERROR MESSAGE
 TYP9B    SA1    TYPA+1 
  
 TYP12    SA1    X2+=XCHARMAP 
          ZR     X1,E.TE5    IF FILL. ALREADY SET 
          MX0    L.CDPC 
          BX6    X0*X1
          SA6    FILL.
          EQ     E.TE5       SYNTAX ERROR 
 TYP13    SA1    B4          ATTEMPT TO RESUME SCAN 
          SB7    X1-O.COMMA 
          ZR     B7,TYP14    IF A COMMA 
          SB4    B4+B1
          NZ     X1,TYP13    IF NO *EOS*
          EQ     PSP         EXIT.. 
 TYP14    =B4    B4-1 
          EQ     TYP9        RESUME SCAN
  
 TYPA     BSS    1           TEMP CELL FOR TYPE 
 TYPB     CON    8LFUNCTION+O.VAR 
 TYPC     DATA   0           NON-ZERO WHEN *IMPLICIT* STMMT IN PROGRESS 
 TYPD     DATA   0           LETTERS SELECTED ON IMPLICIT STATEMENT 
 TYPF     DATA   0           = 0 , NO IMPLICIT STMMT PROCESSED
*                            = 1 , 1 IMPLICIT STMMT PROCESSED 
          LIST   D
          END 
