'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' STKDFA.IN,
'INCLUDE' STKDFB.IN,
'INCLUDE' STKDFC.IN,
'INCLUDE' STKDFD.IN,
'INCLUDE' OPERSAJH.IN,
'INCLUDE' LEVELSAJH.IN,
'INCLUDE' CPAREAJH.IN,
'INCLUDE' RMCODES.IN,
'INCLUDE' GENCMB.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
I DATA IPKT / 1353,'.BUF'/ // '<5>I.BUF'
I 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
RET=1 //**ICLMOD** ASSIGN 5 TO RET
GO TO 100
5 CONTINUE
'ENDIF'
QVALUE = 0
RELPAS = .FALSE.
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' (.NOT.SMSEEN ^
.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
RET=2 //**ICLMOD** 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)
RET=3 //**ICLMOD** 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
GOTO (5,20,25),RET //**ICLMOD** GO TO RET
END