Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0028/forse.306
There are 2 other files named forse.306 in the archive. Click here to see a list.
TITLE FORSE. V26 	 FORTRAN IV OPERATING SYSTEM 
;SUBTTL		26/MAR/70 FROM V25+4/VAA
SUBTTL FORSE PATCHED FOR SNOBOL BY LPW 6-JUNE-70
; CHANGES ARE
; DON'T CONVERT CONTROL CHARACTERS TO BLANKS 
;  ON INPUT.
;
; RELEASE ONLY CHANNELS 0-17 ON RESET. UUO SINCE CHANNEL 17
;  IS USED BY CCL FILES
;
; DON'T OUPUT CONTROL CHARACTERS TO NON-LPT/TTY DEVICES
;
; TRY TO INIT ONLY CHANNELS 0-16
;
; DON'T DO A RESET UUO SINCE SNOBOL DOES ONE ALREADY
;

		;FROM V25+4 23/MAR/70  /VAA FROM V25+3  3/III/70 
		;FROM V25+2 19-FEB-70 FROM V 25+1/VAA
		;V.25+1 13-FEB-70 /  11-FEB-70 FROMV.025  /VAA 
		;V25 29-JAN-70 FROM V24  /VAA
		;V24 26-JAN-70 SUM V175,V1714,V20,V21,V22,V23
		;V.22  11-DEC-69  /KK FIX FOR DOUBLE PRECISION BINARY READ/WRITE
		;V.21		   /TWE WITH CALLS TO ERRINI AND TRPINI
		;V.17+5 26-SEPT-69 FROM V17+3	 /VAA
		;V.17+3  12-JUL-69 FROM V17+0  /NO RANDOM ACCESS
		;V17.14  11-DEC-69 FROM V17.14 25-NOV-69 /VAA RANDOM.ENCDEC.BUFFER.END.ERR.
		;V17.14 25-NOV-69 FROM V17+0/VAA
EXTERNAL	JOBFF,JOBUUO,JOBVER
EXTERNAL	ERROR.,LOGEN.,ILLCH.,INIER.,DEVER.,TBLER.,MSNG.,NOROM.
EXTERNAL	LISTB.,REDER.,ENDTP.,ILUUO.,BPHSE.,ILLMG.,RANASC
EXTERNAL	DEVTB.,PDLST.,IOADR.,ILLEG.,DEVND.,ILRED.,PARER.
EXTERNAL	WLKER.,NMLST.,TFMT.,TPFCN.,BINEN.,BINDT.,BINWR.
EXTERNAL	TABPT.,MBFBG.,MTACL.,DVTOT.,RANAC.,RECNO.
EXTERNAL	DATTB.,NEG1.,NEG2.,NEG3.,NEG5.,BLOCK.,CHARS.,WORDS.
EXTERNAL	ASVAR.,FAKEIN,GOBACK,RANBLT,RANIO.,SETROU
EXTERNAL	SETBFS,RDWRER
EXTERNAL	ERRINI,TRPINI		;V.021   /TWE
ENTRY		FORSE.,DEPOT.,CHINN.,IIB.,ENDLN.,INP.,OUT1
ENTRY		XIO.,OUTT.,RIN.,CLOS.,FI.,FNCTN.,CLRSY.
ENTRY		CLROU.,LOOK.,CLOSI.,SETOU.,STAT.,SESTA.
ENTRY		NXTCR.,NXTLN.,WAIT.,BUFCA.,INP.,IORTR.,EOFTS.
INTERNAL	DYNND.,MTPZ.,FILNUM,FILES.,VADDR.
INTERNAL	EOL.,DADDR.,TCNT1.,TCNT2.,ONLY1.,EOFFL.
INTERNAL	TPNTR.,PAKFL.,TNAM1.,TNAM2.
INTERNAL	TEMP.,UUOH.,DEVIC.,FMTEN.,FMTBG.
INTERNAL	BUFHD.,DYNDV.,DEVNO.,TYPE.,OVFLS.
INTERNAL	RESET.,IN.,OUT.,DATA.,FIN.,RTB.,WTB.,MTOP.
INTERNAL	SLIST.,INF.,OUTF.,RERED.,NLI.,NLO.
INTERNAL	RERDV.,INPDV.,DEVNUM,ROUSET,END.,ERR.

FTSW1=0		;SOLVES READ,READ,WRITE PROBLEM ON DSK ,MTA

    ;ACCUMULATORS
A=1		;UTILITY
B=2		;UTILITY
C=3		;UTILITY
D=4		;UTILITY
E=5		;FORMAT DESCRIPTOR
F=6		;FORMAT REPEAT COUNT
M=7		;ADDR. OF BUFFER HEADER(RH);DEV. NO. (LH)
H=10		;SLIST AOBJN WORD
I=11		;FLAG REGISTER
J=12		;RECORD COUNT(RH);WORD COUNT(LH)-BINARY
K=13		;FORMAT POINTER
L=14		;PARENTHESIS COUNT
G=15		;INPUT BUFFER HDR ADDR.(LH);DEV. NAME ADDR.(RH)
N=16		;UNUSED
P=17		;PUSHDOWN POINTER

	;UUO DEFINITIONS

RESET.=		15B8
IN.=		16B8
OUT.=		17B8
DATA.=		20B8
FIN.=		21B8
RTB.=		22B8
WTB.=		23B8
MTOP.=		24B8
SLIST.=		25B8
INF.=		26B8
OUTF.=		27B8
RERED.=		30B8
NLI.=		31B8
NLO.=		32B8
DEC.=		33B8
ENC.=		34B8

    ;PARAMETER ASSIGNMENTS

LSTBYT==1		;++ LAST BYTE POSN
DQ=42		    ;DOUBLE QUOTE
SL=17		    ;SLASH(SIXBIT)
LF=12		     ;LINE FEED
CR=15		     ;CARRIAGE RETURN
SFCN=10              ;NUMBER OF SPECIAL TAPE FUNCTIONS
VAR=100               ;LENGTH OF VARIABLE PUSHDOWN AREA
LINWDS=^D27		;OUTPUT LINE BUFFER SIZE
LINCH=5*LINWDS		;NO. OF CHARACTERS IN LINE BUFFER
DYDVL.=20		;LENGTH OF DYNAMIC DEVICE TABLE

;THE FOLLOWING ASSIGNMENTS ARE USED AS ARGUMENTS IN
;TLO INSTRUCTIONS WHICH GENERATE UUO'S.

NMTAPE=72000
NCLOSE=70000
NINPUT=66000
NOUTPT=67000
NSETST=60000
NINBUF=64000
NOUBUF=65000
NUSETI=74000
NUSETO=75000
NLOKUP=76000

;STATUS CHECK FLAGS

IOWERR=400000        ;WRITE PROTECTION ERROR
IODERR=200000	     ;DATA MISSED ERROR
IOPERR=100000        ;PARITY OR CHECKSUM ERROR
IOBKTL=40000         ;BLOCK TOO LARGE ON INPUT
IODEND=20000         ;END OF FILE
IOBOT=4000           ;BEGINNING OF TAPE
IOTEND=2000          ;END OF TAPE
IOCON=40             ;CONTINUOUS I-O
;FLAG SETTINGS FOR AC FLAGS (LEFT HALF)

;   FLAG		MEANING		ON/OFF

;400000		OUTPUT/INPUT		OUTPUT/INPUT
;200000		SCALE FACTOR SIGN	-/+
;200000		WRITE OR READ TAPE	YES/NO
;100000		RETURN SWITCH		ON/OFF
; 40000		BUFFER EMPTY(IN)	YES/NO
; 20000		1ST LF ON BACKSPACE	YES/NO
; 20000		T FORMAT		YES/NO
; 10000		SLIST I-O		YES/NO
;  4000		INHIBIT EOF CHECK	YES/NO
;  2000		LAST RECORD IN		YES/NO
;  2000		NAMELIST I-O		YES/NO
;  1000		"TEXT" IN FORMAT	YES/NO
;  1000		LAST RECORD OUT		YES/NO
;   400		SPECIAL TAPE FUNCTION	YES/NO
;   200		FILE COMMAND		YES/NO
;   100		FORMAT I-O		YES/NO
;    40		DECTAPE OR DISC		YES/NO
;    20		DBL. PREC. IN SLIST.	YES/NO
;    10		REREAD UUO		YES/NO
;     4		T FORMAT BACKSPACE	YES/NO
;     2		() REPEAT FOR LEVEL 0,1	YES/NO
;     1		DIGIT FLAG		YES/NO
; SET UP UUO HANDLER

	LOC 41
	JSR UUOH.
	RELOC 0


;VERSION NO

	LOC 137
;	OCT 026
	OCT 301000,,26
	RELOC 0
;FORMAT SCAN INITIALIZATION ROUTINE

MLON

FORSE.:

IORET:	JUMPL	I,GETAC		;JUMP ON OUTPUT
	MOVE	0,DEVIC.	;GET DEVICE NAME
	MOVEM	0,RERDV.	;SAVE INPUT DEVICE NAME
	SKIPGE	RANAC.		;DIRECT ACCESS CALLED FOR?
	PUSHJ	P,RANASC	;YES,GO OFF TO ASCII BLOCK CALC
	TLNN	I,10		;REREAD UUO?
	JRST	GETAC		;NO
	MOVE	C,RPTR1		;POINTER TO BEGINNING OF LINE
	MOVEM	C,1(M)
	MOVE	C,RCNT1		;ORIGINAL ITEM COUNT
	MOVEM	C,2(M)		;IN BUFFER HEADER
GETAC:	LDB	C,PTRU		;AC CONTAINING POINTER TO FMT
	ADDI	C,SAVEAC	;ADDRESS OF AC BLOCK
	MOVSI	0,350700
	MOVEM	0,FMTEN.	;SET UP POINTER TO END OF FMT
	HRRZ	K,(C)		;POINTS TO BEG. OF FORMAT
	HRLI	K,700		;BYTE SIZE
	HLRZ	0,(K)		;SEE IF JRST AROUND FORMAT
	CAIN	0,254000
	JRST	HRS		;YES,THERE IS A JRST
	SOS	K		;NOT A JRST BUT 1ST WORD OF FMT
	HLRZ	0,(C)		;LENGTH OF FORMAT ARRAY
	SKIPN	0
	MOVEI	0,^D251		;MAX. NO OF WORDS ALLOWED
	ADD	0,K		;UPPER BOUND ON FORMAT
	MOVEM	K,LASTLP	;POINTER TO BEG. OF FORMAT
	MOVEM	K,GRPRPT	;POINTER TO BEGINNING OF FMT FOR REPEAT
	AOSA	0		;POINT TO LAST WORD
HRS:	HRRZ	0,@K		;SET END ADR. FOR COMPARE
	HRRM	0,FMTEN.	;END ADDR. OF FORMAT
	MOVEM	K,FMTBG.	;POINTER TO BEGINNING OF FORMAT
	TDZ	I,[377677777777];CLEAR ALL BUT INPUT/OUTPUT, FMT.
	SETOM	EOL.		;SET END OF LINE FLAG AND CHAR. COUNT
	HRRI	E,0		;SCALE FACTOR=0
	CLEARB	L,OVFLS.	;() COUNT AND LINE OVERFLOW
IN1:	TLZ	I,100000	;RETURN SWITCH OFF
RIN.:	HRRI	I,0		;CLEAR ROUTINE FLAG
	CLEARB	A,F		;INITIALIZE COUNTERS
	HRLI	E,0		;INITIALIZE FIELD WIDTH
,CHARACTER SCAN AND DISPATCH

IN:	MOVE	B,K		;SAVE PTR BEFORE INCREMENTING
	MOVEM	B,SAVSCN
	ILDB	B,K		;NEXT FORMAT CHARACTER
	CAML	K,FMTEN.	;CHECK FOR END OF FORMAT
	JRST	PARL
	TRZ	B,100		;CLEAR HIGH ORDER BIT
	TRC	B,40		;CONVERT TO SIXBIT ASCII
	MOVE	C,B		;SAVE FORMAT CHARACTER
	IDIVI	C,7		;SET FOR DISPATCH TABLE ENTRY
	LDB	C,PTRTAB(D)	;PICK UP DISPATCH INDEX
	JRST	@DISTAB(C)	;DISPATCH TO CHARACTER ROUTINE

,CHARACTER IS 0-9

DIG:	TLOE	I,1		;SET DIG FLG, SKIP IF IT WASN'T SET
	JRST	.+3
	MOVE	D,SAVSCN	;GET PTR POSN BEFORE DIGITS
	MOVEM	D,DIGPTR	;SAVE IT FOR RESCAN
	SUBI	B,20		;OCTAL DIGIT
	IMULI	A,12		;ACCUMULATE THE NUMBER
	ADD	A,B
	JRST	IN

, CHARACTER IS .

DECPT:	TSO	E,A		;SET FIELD WIDTH
	TLZ	I,1		;CLEAR DIG FLG
	MOVEI	A,0
	JRST	IN


,CHARACTER IS (

PARLF:	PUSH	P,A		;SAVE COUNT
	PUSH	P,K		;SAVE POINTER TO ( IN FORMAT
	TLNN	I,2		;LAST ( ALREADY STORED?
	CAILE	L,1		;SAVE LEVEL 0 OR 1 ONLY
	JRST	PARLF1		;LEVEL 2  DON'T SAVE FOR RESCAN
	TLZN	I,1		;CLEAR DIG FLG, SKIP IF IT WAS SET
	JRST	PARLF0		;NO DIGS BEFORE GROUP
	MOVE	A,DIGPTR	;DIGS BEFORE GROUP
	MOVEM	A,GRPRPT	;SAVE PTR TO 1ST LEVEL GROUP FOR RESCAN
	JRST	PARLF2		;SKIP
PARLF0:	MOVEM	K,GRPRPT	;SAV PTR TO ( IN GROUP REPEAT
PARLF2:	MOVEM	K,LASTLP	;SAVE POINTER TO (
PARLF1:	MOVEI	A,0
	AOJA	L,IN		;ADD ONE TO () COUNT

,CHARACTER IS )

PARR:	PUSHJ	P,COMMA		;DO CONVERSION IF NECESSARY
	HRRI	I,0		;PREVENT FURTHER CONVERSION
	SOJG	L,PARG		;OFFSET (
	TLON	I,2		;CHECK FOR AUTO. FORMAT REPEAT
	JUMPL	L,PARL
	SKIPLE	-1(P)		;CHECK () COUNT
	JRST	PARG

PARL:	PUSHJ	P,COMMA		;PERFORM CONVERSION
	PUSHJ	P,ENDLN.	;TERMINATE THIS LINE
	HRRZ	0,INIFLG
	CAIL	0,2
	SUB	P,[XWD 2,2]	;COMPENSATE FOR () PUSH
	TLO	I,100000	;RETURN SWITCH ON
	MOVE	K,GRPRPT	;RESET SCAN AT LAST 1ST LEVEL GROUP
	TLZ	I,1		;CLEAR GRP PEPEAT FLG

,RETURN TO USER FOR DATA ADDRESS OR TERMINATION OF SCAN

IORTR.:	TLNE	I,10000		;SLIST?
	JRST	NAS		;YES
NASBAK:	SKIPGE	EDERR		;++ ENCODE DECODE ERROR?
	JRST	EDERRM		;++ YES,TYPE OUT MESSAGE SKIP TO FIN.
	MOVEI	0,SAVFAC	;SAVE OP SYS AC'S
	BLT	0,SAVFAC+P
	JRST	UXIT.


,RESET SCAN AT LAST LEFT ( AND DROP COUNT

PARG:	SOSLE	-1(P)		;DROP () COUNT
	JRST	MSP
	SUB	P,[XWD 2,2]	;RESET P TO POINT TO LAST (
	JRST	IN1		;GET NEXT FORMAT CHARACTER
MSP:	MOVE	K,(P)		;RESET SCAN AT LAST (
	AOJA	L,IN1		;BUMP COUNT FOR RESCAN

,CHARACTER IS -

NEGSC:	TLO	I,200000	;SCALE FACTOR SIGN
	TLZ	I,1		;DIG FLAG
	JRST	IN
,CHARACTER IS /

SLASH:	PUSHJ	P,COMMA		;CONVERSION,IF ANY
	PUSHJ	P,ENDLN.	;TERMINATE LINE
	JRST	RIN.

    ;CHARACTER IS SINGLE QUOTE

SQUOTE:	MOVEI	A,^D132		;MAXIMUM COUNT
	TLZ	I,1		;DIG FLAG CLEAR
	TLO	I,1000		;SINGLE QUOTE FLAG

,CHARACTER IS H

HIO:	TLZ	I,1		;CLEAR DIG FLAG
	JUMPE	A,RIN.
	HRRZ	B,FMTEN.	;END OF FORMAT
	SUBI	B,(K)		;BEG OF FORMAT
	IMULI	B,5
	JUMPGE	I,HINPT		;JUMP ON INPUT
HLDB:	ILDB	0,K		;CHARACTER FROM FORMAT
	SOJE	B,PARL		;TEST FOR END
	TLNN	I,1000		;SINGLE QUOTE?
	JRST	HDPB		;NO
	CAIN	0,"'"		;SINGLE QUOTE IN FORMAT?
	PUSHJ	P,DBLQTE	;TEST FOR TWO SINGLE QUOTES
HDPB:	PUSHJ	P,DEPOT.	;DEPOSIT CHARACTER
	SOJG	A,HLDB		;DROP COUNT
	JRST	RIN.
HINPT:	PUSHJ	P,CHINN.	;GET A CHARACTER
	XCT	IIB.
	SOJE	B,PARL		;TEST FOR END
	ILDB	C,K		;CHARACTER FROM FORMAT
	TLNN	I,1000		;SINGLE QUOTE?
	JRST	HINDPB		;NO
	CAIN	0,"'"		;SINGLE QUOTE IN INPUT?
	MOVEI	0,DQ		;CHANGE TO "
	CAIN	C,"'"		;SINGLE QUOTE IN FORMAT?
	PUSHJ	P,DBLQTE	;YES,TEST FOR TWO SINGLE QUOTES
HINDPB:	DPB	0,K		;PUT CHARACTER IN FORMAT
	SOJG	A,HINPT		;DROP COUNT
	JRST	RIN.

DBLQTE:	MOVE	F,K		;SAVE FORMAT POINTER
	ILDB	C,F		;LOOK FOR SINGLE QUOTE
	CAIE	C,"'"
	JRST	ET		;END OF TEXT
	MOVEM	F,K		;RESTORE FORMAT POINTER
	POPJ	P,
ET:	POP	P,0		;RESET P
	JRST	RIN.		;RETURN TO SCAN
,CHARACTER IS X

XIO.:	TLZ	I,1		;CLEAR DIG FLG
	JUMPGE	I,XINPT		;JUMP IF INPUT
	MOVEI	0," "		;BLANK
	PUSHJ	P,DEPOT.	;OUTPUT A BLANK
	SOJG	A,.-1
	JRST	RIN.
XINPT:	PUSHJ	P,CHINN.	;SKIP A CHARACTER
	SKIPN	OVFLS.		;DON'T ADVANCE IF END OF LINE
	XCT	IIB.		;ADVANCE INPUT POINTER
	SOJG	A,XINPT
	JRST	RIN.


,CHARACTER IS P

PIO:	TLZ	I,1		;CLEAR DIG FLAG
	TLZE	I,200000	;TEST FOR SCALE SIGN
	MOVNS	A		;SCALE NEGATIVE
	HRR	E,A		;SET SCALE FACTOR
	JRST	RIN.

;CHARACTER IS T

TIO:	TLZ	I,1		;CLEAR DIG FLG
	TLO	I,20000		;T FORMAT
	JRST	RIN.		;GET T SETTING

;CHARACTER IS $

DOLSGN:	TLZ	I,1		;CLEAR DIG FLG
	SETOM	DOLFLG		;$ CARRIAGE CONTROL CHAR.
	JRST	RIN.		;RETURN TO SCAN

;CHARACTER IS A,D,E,F,G,I,L,O

AEIOU:	PUSHJ	P,RTNSET	;PICK UP CONV. ROUTINE ADDRESS
AEIOU1:	MOVE	F,A		;SAVE DATA COUNT
	SETZM	A		;CLEAR DECIMAL DIGIT AC
	TLZ	I,1		;CLEAR DIG FLAG
	JRST	IN		;RETURN TO FORMAT SCAN

RTNSET:	LDB	C,[POINT 6,DISTAB(C),11];ROUTINE INDEX
	SKIPGE	I		;INPUT OR OUTPUT ROUTINE NEEDED?
	AOS	C		;OUTPUT
	HRR	I,IOADR.(C)	;PICK UP ROUTINE ADDRESS
	POPJ	P,

,CHARACTER IS ,

COMA:	PUSHJ	P,COMMA		;CONVERSION,IF ANY
	JRST	RIN.

;CHARACTER IS G

GCONV:	TLO	E,200000	;G FLAG
	JRST	AEIOU1

;CHARACTER IS E

ECONV:	TLO	E,400000	;E FLAG
	JRST	AEIOU
;CHARACTER IS D

DCONV:	TLO	E,100000	;SET D FLAG
	JRST	AEIOU
,ROUTINE TO SET FORMAT WORD & GO TO CONVERSION SUBPROGRAMS

COMMA:	TLZ	I,1		;CLEAR DIG FLAG
	TLZE	I,20000		;T FORMAT?
	JRST	TFMT.		;YES
	TLNE	E,200000	; G TYPE?
	JRST	COMMA1		;YES
	TRNN	I,-1		;CONVERSION NECESSARY?
	POPJ	P,		;NO CONVERSION
COMMA1:	ANDI	A,177		;W AND D MOD 128
	MOVSS	A
	TLNE	E,177		;IS THERE A FIELD WIDTH?
	ASH	A,7		;SHIFT TO D FIELD
	IOR	E,A
	TLZN	I,100000	;RETURN SWITCH ON?
	JRST	IORTR.		;GET AN ADDRESS
	JRST	CNVT		;DO CONVERSION
,RETURN WITH DATA ADDRESS (DATA. UUO)

DATA:	PUSH	P,A		;SAVE UUO
	MOVSI	0,SAVFAC	;RESTORE OP SYS AC'S
	BLT	0,16		;ALL BUT P
	POP	P,A		;PICK UP UUO
	HRRZ	C,A		;UUO ADDRESS
	CAIGE	C,20		;SEE IF DATUM IN AC
	ADDI	C,SAVEAC	;YES,PICK UP FROM SAVE LOC.
	MOVEM	C,DADDR.	;SAVE DATA ADDRESS
	LDB	C,PTRU		;AC FIELD CONTAINS TYPE CODE
	MOVEM	C,TYPE.		;SAVE TYPE
	CAIGE	C,6		;IF DATA IS NEITHER COMPLEX NOR
	JRST	TFB		;DOUBLE PRECISION, GO TO TFB
	CAIN	C,7		;IF DATA IS COMPLEX,
	JRST	TFBM3		;OR
	HRRZ	0,I		;IF DATA IS DOUBLE PRECISION
	CAIE	0,14		;AND THE MODE IS BINARY, GO
	JRST	TFB3		;TO TFBM3.
TFBM3:	TLO	I,10000		;SET SLIST FLAG
	MOVSI	H,-2		;ARRAY OF LENGTH 2
	HRR	H,A		;ARRAY ADDRESS
TFB:	HRRZ	0,I		;PICK UP MODE
	CAIN	0,14		;BINARY MODE?
	JRST	BINDT.		;YES
TFB3:	TLNE	I,100000	;RETURN SWITCH ON?
	JRST	RIN.		;YES,GO TO FORMAT SCAN
CNVT:	SKIPGE	F		;CHECK REPEAT COUNT
	POPJ	P,		;RETURN
	TLNN	E,200000	;G FORMAT?
	JRST	NOTGTY		;NO
	MOVE	C,TYPE.		;PICK UP DATUM TYPE
	CAIN	C,6		;CHECK FOR DOUBLE WORD
	TLO	E,100000	;SETS DOUBLE PRECISION
	PUSHJ	P,RTNSET	;PICK UP CONV. ROUTINE ADDRESS
NOTGTY:	PUSH	P,E		;FORMAT SPECIFICATION
	MOVE	C,DADDR.	;ADDRESS OF DATUM
	JUMPL	I,OUTCNV	;JUMP IF OUTPUT
	PUSHJ	P,(I)		;INPUT CONVERSION
	JRST	CHECK		;ILLEGAL CHAR IN INPUT
	MOVEM	0,(C)		;STORE HIGH ORDER WORD
	TLNE	E,100000	;IS THERE A LOW ORDER PART?
	MOVEM	A,1(C)		;YES ,STORE IT
SOSO:	POP	P,0		;ACCOUNT FOR FORMAT WORD
	SOJG	F,IORTR.	;GET NEXT ADDRESS
	TLZ	E,200000	; CLEAR G FORMAT FLAG
	POPJ	P,		;REPEAT COUNT IS ZERO
OUTCNV:	MOVE	0,(C)		;PICK UP HIGH ORDER PART
	MOVE	A,1(C)		;PICK UP LOW ORDER PART
	PUSHJ	P,(I)		;OUTPUT CONVERSION
	JRST	SOSO


CHECK:	SKIPE	ERR.		;DOES THE USER DESIRE PROGRAM CONTROL?
	JRST	FI.		;YES, GO TO POSITION SPECIFIED
	JRST	ILLCH.		;NO, PRINT ERROR MESSAGE AND FAIL

	HRR	H,A		;ARRAY ADDRESS
	JRST	TFB		;DO CONVERSION

;ENTRY ON SLIST. UUO    SHORT LIST I/O

;THE AC OF THE SLIST UUO CONTAINS THE TYPE CODE--0 FOR INTEGER,
;6 FOR DOUBLE PRECISION, AND 7 FOR COMPLEX.  FOR DOUBLE
;PRECISION TWO WORDS ARE PASSED AT A TIME. THE ADDRESS OF
;THE UUO CONTAINS THE ARRAY BASE ADDRESS. THE WORD FOLLOWING
;THE SLIST. UUO CONTAINS THE LENGTH OF THE ARRAY.
;ADDRESS OF THE ARRAY IN THE RIGHT HALF.



SLIST:	PUSH	P,A		;SAVE UUO
	HRLZI	0,SAVFAC	;RESTORE OP SYS AC'S
	BLT	0,16		;ALL BUT P
	POP	P,A		;UUO
	TLO	I,10000		;SLIST FLAG
	LDB	C,PTRU		;AC FIELD OF UUO
	MOVEM	C,TYPE.		;SAVE TYPE CODE
	HRLZ	H,@UUOH.	;ARRAY LENGTH
	AOS	UUOH.		;UPDATE RETURN ADDRESS
	MOVNS	H		;NEGATE LENGTH
	CAIN	C,7		;IS ARRAY COMPLEX?
	ASH	H,1		;YES,MULTIPLY BY 2
	CAIN	C,6		;IS ARRAY DOUBLE PRECISION?
	TLO	I,20		;YES,SET FLAG
	HRR	H,A		;BASE ADDRESS
HRS1:	HRRZM	H,DADDR.	;SAVE SLIST ADDRESS
	JRST	TFB		;DO CONVERSION OR SCAN

;CONTROL TRANSFERRED HERE FOR EACH ADDRESS
;ALSO USED FOR SINGLE COMPLEX ITEMS.

NAS:	TLNE	I,20		;IS ARRAY DOUBLE PRECISION?
	AOS	H		;ACCOUNT FOR 2 WORDS
	AOBJN	H,HRS1		;SET FOR NEXT DATUM
	TLZ	I,10020		;RESET SLIST FLAGS
	JRST	NASBAK		;RETURN TO USER

,TABLE OF POINTERS FOR CHARACTER DISPATCH

PTRTAB:	REPEAT 7,<		POINT 5,IRTAB(C),34-<.-PTRTAB>*5>


,TABLE OF DISPATCHING INDICES

IRTAB:	BYTE (5) 0,0,26,0,0,0,10
	BYTE (5) 6,13,10,0,12,11,24
	BYTE (5) 7,7,7,7,7,1,5
	BYTE (5) 0,0,7,7,7,7,7
	BYTE (5) 0,16,0,0,0,0,0
	BYTE (5) 20,2,14,17,15,23,0
	BYTE (5) 3,21,0,0,22,0,0
	BYTE (5) 0,0,0,25,0,0,0
	BYTE (5) 0,0,0,0,0,0,4
	BYTE (5) 0,0,0,0,0,0,0
;DISPATCH TABLE USED FOR CHARACTER DISPATCH
;AND INDICES FOR CONVERSION ROUTINE NAMES.
;THE LEFT HALF OF THE FIRST 8 ENTRIES CONTAINS AN INDEX
;TO ENTRIES IN THE TABLE OF CONV. ROUTINE ADDRESSES,IOADR.,
;FOR G FORMAT.
;THE LEFT HALF OF THE ENTRIES FOR E,A,F,I,O,L,D CONTAINS
;AN INDEX TO THE ENTRIES IN IOADR. CORRESPONDING TO E,A,F,I,O,L,D.

DISTAB:	XWD	400,ERROR1	; ILLEGAL
	XWD	000,SLASH	;/
	XWD	200,HIO		;H
	XWD	1000,PIO	;P
	XWD	600,XIO.	;X
	XWD	000,DECPT	;.
	XWD	1200,NEGSC	;-
	XWD	200,DIG		;0-9
	XWD	000,IN		;BLANK OR +
	XWD	0,PARLF		;(
	XWD	0,PARR		;)
	XWD	0,COMA		;,
	XWD	000,GCONV	;G
	XWD	200,ECONV	;E FLOATING
	XWD	000,AEIOU	;A ALPHANUMERIC
	XWD	200,AEIOU	;F FLOATING
	XWD	400,AEIOU	;I FIXED
	XWD	600,AEIOU	;O OCTAL
	XWD	1000,AEIOU	;L LOGICAL
	XWD	1200,DCONV	;D    DOUBLE PRECISION
	XWD	000,SQUOTE	;'   TEXT
	XWD	000,TIO		;T  COLUMN SETTING
	XWD	000,DOLSGN	;$ CARRIAGE CONTROL

ERROR1:	PUSHJ	P,ERROR.	;ILLEGAL CHARACTER IN FORMAT
;OUTPUT ROUTINE CALLED BY DEPOT. FOR DEPOSITING CHARACTERS
;IN PROPER BUFFER,CHECKING LINES FOR OVERFLOW, DOING OUTPUTS
;AND ERROR CHECKING.

CO:	SKIPL	TTYLPT		;TTY OR LPT?
	SKIPG	HDRADD		;LINE BUFFER IN USE?
	JRST	DLB		;NO
	SKIPE	OVFLS.		;LINE OVERFLOW?
	JRST	LBCRCK		;YES,LOOK FOR CR
	IDPB	0,1(M)		;NO,DEPOSIT CHARACTER
	SOSG	2(M)		;BUFFER FULL?
	JRST	LBXCD		;YES,STASH CR,LF
LBCRCK:	CAIE	0,CR		;CARRIAGE RETURN?
	POPJ	P,		;NO,KEEP LOOKING
STLF:	SETZM	OVFLS.		;CLEAR LINE OVERFLOW SWITCH
	MOVEI	0,LF		;PICK UP LINE FEED
	IDPB	0,1(M)		;DEPOSIT IT
	HRR	A,HDRADD	;ADDRESS OF REAL BUFFER HEADER
	SKIPL	RANAC.		;RANDOM ACCESS?
	JRST	NOTRN1		;NO
	SKIPL	ROUSET		;YES,IS BUF HDR SETUP FOR RANDOM I/O
	PUSHJ	P,SETROU	;NO,GO DIDDLE BUFFER HEADER
NOTRN1:	MOVE	0,2(M)		;COUNT OF CHARS. LEFT IN LINE BUFFER
	SUBI	0,LINCH+1	;LENGTH OF LINE BUFFER +1 FOR LF
	ADDM	0,2(A)		;UPDATE REAL BUFFER COUNT
	SKIPGE	2(A)		;IF NEGATIVE,DO OUTPUT
	JRST	BOUT
BLTSET:	MOVEI	0,@1(M)		;WHERE POINTER IS NOW
	SUBI	0,LINBUF-1	;NO. OF WORDS IN LINE BUFFER
	HRRM	0,BUFBLT	;NO. OF WORDS TO BLT
	HRRZ	0,1(A)		;ADDRESS OF REAL BUFFER
	ADDM	0,BUFBLT	;BLT LIMIT
	ADD	0,[XWD LINBUF,1];FROM-TO FOR BLT
BUFBLT:	BLT	0,0		;***THIS ADDRESS MODIFIED
	HRR	0,BUFBLT	;LAST WORD USED
	HLL	0,1(M)		;POSITION AND SIZE
	MOVEM	0,1(A)		;UPDATED REAL BUFFER POINTER
	LSHC	0,-36-44	;POSITION
	DIV	0,[-7]		;GET NUMBER OF NULLS
	HRR	A,HDRADD	;ADDRESS OF REAL BUFFER HEADER
	ADDM	0,2(A)		;ACCOUNT FOR NULLS
ZELB:	SETZM	LINBUF		;CLEAR LINE BUFFER
	MOVE	0,[XWD LINBUF,LINBUF+1]
	BLT	0,@1(M)		;CLEAR UP TO LAST WORD USED
	MOVEI	0,LINCH		;RESET ITEM COUNT
	MOVEM	0,2(M)	
	MOVE	0,LBPTR		;RESET POINTER
	MOVEM	0,1(M)		;TO BEGINNING OF LINE BUFFER
	AOS	ASVAR.		;INCREASE VALUE OF ASSOCIATED VARIABLE
	POPJ	P,		;RETURN
BOUT:	SKIPE	ENCDEC		;++ NO OUTPUT FOR ENCODE
	JRST	[PUSHJ	P,EDERR.	;++SET ERROR FLG
		JRST	NOLOK1	];++ RETURN
	PUSH	P,0		;SAVE ITEM COUNT
	PUSHJ	P,OUTOK		;DO OUTPUT
	SKIPGE	RANAC.		;RANDOM ACCESS?
	PUSHJ	P,RANIO.		;YES,GET NEXT DATA SETUP FOR OUTPUT
	POP	P,0		;RESTORE ITEM COUNT
	ADDM	0,2(A)		;PUT INTO BUFFER HEADER
	JRST	BLTSET		;DUMP AND CLEAR LINE BUFFER
LBXCD:	CAIN	0,CR		;WAS LAST CHAR. A CR?
	JRST	STLF		;YES,STASH LF
	HRLI	0,170700	;NO,SET POINTER FOR CR
	HLLM	0,1(M)
	MOVEI	0,CR		;PICK UP CR
	IDPB	0,1(M)		;STASH IT
	SETOM	OVFLS.		;SET LINE OVERFLOW FLAG
	POPJ	P,
DLB:	IDPB	0,1(M)		;DEPOSIT CHARACTER
	SOSLE	2(M)		;DROP ITEM COUNT
	CAIN	0,CR
	SKIPA
	POPJ	P,
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO OUTPUT ACR-LF
; PAIR ON LINE TERMINATIONS INSTEAD OF JUST CR
;	SKIPGE	DOLFLG		;CHECK FOR $
;	MOVEI	0,0		;YES,CLEAR OUT CR
;	DPB	0,1(M)		;DEPOSIT CHARACTER

	SKIPL DOLFLG
	JRST WADE10	;NOT A DOLLAR SIGN TERMINATION
	MOVEI 0,0	;CLEAR OUT THE CR
	DPB 0,1(M)
	JRST OUTOK
WADE10:	MOVEI 0,LF	;ADD THE NEW SNOBOL LF CHARACTER
	SKIPG 2(M)	;GUARD AGAINST THE CASE OF LAST CHARACTER
	JRST OUTOK
	IDPB 0,1(M)
	SOS 2(M)	;UPDATE THE BUFFER CHARACTER COUNT

OUTOK:	PUSHJ	P,OUTT.		;DO OUTPUT
	PUSH	P,F		;SAVE F-USED FOR STATUS
	PUSHJ	P,STAT.		;GET STATUS
	TRNE	F,IODERR
	PUSHJ	P,REDER.	;DATA ERROR
	TRNE	F,IOPERR
	PUSHJ	P,PARER.	;PARITY ERROR
	TRNE	F,IOWERR
	PUSHJ	P,WLKER.	;WRITE PROTECTION ERROR
	TRNN	F,IOBKTL	;ILL DECTAPE BLK. NUMBER
	TRNE	F,IOTEND
	PUSHJ	P,ENDTP.	;END OF TAPE
	SETZM	OVFLS.		;CLEAR LINE OVERFLOW SWITCH
	POP	P,F		;RESTORE F
	POPJ	P,
;DEPOT. IS CALLED BY ALL OUTPUT ROUTINES FOR DEPOSITING
;CHARACTERS IN THE OUTPUT BUFFER AND DOING OUTPUTS. THE
;CHARACTER IS SENT IN AC 0 AND AC M IS USED.DEPOT. IS 
;CALLED BY   PUSHJ P,DEPOT.

DEPOT.:	PUSH	P,A		;UTILITY AC
	PUSH	P,0		;OUTPUT CHARACTER
	SKIPGE	ENCDEC		;++ ENCODE?
	JRST	ENCOUT		;++ DON'T MESS AROUND WITH CRLF STUFF
	AOSLE	EOL.		;IS THIS THE FIRST CHARACTER?
	JRST	NOLOOK		;NO
	SKIPGE	CDPCDR		;CARDS...FORCE LF ON OUTPUT
	JRST	[MOVE	A,0	;SAVE CHAR
		MOVEI	0,LF	;GET LINE FEED
		PUSHJ	P,CO	;OUTPUT IT
		MOVE	0,A	;GET THE CHAR
		JRST	NOLOOK	];OUTPUT THAT CHAR
; FOLLOWING PATCHED OUT FOR SNOBOL IN ORDER TO ALLOW THE
; SNOBOL PROGRAMMER TO GET HIS DISK LISTINGS WITHOUT HAVING
; TO GO THROUGH PIP WITH THE "P" SWITCH
;	SKIPL	TTYLPT		;TTY OR LPT?
;	JRST	NOLOOK		;NO
	MOVE	A,0		;CONTROL CHARACTER
	MOVEI	0,LF		;LINE FEED
	CAIN	A,"0"		;0?
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO OUTPUT A CR-LF
; PAIR ON LINE TERMINATIONS INSTEAD OF JUST CR
;	JRST	ZE		;YES
	JRST NOLOOK
	CAIN	A," "		;BLANK?
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO OUTPUT A CR-LF
; PAIR ON LINE TERMINATIONS INSTEAD OF JUST CR
;	JRST	NOLOOK		;YES
	JRST NOLOK1
	CAIN	A,"-"		;-  SKIP TWO LINES
	JRST	MI		;MINUS SIGN
	HRRI	A,-52(A)	;LOOK FOR CODE
	JUMPL	A,NOLOOK	;SKIP A LINE IF NOT IN RANGE
	CAILE	A,11		;NOT IN RANGE
	JRST	NOLOOK		;THEN ISSUE LF
	HRRZ	0,TABLE(A)	;SELECT CONTROL CHARACTER
	JRST	NOLOOK		;DEPOSIT CONTROL CHARACTER
MI:	PUSHJ	P,CO		;DEPOSIT CHARACTER
ZE:	PUSHJ	P,CO		;DEPOSIT CHARACTER

NOLOOK:	PUSHJ	P,CO		;DEPOSIT CHARACTER
NOLOK1:	POP	P,0
	POP	P,A
	POPJ	P,
;++ THIS REPLACES THE OUTPUT STUFF FOR REGULAR OUTPUT. DOES NO CRLF
;++ INSERTS, JUST DEPOSITS CHAR.

ENCOUT:	IDPB	0,1(M)		;++ DEPOSIT
	SKIPL	OVFLS.		;++ LINE FINISHED?
	SOSG	2(M)		;++ NO,BUFFER EMPTY?
	JRST	[HRR	A,HDRADD	;++GET REAL BUFFER HEADER
		JRST	NOTRN1	;++ DO BLT 
]
	JRST	NOLOK1		;++ NOT END OF LINE NOR BUFFER.

TABLE:	OCT 23			;*,CR WITH NO FF AFTER 60 LINES
	OCT 0			;+, NULL
	OCT 21			;,,THIRTIETH
	OCT 0			;-,SKIP 2 LINES
	OCT 22			;.,TWENTIETH
	OCT 24			;/,SIXTH
	OCT 0			;0,SKIP 1 LINE FF AFTER 60 LINES
	OCT 14			;1,TOP OF FORM
	OCT 20			;2, HALF
	OCT 13			;3, THIRD OR V.T.
,END OF FORMAT ROUTINES

ENDLN.:	TLZN	I,4		;T FORMAT THIS LINE
	JRST	NOTTL		;NO
	MOVE	0,TPNTR.	;RESET POINTER
	CAMG	0,1(M)		;IF THERE HAS BEEN A BACKUP
	JRST	NOTTL		;THERE HASN'T BEEN
	MOVEM	0,1(M)
	MOVE	0,TCNT2.	;RESTORE ITEM COUNT
	MOVEM	0,2(M)
NOTTL:	JUMPGE	I,BUFST		;JUMP IF INPUT
	SKIPGE	ENCDEC		;++ ENCODE?
	JRST	[SETOM	OVFLS.	;++ SET LIN END FLG - ENCODE!
		POPJ	P,	;++ AND RETURN 
]
	SKIPLE	L		;YES,IS IT END OF FMT?
	CAIN	B,SL		;THIS CHAR. A /?
	SKIPLE	EOL.		;YES, CHARACTER COUNT <= 0?
	JRST	CRTN		;NO,DELIMIT WITH CR
	MOVEI	0," "		;BLANK TURNS INTO LF
	PUSHJ	P,DEPOT.	;DEPOSIT BLANK
CRTN:	MOVEI	0,CR		;CARRIAGE RETURN
	PUSHJ	P,DEPOT.	;DEPOSIT C.R.
	SETOM	EOL.		;SET END OF LINE FLAG
	POPJ	P,

BUFST:	SKIPGE	ENCDEC		;++DECODE?
	JRST	LINEND		;++ YES TERMINATE LINE
	CAIN	B,SL		;LAST CHAR. A /?
	SKIPLE	2(M)		;YES,BUFFER EMPTY?
	JRST	PPN		;NO,ADVANCE TO NEXT RECORD
	SETZM	OVFLS.		;CLEAR LINE OVERFLOW
	TLZN	I,40000		;BUFFER EMPTY FLAG ON?
	PUSHJ	P,CHINN.	;NO,DO INPUT
PPN:	PUSHJ	P,NXTCR		;ADVANCE TO NEXT LINE
	SETZM	OVFLS.		;CLEAR LINE OVERFLOW
	SETOM	EOL.		;SET END OF LINE FLAG
	POPJ	P,		;RETURN

;++ FINISH UP ENCODE DECODE LINE END

LINEND:	SETOM	EOL.		;++ END OF LINE FLG
LINEN1:	LDB	0,[POINT 6,1(M),5]	;++ GET PTR
	CAIN	0,LSTBYT		;++ IS THIS THE LAST BYTE?
	POPJ	P,		;++ YES, RETURN
	XCT	IIB.		;++ BUMP POINTER
	JRST	LINEN1		;++ TEST THIS BYTE


	INTERN FIN

;TERMINATE FORTRAN I-O STATEMENT

FIN:	HRLZI	0,SAVFAC	;SET UP BLT TO RESTORE OP SYS AC'S
	BLT	0,16		;RESTORE ALL BUT P
	HRRZ	0,I		;PICK UP MODE
	CAIN	0,14		;BINARY MODE?
	JRST	BINEN.		;YES
	AOSE	EOL.		;END OF LINE SEEN?
	PUSHJ	P,ENDLN.	;NO,TERMINATE LINE
	SETZM	END.		;CLEAR END OF FILE FLAG
	SETZM	ERR.		;CLEAR INPUT ERROR FLAG
	SKIPL	RANAC.		;RANDOM ACCESS?
	JRST	FI.		;NO
	MOVE	B,FILNUM	;GET F4 DEVICE NO.
	IMULI	B,5		;5 ENTRIES/DEVICE(DATA SET)
	MOVE	C,FILES.-1(B)	;GET ADR OF ASSOC VARIABLE
	MOVE	B,ASVAR.	;GET INTERNAL ASSOC VAR VALUE
	MOVEM	B,(C)		;PUT VALUE IN REAL ASSOC VAR
	SKIPGE	I
	PUSHJ	P,OUTOK		;OUTPUT THE BUFFER IF RANDOM OUTPUT
	PUSHJ	P,CLOSI.	;??? SET UP FOR NEW INPUT EACH TIME
	SETZM	RANAC.		;CLEAR RANDOM ACCESS FLG
FI.:	MOVE	0,FOBPDP	;INITIALIZE PUSHDOWN POINTER
	MOVEM	0,SAVFAC+P	;RESTORE PUSHDOWN PTR
	SETZM	ILLEG.		;CLEAR ILL. CHAR. FLAG
	SETZM	INIFLG		;CLEAR FLAGS FOR NXT I/O
	MOVE	0,[XWD INIFLG,INIFLG+1]
	BLT	0,INPDEV	;...
	MOVSI	17,SAVEAC	;SET UP BLT TO RESTORE USERS ACS
	BLT	17,17		
	MOVE	0,SAVEAC+0	;RESTORE AC0
	SKIPN	A,ERR.		;USER PROGRAM CONTROL IF INPUT ERROR
	JRST	ENDTST		;NO ERROR OR CONTROL NOT DESIRED
	SETZM	ERR.		;CLEAR ERROR FLAG
	JRSTF	(A)		;GO TO POSITION SPECIFIED
ENDTST:	SKIPN	A,END.		;USER PROGRAM CONTROL IF END-OF-FILE
	JRST RERTN1	;CHECK FOR SYSTEM CUT DESIRED
;	JRSTF	@UUOH.		;NO END OF FILE OR CONTROL NOT DESIRED
	SETZM	END.		;CLEAR EOF FLAG
	JRSTF	(A)		;GO TO POSITION SPECIFIED


;CHINN. IS CALLED BY ALL INPUT ROUTINES TO GET A CHARACTER.
;THE CHARACTER IS RETURNED IN AC 0. AC M IS USED.

CHINN.:	SKIPE	OVFLS.		;SWITCH ON IF ALL CHARS. USED
	JRST	RETCR		;IN WHICH CASE, RETURN A C.R.
IOK6:	SKIPG	2(M)		;IS BUFFER EMPTY?
	PUSHJ	P,DOINP		;YES,DO INPUT
IOK:	LDB	0,1(M)		;PICK UP A CHARACTER

; FOLLOWING ADDED FOR SNOBOL TO MAKE FORSE IGNORE ANY LINES
; WITH LINE NUMBERS. A FULL WORD OF FIVE CHARACTERS IS SKIPPED
; ALONG WITH AN ASSUMED 'TAB' AS ADDED BY LINED.

	PUSH P,I	;GRAB AN EXTRA AC
IOK2:	MOVE I,@1(M)
	TRZN I,1	;LINE SEQ. NO. ON?
	JRST IOK1	;BRIEF MODE EXIT
	CAMN I,[ASCII '     ']	;PAGE MARK?
	JRST PGMRK	;YES
	MOVNI I,6
	ADDM I,2(M)
	AOS 1(M)
	IBP	1(M)	;THIS SHOULD GET THE TAB
IOK4:	POP P,I
	JRST IOK6	;CONTINUE PROCESSING
PGMRK:	AOS 1(M)	;BYPASS BLANKS
	MOVNI I,5
	ADDM I,2(M)
	MOVE I,@1(M)	;LOOK AT NEXT WORD
	CAME I,[BYTE (7) 15,15,14,00,00]
	JRST IOK4	;DON'T KNOW WHAT IT IS THEN
	AOS  1(M)
	MOVNI I,5
	ADDM I,2(M)
	JRST IOK4
IOK1:	POP P,I

; END OF CHANGE
	AOS	EOL.		;INCREMENT COLUMN COUNT
	CAIN	0,CR		;IS IT A CARRIAGE RETURN?
	JRST	NXTLN.		;YES,SKIP TO NEXT LINE

; FOLLOWING CODE ADDED TO SNOBOL IN ORDER TO ALLOW FORM FEEDS
; AND VERTICAL TABS IN THE SOURCE TEXT

	CAIE 0,14	;FORM FEED?
	CAIN 0,13	;VERT. TAB?
	JRST [ MOVEI 0,LF	;CONVERT TO LF
	       JRST NXTLN.]

; END OF FF AND VT FIX
;	CAIG	0,24		;IGNORE SPECIAL CHARACTERS
;	MOVEI	0," "		;REPLACE WITH BLANK
	SOSG	2(M)		;DROP CHARACTER COUNT
	TLO	I,40000		;BUFFER EMPTY FLAG
	POPJ	P,		;RETURN
DOINP:	SKIPGE	ENCDEC		;++ DECODE?
	JRST	EDERR.		;++ YES DON'T DO INPUT
	PUSHJ	P,INP.		;GET NEXT BUFFERFUL
	PUSHJ	P,SAVPTR	;SAVE POINTER FOR REREAD
	IBP	RPTR2		;INCREMENT SAVED POINTER
IIB.:	IBP	1(M)		;ADVANCE POINTER
	PUSH	P,F		;SAVE F-USED FOR STATUS
	PUSHJ	P,STAT.		;GET ERRORS NOT ASSOCIATED WITH A BUFFER
	TRNE	F,IODEND
	JRST	EOFTS.		;END OF FILE
	TRNE	F,IOTEND	;END OF TAPE
	PUSHJ	P,ENDTP.	;EOT
; FOLLOWING REMOVED FOR SNOBOL-I BELIEVE THERE IS NO
; GUARANTEE IN 4S50 OR 4S72 THAT THE ERROR STATUS IS EVER
; RECORDED IN THE PROPER BUFFER
;	HRRZ	F,(M)		;PICK UP 1ST WORD BUFFER
;	MOVE	F,-1(F)		;TO GET STATUS

	TRNN F,740000		;ANY ERRORS?
	JRST WADE1		;NO SO DON'T CHECK ANY!
	SKIPN ERR.		;IS THE USER INTERESTED?
	JRST WADE2		;SO TELL HIM ANYWAY
	MOVEM F,ERRW.		;RECORD IT FOR THE INTERESTED USER
	POP P,F			;RESTORE ORIGINAL F
	POP P,(P)		;RETURN ONE LEVEL UP
	JRST FI.		;RETURN TO USER AT ERR. ENTRY
WADE2:

; END OF CHANGE FOR SNOBOL
	TRNE	F,IODERR
	PUSHJ	P,REDER.	;DATA ERROR
	TRNE	F,IOPERR
	PUSHJ	P,PARER.	;PARITY ERROR
	TRNE	F,IOBKTL
	PUSHJ	P,LISTB.	;LIST TOO LONG
WADE1:	POP	P,F		;RESTORE F
	POPJ	P,		;RETURN WITH CHARACTER

EDERR.:	SKIPE	EDERR		;++ HAVE WE BEEN HERE BEFORE?
	SETOM	EDERR		;++YES, SET 2ND TIME ERROR FLAG
	HRRM	P,EDERR		;++ NO SET 1ST TIME FLG(NON 0 R.H.)
	POPJ	P,		;++ RETURN
;SEARCH TO END OF CURRENT LINE

NXTCR:	SKIPE	OVFLS.		;END OF LINE ALREADY SEEN?
	POPJ	P,		;YES
NXTCR.:	XCT	IIB.
	SOSG	2(M)		;DROP ITEM COUNT
	PUSHJ	P,DOINP		;DO INPUT
	LDB	0,1(M)		;GET NEXT CHARACTER
	CAIE	0,CR		;IS IT A CARRIAGE RETURN
	CAIN	0,LF		;IS IT A LINE FEED?
	JRST	NXTLN.		;YES,YES...GO TO NEXT LINE

; FOLLOWING CODE ADDED TO SNOBOL TO ALLOW FORM FEEDS AND VERT. TABS
; TO BE IN THE SOURCE TEXT

	CAIE 0,14
	CAIN 0,13
	JRST [ MOVEI 0,LF
	       JRST NXTLN.]

; END OF ADDITION
	JRST	NXTCR.		;NO,KEEP LOOKING

;ADVANCE TO NEXT LINE IN BUFFER (IF THERE IS ONE)

NXTLN.:	SETOM	OVFLS.		;SET END-OF-LINE SWITCH
	SKIPGE	RANAC.		;RANDOM ACCESS?
	AOS	ASVAR.		;YUP, INCREMENT VALUE OF ASSOC VAR
; THE FOLLOWING INSTRUCTION PATCHED OUT FOR SNOBOL IN ORDER
; TO FIX AN INTERMITTENT PROBLEM CAUSED BY A CARRIAGE RETURN
; BEING THE LAST CHARACTER IN THE BUFFER. THIS CAUSES THE
; SYSTEM TO RETRIEVE ANOTHER BUFFER. THERE IS ADDITIONAL CODE REQUIRED 
; A FEW INSTRUCTIONS DOWN
;	JRST	RETBLK		;RETURN A C.R.
NXTCH:	SOSG 2(M)	;DROP ITEM COUNT
	JRST	[ PUSHJ P,DOINP
		  SOSG 2(M)
		  JRST NXTCH	;SHOULDN'T HAPPEN!
		  JRST NXTCH3]
NXTCH3:
	ILDB	0,1(M)		;GET NEXT CHARACTER
	JUMPE	0,NXTCH		;IGNORE NULLS
; FOLLOWING CHANGED FOR SNOBOL
;	CAIE	0,CR		;LOOK FOR CR IN CASE CALLED FROM ENDLN
;	CAIN	0,LF		;LINE FEED?
;	JRST	NXTCH		;YES,CONTINUE LOOKING

	CAIN 0,CR	;IS IT A CARRIAGE RETURN?
	JRST NXTCH	;DO AS BEFORE
	CAIE 0,LF
	JRST RETBLK	;WE HAVE FOUND BEGINNING OF NEXT LINE
; THE FOLLOWING GYMNASTICS ARE NECESSARY BECAUSE OF NULL CHARACTERS
NXTCH1:	SOSG 2(M)	;BUFFER EMPTY?
	JRST RETBLK	;YES
	ILDB 0,1(M)	;GET THE NEXT CHARACTER
	JUMPE 0,NXTCH1
	CAIN 0,LF
	JRST NXTCH1
; THIS MAY SEEM UNNECESSARY BUT IT WORKS AT LEAST!

RETBLK:	SKIPGE	RERDFL		;HAS THERE BEEN A REREAD?
	JRST	RETCR		;YES,LEAVE POINTERS AS THEY ARE
	MOVE	0,1(M)		;SAVE POINTER
	EXCH	0,RPTR2		;AND EXCHANGE WITH LAST ONE
	MOVEM	0,RPTR1
	MOVE	0,2(M)		;SAME FOR ITEM COUNT
	EXCH	0,RCNT2
	MOVEM	0,RCNT1
RETCR:	MOVEI	0,CR		;RETURN A C.R.
	POPJ	P,		;RETURN

;END OF FILE TESTING

EOFTS.:	SKIPL	EOFFL.		;HAS THE EOFTST PROGRAM BEEN CALLED
	JRST	[SKIPN	END.	;NO,DOES USER WANT PROGRAM CONTROL?
		JRST	LOGEN.	;NO,PRINT ERROR MESSAGE AND FAIL
		SETZM ERR.	;AVOID UNPLEASANT HAPPENINGS
				;WITH ERRORS ON EOFS
		JRST	FI.	];YES,GO TO POSITION SPECIFIED
	PUSHJ	P,CLOSI.	;YES EOFTST WAS CALLED,TURN OFF EOF BIT
	MOVEI	A,4		;SET UP EOF SWITCH 
	IORM	A,(G)		;                  IN DEVICE NAME
	SETZM ERR.	;PREVENT ERROR RETURN ON EOF
EDFIN:	SOS	UUOH.		;SET UP FOR CHECKING FOR FIN.
	MOVSI	B,21000		;PUT FIN.'S OP CODE IN  AC B
MOVUUO:	MOVE	A,@UUOH.	;GET FORTRAN UUO FROM PROGRAM
	AOS	UUOH.		;INCREMENT PASSED THE FIN. OP CODE
	CAME	A,B		;IS  THE UUO A FIN. 00,0
	JRST	MOVUUO		;NO,GET NEXT UUO
	JRST	FI.		;EXECUTE FI. AND GO TO NXT UUO AFTER FIN.

;RETURN TO USER...RESTORE USER'S AC'S

UXIT.:
FINUX:	MOVSI	17,SAVEAC	;SET UP BLT TO RESTORE USER'S AC'S
	BLT	17,17
RERTN:	MOVE	0,SAVEAC+0	;RESTORE AC0

	EXTERN CUTFLG

RERTN1:	SETZM NCTRLC
	SKIPE CUTFLG	;REENTER TYPED WHILE IN FORSE?
	JRST @CUTFLG	;YES
	JRSTF	@UUOH.		;RETURN TO USER

;ENTRY FROM USER

UUOH.:	0
	SETOM NCTRLC	;DONT ALLOW REENTER WHILE IN FORSE
	MOVEM	0,SAVEAC+0	;SAVE AC 0
	EXCH	A,JOBUUO	;PICK UP UUO
	LDB	0,[POINT 9,A,8]	;PICK UP UUO OP CODE
	CAIE	0,15		;RESET. ?
	JRST	NRES		;NO

;RESET. UUO COMES HERE

;RELEASE ALL DEVICES IN CASE ANY BUFFERS STILL FULL

	MOVEI	0,16		;CHANNELS 16-0
	DPB	0,[POINT 4,REL,12];DEPOSIT CHANNEL NO.
REL:	RELEAS			;****   MODIFIED
	SOJGE	0,.-2

;	CALLI	0		;RESET I/O
	HRRZ	A,JOBFF		;CURRENT END OF JOB AREA
	HRLI	A,-VAR		;LENGTH OF OP SYS PUSHDOWN
	MOVEM	A,FOBPDP	;SAVE START OF PUSHDOWN
	MOVEM	A,SAVFAC+P	;SAVE POINTER FOR NEXT UUO
	ADDI	A,VAR		;ADD LENGTH OF PUSHDOWN
	HRRM	A,JOBFF		;NEW END OF JOB AREA
	SETZM	TNAME		;CLEAR FILE NAME BLOCK
	MOVE	0,[XWD TNAME,TNAME+1]
	BLT	0,LASTFL	; TNAME IS 36 LOC
	MOVE	17,PDLST.	;INITIALIZE FORTRAN
				;FUNCTION PUSHDOWN POINTER
	PUSHJ	P,MTACL.	;V.008 CLEAR MTA TABLE
	PUSHJ	P,ERRINI	;V.021- INITIALIZE ERROR HANDLER
	PUSHJ	P,TRPINI	;V.021- INITIALIZE TRAP HANDLER
	HRRZS	UUOH.		;V.021- CLEAR ARITHMETIC FLAGS
	JRST	RERTN		;RETURN TO USER

;UUO'S OTHER THAN RESET. COME HERE

NRES:	CAIG	0,34		;CHECK UUO LIMITS
	CAIG	0,15
	PUSHJ	P,ILUUO.	;ILLEGAL UUO VALUE
	SUBI	0,16		;UUO VALUE RELATIVE TO ZERO
	DPB	0,XRP		;PUT UUO IN I.R.FIELD
	MOVEM	A,0		;SAVE UUO
	MOVE	A,ACBLT		;SET UP BLT FOR USER'S AC'S
	BLT	A,SAVEAC+P
	MOVE	P,SAVFAC+P	;SET UP OP SYS PUSHDOWN POINTER
;SAVE USER'S ACCUMULATORS AND DISPATCH ON UUO

	MOVEM	0,A		;UUO
	MOVE	0,JOBUUO	;USER'S AC A
	MOVEM	0,SAVEAC+A	;USER'S AC A
	LDB	B,XRP		;RELATIVE UUO VALUE
	JRST	@TABU(B)	;DISPATCH TO UUO ROUTINES


XRP:	POINT	4,A,17		;X.R. FIELD OF UUO

;DISPATCH TABLE FOR INCOMING UUO'S..IN ORDER OF NUMERIC VALUE.

TABU:	EXP	IN12		;IN.
	EXP	OUT1		;OUT.
	EXP	DATA		;DATA.
	EXP	FIN		;FIN.
	EXP	RTB		;RTB.
	EXP	WTB		;WTB.
	EXP	RRBBW		;REW.,REWUN.,BSR.,WEF.,SPR.
	EXP	SLIST		;SLIST.
	EXP	INF		;INF.
	EXP	OUTF		;OUTF.
	EXP	REREAD		;RERED.
	EXP	NLI		;NAMELIST INPUT
	EXP	NLO		;NAMELIST OUTPUT
	EXP	DEC		;DECODE
	EXP	ENC		;ENCODE
,ENTRY ON IN. OR OUT. UUOS

OUT1:	SKIPL	RANAC.		;RANDOM ACCESS?
	JRST	OUT3		;NO,DO NORMAL OUTPUT
	SKIPE	FAKEIN		;YES,RANDOM,MUST WE INPUT A BLOCK?
	JRST	OUT2		;NO,FAKEIN FLG WAS SET,DO OUTPUT
	SETOM	FAKEIN		;YES,SET FAKEIN,DO INPUT
	JRST	IN12		;INPUT A BUFFER FULL & RETURN

OUT2:	SETZM	FAKEIN		;INHIBIT INPUT SET UP
	SETZM	INPDEV		;CLEAR ASCII INPUT DEVICE FLAG
OUT3:	MOVSI	I,400000	;OUTPUT,ASCII
	JRST	SFMTFL		;SET THE FORMAT FLAG
IN12:	SKIPL	RANAC.		;RANDOM ACCESS?
	JRST	IN13		;NO DO NORMAL INPUT
	MOVE	B,RECNO.	;GET NEXT RECORD FROM FORTRAN PROGRAM
	MOVEM	B,ASVAR.	;PUT IN ASSOCIATED VARIABLE (INTERNAL)

IN13:	SETZM	I		;INPUT,ASCII
	SETOM	INPDEV		;SET ASCII INPUT DEVICE FLAG
SFMTFL:	TLO	I,100		;SET FORMAT FLAG
NFI:	AOS	INIFLG
	HRRE	0,A		;DEVICE NO.
	JUMPE	0,PDERR		;DEVICE 0 IS ILLEGAL
	CAIG	0,77		;CHECK RANGE OF DEVICE NO.
	CAMGE	0,[-6]		;6 SPECIAL FORTRAN I/O STATEMENTS
PDERR:	PUSHJ	P,DEVER.	;ILLEGAL DEVICE NO.
	MOVEM	0,DEVNUM	;SAVE F4 DEV NUM
	JUMPL	0,NEGNUM	;IS DEV NEG => DEFAULT DEVICES?
	PUSH	P,A		;SAVE AC
	IDIVI	0,12		;CONVRT TO 6-BIT
	LSH	0,6
	OR	0,1		;CAN HAVE UP TO 77 OCT DEVICES THIS WAY
	IORI	0,2020
	TRNN	0,700		;TWO DIGITS?
	LSH	0,6		;ONE DIGIT
	LSH	0,30		;LEFT JUSTIFY
	MOVEM	0,E
	MOVEM	0,B
	MOVEM	0,DEVNAM
	POP	P,A		;RESTORE AC
	CALL	E,[SIXBIT .DEVCHR.]
	TRNN	E,400000	;HAS THE DEVICE BEEN ASIGNED BY CONSOL?
NEGNUM:	PUSHJ	P,GETDEV	;NO, GET NAME FROM DEVTB
	TLNE	E,4		;DECTAPE OR DISK?
	TLOA	I,40		;YES
	TLNN	E,40000		;LPT
	TLNE	E,10		;LPT OR TTY?
	SETOM	TTYLPT		;YES,SET LPT OR TTY FLAG
	TLNE	E,100000	;CARDS I/O?
	SETOM	CDPCDR		;SET CARD READER/PUNCH FLAG
	TLNE	E,20000		;IS THIS THE USERS TELETYPE ?
	MOVE	B,[SIXBIT ?TTY?];YES, MOVE TTY INTO DYNDV. TABLE
	MOVEI	D,DYNDV.	;ADDR. OF DYNAMIC DEVICE TABLE
	MOVE	C,DEVNO.	;HIGHEST CHANNEL NUMBER
	JUMPE	C,OKINIT	;FIRST DEVICE
	ADD	D,C		;ADDR. OF THIS DEVICE NAME
LPT3:	LDB	0,[POINT 30,(D),29]   ;YES,ITS BEEN INITED
	LSH	0,6		;GET THE NAME AND CHAN NO
	CAMN	B,0		;CORRECT CHAN ?...DOES THE NAME MATCH?
	JRST	DEVFND		;YUP DO LOOKUPS,TAPE FUNCTS ETC.
	SOS	D		;SET FOR NEXT LOWER DEVICE IN DYNDV.
	SOJG	C,LPT3		;KEEP LOOKING
	JRST	OKINIT		;FAILED TO MATCH DEV NAME IN DYNDV.



GETDEV:	MOVE	0,DEVNUM	;RESTORE DEVICE LOGICAL NUMBER
	MOVNI	C,DEVTB.	;CALCULATE ADDR. OF DEVICE NAME
	AOS	C
	SKIPG	B,0		;DEVICE NO. NEGATIVE?
	ADDI	B,DEVND.(C)	;YES,GO TO END OF TABLE
	MOVE	B,DEVTB.(B)	;PICK UP DEVICE NAME
	CAMN	B,[SIXBIT /REREAD/]
	JRST	REREAD		;SET UP TO REREAD 
SAVDNM:	SKIPN	E,B		;GET DEV NAME AND
	PUSHJ	P,ILRED.	;FAIL IF IT WAS RELEASED.
	ANDCM	E,[770000]	;STRIP OFF #
	CAME	E,[SIXBIT .DSK.]	;DSKN ?
	MOVE	E,B	;NO RESTORE NAME
	MOVEM	E,DEVNAM	;SAVE DEVICE FOR INITIALIZATION
	CALL	E,[SIXBIT .DEVCHR.]
	POPJ	P,
OKINIT:	TLNE	I,10		;COMPARE FOR REREAD
	PUSHJ	P,ILRED.	;ILLEGAL REREAD
	MOVEI	C,1		;SET DEVICE NO. TO 1
	ADDB	C,DEVNO.	;UPDATE AND SAVE HIGHEST DEV. NO.
	ADD	D,C		;ADDR. OF NAME IN TABLE
	CAILE	C,16		;IF MORE THAN 16 INIT,
	PUSHJ	P,FNDSLT	;SEE IF ANY WERE RELEASED
	HRLZ	M,C		;SAVE DEVICE NO.
	ASH	M,5		;DEVICE NO. IN AC FIELD
	MOVEM	B,(D)		;PUT DEVICE NAME IN TABLE
	HRR	G,D		;SAVE ADDR. FOR THIS NAME
	PUSHJ	P,BUFCA.	;GET A BUFFER HEADER
	MOVEM	G,DNAME		;SAVE DEV NAME ADDR
	MOVEM	0,INT+2		;BUFFER HEADER ADDRESS
	MOVE	B,DEVNAM
	MOVEM	B,INT+1		;DEVICE NAME
	DPB	C,[POINT 4,INT,12];DEVICE NO.
	SKIPGE	TTYLPT		;TTY OR LPT?
	HRRI	I,1		;YES,ASCII LINE
	HLLZS	INT		;V.007  ZERO THE ADDRESS PART
	TLNE	E,20		;V.007  DEVICE MTA?
	PUSHJ	P,MGINIT	;V.007  YES, GO SET UP MODE BITS
INT:	INIT	0,(I)		;INIT THE DEVICE
	Z
	Z
	PUSHJ	P,INIER.	;NOT AVAILABLE OR UNDEFINED
	MOVEM	B,DEVIC.	;CURRENT DEVICE NAME
	PUSHJ	P,CLROU.	;CLEAR OUTPUT-LAST BIT
	MOVE B,DEVNUM		;GET DEV NUMBER
	SKIPL	I		;SKIP ON OUTPUT
	MOVEM	B,RERDN.	;SAVE DEV. # FOR REREAD.
	SKIPG	B		;IF DEV NUM < 0,
	PUSHJ	P,MAKPOS	;MAKE IT POSITIVE.
	MOVEM	B,FILNUM	;SAVE FOR FILE NAME
;	SKIPE	B,DATTB.(B)	;IF BUFFER WAS CALLED,
;	PUSHJ	P,SETBFS	;GO SET UP RINGS.
	SKIPGE	RANAC.		;RANDOM ACCESS?
	PUSHJ	P,SNGLBF	;YES,SETUP SINGLE BUFFERING
	TLNE	I,200		;FILE COMMAND?
	JRST	FCM		;YES
	JRST	FTST		;NO


SNGLBF:	MOVEI	B,1		;SETUP INBUF UUO
	TLO	B,NINBUF	;WITH ONE BUFFER
	DPB	C,[POINT 4,B,12];CHANNEL #
	XCT	B
	ADD	B,[1000000000]	;OUTBUF UUO
	XCT	B
	POPJ	P,


DEVFND:	MOVE	B,DEVNUM
	SKIPG	B
	PUSHJ	P,MAKPOS
	MOVEM	B,FILNUM	;SAVE F4 DEVICE NUMBER
	SKIPL	I		;SKIP ON OUTPUT
	MOVEM	B,RERDN.	;SAVE DEV. # FOR REREAD
	MOVEM	0,DEVIC.	;SAVE DEVICE NAME
	SKIPGE	INPDEV		;IS THIS AN ASCII INPUT DEVICE ?
	PUSHJ	P,CKDVEQ	;YES, SEE IF THE SAME AS LAST INPUT DEV.
	HRLZ	M,C		;DEVICE NUMBER
	ASH	M,5		;DEVICE NO. IN AC FIELD
	PUSHJ	P,BUFCA.	;GET HEADER ADDRESS
	HRR	G,D		;ADDR. FOR THIS DEVICE NAME
	MOVEM	G,DNAME		;SAVE DEVICE NAME ADDR
	SKIPLE	INPDEV		;IS THIS A NEW INPUT DEVICE ?
	PUSHJ	P,SAVPTR	;YES,SAVE NEW POINTER FOR REREAD
	SKIPL	TTYLPT		;IS THE DEVICE THE TTY OR LPT ?
	PUSHJ	P,JSB		;NO,CHECK FOR CHANGE IN MODE
IFE FTSW1<JUMPGE	I,DVF		;DONT CHECK ON INPUT FOR CHANGE IN I/O
	SKIPG	-3(M)		;HAS AN INPUT BEEN DONE YET?
	JRST	DVF		;NO,CONTINUE
	MOVE	D,(D)		;
	TRNN	D,2		;OUTPUT LAST?
	SETOM	RDWRFL		;SET READ TO WRITE FLAG
>
DVF:	TLNE	I,200		;FILE COMMAND?
	JRST	FCM		;YES
FTST:	TLNE	I,400		;SPECIAL TAPE FUNCTION?
	JRST	FTST1		;YES
	TLNN	I,40		;DECTAPE?
	JRST	FTST1
	MOVE	D,C		;YES,GET DEV. NO.
	ASH	D,1		;SET INDEX FOR FILE NAME
	SKIPG	I		;SKIP ON INPUT
	AOS	D		;INDEX FOR OUTPUT FILE
	SKIPE	TNAME-2(D)	;ANY NAME THERE?
	JRST	FTST1		;FILE NAME ALREAD	 SET
	PUSH	P,A
	MOVE	B,FILNUM
	IMULI	B,5		;B HAS F4 DEV NO
	SKIPE	A,FILES.-5(B)	;IS THERE A FILE NAME?
	JRST	SETNAM		;YES, GO PUT IT IN TEMP FOR LOOKUP ETC.
	LDB	0,[POINT 6,FILNUM,35]    ;NO, GET POSITIVE F4 DEVICE NO
	IDIVI	0,12		;CONVERT TO 6BIT
	LSH	0,6
	OR	0,1
	IOR	0,FORZRO	;SIXBIT FOR00
	LSH	0,6
	MOVEM	0,TEMP
	MOVSI	A,444164	;SIXBIT 'DAT'
	MOVEM	A,TEMP+1	;SET 'DAT' UP FOR EXTENSION
	SKIPE	A,FILES.-3(B)	;IS THERE A PPN FOR LOOKUPS OR ENTER?
	JRST	SETPPN		;YES, GO SET IT UP
DEFALT:	POP	P,A		;NO,FORGET IT
	PUSHJ	P,FCM1		;DO LOOKUP OR ENTER
FTST1:	IFE FTSW1<SKIPGE RDWRFL	;TRYING TO READ THEN WRITE?
	JRST	RDWR		;YES,GO SET UP BUFFERS ETC
FTST0:>JUMPGE	I,FTST2		;OUTPUT?
	PUSHJ	P,CLOSI.	;YES,DO INPUT CLOSE FOR LAST READ
	SKIPG	(M)		;DUMMY OUTPUT NEC. ?
	PUSHJ	P,OUTT.		;YES
	SKIPGE	RANAC.		;RANDOM ACCESS I/O?
	PUSHJ	P,RANBLT	;YES,GET INPUT BUFFER FULL AND BLT
				;IT INTO THE OUTPUT BUFFER
FTST2:	TLNE	I,2000		;NAMELIST?
	JRST	NAMEL		;YES
	TLNE	I,400		;SPECIAL TAPE FUNCTION?
	JRST	TPFCN.		;YES,GO TO FUNCTION DISPATCH
	TLNN	I,100		;FORMAT?
	JRST	BINWR.		;NO,GO TO BINARY READ & WRITE
	SKIPGE	TTYLPT		;TTY OR LPT?
	JRST	IORET		;YES
	LDB	C,[POINT 9,@(M),17];PICK UP BUFFER WORD-SIZE
	SUBI	C,LINWDS+1
	JUMPLE	C,IORET		;DON'T USE LINE BUFFER IF
				;DEVICE BUFFER SIZE TOO SMALL
FTST3:	HRRZM	M,HDRADD	;ADDRESS OF REAL BUFFER HEADER
	JUMPGE	I,IORET		;ON INPUT,DON'T SET UP LINE BUFFER
	PUSHJ	P,SETOU.	;SET OUTPUT BIT
	MOVEI	C,LINBUF-1	;INITIALIZE LINE BUFFER HEADER
	MOVEM	C,LINHDR
	MOVE	C,LBPTR		;POINTER TO LINE BUFFER
	MOVEM	C,LINHDR+1
	MOVEI	C,LINCH		;ITEM COUNT
	MOVEM	C,LINHDR+2
	HRRI	M,LINHDR	;HEADER ADDRESS
	SETOM	PAKFL.		;SET PACK FLAG
	JRST	IORET		;GO TO FORMAT SCAN


;SET UP PROJ,PROG NO,  FILENAME,  EXT FOR I/O.

SETNAM:	MOVEM	A,TEMP		;SET UP DESIRED FILENAME
	SKIPE	A,FILES.-4(B)	;GET EXT IF ANY & SET IT UP
	MOVEM	A,TEMP+1
	SKIPE	A,FILES.-3(B)	;GET PPN, IF ANY
SETPPN:	MOVEM	A,TEMP+3	;SET IT UP
	JRST	DEFALT		;RETURN.


;CHECK TO SEE IF CURRENT INPUT DEVICE IS THE SAME AS LAST ONE
CKDVEQ:	SKIPN	INPDV.		;IS THIS THE FIRST INPUT DEV. ?
	MOVEM	0,INPDV.	;YES,MOVE INTO HOLDING AREA
	CAMN	0,INPDV.	;ARE THE TWO DEVICES THE SAME ?
	POPJ	P,		;YES, RETURN
	MOVEM	0,INPDV.	;NO,MOVE NEW DEV. INTO HOLDING AREA
	XORM	0,INPDEV	;SET UP FLAG TO SAY THEY ARE DIFF.
	POPJ	P,		;RETURN

;SAVE THE CURRENT POINTER AND ITEM COUNT FOR REREAD

SAVPTR:	MOVE	0,1(M)		;GET POINTER
	MOVEM	0,RPTR2		;SAVE IN RPTR2
	MOVE	0,2(M)		;GET ITEM COUNT
	MOVEM	0,RCNT2		;SAVE IN RCNT2
	POPJ	P,		;RETURN
;RESET STATUS FOR CURRENT DEVICE

JSB:	TLNN	I,100		;IS THE MODE ASCII ?
	POPJ	P,		;NO, RETURN
	LDB	0,[POINT 6,1(M),11];YES, GET POINTER SIZE
	CAIE	0,44		;IS THE POINTER BINARY ?
	POPJ	P,		;NO,RETURN
	MOVEI	0,0700		;YES,SET UP ASCII POINTER
	HRLM	0,1(M)		;PUT NEW POINTER INTO BUFFER HEADER
	MOVE 	0,2(M)		;ADJUST WORD COUNT
	IMULI	0,5		;FOR ASCII MODE
	MOVEM	0,2(M)		;REPLACE WITH NEW COUNT
	POPJ	P,		;RETURN WITH MODE CHANGED

;SET BUFFER HEADER ADDRESS FOR CURRENT DEVICE

BUFCA.:	LDB	0,[POINT 4,M,12];DEVICE NUMBER
	IMULI	0,6		;SIX WORDS FOR EACH DEVICE
	ADDI	0,BUFHD.	;BASE ADDRESS
	HRLS	0		;IN BOTH HALVES
	HLL	G,0		;ADDRESS OF INPUT BUFFER HEADER
	ADD	0,[XWD 3,0]	;OUTPUT ADDR.,INPUT ADDR.
	HLRM	0,M		;HEADER ADDRESS
	SKIPL	I		;SKIP ON OUTPUT
	HRRM	0,M		;HEADER ADDRESS
	POPJ	P,
;ENTRY ON INF. AND OUT. UUOS

INF:	MOVSI	I,200		;FILE COMMAND,ASCII
	LDB	D,PTRU		;AC CONTAINING FILE NAME
	ADDI	D,SAVEAC	;ADDR. WHERE AC SAVED

	HRLZ D,(D)	;NEW FORM FOR IFILE/OFILE LPW
	HRRI D,TEMP
	BLT D,TEMP+3
	JRST NFI


;CONVERT FILE NAME TO SIXBIT

;	MOVE	B,[POINT 6,TEMP];RESULT POINTER
;	MOVE	D,(D)		;7-BIT ASCII FILE NAME
;	SETZM	TEMP		;CLEAR NAME
;SSBC:	JUMPE	D,NFI		;JUMP IF THROUGH
;	LSHC	C,7		;GET NEXT CHARACTER
;	TRC	C,40		;CONVERT TO SIXBIT
;	IDPB	C,B		;DEPOSIT IN ENTRY BLOCK
;	JRST	SSBC

OUTF:	MOVSI	I,400200	;OUTPUT,FILE COMMAND,ASCII
	JRST	INF+1		;GET NAME AND DO INIT

;ENTRY ON REREAD UUO--FORMAT SIMILAR TO READ

REREAD:	TLO	I,10		;REREAD , ASCII
	SETOM	RERDFL		;SET REREAD USE FLAG ON
	MOVE	B,RERDN.	;PICK UP LAST INPUT DEVICE NUMBER
	MOVEM	B,DEVNUM	;MAKE IT THIS DEVICE NUMBER
	MOVE	B,RERDV.	;PICK UP LAST INPUT DEVICE NAME
	JRST	SAVDNM		;RETURN

;ENTRY ON NAMELIST (NLIN.,NLOUT.) UUO'S

NLI:	MOVSI	I,2000		;NAMELIST
	JRST	NFI		;INITIALIZE DEVICE

NLO:	MOVSI	I,402000	;OUTPUT,NAMELIST,ASCII
	JRST	NFI

;NAMELIST SET UP

NAMEL:	LDB	A,PTRU		;AC FIELD OF NAMELIST UUO
	MOVEI	A,@SAVEAC(A)	;POINTER TO NAMELIST TABLE
	PUSHJ	P,NMLST.	;GO OFF TO NAMELIST ROUTINE
	JRST	IORTR.		;RETURN TO USER

;ENTRY ON BINARY TAPE READ UUO
;DEVICE NO. IN RIGHT HALF OF UUO

RTB:	SKIPL	RANAC.		;RANDOM ACCESS?
	JRST	RTB1		;NO,DO NORMAL BINARY READ
	MOVE	0,RECNO.	;YES,GET RECORD NUMBER TO BE ACCESSED
	MOVEM	0,ASVAR.	;PUT IT IN INTERNAL ASSOCIATED VARIABLE
	SETZM	FAKEIN		;CLEAR A FLG THAT IS SET DURING ASCII

RTB1:	MOVEI	I,14		;SET TO BINARY MODE
	JRST	NFI		;DO INITIALIZATION
;ENTRY ON BINARY TAPE WRITE UUO

WTB:	SKIPL	RANAC.		;RANDOM ACCESS?
	JRST	WTB1		;NO DO NORMAL BINARY WRITE
	MOVE	0,RECNO.	;GET RECORD # TO BE ACCESSED
	MOVEM	0,ASVAR.	;PUT IN INTERNAL ASSOCIADTED VARIABLE
	SETZM	FAKEIN		;CLEAR AN ASCII RANDOMACCESS FLAG

WTB1:	MOVE	I,[XWD 400000,14];OUTPUT,BINARY
	JRST	NFI		;DO INITIALIZATION

;ENTRY ON SPECIAL TAPE FUNCTIONS
;DEVICE NO. IN RIGHT HALF OF UUO
;FUNCTION IN AC FIELD OF UUO

RRBBW:	LDB	I,PTRU		;AC FIELD OF UUO
	TRO	I,400		;SPECIAL FUNCTION
	HRLZS	I		;SWAP AND ZERO RH FOR ASCII
	JRST	NFI		;DO INITIALIZATION

;++ ENCODE COMES HERE

ENC:	HRLI	I,400100	;++ FORMAT, OUTPUT.
	MOVEI	M,ENCHDR	;++ SET UP ENCODE BUFFER HEADER
	PUSHJ	P,DECENC	;++ SET UP HEADER WORDS
	JRST	GETAC		;++ GO TO FORMAT SCAN

;++ DECODE COMES HERE

DEC:	HRLI	I,100		;++ INPUT ASCII
	AOS	INIFLG		;++ ??
	MOVEI	M,DECHDR	;++ SET UP DECODE BUFFER HDR
	PUSHJ	P,DECENC	;++SET UP HEADER WORDS
	XCT	IIB.		;++ MOVE POINTER UP ONE
	JRST	GETAC		;++ GO TO FORMAT SCAN

DECENC:	SETOM	ENCDEC		;++ SET ENCODE/DECODE FLAG
	HRRM	A,2(M)		;++ GET # CHARS PUT IN HDR
	HRLI	0,700		;++ SET UP HEADER
	HRR	0,VADDR.	;++ GET ADR OF 1ST WORD
	MOVEM	0,1(M)		;++ SET UP BYTE PTR
	SOS	1(M)		;++POINT TO WORD BEFORE DATA FOR ENC.
	POPJ	P,		;++ RETURN

EDMESS:	ASCIZ /
ENCODE - DECODE ERROR!
/
EDERRM:	TTCALL	3,EDMESS	;++ TYPE OUT ERROR MESSAGE
	SETZM	EDERR		;++ CLEAR ERROR FLAG
	JRST	EDFIN		;++ GO TO FIN UUO DIRECTLY SKIPPING OTHERS



;ROUTINE TO DO LOOKUP AND ENTER FOR FILE NAMES ON TAPE.
;DEVICE NO. IN ACZ AND FILE NAME IN TEMP

FCM:	PUSHJ	P,CLOSI.	;DO INPUT CLOSE ON DEVICE
	PUSHJ	P,FCM1		;DO LOOKUP OR ENTER
	JRST	FI.		;RETURN



FCM1:	SKIPGE	RANAC.		;RANDOM ACCESS?
	JRST	LOSES1		;DO LOOKUP FOLLOWED BY ENTER ONLY
LOSES2:	MOVE	0,TEMP		;GET FILE NAME
	ASH	C,1		;SET INDEX FOR LOC. OF NAME
	JUMPL	I,OENTER	;JUMP ON OUTPUT
	PUSHJ	P,CLOS.		;DO CLOSE BEFORE LOOKUP
	MOVE	0,TEMP		;INPUT,GET FILE NAME
	MOVEM	0,TNAME-2(C)	;SAVE THE NAME
	MOVE	0,[LOOKUP 0,TEMP]
	DPB	C,[POINT 5,0,13];DEPOSIT CHAN. NO.
	XCT	0		;DO LOOKUP
	JRST	RETRY		;DO ANOTHER LOOKUP WITHOUT THE EXT.
	POPJ	P,

OENTER:	AOS	C		;SET INDEX FOR OUTPUT FILE NAME
	MOVEM	0,TNAME-2(C)	;SAVE NAME
	SOS	C		;RESTORE DEV. NO. VALUE
	SETZM	TEMP+2		;FOR DATE
	MOVE	0,[ENTER 0,TEMP]
	DPB	C,[POINT 5,0,13];   CHAN. NO.
	XCT	0		;DO ENTER
; FOLLOWING CHANGED FOR SNOBOL IN ORDER TO PROVIDE THE ABILITY
; TO CHECK FOR FUNCTION FAILURE ON 'IFILE' AND 'OFILE' CALLS.
; INSTEAD OF TYPING AN ERROR MESSAGE, THE ROUTINE SETS A 
; FLAG WHICH IS NONZERO ON FUNCTION FAILURE
;	PUSHJ	P,NOROM.	;DIRECTORY FULL
	PUSHJ P,FLGSNO		;SET THE FAILURE FLAG
	POPJ	P,


;THIS INSURES LOOKUP IS FOLLOWED IMMEDIATELY BY AN ENTER AND AN ENTER
;DOES NOT FOLLOW AN INPUT IN THE CASE OF RANDOM OUTPUT.

LOSES1:	TLNN	I,100		;BINARY?
	JRST	LOSES2		;YES,DO REGULAR LOOKUP-ENTER
	SKIPGE	I		;SKIP ON INPUT
	POPJ	P,		;RETURN ON OUTPUT
	PUSH	P,C		;CHANNEL NUMBER WHICH GETS CLOBBERED
	PUSHJ	P,LOSES2	;DO LOOKUP
	POP	P,C		;RESTORE CHANNEL #
	SKIPL	FAKEIN		;RANDOM OUTPUT?
	POPJ	P,		;NO,RETURN
	TLO	I,400000	;SET OUTPUT FLG
	PUSHJ	P,LOSES2	;DO ENTER
	TLZ	I,400000	;CLEAR OUTPUT FLG
	POPJ	P,		;RETURN

;DO ANOTHER LOOKUP ON DECTAPE OR DISC---THIS TIME WITHOUT
;EXTENSION "DAT" ,THEN ON FORTR.DAT THEN ON FORTR.

RETRY:	SETZM	TEMP+1		;CLEAR EXTENSION
	XCT	0		;LOOKUP 0,TEMP IN AC 0
	JRST	.+2		;FAIL
	POPJ	P,		;SUCCEED
	MOVE	D,[SIXBIT .FORTR.]
	MOVEM	D,TEMP
	MOVSI	D,444164		;DAT
	MOVEM	D,TEMP+1
	XCT	0
	JRST	.+2
	POPJ	P,
	SETZM	TEMP+1		;NULL EXTENSION
	XCT	0
; FOLLOWING CHANGED FOR SNOBOL TO PROVIDE FUNCTION
; FAILURE CAPABILITY FOR 'IFILE'
;	PUSHJ	P,MSNG.		;COMPLETE FAILURE
	PUSHJ P,FLGSNO	;SET THE FUNCTION FAILURE FLAG
	POPJ	P,

	EXTERN IFFAIL
FLGSNO:	SETOM IFFAIL
	POPJ P,

;DO SPECIAL MAG TAPE OPERATION

FNCTN.:	HLLZ	0,M		;DEVICE NO.
	TLO	0,NMTAPE+D	;MTAPE UUO
	XCT	0
	POPJ	P,

;SET OUTPUT LAST FLAG IN WORD CONTAINING SIXBIT DEVICE NAME

SETOU.:	PUSH	P,G
	MOVE	G,DNAME
	MOVEI	0,2
	IORM	0,(G)
SETOU1:	POP	P,G
	POPJ	P,

;CLEAR OUTPUT LAST FLAG

CLROU.:	PUSH	P,G
	MOVE	G,DNAME
	MOVEI	0,2	
	ANDCAM	0,(G)
	JRST	SETOU1

;CLEAR ITEM COUNT IN INPUT BUFFER HEADER
;     ITEM COUNT USED AS USER-SYSTEM SYNC FLAG

CLRSY.:	PUSH	P,G
	HLRZ	G,DNAME
	SETZM	2(G)
	JRST	SETOU1

;DO STATUS CHECK FOR CURRENT DEVICE
STAT.:	HLLZ	0,M		;DEVICE NO.
	IOR	0,[GETSTS F]	;GET STATUS
	XCT	0
	POPJ	P,
;DO CLOSE FOR CURRENT DEVICE

CLOSI.:	SKIPGE	0,RANAC.	;DONT WANT TO CLOSE ON RANDOM ACCESS
	JRST	CLRSY.
IFE FTSW1<
	EXCH 0,D
	LDB D,[POINT 4,M,12]	;GET CHAN #
	SETZM	INCNT(D)	;CLEAR "INPUT"TALLY
	EXCH 0,D
>
	MOVEI	0,1		;INHIBIT OUTPUT CLOSE
	SKIPA

CLOS.:	SETZM	0
	HLL	0,M		;DEVICE NO.
	TLO	0,NCLOSE	;CLOSE UUO
	XCT	0
	JRST	CLRSY.		;CLEAR SYNC FLAG

;DO INPUT FOR CURRENT DEVICE

INP.:	SKIPL	0,RANAC.	;@@@ARE WE DOING DIRECT ACCESS?
	JRST	INP1		;@@@NO
	HLLZ	0,M		;@@@YES,GET THE BLOCK WHERE THE RECORD IS
	HRR	0,BLOCK.	;@@@SET UP BLOCK # WHERE REC IS.
	TLO	0,NUSETI	;@@@USETI OP CODE
	XCT	0		;@@@
INP1:	HLLZ	0,M		;DEVICE NO.
	TLO	0,NINPUT	;INPUT UUO
	XCT	0
IFE FTSW1<
	EXCH 0,D
	LDB D,[POINT 4,M,12]		;GET CHAN#
	AOS	INCNT(D)	;TALLY UP # OF "INPUTS" DONE
	EXCH 0,D
>
	SKIPL	RANAC.		;@@@RANDOM ACCESS?
	JRST	CLROU.		;NO,CLEAR OUTPUT LAST FLAG
	TLNN	I,100		;@@@YES, FORMAT INPUT?
	JRST	CLROU.		;@@@NO, BINARY! CLEAR FLAGS.
	HLLZ	0,M		;@@@YES FORMAT ,RESET BLOCK FOR OUTPUT 
	HRR	0,BLOCK.	;@@@GET BLOCK
	TLO	0,NUSETO	;@@@USETO=USETI IN REALITY
	XCT	0		;@@@'USETO  CHAN,BLOCK. '
	AOS	BLOCK.		;@@@SETUP BLOCK FOR NEXT INPUT
	SKIPGE	GOBACK		;@@@IS THIS INPUT FOR OUTPUT PURPOSES?
	POPJ	P,		;YUP!
	SKIPGE	RINSET		;@@@NO, HAS PTR & CNTR BEEN SET ONCE?
	JRST	CLROU.		;@@@YES,RETURN
	SETOM	RINSET		;@@@NO,SET UP HEADER FOR RANDOM INPUT
	MOVE	0,2(M)		;@@@ GET CHAR COUNT
	SUB	0,CHARS.	;@@@ SUBTRACT THOSE TO BE SKIPPED
	MOVEM	0,2(M)		;@@@ RESET CHAR COUNT
	HRRZ	0,1(M)		;@@@ GET ADDR FOR BYTE PTR
	ADD	0,WORDS.	;@@@ ADD WORDS TO BE SKIPPED
	HRRM	0,1(M)		;@@@ RESET PTR
	JRST	CLROU.		;@@@ CLEAR OUTPUT LAST FLAG

;DO OUTPUT FOR CURRENT DEVICE

OUTT.:	SKIPL	RANAC.		;RANDOM ACCESS?
	JRST	OUTT1		;NO, NORMAL OUTPUT
	TLNN	I,100		;FORMAT?
	PUSHJ	P,USET		;NO,BINARY, GET BLOCK

OUTT1:	HLLZ	0,M		;DEVICE NO.
	TLO	0,NOUTPT	;OUTPUT UUO
	XCT	0
	PUSHJ	P,SETOU.	;SET OUTPUT LAST FLAG
	JRST	CLRSY.		;CLEAR USER-SYS SYNCH FLAG


USET:	HLLZ	0,M		; CHAN #
	HRR	0,BLOCK.	;BLOCK WHERE RECORD STARTS
	TLO	0,NUSETO	;USETO UUO OPCODE
	XCT	0		;
	POPJ	P,
	
IFE FTSW1<
RDWR:	SKIPL	RANAC.		;RETURN IF RANDOM ACCESS
	TLNN	I,100		;FORMAT I/O?
	JRST	FTST0		;NO,BINWR TAKES CARE OF THIS FOR BINARY
	SKIPL	TTYLPT		;TTY IS OK.
	TLNE	I,2400		;NAMELIST OR TAPE FUNCTION?
	JRST	FTST0		;YES,DON'T SET UP BUFFERS ETC
	TLNN	E,20		;MTA? THIS WILL WORK FOR DSK LATER
	JRST	[PUSHJ	P,RDWRER ;NO,PRINT ERROR MESSAGE
		JRST	FTST0];CONTINUE
	MOVE	0,-1(M)		;GET NO OF CHARS.
	MOVEM	0,CHARS.	;STORE IT
	HRRZ	0,-2(M)		;BYTE PTR
	HRRZ	B,-3(M)		;BUFFER PTR
	SUB	0,B		;GET NO WORDS USED
	SUBI	0,2		;MAKE UP FOR 3RD WORD & IN/OUT DIFFERENCES
	MOVEM	0,WORDS.	;STORE IT
	SKIPG	(M)		;OUTPUT RING SETUP?
	PUSHJ	P,OUTT.		;NO DO DUMMY OUTPUT
	HRRZ	B,@(M)		;GET 2ND WD IN BUFFER
	HLRZ	B,(B)		;# WORDS IN THIS BUFFER
	HRRZ	D,(M)		;GET BUFFER ADDRESS
	ADDM	B,D		;GET FINAL ADDRESS
	HRRM	D,BLOTZ		;SET UP BLT
	HRLZ	D,-3(M)		;-FROM- INPUT BUFFER
	HRR	D,(M)		;-TO-   OUTPUT BUFFER
	ADD	D,[XWD 1,1]	;1ST DATA WORD
BLOTZ:	BLT	D,0		;***THIS INST GETS CHANGED, DO BLT
	MOVE	0,CHARS.	;PICK UP CHAR COUNT
	MOVEM	0,2(M)		;SET IT UP FOR OUTPUT
	HRRZ	0,1(M)		;OUTPUR POINTER
	ADD	0,WORDS.	;SKIP OVER WORDS USED ALREADY
	HRRM	0,1(M)		;SET UP OUTPUT POINTER
	TLNN	I,40		;DSK?
	JRST	[MOVEI	D,7	;BACKSPACE CODE
		PUSHJ	P,FNCTN.;NO,MTA. DO A BACKSPACE
		PUSHJ	P,CLOSI. ;CLOSE INPUT
		JRST	FTST3]	;CONTINUE,SET UP LINE BUFFERS ETC.
	LDB	D,[POINT 4,M,12];CHANNEL NUMBER
	MOVE	0,INCNT(D)	;GET COUNT OF # OF INPUTS DONE
	MOVEM	0,BLOCK.	;SET UP BLOCK#
	PUSHJ	P,CLOSI.	;CLOSE INPUT
	PUSHJ	P,USET		;DO USETI ON 'BLOCK'
	JRST	FTST3		;CONTINUE,SET UP LINE BUFFERS ETC
>
;SET STATUS FOR CURRENT DEVICE

SESTA.:HLLZ	0,M		;DEVICE NO.
	TLO	0,NSETST+F	;SET STATUS UUO
	XCT	0
	POPJ	P,

;I-O WAIT FOR CURRENT DEVICE

WAIT.:	HLLZ	0,M		;DEVICE NO.
	IOR	0,[CALLI 10]	;WAIT
	XCT	0
	POPJ	P,


;I/O WAIT FOR MAG TAPES

MTPZ.:	HLLZ	0,M		;CHAN NO
	IOR	0,[MTAPE 0,0]	;MTAPE AC,0 UUO
	XCT	0
	POPJ	P,		;RETURN

;DUMMY LOOKUP FOR CURRENT DEVICE-CLEARS SYSTEM CLOSE BIT

LOOK.:	HLLZ	0,M		;DEVICE NO.
	TLO	0,NLOKUP	;LOOKUP UUO
	XCT	0
	JFCL			;ERROR RETURN
	POPJ	P,
; WE ARE ABOUT TO INIT A MAG TAPE UNIT
; SEE IF MAGDEN HAS BEEN CALLED FOR THIS UNIT, IF SO SET
; THE APPROPRIATE MODE BITS IN THE RIGHT HALF OF THE INIT.

MGINIT:	PUSH	P,G		;SAVE
	PUSH	P,C		;AC'S
	PUSH	P,D		;G,C,D
	SETZM	D		;INIT
	MOVEI	G,TABPT.	;POINTERS
FINDLP:	LDB	C,[POINT 30,(G),29]	;GET A NAME
	LSH	C,6		;LEFT ADJUST IT
	CAMN	C,B		;IS IT THE ONE WE WANT?
	JRST	SETMOD		;YES, GO SET MODE
	JUMPN	C,MGNDTS	;NO, IS IT AN EMPTY SLOT?
	MOVE	D,G		;YES, SAVE POINTER
MGNDTS:	SOS	G		;NO, DECREMENT POINTER AND
	CAIE	G,MBFBG.	;SEE IF DONE WITH TABLE
	JRST	FINDLP		;NOT DONE, GET NEXT NAME
	JUMPE	D,TBLER.	;IF NOT ENTERED & NO ROOM, FAIL!
	JRST	SETRET		;RETURN
SETMOD:	LDB	B,[POINT 6,(G),35]	;GET MODE BITS
	LSH	B,6		;POSITION THEM
	HRRM	B,INT		;PUT THEM IN INT
SETRET:	MOVEI	B,40		;SYNC MODE BIT
	IORM	B,INT		;SET SYNC MODE FOR INIT
	POP	P,D		;RESTORE
	POP	P,C		;AC'S D,C,G
	POP	P,G
	POPJ	P,		;RETURN

;THIS ROUTINE CONVERTS A NEG F4 DEV NUM TO A POS DEV NUM.
;EXPECTS (B)=DEV NUM, RETURNS DEV NUM IN B.


MAKPOS:	CAMGE	B,[-5]		;LEGAL NUM?
	PUSHJ	P,ILRED.	;NO, PROBABLY "REREAD".
	CAMN	B,[-5]		;CDR?
	MOVEI	B,NEG5.		;YES.
	CAMN	B,[-3]	;LPT?
	MOVEI	B,NEG3.		;YES.
	CAMN	B,[-2]		;PTP?
	MOVEI	B,NEG2.		;YES.
	SKIPL	B		;DONE?
	POPJ	P,		;YES,RETURN.
	MOVEI	B,NEG1.		;NO,MUST BE TTY.
	POPJ	P,		;RETURN.



; CALLED BY: PUSHJ P,FNDSLT
; FINDS AN AVAILABLE SLOT IN DYNDV.
; BAD RETURN: TBLER.---DYNDV. IS REALLY FULL.
; GOOD RETURN: (C)=THE NUMBER OF THIS CHANNEL,(D)=PTR TO SLOT IN DYNDV.
;              (DEVNO.)=17

FNDSLT:	MOVEI	D,DYNND.	;PTR TO LAST SLOT
SLLOOP:	LDB	C,[POINT 30,(D),29]	;GET NAME
	JUMPE	C,GOTSLT	;IS SLOT EMPTY?
	SOS	D		;NO, UPDATE PTR.
	CAILE	D,DYNDV.	;DONE?
	JRST	SLLOOP		;NO, LOOP BACK.
	PUSHJ	P,TBLER.	;YES, FAIL!

GOTSLT:	MOVEI	C,17		;HIGHEST
	MOVEM	C,DEVNO.	;CHANNEL NUMBER.
	MOVEI	C,DYNDV.	;SET UP ACTUAL
	SUBM	D,C		;CHANNEL NUMBER
	POPJ	P,		;RETURN
; THE FOLLOWING BLOCK FROM TNAME TO LASTFL GETS CLEARED BY RESET
;A SUBSET OF WHICH GETS CLEARED DURING FIN. UUO (INIFLG-INPDEV)
MLOFF
TNAME:	BLOCK	36		;FILE NAME ENTRIES
TNAM1.=	TNAME-1
TNAM2.=	TNAME-2
DEVNO.:	BLOCK	1		; HIGHEST DEVICE NUMBER
INIFLG:	BLOCK	1		; INITIALIZATION FLAG
HDRADD:	BLOCK	1		; ADDRESS OF REAL HEADER IF LINE
				;BUFFER IN USE...ALSO LINE BUF. FLAG
TEMP.:
TEMP:	BLOCK	4		;DIRECTORY NAME,EXT,PPN BLOCK
EDERR:	BLOCK	1		;++ ENCODE - DECODE ERROR FLAG
VADDR.:	BLOCK	1		;++ENCODE DECODE
ENCDEC:	BLOCK	1		;++ -1 IF ENCODE OR DECODE
RINSET:	BLOCK	1		;-1 IF RANDOM INPUT HEADER HAS BEEN SETUP
ROUSET:	BLOCK	1		;-1 IN RANDOM OUTPUT HEADER HAS BEEN SETUP
CDPCDR:	BLOCK	1		;-1 IF CARD I/O
TTYLPT:	BLOCK	1		;-1 IF TTY OR LPT IN USE
DOLFLG:	BLOCK	1		;-1 IF CR AFTER TEXT
RERDFL:	BLOCK	1		;-1 IF A REREAD
RDWRFL:	BLOCK	1		;FORMAT READ TO WRITE ATTRMPT
INPDEV:	BLOCK	1		;-1 IF AN ASCII INPUT DEVICE
OVFLS.:	BLOCK	1		;LINE OVERFLOW SWITCH
INPDV.:	BLOCK	1		;ASCII INPUT DEVICE USED LAST
ONLY1.:	BLOCK	1		;-1 IF EOF SKIPPED
EOFFL.:	BLOCK	1		;-1 IF EOFTST PROGRAM LOADED
DEVNUM:	BLOCK	1		;FOR "BUFFER"
PAKFL.:	BLOCK	1		;-1 IF PACKED I/O WAS DONE
END.:	BLOCK	1		;FOR END OF FILE ON INPUT
ERR.:	BLOCK	1		;FOR ILLEGAL CHAR ON INPUT
	INTERN ERRW.
ERRW.:	BLOCK 1			;ERROR RECORD FOR INTERESTED USER

	INTERN NCTRLC
NCTRLC:	Z	;FLAG WORD FOR NOT ALLOWING REENTER TO HAPPEN
		;WHILE INSIDE OF FORSE
SXBTNO:	BLOCK	1		;6-BIT F4 DEVICE # FOR INITS
FILNUM:	BLOCK	1		;FOR FILENAME
INCNT:	BLOCK	DYDVL.		;COUNT OF #OF INPUT UUOS DONE ON EACH CHAN
DYNDV.:	BLOCK	DYDVL.		;DYNAMIC DEVICE TABLE
ENCHDR:	BLOCK	3		;++ ENCODE 'BUFFER' HEADER
DECHDR:	BLOCK	3		;++ DECODE 'BUFFER' HEADER
FILES.:	BLOCK	36		;FILE NAMES,EXT,PPN ETC.IN HERE
LASTFL=.-1


FOBPDP:	BLOCK	1		;PUSHDOWN POINTER SAVED
LASTLP:	BLOCK	1		;POINTER TO LAST ( IN FORMAT
FMTEN.:	BLOCK	1		;POINTER TO END OF FORMAT
FMTBG.:	BLOCK	1		;POINTER TO BEG. OF FORMAT
EOL.:	BLOCK	1		;END OF LINE FLAG AND COLUMN COUNT
DADDR.:	BLOCK	1		;ADDRESS OF DATUM BEING CONVERTED
SAVEAC:	BLOCK	20		;USER'S AC'S SAVED
SAVFAC:	BLOCK	20		;OP SYS AC'S SAVED
BUFHD.:	BLOCK	140		;BUFFER HEADERS
DEVIC.:	BLOCK	1		;DEVICE NAME SAVED
DNAME:	BLOCK	1		;DEVICE NAME ADDR
RERDV.:	BLOCK	1		;REREAD DEVICE NAME SAVED
RERDN.:	BLOCK	1		;REREAD DEVICE NUMBER SAVED
DEVNAM:	BLOCK	1		;DEVICE NAME SAVED
TYPE.:	BLOCK	1		;CODE FOR DATA TYPE
TPNTR.:	BLOCK	1		;SAVED POINTER FOR T FORMAT
TCNT1.:	BLOCK	1		;SAVED VALUE OF EOL FOR T FORMAT
TCNT2.:	BLOCK	1		;SAVED ITEM COUNT FOR T FORMAT
RPTR1:	BLOCK	1		;POINTER TO BEG. OF PREV. LINE
RPTR2:	BLOCK	1		;POINTER TO BEG. OF CURRENT LINE
RCNT1:	BLOCK	1		;ITEM COUNT,PREV. LINE
RCNT2:	BLOCK	1		;ITEM COUNT,CURRENT LINE
LINBUF:	BLOCK	LINWDS		;LINE BUFFER
LINHDR:	BLOCK	3		;HEADER FOR LINE BUFFER
SAVSCN:	BLOCK	1		;POINTER TO POSN BEFORE ILDB FOR RESCAN
DIGPTR:	BLOCK	1		;POINTER TO DIGIT IN FORMAT
GRPRPT:	BLOCK	1		;GROUP REPEAT SAVE FOR FORMAT RESCAN

XVAR:	XWD	VAR,VAR		;LENGTH OF PUSHDOWN LIST
ACBLT:	XWD	B,SAVEAC+B	;BLT POINTER FOR AC SAVE
LBPTR:	POINT	7,LINBUF	;POINTER TO LINE BUFFER
PTRU:	POINT	4,A,12		;AC FIELD OF UUO
FORZRO:	OCT	4657622020	;6-BIT FOR00
DYNND.=DYNDV.+DYDVL.		;V.007  PTR TO LAST DYNDV. ENTRY

CODEND:	END