Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

	TITLE  XPLLIB -- THE XPL SYSTEM LIBRARY

	SUBTTL	R.W. HAY - MODIFIED FOR TTY AND BINARY - 22-JUL-74
	EXTERNAL	.JBFF,.JBREL

R0=0;
R1=1;
R2=2;
R3=3;
R4=4;
R5=5;
R6=6;
R7=7;
R8=10;
R9=11;
R10=12;
R11=13;
R12=14;
R13=15;
R14=16;
R15=17;

P=R15		;PUSH-DOWN LIST FOR PACKAGE

;	ASCII CHARACTER CODES

CR==15		;CARRIAGE RETURN
LF==12		;LINE FEED
FF==14		;FORM FEED
HT==11		;HORIZONTAL TAB

;
;	FLAG BIT DEFINITIONS
;
;LEFT HALF
FILOPN=	1		;FILE HAS HAD OPEN DONE ON IT
FILOUT= 2		;FILE IS OUTPUT FILE
FILIN= 4		;FILE IS INPUT FILE
CHNCLS=	10		;SOFTWARE CHANNEL IS NOT OPEN (CLOSED)
CHNCHG=	20		;SOFTWARE CHANNEL MUST BE REOPENED BEFORE NEXT LOOKUP/ENTER
CHNFAL=	40		;LAST OPEN FAILED
FILBIN=	100		;FILE (SOFTWARE CHANNEL) IS INITED FOR BINARY (14)

;ENTRY DECODER
;
; R11=LIBRARY SERVICE
;
;
	LOC	40
UUO:	Z			;UUO STORED HERE.
	JSR	XPLLIB		;UUO ENTRY POINT
	RELOC

	ENTRY	XPLLIB

XPLLIB:	Z
	MOVEM	R15,SAVE+R15	;SAVE AC 15
	MOVEI	R15,SAVE	;MAKE A BLT POINTER WORD
	BLT	R15,SAVE+R14	;SAVE THEM ALL
	MOVE	P,PDL		;INITIALIZE PDL
	MOVE	R14,UUO	
	LDB	R11,[POINT 9,R14,8]	;PUT FUNCTION CODE IN R11
	HRREI	R12,0(R14)		;PUT FILE NUMBER INTO R12
	LDB	R13,[POINT 4,R14,12]	;ARGUMENT REGISTER # TO R13
	MOVE	R13,SAVE(R13)		;LOAD R13 WITH ACTUAL ARG.
	JUMPA	TABLE(R11)	;GO ON FUNCTION CODE IN R11
TABLE:	JRST	RETURN		;0 = IMPOSSIBLE
	JUMPA	INITS		;1 = INITIALIZE
	JUMPA	INPUTS		;2 = SEQUENTIAL INPUT
	JUMPA	PUTOUT		;3 = SEQUENTIAL OUTPUT
	JUMPA	EXITS		;4 = EXIT CALLED
	JRST	FILSET		;5 = SET FILE NAME AND DEVICE
	JRST	BININ		;6 = BINARY SEQUENTIAL FILE INPUT
	JRST	BINOUT		;7 = BINARY SEQUENTIAL FILE OUTPUT
	JRST	FILSET		;8 = DUMMY
	JRST	RETURN		;9 = DUMMY

;
;STANDARD LIBRARY RETURN
;
RETURN:
RET1:	MOVSI	R15,SAVE		;SET UP FOR RETURN
	BLT   R15,R15           ;RESTORE R1 TO R15
	JRST  @XPLLIB              ;RETURN TO CALLER

;
;INITIALIZE XPL SYSTEM
;
;
;RETURNS
;
; R12=FIRST WORD OF STRING SPACE
; R13=LAST WORD OF STRING SPACE
;
INITS:    RESET                   ;RESET CHANNELS
	MOVE	R1,.JBFF	;GET FIRST FREE LOCATION
	LSH	R1,2		;CONVERT TO BYTE ADDRESS
	MOVEM	R1,SAVE+R12
	MOVE	R1,.JBFF	;GET FIRST FREE AGAIN
	ADDI	R1,4*2000	;AT LEAST 4K FOR STRINGS
	CAMLE	R1,.JBREL
	CORE	R1,
	JFCL			;IGNORE ERROR
	MOVE	R1,.JBREL
	SUBI	R1,^D700	;SUBTRACT SPACE FOR PDL
	MOVEM	R1,SAVE+R15	;CONSTRUCT PDL POINTER
	SUBI	R1,^D300	;**TEMP **
	LSH	R1,2		;CONVERT TO BYTE ADDRESS
	MOVEM	R1,SAVE+R13
	MOVNI	R1,^D699	;SIZE OF PDL
	HRLM	R1,SAVE+R15	;FINISH PDL  POINTER
	MOVE	R1,.JBREL	;GET TOP OF CURRENT CORE
	MOVEM	R1,.JBFF	;MAKE SURE MONITOR DOESN'T USE SPACE
	AOS	.JBFF

	SETZM	ZERST		;CLEAR ALL LOCATIONS CHANGED DURING EXECUTION
	MOVE	R1,[XWD ZERST,ZERST+1]
	BLT	R1,ZERSTP

	MOVE	R1,[SIXBIT /SYSIN/]	;LOGICAL DEVICE 0 = SYSIN
	MOVEM	R1,DEVLST
	HRRI	R1,'OUT'	;LOGICAL DEVICE 1 = SYSOUT
	MOVEM	R1,DEVLST+1
	MOVSI	R1,'DSK'	;DEFAULT FOR ALL OTHERS IS DSK
	MOVEM	R1,DEVLST+2
	MOVE	R1,[XWD DEVLST+2,DEVLST+3]
	BLT	R1,DEVLST+^D15

	MOVSI	R1,-^D16	;SET FILNAMES TO 'XPLNN.DAT'
	MOVE	R2,[SIXBIT /XPL00 /]
	MOVSI	R3,'DAT'
	MOVEM	R2,FILNAM(R1)
	MOVEM	R3,FILNAM+1(R1)
	ADDI	R2,100		;INCREMENT FILE NAME
	TRNE	R2,1000		;IS IT 08,09,OR 10?
	TRNN	R2,600		;IS IT 10?
	SKIPA				;NO
	HRRI	R2,'10 '	;YES. MAKE IT LOOK RIGHT
	ADDI	R1,3		;WANT INDEX TO INCREMENT BY 4
	AOBJN	R1,.-8		;LOOP FOR ALL FILES

	MOVSI	R0,CHNCLS	;INITIAL FLAGS: ALL CHANNELS CLOSED
	MOVEM	R0,FLAGS
	MOVE	R1,[XWD FLAGS,FLAGS+1]	;
	BLT	R1,FLAGS+^D15

	JRST	RETURN

;SEQUENTIAL INPUT
;
;INPUT PARAMETERS
;
; R12=UNIT (0)
;     SYSIN
; R13=TSA
;
;RETURNS
;
; R12=XPL STRING DOPE VECTOR
; R13=NEW TSA
;
;REGISTER USAGE
;
; R1=INPUT BUFFER
; R2=OUTPUT STRING POINTER
; R3=INPUT BUFFER LENGTH
; R4=WORK
;
INPUTS:	MOVE	R13,SAVE+R13	;REGISTER 13 SET UP BY XPL PROG
	JUMPL	R12,TTYIN	;DO TTCALL INPUT IF -VE UNIT
	CAIE	R12,1		;1 IS ILLEGAL FOR INPUT
	CAILE	R12,^D15	;MAKE SURE OF LEGAL FILE NUMBER
	JRST	INERR1		;TELL USER AND QUIT
	MOVE	R0,FLAGS(R12)	;LOAD FLAGS FOR THIS FILE.
	TLNN	R0,FILIN	;IS IT SET FOR INPUT?
	JRST	.+3		;NO.
	TLNN	R0,FILBIN	;IS IT ASCII?
	JRST	INPOK		;YES. GO USE IT
	PUSHJ	P,CLOSFL	;NO TO ANY OF ABOVE: CLOSE FILE
	TLNE	R0,CHNCLS	;IS CHANNEL INITED?
	PUSHJ	P,INITAS	;NO. OPEN IN ASCII
	TLNE	R0,FILBIN	;BINARY MODE?
	PUSHJ	P,SETASC	;YES. SET IT TO ASCII
	PUSHJ	P,LOOKFL	;DO LOOKUP, ETC.
	MOVEM	R0,FLAGS(R12)	;SAVE FLAGS
;
INPOK:
	SKIPE	R0,EOFSW(R12)	;TEST FOR EOF
	JUMPA	INPUT2		;GO RETURN NULL STRING
	MOVE	R1,R13		;ADDRESS OF FIRST BYTE 
	SUBI	R1,1		;CORRECT FOR IDPB
	LSHC	R1,-2		;CORE ADDRESS IN R1
	LSH	R2,-42		;BYTE NO. IN R2
	HLL	R1,BYTEPT(R2)	;CONSTRUCT 9-BIT BYTE POINTER
	MOVEI	R2,0		;CLEAR COUNT OF BYTES INPUT
;
GETIN:	SOSLE	@ICNT(R12)	;ANYTHING IN BUFFER?
	JRST	INLD		;YES
	XCT	INLST(R12)	;GET NEXT BUFFER. ANY ERRORS?
	JRST	INLD		;NO
	SETOM	EOFSW(R12)	;YES
	JRST	ENDLIN
;
INLD:	ILDB	R0,@IPTR(R12)	;PICK UP CHAR.
	CAIN	R0,CR		;IGNORE CARRIAGE-RETURN
	JRST	GETIN
	JUMPE	R0,GETIN	;IGNORE NULLS
	CAIE	R0,LF		;LF?
	CAIN	R0,FF		;OR FF?
	JRST	ENDLIN
	IDPB	R0,R1
	AOJA	R2,GETIN
;
ENDLIN:	JUMPE	R2,ONEBLK	;NOTHING. GIVE HIM A SINGLE BLANK
	MOVE	R1,R2
	LSH	R1,33		;PUT COUNT INTO R1
	ADD	R1,R13		;CONSTRUCT NEW DOPE VECTOR
	ADDM	R2,SAVE+R13	;UPDATE TSA FOR RETURN
	JRST	INPTEX		;RETURN
;
ONEBLK:	MOVEI	R0," "		;LOAD A BLANK
	IDPB	R0,R1		;STORE IT AWAY
	AOJA	R2,ENDLIN	;INCREMENT COUNT AND FINISH UP
;
INPUT2:	SETZ	R1,		;FINAL RESULT = 0 (NULL)
INPTEX:	LDB	R12,[POINT 4,R14,12]	;FIND RESULT REGISTER
	MOVEM	R1,SAVE(R12)	;STORE RESULT IN DESIGNATED REG.
	JUMPA	RETURN		;GOTO EXIT

TTYIN:	MOVE	R1,R13		;GET TSA
	SUBI	R1,1		;ADJUST FOR IDPB
	IDIVI	R1,4		;CALCULATE WORD ADDRESS
	HLL	R1,BYTEPT(R2)	;AND MAKE A BYTE POINTER
	MOVEI	R2,0		;CLEAR COUNT OF BYTES INPUT
TTYIN1:	INCHWL	R0		;GET NEXT CHARACTER FROM INPUT
	CAIN	R0,CR		;CARRIAGE RETURN?
	JRST	TTYIN2		;YES.
	IDPB	R0,R1		;NO. PUT AWAY IN NEW STRING
	AOJA	R2,TTYIN1	;LOOP UNTIL CR.

TTYIN2:	INCHWL	R0		;LOOK FOR LINE-FEED
	CAIE	R0,LF
	JRST	TTYIN2		;LOOP UNTIL FOUND
	JRST	ENDLIN		;GO TO COMMON ROUTINE

INERR1:	OUTSTR	[ASCIZ /ILLEGAL FILE NUMBER IN CALL TO INPUT.
/]
	JRST	EXITS

;SEQUENTIAL OUTPUT
;
;INPUT PARAMETERS
;
; R12=UNIT (0,1,2,3) FOR
;     SYSOUT
;     SYSOUT WITH CC
;     SYSUT1
;     SYSUT2
; R13=XPL STRING DOPE VECTOR
;
;REGISTER USAGE
;
; R0=OUTPUT BUFFER LENGTH
; R1=INPUT STRING LENGTH
; R2=INPUT STRING POINTER
; R3=OUTPUT BUFFER POINTER
; R4=WORK
;
PUTOUT:	JUMPL	R12,TTYOUT	;TYPE IF FILE # -VE
	CAILE	R12,^D15	;MAKE SURE FILE NUMBER IS LEGAL
	JRST	OTERR1		;TELL USER AND QUIT
	SETZM	NOCTL		;TESTED LATER
	JUMPG	R12,PUT0	;FILE 0?
	SETOM	NOCTL		;YES. CHANGE TO 1 , BUT REMEMBER
	AOJ	R12,		;INCREMENT R12 TO RIGHT NUMBER
PUT0:	MOVE	R0,FLAGS(R12)	;LOAD FLAGS FOR THIS FILE.
	TLNN	R0,FILOUT	;IS IT SET FOR OUTPUT?
	JRST	.+3		;NO.
	TLNN	R0,FILBIN	;IS IT ASCII?
	JRST	OUTOK		;YES. GO USE IT
	PUSHJ	P,CLOSFL	;NO TO ANY OF ABOVE: CLOSE FILE
	TLNE	R0,CHNCLS	;IS CHANNEL INITED?
	PUSHJ	P,INITAS	;NO. OPEN IN ASCII
	TLNE	R0,FILBIN	;BINARY MODE?
	PUSHJ	P,SETASC	;YES. SET IT TO ASCII
	PUSHJ	P,ENTFIL	;DO ENTER, ETC.
	MOVEM	R0,FLAGS(R12)	;SAVE FLAGS
;
OUTOK:	MOVE  R2,R13            ;COPY DV FOR BURSTING
	MOVEI	R1,0		;CLEAR LENGTH REG
	LSHC  R1,11             ;LENGTH TO R1 (9 BITS)
	MOVE  R0,R1             ;COPY LENGTH IN R0
	LSH   R2,-11            ;BYTE ADDR ONLY
	SUBI  R2,1              ;DECR OPTR FOR ILDP
	LSHC  R2,-2           ;BYTE OFFSET TO R3
	LSH   R3,-42            ;RIGHT JUSTIFY BYTE OFFSET
	HLL   R2,BYTEPT(R3)     ;FORM PDP-10 OPTR
	CAIN	R12,1             ;CC UNIT SPECIFIED?
	SKIPE	NOCTL		;WAS 0. NO CONTROL.
	JUMPA	OUT3		;NO
	SUBI  R1,1              ;DECR INPUT COUNT FOR CC CHAR
	ILDB  R4,R2             ;PICK UP CC BYTE
	CAIE  R4,"0"             ;IS IT 0? (DOUBLE SPACE)
	JUMPA	OUT1		;NO, GO LOOK FOR OTHERS
	PUSHJ	P,LFOUT		;PUT OUT A LINE FEED
	JUMPA	OUT3		;
	;
OUT1:     CAIE  R4,"1"            ;IS IT 1? (EJECT)
	JUMPA	OUT3		;NO, IGNORE IT
	MOVEI	R4,14		;FF
	PUSHJ	P,CHAROT	;PUT IT OUT
OUT3:     JUMPE R1,OUT5          ;GO AROUND IF NULL STRING
OUT4:     ILDB  R4,R2            ;PICK UP ONE BYTE
	PUSHJ	P,CHAROT	;OUTPUT CHARACTER
	SOJG  R1,OUT4          ;LOOP THRU ALL BYTES
OUT5:	PUSHJ	P,CRLF		;ADD CR-LF SEQUENCE AT END OF STRING
	JUMPA	RETURN		;GOTO EXIT

TTYOUT:	MOVE	R1,R13		;GET STRING POINTER
	TLZ	R1,777000	;CLEAR COUNT
	SUBI	R1,1		;ADJUST FOR ILDB
	IDIVI	R1,4		;GET WORD ADDRESS
	HLL	R1,BYTEPT(R2)	;MAKE CORRECT BYTE POINTER
	LDB	R2,[POINT 9,R13,8]	;GET COUNT FROM R13
	JUMPE	R2,TTYODN	;JUST CR,LF IF COUNT = 0
TTYOU1:	ILDB	R0,R1		;GET NEXT BYTE
	TRNE	R0,173		;SKIP IT IF = 004(EOT) OR 000(NUL)
	OUTCHR			;STUFF IT OUT
	SOJG	R2,TTYOU1	;LOOP UNTIL ALL OUT
;
TTYODN:	CAME	R12,[-2]	;NO CR-LF IF FILE # =-2
	OUTSTR	[BYTE	(7)CR,LF,0]	;TYPE CR,LF
	JRST	RETURN		;RETURN TO CALLER

OTERR1:	OUTSTR	[ASCIZ /ILLEGAL FILE NUMBER IN OUTPUT CALL
/]
	JRST	EXITS

CRLF:	MOVEI	R4,CR		;LOAD CR INTO REGISTER
	PUSHJ	P,CHAROT	;PUT IT OUT
LFOUT:	MOVEI	R4,LF		;LOAD A LINE FEED
CHAROT:	SOSG	@OCNT(R12)	;DECREMENT ITEM COUNT
	XCT	OUTLST(R12)	;NO SPACE LEFT. DO OUTPUT
	IDPB	R4,@OPTR(R12)	;PUT BYTE INTO BUFFER
	POPJ	P,		;RETURN

;
;CALL EXIT ROUTINE
;
EXITS:	MOVSI	R2,-^D16	;SET LOOP COUNTER
ELOOP:	MOVE	R0,FLAGS(R2)	;GET FILE FLAGS
	TLNN	R0,FILOPN	;IS FILE OPEN?
	JRST	EXT1		;NO. CHECK NEXT FILE
	TLNE	R0,FILOUT	;YES. IS IT OUTPUT?
	XCT	OUTLST(R2)	;YES. ONE LAST OUTPUT TO CLR BUFFER
	XCT	CLSLST(R2)	;CLOSE FILE
EXT1:	AOBJN	R2,ELOOP	;LOOP FOR ALL FILES
	EXIT

;	SET NEW FILE NAME ROUTINE
;	CALL WITH STRING = DEVICE:FILENAME.EXTENSION
;	IF DEVICE IS OMITTED, DSK ASSUMED
;	IF EXTENSION IS OMITTED, 'DAT' IS ASSUMED.
;;
FILSET:
	JUMPL	R12,SETER1	;ONLY FILE NUMBERS 0-15 LEGAL
	CAILE	R12,^D15
	JRST	SETER1
	MOVE	R0,FLAGS(R12)	;GET FILE'S FLAGS
	PUSHJ	P,CLOSFL	;MAKE SURE FILE IS CLOSED
	LDB	R1,[POINT 9,R13,8]	;GET BYTE COUNT
	MOVE	R2,R13		;GET COPY OF POINTER
	TLZ	R2,777000	;CLEAR LENGTH CODE
	SUBI	R2,1		;ADJUST FOR ILDB
	IDIVI	R2,4		;FIND WORD ADDRESS AND DISPL.
	HLL	R2,BYTEPT(R3)	;MAKE A BYTE POINTER IN R2
	MOVE	R13,R12		;CONSTRUCT INDEX TO FILE TABLE
	IMULI	R13,4
	MOVE	R3,[SIXBIT /XPL00/]	;MAKE DEFAULT FILE NAME
	MOVE	R4,R12		;GET FILE NUMBER
	IDIVI	R4,^D10		;TWO DIGITS
	LSH	R4,^D12		;SHIFT TENS DIGIT
	LSH	R5,^D6		;UNITS DIGIT
	ADD	R3,R4
	ADD	R3,R5		;MAKE FILE NAME RIGHT
	MOVEM	R3,FILNAM(R13)	;MAKE DEFAULT NAME BLOCK
	MOVSI	R3,'DAT'
	MOVEM	R3,FILNAM+1(R13)
	SETZM	FILNAM+2(R13)
	SETZM	FILNAM+3(R13)	;OWN PROJ-PROG NUMBER
	MOVSI	R3,'DSK'	;STANDARD DEVICE NAME
	MOVEM	R3,TEMPDV#	;SAVE FOR LATER REF.
	SETZB	R4,R6		;CLEAR REGS
	MOVE	R5,[POINT 6,R6]	;INIT BYTE POINTER
	JUMPLE	R1,FILDON	;JUST RESET FILE IF GIVEN NULL STRING
;
FILST1:	ILDB	R3,R2		;GET FIRST (NEXT) BYTE
	CAIN	R3,":"		;END OF DEVICE NAME SPEC?
	JRST	FILST2		;YES
	CAIE	R3,"."		;EITHER . OR [ MARK END OF NAME
	CAIN	R3,"["		;OF FILE
	JRST	FILST4
	SUBI	R3,40		;CONVERT TO SIXBIT
	AOJ	R4,		;INCREMENT COUNT OF CHARACTERS
	CAIG	R4,6		;MAXIMUM IS SIX
	IDPB	R3,R5		;STUFF INTO ACC.
	SOJG	R1,FILST1	;LOOP BACK IF MORE THERE
	JRST	FILST4		;NOPE--MUST BE JUST NAME
;
FILST2:	MOVEM	R6,TEMPDV	;SAVE NEW DEVICE NAME
	SETZB	R4,R6		;CLEAR REGS FOR FILE NAME
	MOVE	R5,[POINT 6,R6]	;INITIAL BYTE POINTER
	SOJLE	R1,FILDON	;ALL DONE IF NO MORE CHARS
FILST3:	ILDB	R3,R2		;GET NEXT BYTE
	CAIE	R3,"."		;LEGAL TERMINATORS ARE .
	CAIN	R3,"["		;AND [
	JRST	FILST4		;FOUND ONE. DO NAME STUFF
	SUBI	R3,40		;CONVERT TO SIXBIT
	AOJ	R4,		;INCREMENT COUNT OF CHARS
	CAIG	R4,6		;ONLY SIX ALOWWED
	IDPB	R3,R5		;STUFF INTO ACC.
	SOJG	R1,FILST3	;LOOP BACK IF MORE THERE
;
FILST4:	MOVEM	R6,FILNAM(R13)	;SAVE NEW FILE NAME
	SETZB	R4,R6		;INIT REGS
	MOVE	R5,[POINT 6,R6]	;INIT BYTE POINTER
	SOJLE	R1,FILDON	;ALL DONE IF COUNT EXHAUSTED
	CAIN	R3,"["		;IF STOPPED ON [, THERE IS NO EXT
	JRST	FILST7		;GO LOOK FOR PROJ,PROG
FILST5:	ILDB	R3,R2		;GET NEXT BYTE
	CAIN	R3,"["		;ONLY LEGAL TERMINATOR IS [
	JRST	FILST6		;SAVE NEW EXT
	SUBI	R3,40		;CONVERT TO SIXBIT
	ADDI	R4,1		;INCREMENT CHAR COUNT
	CAIG	R4,3		;ONLY THREE ALLOWED
	IDPB	R3,R5		;STUFF IT IN
	SOJG	R1,FILST5	;LOOP BACK IF THERE IS MORE
;
FILST6:	MOVEM	R6,FILNAM+1(R13)	;STORE NEW EXTENTION
	SOJLE	R1,FILDON	;ALL DONE WHEN COUNT DONE
FILST7:	SETZB	R4,R6		;CLEAR REGS
FILST8:	ILDB	R3,R2		;GET NEXT CHAR
	CAIN	R3,","		;PROJ NUMBER TERMINATED BY ,
	JRST	FILST9		;
	ANDI	R3,7		;KEEP ONLY OCTAL BITS
	ADDI	R4,1		;COUNT NUMBER OF DIGITS
	CAILE	R4,6		;MUST NOT EXCEED 6
	JRST	SETER2
	IMULI	R6,10		;MULITPLY PREV. NO. BY 8
	ADD	R6,R3		;ADD NEW DIGIT
	SOJG	R1,FILST8	;GO BACK FOR NEXT DIGIT
	JRST	SETER2		;ERROR IF EXHAUSTED
;
FILST9:	HRLZ	R5,R6		;PUT PROJ NO. IN LEFT HALF
	SETZB	R4,R6		;CLEAR REGS
	SOJLE	R1,SETER2
FILSTA:	ILDB	R3,R2		;GET NEXT CHAR
	CAIN	R3,"]"		;LEGAL TERMINATOR IS ]
	JRST	FILSTB		;FOUND IT
	ANDI	R3,7		;MAKE INTO OCTAL DIGIT
	ADDI	R4,1		;INCREMENT COUNT
	CAILE	R4,6		;MUST NOT EXCEED 6
	JRST	SETER2		;OR ERROR
	IMULI	R6,10		;MULTIPLY BY 8
	ADD	R6,R3		;ADD NEW DIGIT
	SOJG	R1,FILSTA	;LOOP FOR REST
	JRST	SETER2		;ERROR IF NOT ENOUGH
;
FILSTB:	HRR	R5,R6		;PROG NO TO RIGHT HALF
	MOVEM	R5,FILNAM+3(R13)	;SAVE PROJ,PROG NO.
;
FILDON:	MOVE	R5,TEMPDV	;GET NEW DEVICE NAME
	CAME	R5,DEVLST(R12)	;IS IT SAME AS OLD DEVICE?
	TLO	R0,CHNCLS	;NO. INDICATE INIT IS REQUIRED
	MOVEM	R5,DEVLST(R12)	;STORE NEW DEVICE NAME
	MOVEM	R0,FLAGS(R12)	;SAVE FILE FLAGS
;
	JRST	RET1		;RETURN TO CALLER

SETER1:	OUTSTR	[ASCIZ /INVALID FILE NUMBER TO "FILENAME".
/]
	JRST	EXITS

SETER2:	OUTSTR	[ASCIZ /IMPROPER PROJ,PROG NUMBER TO "FILENAME".
OWN NUMBER USED INSTEAD.
/]
	JRST	FILDON

;	BINARY INPUT (SEQUENTIAL) ROUTINE
;
;
BININ:
	CAILE	R12,1		;FILES 0,1 ARE ASCII ONLY
	CAILE	R12,^D15	;MAX FILE # IS 15
	JRST	INERR1		;TYPE ERROR MESSAGE
	MOVE	R0,FLAGS(R12)	;LOAD FLAGS FOR THIS FILE.
	TLNN	R0,FILIN	;IS IT SET FOR INPUT?
	JRST	.+3		;NO.
	TLNE	R0,FILBIN	;IS IT BINARY?
	JRST	BINOK		;YES. GO USE IT
	PUSHJ	P,CLOSFL	;NO TO ANY OF ABOVE: CLOSE FILE
	TLNE	R0,CHNCLS	;IS CHANNEL INITED?
	PUSHJ	P,INITBI	;NO. OPEN IN BINARY
	TLNN	R0,FILBIN	;BINARY MODE?
	PUSHJ	P,SETBIN	;NO. SET IT TO BINARY
	PUSHJ	P,LOOKFL	;DO LOOKUP, ETC.
	MOVEM	R0,FLAGS(R12)	;SAVE FLAGS
;
BINOK:	SKIPE	EOFSW(R12)	;ANYTHING LEFT?
	JRST	BIN1		;RETURN A ZERO FOR NOW
	SOSLE	@ICNT(R12)	;DECREMENT BYTE COUNTER
	JRST	BINLD		;OK. GO LOAD BYTE
	XCT	INLST(R12)	;DO INPUT FOR NEW BUFFER
	JRST	BINLD		;OK. LOAD BYTE
	SETOM	EOFSW(R12)	;FLAG END OF FILE (MAYBE ERROR)

BIN1:	SETZ	R1,		;RETURN A ZERO
	JRST	BINRET
;
BINLD:	ILDB	R1,@IPTR(R12)	;LOAD NEXT BYTE FROM BUFFER
BINRET:	LDB	R12,[POINT 4,R14,12]	;GET RESULT REGISTER #
	MOVEM	R1,SAVE(R12)	;RETURN IT IN R12
	JRST	RETURN		;RETURN TO CALLER

;	BINARY SEQUENTIAL OUTPUT ROUTINE
;
BINOUT:
	CAILE	R12,1		;FILES 0, 1 ARE ASCII ONLY
	CAILE	R12,^D15	;FILE NUMBER 15 OR LESS
	JRST	OTERR1		;WRONG: TYPE ERROR MESSAGE
	MOVE	R0,FLAGS(R12)	;LOAD FLAGS FOR THIS FILE.
	TLNN	R0,FILOUT	;IS IT SET FOR OUTPUT?
	JRST	.+3		;NO.
	TLNE	R0,FILBIN	;IS IT BINARY?
	JRST	BOUTOK		;YES. GO USE IT
	PUSHJ	P,CLOSFL	;NO TO ANY OF ABOVE: CLOSE FILE
	TLNE	R0,CHNCLS	;IS CHANNEL INITED?
	PUSHJ	P,INITBI	;NO. OPEN IN BINARY
	TLNN	R0,FILBIN	;BINARY MODE?
	PUSHJ	P,SETBIN	;NO. SET IT TO BINARY
	PUSHJ	P,ENTFIL	;DO ENTER, ETC.
	MOVEM	R0,FLAGS(R12)	;SAVE FLAGS
;
BOUTOK:	SOSG	@OCNT(R12)	;SPACE LEFT IN BUFFER?
	XCT	OUTLST(R12)	;NO. DO OUTPUT
	IDPB	R13,@OPTR(R12)	;PUT WORD INTO BUFFER
	JRST	RETURN		;RETURN TO CALLER

;		COMMON SUBROUTINES

;	OPEN (INIT) A LOGICAL CHANNEL

INITAS:	MOVEI	R1,0		;SET MODE BITS = ASCII
	JRST	INITFL		;INIT THE FILE

INITBI:	MOVEI	R1,14		;SET MODE BITS TO BUFFERED BINARY
				;FALL INTO INIT ROUTINE

;	ENTER WITH MODE BITS IN AC R1
INITFL:	MOVE	R2,DEVLST(R12)	;GET SPECIFIED DEVICE 
	MOVE	R3,[XWD 3,3]	;SET UP BUFFER HEADER POINTERS
	IMUL	R3,R12		;DISPLACEMENTS INTO IBUFS AND OBUFS
	ADD	R3,[XWD OBUFS,IBUFS]
INITF1:	XCT	OPNLST(R12)	;TRY OPEN
	JRST	INITF2		;FAILED
	TLZ	R0,CHNCLS!CHNCHG	;CLEAR CHANNEL CLOSED AND CHANNEL CHANGE BITE
	CAIN	R1,0		;WAS THIS ASCII?
	TLZA	R0,FILBIN	;YES
	TLO	R0,FILBIN	;NO. ASSUME BINARY
	TLZ	R0,FILOPN!FILIN!FILOUT	;CLEAR FLAG BITS
	SETZM	EOFSW(R12)	;CLEAR END-OF-FILE FLAG
	POPJ	P,		;RETURN

INITF2:	CAMN	R2,[SIXBIT /DSK/]	;FIALURE ON DEVICE DSK?
	JRST	INITFE		;YES
	MOVSI	R2,'DSK'	;NO. CHANGE TO DSK LEAVE DEVLST ENTRY ALONE
	JRST	INITF1		;TRY AGAIN

INITFE:	OUTSTR	[ASCIZ /CAN'T INIT LOGICAL DEVICE.
/]
	JRST	EXITS

;	SET LOGICAL CHANNEL TO BINARY (14) MODE

SETBIN:	TLO	R0,FILBIN	;SET BIT
	XCT	GSTLST(R12)	;GET FILE STATUS BITS
	TRNE	R1,10		;BINARY MODE?
	POPJ	P,		;YES
	TRZE	R1,17		;NO CLEAR ALL BITS
	TRO	R1,14		;SET MODE 14
	XCT	SSTLST(R12)	;SET FILE STATUS
	POPJ	P,		;RETURN

;	ROUTINE TO SET ASCII MODE ON LOGICAL CHANNEL

SETASC:	TLZ	R0,FILBIN	;CLEAR BINARY BIT
	XCT	GSTLST(R12)	;GET FILE STATUS BITS
	TRZN	R1,17		;ANY MODE BITS ON?
	POPJ	P,		;NO. MUST BE ASCII
	XCT	SSTLST(R12)	;YES. SET NEW FILE STATUS
	POPJ	P,		;RETURN

;ROUTINE TO CLOSE A FILE IF IT IS OPEN.

CLOSFL:	TLNN	R0,FILOPN	;IS FILE OPEN?
	JRST	CLOS1		;NO
	TLNE	R0,FILOUT	;YES. IS IT OUTPUT FILE?
	XCT	OUTLST(R12)	;YES. DO OUTPUT TO FLUSH BUFFER
	XCT	CLSLST(R12)	;CLOSE THE FILE
CLOS1:	TLZ	R0,FILOPN!FILIN!FILOUT	;CLEAR THE RELEVANT BITS
	TLNN	R0,CHNCLS	;UNLESS CHANNEL NOT INITED,
	XCT	REWLST(R12)	;REWIND THE FILE.
	POPJ	P,		;RETURN


;	OPEN FILE ON LOGICAL CHANNEL FOR INPUT

LOOKFL:	MOVS	R4,R12		;FILE NUMBER TO R4 LH
	LSH	R4,2		;TIMES 4 TO ADDRESS RIGHT NAME BLOCK
	ADD	R4,[XWD FILNAM,R1]	;MAKE A BLT WORD
	BLT	R4,R4		;LOOKUP BLOCK IN R1-R4
	XCT	LUKLST(R12)	;DO LOOKUP
	JRST	LUKER1		;NOT THERE
	TLO	R0,FILOPN!FILIN	;SET CHANNEL STATUS BITS
	SETZM	EOFSW(R12)	;CLEAR END-OF-FILE SWITCH
	POPJ	P,		;RETURN


;	OPEN FILE ON LOGICAL CHANNEL FOR OUTPUT

ENTFIL:	MOVS	R4,R12		;FILE NUMBER TO LH R4
	LSH	R4,2		;TIMES 4 TO ADDRESS RIGHT FILE NAME BLOCK
	ADD	R4,[XWD FILNAM,R1]	;MAKE A BLT WORD
	BLT	R4,R4		;ENTER BLOCK IN R1-R4
	XCT	ENTLST(R12)	;DO ENTER
	JRST	ENTER1		;FAILED
	TLO	R0,FILOPN!FILOUT	;SET MODE BITS FOR CHANNEL
	POPJ	P,		;RETURN

LUKER1:	OUTSTR	[ASCIZ /LOOKUP FAILURE.
/]
	JRST	EXITS

ENTER1:	OUTSTR	[ASCIZ /ENTER FAILURE.
/]
	JRST	EXITS

	;
	;DATA AREA
	;

	DEFINE	OPBLK	(OPN,ADR)	;GENERATES BLOCK OF OPS FOR EACH CHN
<	CHN=0
	REPEAT	^D16,<	OPN	CHN,ADR
	CHN=CHN+1>
>
	DEFINE	INDIR	(LOC)
<	CHN=0
	REPEAT	^D16,<	EXP	LOC'CHN
	CHN=CHN+1>
>
SAVE:    BLOCK ^D16                ;REGISTER SAVE AREA
;

IPTR:	INDIR	<IBUFS+1+3*>	;INPUT BYTE POINTERS
ICNT:	INDIR	<IBUFS+2+3*>	;INPUT ITEM COUNTS
OPTR:	INDIR	<OBUFS+1+3*>	;OUTPUT BYTE POINTERS
OCNT:	INDIR	<OBUFS+2+3*>	;OUTPUT ITEM COUNTS


OUTLST:	OPBLK	OUTPUT


INLST:	OPBLK	IN		;IN UUOS FOR INPUT ROUTINES.

CLSLST:	OPBLK	CLOSE

OPNLST:	OPBLK	OPEN,R1

LUKLST:	OPBLK	LOOKUP,R1	;LOOKUP INSTR

ENTLST:	OPBLK	ENTER,R1	;ENTER INSTR
GSTLST:	OPBLK	GETSTS,R1
SSTLST:	OPBLK	SETSTS,R1
REWLST:	OPBLK	MTAPE,1	;REWIND OPERATION

ZERST:
IBUFS:	BLOCK	3*^D16		;INPUT BUFFER POOL BLOCKS
OBUFS:	BLOCK	3*^D16		;OUTPUT BUFFER POOL BLOCKS
EOFSW:	BLOCK	^D16		;END-OF-FILE INDICATORS

FILNAM:
	BLOCK	4*20		;SPACE FOR 16 FILE NAME BLOCKS
FLAGS:	BLOCK	^D16		;FLAG CELLS

DEVLST:	BLOCK	^D16		;DEVICE NAMES FOR THE FILES
ZERSTP=.-1			;STOP ADDRESS FOR INITIAL CLEAR

BYTEPT:  POINT 9,0,8             ;XPL BYTE POINTERS
	POINT	9,0,17
	POINT	9,0,26
	POINT	9,0,35

NOCTL:	BLOCK	1		;FLAG FOR ASCII OUTPUT ON FILE 0/1

PDLSIZ=20
PDL:	IOWD	PDLSIZ,.+1	;INITIAL PDL POINTER WORD
	BLOCK	PDLSIZ		;PUSH-DOWN LIST

	VAR
	LIT
	END                     ;