'HEAD'  ERROR PROCESSING
C     EDIT DATE   18JAN79  21:02
C     SOURCE FILE FAULTFTM.FS
C     AUTHOR      F. T. MICKEY
C     CLUSTER     25
      'OUTFILE'   FAULTPFTM.FR
      SUBROUTINE  FAULTP (FAULT)
      'INCLUDE'   CTRLAJH.IN,
      'INCLUDE'   FAULTSFTM.IN,P
      INTEGER     FAULT
      EXTERNAL    OLFLT
      'IF' (CTLUSE .NE. 0)
         CTLERR = FAULT
         'ELSE'
         FLTNR = FAULT
C         CALL OVLOD (OLFLT)
         CALL OFAULT
         EXFLT = 0
         'ENDIF'
      RETURN
      END
      'OUTFILE'   FATALFTM.FR
      SUBROUTINE  FATAL (ERROR)
      INTEGER     ERROR
      'INCLUDE'   CTRLAJH.IN,
      EXTERNAL    OLPS2
      CTLUSE = 0
      CALL FAULTP (ERROR)
C      CALL OVLOD (OLPS2)
      CALL QUIT
      STOP
      END
      'OUTFILE'   OBJFLTAJH.FR
      SUBROUTINE  OBJFLT (FAULT)
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   OBJECTAJH.IN,
      'INCLUDE'   PRTCOMFTM.IN,
      INTEGER     FAULT
      INTEGER     MSGS (16, 6)
      DATA  MSGS / ^
         'SEE SYSTEMS PROGRAMMING **1**   ',^   // 1
         'ILLEGAL INSTRUCTION FORMAT      ',^   // 2
         'SEE SYSTEMS PROGRAMMING **3**   ',^   // 3
         'BRANCH ADDRESSING ERROR         ',^   // 4
         'ADDRESS OUT OF RANGE (PASS 2)   ',^   // 5
         'MISSING ENTRY POINT DEFINITION  '/    // 6
      CALL EHX (LC,     LBUF, 1, 4)     // LOCATION COUNTER VALUE
      CALL EHX (NEWLCI, LBUF, 6, 9)     // LOCATION COUNTER
      CALL EHX (OW,     LBUF, 11, 14)   // OBJECT WORD
      CALL ESP (WF,     LBUF,  1, 20)   // WORD FLAG
      CALL EHX (RWORD1, LBUF, 22, 25)   // OUTPUT BLOCK 1, 2, 3
      CALL EHX (RWORD2, LBUF, 27, 30)
      CALL EHX (RWORD3, LBUF, 32, 35)
      CALL WRLIN (CO, LBUF, 36)
      CALL SGLPRT
      CALL EST ('**ERROR**', LBUF, 1, 9)
      CALL EST (MSGS (1, FAULT), LBUF, 11, 42)
      CALL WRLIN (CO, LBUF, 43)
      CALL SGLPRT
      CALL SGLPRT
      FLTCNT = FLTCNT + 1
      RETURN
      END
      'OUTFILE'   OFLTAPB.FR
N     OVERLAY     OLFLT
      SUBROUTINE  OFAULT
      INTEGER     PFLTS
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   PRTCOMFTM.IN,
      'INCLUDE'   CTRLAJH.IN,
      'INCLUDE'   SRCDFSFTM.IN,
      'INCLUDE'   FAULTSFTM.IN,
      'INCLUDE'   FLMSGAPB.IN,

      PFLTS = PRINTF
      'IF' (PFLTS .EQ. 0)
C        PRINT THE LINE IN ERROR
         CALL ESP (PGECNT, LBUF, 1, 4)
         CALL ESP (FLINCT (PI), LBUF, 1, 8)
         CALL EST (RECORD, LBUF, 11, 90)
         PRINTF = 1
         CALL SGLPRT
         'ENDIF'
C     PRINT THE ERROR MESSAGE
      CALL SGLPRT
      CALL EST ('**ERROR**', LBUF, 1, 9)
      CALL EST (MSGS (1, FLTNR), LBUF, 11, 42)
      IF (EXFLT .NE. 0) ^
         CALL ESP (EXFLT, LBUF, 1, 54)
      CALL WRLIN (CO, LBUF, 55)
      CALL SGLPRT
      CALL SGLPRT
      FLTCNT = FLTCNT + 1
      PRINTF = PFLTS
      RETURN
      END
      'OUTFILE'   FMSGDATA.FR
      BLOCK DATA
      'INCLUDE'   FLMSGAPB.IN,P
      'EJECT'
      DATA MSG01/^
         '                                ',^
         '                                ',^
         'MISSING OPERATOR AFTER )        ',^
         'ILLEGAL NOUN LIST CONSTRUCTION  ',^
         'ILLEGAL USE OF NAME             ',^
         'SEE SYSTEMS PROGRAMMING **6**   ',^
         'TOO MANY RELATIONALS (30)       ',^
         'ILLEGAL OPERATOR PAIR           ',^
         'ILLEGAL XXX OPERATOR            ',^
         'MISSING NAME (OPERAND)          '/
      DATA MSG11/^
         'CONSTANT EXPRESSION REQUIRED    ',^
         'MISSING RIGHT BRACE(S)          ',^
         'TOO MANY EQUIVALENT NAMES (50)  ',^
         'EXTRA RIGHT BRACES              ',^
         'DP ARS/ALS NOT IMPLEMENTED      ',^
         'ILLEGAL MODE/TYPE OPERATOR USE  ',^
         'NAME USED BEFORE DEFINITION     ',^
         'MULTIPLE NAME DEFINITION        ',^
         'TOO MANY NAMES (499)            ',^
         'ILLEGAL OPERATOR AFTER NAME     '/
      DATA MSG21/^
         '                                ',^
         'MISSING ASM ;                   ',^
         'STORE INTO/INCREMENT A CONSTANT ',^
         'MISSING OPERATOR AFTER STRING   ',^
         'MISSING COMPARISON TERMINATORS  ',^
         'MISSING OPERATOR AFTER NUMBER   ',^
         'ILLEGAL ASM OP CODE             ',^
         'STRING TOO LONG (200 CHARS)     ',^
         '                                ',^
         'MISSING INITIAL VALUE           '/
      DATA MSG31/^
         'ILLEGAL SUBSCRIPT               ',^
         'MISSING OPERATOR AFTER SUBSCRIPT',^
         'MISSING COLON IN I/O STATEMENT  ',^
         'ILLEGAL RELATIONAL OPERATOR     ',^
         'ILLEGAL REGISTER USE            ',^
         'ILLEGAL & OR OR CONNECTOR       ',^
         'TOO MANY COMPARISONS (9)        ',^
         '                                ',^
         'SP LSS 0 OR GEQ 0               ',^
         '                                '/
      DATA MSG41/^
         'MISSING SUBSCRIPT OPERAND       ',^
         'ILLEGAL SP INDIRECT JUMP        ',^
         'ILLEGAL LT,GT IN QUOTE          ',^
         '                                ',^
         'STACK OVERFLOW (FATAL)          ',^
         'STACK UNDERFLOW (FATAL)         ',^
         '                                ',^
         'NAME TEXT OVERFLOW (3000 CHARS) ',^
         'MISSING SUBSCRIPT WITH TP       ',^
         'EXTRA OPERAND                   '/
      'EJECT'
      DATA MSG51/^
         '                                ',^
         'TOO MANY PARAMETERS DEFINED (6) ',^
         'INTERNAL ERROR-- BRACE STACK    ',^
         'ILLEGAL NESTED FUNCTION         ',^
         'TOO MANY LABELS IN FUNCTION (10)',^
         '                                ',^
         'TOO MANY COMMON BLOCKS (9)      ',^
         'MISSING LEFT BRACE              ',^
         'TOO MANY LEFT BRACES (10)       ',^
         'MISSING ) OR ]                  '/
      DATA MSG61/^
         'EXTRA ]                         ',^
         'EXTRA )                         ',^
         'EXTRA ;                         ',^
         'JUMP OR CALL TO A CONSTANT      ',^
         'SUBSCRIPTED CONSTANT            ',^
         'ILLEGAL USE OF LOC OPERATOR     ',^
         'ILLEGAL USE OF RETURN OPERATOR  ',^
         'ILLEGAL USE OF ZREL OPERATOR    ',^
         'NO FREE REGISTER (FATAL)        ',^
         'ILLEGAL STKPTR USAGE            '/
      DATA MSG71/^
         'ILLEGAL CONTROL DIRECTIVE NAME  ',^
         'ERROR WITHIN CONTROL DIRECTIVE  ',^
         'INVALID ORG DIRECTIVE           ',^
         'USE FILE DOES NOT EXIST         ',^
         'ILLEGAL CRUTCH FORMAT           ',^
         '                                ',^
         '                                ',^
         '                                ',^
         'UNEXPECTED FLOWCHART END        ',^
         'UNEXPECTED END DIRECTIVE        '/
      DATA MSG81/^
         '... ERROR IN SCAN (FATAL)       ',^
         'UNEXPECTED EOF                  ',^
         '                                ',^
         '                                ',^
         '                                ',^
         'NUMBER TOO LARGE                ',^
         'WARNING OF INCOMPATIBILITY      ',^
         'ILLEGAL SOURCE CHARACTER        ',^
         'FLOWCHART TOO COMPLEX           ',^
         '                                '/
      END
      'OUTFILE'   SCANAJH.FR
      SUBROUTINE  SCAN (MATCH, LOW, HIGH)
      INTEGER     MATCH,  LOW,    HIGH
      EXTERNAL    OLSCN
C      CALL OVLOD (OLSCN)
      CALL OSCAN (MATCH, LOW, HIGH)
      RETURN
      END
      'OUTFILE'   OSCANAJH.FR
N     OVERLAY     OLSCN
      SUBROUTINE  OSCAN (MATCH, LOW, HIGH)
      INTEGER     MATCH, LOW, HIGH
      'INCLUDE'   LOGOSAJH.IN,
      'INCLUDE'   OPERSAJH.IN,
      'INCLUDE'   SRCXDFFTM.IN,
      SCFLAG = 1                          // PRINT ////ES//// ON LINES
      'DO'
         'IF' (PSYMB .EQ. PERIOD)
            CALL PEEK
            IF (PEEKS .EQ. PERIOD) ^
               CALL FATAL (81)            // CAN'T COPE WITH FC END
            'ENDIF'
         'IF' ( (PSYMB .EQ. MATCH) ^
            .OR. (LOW .LT. PSYMB .AND. PSYMB .LT. HIGH))
C           FOUND A GOOD PLACE TO STOP
            SCFLAG = 0
            CUROP  = COMMA
            NEXTOP = PSYMB
            'BREAK'
            'ENDIF'
         'IF' (PSYMB .EQ. QUOTE)
            'DO'  // SKIP OVER A QUOTE STRING
               CALL FNZS
               'WHILE' (PSYMB .NE. QUOTE)
                  'END'
            'ENDIF'
         CALL FNZS
         'END'
      RETURN
      END