'HEAD'  INPUT/OUTPUT PROCESSING
C     EDIT DATE   12DEC78  10:53
C     SOURCE FILE IOFTM.FS
C     AUTHOR      F. T. MICKEY
C     CLUSTER     6
      'OUTFILE' IOFTM.FR
N     OVERLAY OLIO
      SUBROUTINE IO
      'INCLUDE' LOGOSAJH.IN,
      'INCLUDE' IOCONFTM.IN,
      'INCLUDE' NLISTCFTM.IN,
      'INCLUDE'   NLNAMEFTM.IN,
      'INCLUDE' SRCXDFFTM.IN,
      'INCLUDE' BLDPOAJH.IN,
      'INCLUDE'   STKDEFA.IN,
      'INCLUDE'   STKDEFB.IN,
      'INCLUDE'   STKDEFC.IN,
      'INCLUDE'   STKDEFD.IN,
      'INCLUDE' OPERSAJH.IN,
      'INCLUDE' LEVELSAJH.IN,
      'INCLUDE' CPAREAJH.IN,
      'INCLUDE' RMCODES.IN,
      'INCLUDE' GENCOMFTM.IN,
      'INCLUDE' OPINXJHP.IN,
      'INCLUDE' WFLAGSJHP.IN,
      'INCLUDE' BRACEFTM.IN,
      'INCLUDE' REGSJHP.IN,
      INTEGER     IOTS, IOSTOP, RET, OPTS
      INTEGER     IOSUFX (11), TS, IPKT(3), OPKT (3)
      INTEGER     ENTNUM, NLOPS, SNMLST, GCHAR
      LOGICAL     NLTEST
N     DATA  IPKT     / 1353,'.BUF'/        // '<5>I.BUF'
N     DATA  OPKT     / 1349,'.BUF'/        // '<5>E.BUF'
P     DATA  IPKT     /18693,'.BUF'/        // '<5>I.BUF'
P     DATA  OPKT     /17669,'.BUF'/        // '<5>E.BUF'
      DATA  IOSUFX   /'SP', ^      // SP      1
                      'DP', ^      // DP      2
                      'ST', ^      // STRING  3
                      'HX', ^      // HEX     4
                      'UN', ^      // N:      5
                      'LN', ^      // ;   ^N  6
                      'EJ', ^      // ^       7
                      'MC', ^      // <=      8
                      'PC', ^      // ->N     9
                      'TA', ^      // =N     10
                      'BL'/        // :N     11
      'EJECT'
C     SET UP FOR INPUT OR OUTPUT
      'IF' (OP .EQ. GTR)
         IOSTOP = LESS
         IONX = 4
         PACKET = -1          // SIGNAL INPUT PACKET
         'ELSE'
         IOSTOP = GTR
         IONX = 1
         PACKET = -2          // SIGNAL OUTPUT PACKET
         'ENDIF'
      LEVELB = ILEVEL
      'IF' (NEXTOP .EQ. SEMIC)
         PACKET = NAMEX (OPX)
         CALL BLDPO
         'ENDIF'
      'IF' (NAMEX (OPX) .NE. 0)
         IOSTEP = 5
         ASSIGN 5 TO RET
         GO TO 100
5        CONTINUE
         'ENDIF'
      QVALUE = 0
      RELPAS = 0
C     PROCESS IO
      'DO'
         SCOUNT = 0
         CALL PEEK
         'IF' (PEEKS .EQ. ARROW .OR. PEEKS .EQ. LESSEQ)
            CALL FNZS
            IOSTEP = PEEKS - 14
            GOTO 10
            'ENDIF'
         'IF' (PEEKS .EQ. EQUAL)
            IOSTEP = 10
            GOTO 10
            'ENDIF'
         'IF' (PEEKS .EQ. COLON)
            IOSTEP = 11
10          CALL FNZS
            'ELSE'
            'IF' (PEEKS .EQ. UPARO ^
                  .OR. PEEKS .EQ. IOSTOP ^
                  .OR. PEEKS .EQ. SEMIC ^
                  .OR. PEEKS .EQ. COMMA)
               CALL ADVAN
               GOTO 20
               'ENDIF'
C           FARG
            IOTYPE = 0
            QVALUE = 0
            DEFMOD = 0
            SCOUNT = 0
            STOAC = 0
            CALL BLDPO
            NEXTX = OPX
            OSTACK (NEXTX) = IAND (OSTACK (NEXTX), -64) + COMMA
            IOTS = NAMEX (NEXTX)
            IF (NLTEST (IOTS, REGBIT)) ^
               CALL GENER (SAVCAL)   // REGISTER, DEFINE TEMP
            IF (LOCFLG (NEXTX) .NE. 0) CALL FAULTP (66)
            IF (NEXTOP .NE. COLON) CALL FAULTP (33)
            'IF' (IOTYPE .NE. 0)
               IOSTEP = IOTYPE + 3 - ST
               'ELSE'
               IF (NLOPS (DFINED, NLX) .EQ. 0) ^
                   CALL NLSET (NLX, IOBIT)
               'IF' (SMSEEN .EQ. 0 ^
                     .AND. (QVALUE .NE. 0 ^
                     .OR. NLTEST (NLX, STRBIT)))
                  QVALUE = 0
                  IOSTEP = 3
                  'ELSE'
                  IOSTEP = MODE (NEXTX) + 1
                  'ENDIF'
               'ENDIF'
            OPX = OPX + 1
            'ENDIF'
15       CALL BLDPO
         CALL DUMST ('IO  ')
         NEXTX = OPX - 1
         'IF' (IOSTEP .EQ. 3)
            'IF' (NAMEX (NEXTX) .EQ. 0)
               NUMBER = SCOUNT
               NAMEX (NEXTX) = ENTNUM (NLX)
               'ENDIF'
            'ELSE'
            IF (IOSTEP .EQ. 6 .AND. NAMEX (OPX) .EQ. 0) ^
               IOSTEP = 7
            'ENDIF'
         SCOUNT = 0
         ASSIGN 20 TO RET
         GO TO 100
20       'WHILE' (NEXTOP .NE. IOSTOP)
            'IF' (NEXTOP .EQ. SEMIC)
               IOSTEP = 6
               NUMBER = 1
               CALL CLRSTK (OPX)
               NAMEX (OPX) = ENTNUM (NLX)
               ASSIGN 25 TO RET
               GO TO 100
25             CONTINUE
               'ELSE'
               'IF' (NEXTOP .EQ. UPARO)
                  IOSTEP = 6
                  GOTO 15
                  'ENDIF'
               'ENDIF'
            'END'
      CALL REGMAN (CLRSTA, 0, 0)
      NEXTOP = COMMA
      LEVELB = LLEVEL
      OPX = 2
      RETURN
      'EJECT'
100   'IF' (IOSTEP .LT. 5)
         TS = 3       // 'SP' 'DP' 'ST' 'HEX'
         'ELSE'
         TS = 2
         OPX = OPX + 1
         'ENDIF'
      IF (IOSTEP .EQ. 7) GO TO 120   // ^
110   CALL CLRSTK (OPX)
      NAMEX (OPX) = FLS (TS)
      NEXTX = OPX - 1
      LOCFLG (NEXTX) = 1
      MODE (OPX) = DPMODE
      MODE (NEXTX) = DPMODE
      ACTHI = 0
      ACTLO = 0
      CALL REGMAN (CLRSTA, 0, 0)
      CALL SETUP (LDAINX, NEXTX)
      CALL SETUP (STAINX, OPX)
      OPTS = NEXTOP
      NEXTOP = COMMA
      CALL GEN (ARROW, NEXTX, OPX)
      NEXTOP = OPTS
      'IF' (TS .EQ. 3)
         TS = 2
         OPX = OPX - 1
         GO TO 110
         'ENDIF'
      'IF' (TS .EQ. 2)
120      TS = 1
         NEXTX = OPX - 1
         CALL CLRSTK (NEXTX)
         'IF' (PACKET .LT. 0)
            'IF' (PACKET .EQ. -1)       // INPUT DEFAULT PACKET
               CALL MOVE (IPKT, NAME, 3)
               'ELSE'
               CALL MOVE (OPKT, NAME, 3)
               'ENDIF'
            NAMEX (NEXTX) = SNMLST (NLX)
            'ELSE'
            NAMEX (NEXTX) = PACKET
            'ENDIF'
         GO TO 110
         'ENDIF'
      CALL MOVE (IONAME (IONX), NAME, 3)
      NAME (4) = IOSUFX (IOSTEP)
      TS = SNMLST (TS)
      CALL BLDOP (32, WF8, 0, TS, WF7)   // JSR
      OPX = OPX - 1
      GO TO RET
      END