'HEAD'  SOURCE PROCESSING
C     EDIT DATE   14JAN79  09:09
C     SOURCE FILE SOURCEFTM.FS
C     AUTHOR      F. T. MICKEY
C     CLUSTER     17
      'OUTFILE' LDSRCEFTM.FR
C     SUBROUTINE LDSRCE
C
C     GETS A NEW LINE FROM INPUT, PREPARES IT FOR SCANNING,
C     AND PRINTS THE SOURCE LINE IF NOT INHIBITED
C
N     OVERLAY OLLDS
      SUBROUTINE LDSRCE
      INTEGER GCHAR
      'INCLUDE' SRCDFSFTM.IN,
      'INCLUDE' SRCXDFFTM.IN,
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' CTRLAJH.IN,
      'INCLUDE' PRTCOMFTM.IN,
      'INCLUDE' CPAREAJH.IN,
      INTEGER  ESMSG (4), NCMSG (4), TS, TS1, IERR
      DATA  ESMSG    / '***ES***' /
      DATA  NCMSG    / '***NC***' /
C     CLEAR THE INPUT RECORD AND READ FROM INPUT
1     CALL SET (XBBL, RECORD, 66)
      CALL RDLIN (PI, RECORD, SLEN, IERR)
      'IF' (IERR .EQ. 9)
C        END-OF-FILE ROUTINE
         'IF' (PI .GT. 4)
C           USE FILE, NOT UNEXPECTED EOF
            CALL CLOSF (PI, IERR)
            PI = PI - 1
            PRINTF = IAND (USFLGS, 1)
            USFLGS = ISHFT (USFLGS, -1)
            GO TO 1
            'ENDIF'
C        "UNEXPECTED EOF"
         CALL FAULTP (82)
         SKIP = 6
         CALL SET (XBBL, RECORD, 66)
         CALL MOVE (ENDCRD, RECORD, 3)
         'ENDIF'
C     IGNORE FORM FEED LINES
      IF (GCHAR (RECORD, 1) .EQ. 12) GO TO 1
      RECPTR = 1
C     FLAG NEW CARD READ AND UPDATE FILE LINE COUNT
      CARDC = CARDC + 1
      FLINCT (PI) = FLINCT (PI) + 1
      'EJECT'
C     CHECK FOR '' INDICATING CONTROL CARD
      CALL SETCF
      'IF' (CONTF .EQ. CONTRL)
C        CHECK FOR ''HEAD OR ''END
         TS = RECORD (2)
         'IF' (TS .EQ. HEAD .OR. TS .EQ. EJECT)
            'IF' (CARDC .LT. 2)
C              FIRST CARD, START PAGE
               LCOUNT = 3
               'ENDIF'
            SKIP = SKIP + 1
C           RETURN CONTROL CARD
            RETURN
            'ENDIF'
         'ENDIF'
      'IF' (FCHRTS .NE. 0)
C        SIGNAL FLOWCHART BEGUN
         FCHRTS = 0
         IF (LCOUNT .NE. 1) CALL NPAGE
         'ENDIF'
      'IF' (PRINTF .NE. 0)
C        PRINTING NOT INHIBITED BY GLOBAL SWITCH
         CALL SET (XBBL, LBUF, 66)
C        PRINT LINE NUMBER WITHIN FILE
         CALL ESP (FLINCT (PI), LBUF, 1, 4)
C        SET UP LOCATION COUNTER VALUE FOR PRINT
         CALL LCVSET
         'IF' (PNESTX .NE. 1)
C           CONDITIONALS PRESENT, PRINT T/F FLAGS
            N = 6
            'DOLOOP' TS = 2, PNESTX
               TS1 = CNLSID (TS - 1) + 1
               CALL EST (TF (TS1), LBUF, N, N)
               N = N + 1
               'END'
            'ENDIF'
C        PRINT THE SOURCE LINE
         CALL EST (RECORD, LBUF, 19, 98)
         IF (SCFLAG .NE. 0) ^ // ERROR SCAN, INCLUDE ESMSG
            CALL EST (ESMSG, LBUF, 6, 13)
         'ENDIF'
      'EJECT'
      TS = GCHAR (RECORD, RECPTR) - XA
C     CHECK FOR ALPHABETIC COMPILE CHARACTER
      'IF' (TS .GE. 0)
C        FOUND ONE - SEE IF COMPILE FLAG SET FOR THIS ONE
         'IF' (QMODE .EQ. 0)
            'IF' (TS .GE. 16)
C              SECOND WORD OF COMPILE FLAGS
               TS = ISHFT (COMPFL (2), 16 - TS)
               'ELSE'
               TS = ISHFT (COMPFL (1), -TS)
               'ENDIF'
            'IF' (IAND (TS, 1) .EQ. 0)
C              COMPILE NOT REQUESTED, SKIP FOR THIS LINE
               SKIP = SKIP + 1
               CALL EST (NCMSG, LBUF, 6, 13)
               CALL SGLPRT
               GO TO 1
               'ENDIF'
C           COMPILE REQUESTED, BLANK COMPILE LETTER
            CALL PCHAR (RECORD, RECPTR, BLANK)
            RECPTR = RECPTR + 1
            CALL SETCF
            RECPTR = RECPTR - 1
            'ENDIF'
         'ENDIF'
      SKIP = SKIP + 1
      IF (SKIP .LT. 0) ^
         CALL EST (NCMSG, LBUF, 6, 13)
C     PRINT, SINGLE SPACED
      CALL SGLPRT
      RETURN
      END
      'OUTFILE' LCVSETFTM.FR
C     SUBROUTINE LCVSET
C
C     SET UP LOCATION COUNTER VALUE IN LBUF
C
      SUBROUTINE LCVSET
      'INCLUDE' SRCXDFFTM.IN,
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' CTRLAJH.IN,
      'INCLUDE' LCFUNCAJH.IN,
      'INCLUDE' PRTCOMFTM.IN,
      INTEGER  TS
      'IF' (LOCPRT .NE. 0 .AND. LOCSUP .LE. 0)
C        LOCATION COUNTER NOT SUPPRESSED
         TS = LC
         IF (LCI .EQ. CODE) TS = TS + LBIAS
         CALL EHX (TS, LBUF, 14, 17)
         'ENDIF'
      RETURN
      END
      'OUTFILE' SETCFFTM.FR
C     SUBROUTINE SETCF
C
C     SET CONTROL FLAG IF FIRST TWO CHARACTERS ARE "''"
      SUBROUTINE SETCF
      INTEGER GCHAR
      'INCLUDE' SRCDFSFTM.IN,
      CONTF = ISHFT (GCHAR (RECORD, RECPTR), 8) ^
                   + GCHAR (RECORD, RECPTR + 1)
      RETURN
      END
      'OUTFILE' PRNEWSFTM.FR
C     SUBROUTINE PRNEWS
C
C     PROCESS INCOMING SOURCE LINE, SQUASH BLANKS AND OMIT COMMENTS
C
      SUBROUTINE PRNEWS
      'INCLUDE' SRCDFSFTM.IN,
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' SRCXDFFTM.IN,
      K = 1
      'DO'
C        GET CHARACTER FROM SOURCE LINE
         CALL GETC (I,K)
1        SOURCE (J) = I
C        CHECK FOR COMMENT
         'IF' (I .EQ. SLASH .AND. QMODE .EQ. 0)
C           SUPPRESS CHECK IF IN QUOTE MODE
            CALL GETC (I, K)
            'IF' (I .NE. SLASH)
C              NOT A COMMENT, PROCEED
               J = J + 1
               GO TO 1
               'ENDIF'
C           COMMENT, END OF CURRENT LINE
            'BREAK'
            'ENDIF'
         'IF' (I .EQ. BLANK .AND. QMODE .EQ. 0)
C           NOT A STRING, DROP THE BLANK
            'NEXT'
            'ENDIF'
C        FLIP QUOTE FLAG IF QUOTE IS ENCOUNTERED
         'IF' (I .EQ. 34)
            QMODE = IEOR (QMODE, 1)
            'ENDIF'
C        SUPPRESS NULL, TAB AND FORM FEED CHARACTERS
         'IF' (I .EQ. 0 .OR. I .EQ. 9 .OR. I .EQ. 12)
            'NEXT'
            'ENDIF'
         'WHILE' (I .NE. EOCC)
C           NOT END OF CARD, PROCEED
            J = J + 1
            'END'
      SOURCE (J) = 0
      RETURN
      END
      'OUTFILE' GETCFTM.FR
C     SUBROUTINE GETC (I, K)
C
C     UNPACK A CHARACTER FOR PRNEWS
C
      SUBROUTINE GETC (I, K)
      'INCLUDE' SRCDFSFTM.IN,
      INTEGER GCHAR, I, K
      K = K + 1
      'IF' (K .GT. SLEN)
C        RETURN END OF CARD CODE
         I = EOCC
         'ELSE'
         I = GCHAR (RECORD, RECPTR)
         RECPTR = RECPTR + 1
         'ENDIF'
      RETURN
      END
      'OUTFILE' PSRENTFTM.FR
C     SUBROUTINE PSRENT
C
C     LOADS NEXT SOURCE LINE UNTIL INFORMATION IS PRESENT
C
      SUBROUTINE PSRENT
      EXTERNAL OLLDS
      'INCLUDE' SRCDFSFTM.IN,
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' CTRLAJH.IN,
      INPUTJ = J
C      CALL OVLOD (OLLDS)
      'DO'
         CALL LDSRCE
C        RESET SOURCE LINE POINTER
         K = 0
         'IF' (SKIP .LT. 0 .AND. CONTF .NE. CONTRL)
C           IGNORE THIS LINE
            'NEXT'
            'ENDIF'
C        COMPRESS SOURCE AND CHECK FOR CONTROL CARD
         CALL PRNEWS
         SRCEND = J
C        IF THE INPUT POINTER HASN'T CHANGED, GET ANOTHER LINE
         'WHILE' (J .EQ. INPUTJ)
            'END'
      J = INPUTJ
      RETURN
      END