'HEAD'  LABEL PROCESSING
C     EDIT DATE   09DEC78  15:43
C     SOURCE FILE LABELFTM.FS
C     AUTHOR      F. T. MICKEY
C     CLUSTER     7
      'OUTFILE'   LABELDATA.FR
      BLOCK DATA
      'INCLUDE'   LABCOMFTM.IN,P
      DATA         LTLI /0/
      END
      'OUTFILE'   LABELFTM.FR
N     OVERLAY     OLLAB
      SUBROUTINE  LABEL
C
C     PROCESSES LABEL DEFINITIONS, CHECKING FOR "LABEL::"
C     ENTRY POINT DEFINITIONS
C
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' OPERSAJH.IN,
      'INCLUDE' NLISTCFTM.IN,
      'INCLUDE' BLDPOAJH.IN,
      'INCLUDE' BRACEFTM.IN,
      'INCLUDE' RMCODES.IN,
      'INCLUDE'   STKDEFA.IN,
      'INCLUDE' LCFUNCAJH.IN,
      'INCLUDE' LCONSTAJH.IN,
      'INCLUDE' LABCOMFTM.IN,
      'INCLUDE'   CODE1FTM.IN,
      INTEGER APAREN
      'EJECT'
C     LOOK FOR LOCAL LABELS
      'IF' (SPARFL .EQ. 0)
C        NOT IN A LOCAL AREA
         CALL NDEFN
         'ELSE'
C        THIS IS A LOCAL AREA
C        REDIRECT ANY PRIOR REFERENCES
         'DOLOOP' LLX = LTLI, TLI
            'IF' (TL (LLX) .EQ. -NLX)
               TL (LLX) = LC
               CALL DEFTL (LLX)
               'ENDIF'
            'END'
C        PUT THE DEFINITION IN THE LIST
         CALL LIST (LLNAME, NLX, 0)
         LLX = 1
         'DO'
            'IF' (LOCNLX (LLX) .EQ. NLX)
               CALL FAULTP (18)  // IT'S BEEN DEFINED BEFORE
               'BREAK'
               'ENDIF'
            'IF' (LOCNLX (LLX) .EQ. 0)
               LOCNLX (LLX) = NLX
               LOCTLI (LLX) = TLI
               CALL DEFTL (TLI)
               TLI = TLI + 1
               'BREAK'
               'ENDIF'
            LLX = LLX + 1
            IF (LLX .GT. 10) CALL FAULTP (55)
            'WHILE' (LLX .LE. 10)
               'END'
         'ENDIF'
      LABNLX = NLX
      CALL REGMAN (CLRACV, 0, 0)
      CALL SET (0, FLSAVE, 6)
      DEFMOD = STDMD
C     LOOK FOR "LABEL::" ENTRY POINT
      CALL PEEK
      'IF' (PEEKS .EQ. COLON)
         CALL FNZS
         IF (SPARFL .EQ. 0) ^
            CALL NLSET (NLX, EPBIT)
         'ENDIF'
      'EJECT'
      'IF' (STOAC .NE. 0)
         STOAC = 0
         CALL FAULTP (8)
         CALL SCAN (RBRACE, NINE, FOR)
         RETURN
         'ENDIF'
      CALL PEEK
      'IF' (PEEKS .EQ. LBRACE)
C        SET SUBROUTINE ENTRY
         SUBENT (SELX) = 0
         CALL STSLX (1)       // STEP SELX
         CALL PLBR         // PROCESS LEFT BRACE (1)
C        END SET SUBROUTINE ENTRY
         RETURN
         'ENDIF'
      'IF' (PEEKS .EQ. LPAREN)
         CALL PEEKFO
         IF (PEEKS .GE. SP) CALL PEEKFO
         IF (PEEKS .EQ. COMMA) GO TO 1000
         'IF' (PEEKS .EQ. RPAREN)
            CALL PEEKA
            'IF' (PEEKS .EQ. LBRACE)
               GOTO 1000
               'ENDIF'
            'ENDIF'
         'ENDIF'
      RETURN
'EJECT'
C     SUBROUTINE F PARAM
1000  IF (SPARFL .NE. 0) CALL FAULTP (54)
      CALL STSLX (1)       // STEP SELX
      PARFLG = 1
      FUNCNT = FUNCNT + 1
      PARSAV = -1
      'DO'
         'WHILE' (PARFLG .NE. 0 .AND. NEXTOP .NE. RPAREN)
            DEFMOD = STDMD
            CALL ADVAN
            ARGSIZ = 2
            'IF' (NEXTOP .GE. SP)
               DEFMOD = NEXTOP - SP
               CALL ADVAN
               'ENDIF'
            NLX = NAMEX (OPX)
C           PROCESS PARAMETER
            CALL RBOTH (NOUNLC)
            CALL NDEFN
            CALL NLSET (NLX, PBIT)
            SUBENT (SELX) = NLX
            IF (PARSAV .EQ. -1) PARSAV = NLX
            MAXLCV = MAXLCV + ARGSIZ
            CALL LIST (LBSS, ARGSIZ, 0)
            CALL SETLCI
            CALL STSLX (2)    // BUMP SELX
            'END'
      PARFLG = 0
      CALL RBOTH (CODE)
      SUBENT (SELX) = PARCNT
      SELX = SELX + 1
      SPARFL = PARCNT
      CALL ADVAN
      CALL PLBR
C     SAVE THE CURRENT TRANSFER LIST INDEX FOR LOCAL LABEL PROCESSING
      LTLI = TLI
      CALL SET (0, LOCNLX, 10)
      RETURN
      END
      'OUTFILE' DEFTLFTM.FR
C     SUBROUTINE DEFTL
C
C     MAKE AN ENTRY IN THE TRANSFER LIST
C
      SUBROUTINE DEFTL (TLX)
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' CODE1FTM.IN,
      'INCLUDE' LCONSTAJH.IN,
      INTEGER TLX
      TL (TLX) = LC
      CALL LIST (LTLNA, TLX, 0)
      RETURN
      END