Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-02 - 43,50263/sddior.mac
There are 2 other files named sddior.mac in the archive. Click here to see a list.
	TITLE	S$$IOR INPUT/OUTPUT ROUTINES
	SUBTTL	P$$DTC DETACH(VARNAME) PRIMITIVE FUNCTION

	ENTRY	P$$DTC
	EXTERN	S$$ASB,S$$LKV
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 1.
	DETACH(VARNAME) DETACHES ANY INPUT AND(OR) OUTPUT ASSOCIATIONS
THE VARIABLE MAY HAVE, CLEARS THE ASSOCIATION TABLE ENTRY FOR THAT
VARIABLE, AND RETURNS NULL/

P$$DTC:	POP	ES,R1	; GET VARIABLE NAME (STRING)
	JSP	R10,S$$LKV	; LOOKUP VARIABLE
	HRRZ	R1,(R2)	; GET VARIABLE LOC POINTER
	CAIGE	R1,^O776000	; IS IT A TRAP ADDR?
	JRST	NULRET	; NO, NO ASSOCIATION, RETURN
	ASH	R1,2	; COMPUTE ASSOCIATION TABLE ENTRY
	ADD	R1,S$$ASB
	HRRZ	R3,(R1)	; GET ACTUAL VARIABLE LOC POINTER
	HRRM	R3,(R2)	; STORE IN NAME LOC
	SETZM	(R1)	; CLEAR ENTRY
	SETZM	1(R1)
	SETZM	2(R1)
	SETZM	3(R1)
NULRET:	SETZ	R1,	; RETURN NULL
	JRST	(R12)
	PRGEND
	SUBTTL	P$$RLS RELEASE(CHAN) PRIMITIVE FUNCTION

	ENTRY	P$$RLS
	EXTERN	S$$MKI,S$$PGL,S$$CHT,S$$MRS,S$$AST,S$$ASB
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 1.
	RELEASE(CHAN) RELEASES THE SOFTWARE CHANNEL AND ALL ASSOCIAYIONS
TO IT, RETURNS THE BUFFERS TO FREE STORAGE, AND RETURNS NULL. IF CHAN=0,
ALL CHANNELS ARE RELEASED/

P$$RLS:	POP	ES,R1	; GET CHANNEL NUMBER
	JSP	R7,S$$MKI	; MUST BE INTEGER
	CFERR	10,S$$PGL	; BAD ARG IF NOT
	JUMPL	R1,.+2	; IF <0
	CAILE	R1,15	; OR >15
	CFERR	12,S$$PGL	; IT IS AN ILLEGAL UNIT
	JUMPE	R1,MULRLS	; RELEASE ALL CHANNELS IF =0
	JSP	R11,CHNRLS	; OR RELEASE JUST ONE
NULRET:	SETZ	R1,	; RETURN NULL
	JRST	(R12)
MULRLS:	MOVEI	R1,15	; START WITH CHANNEL 15
	MOVEM	R1,MULCHN	; AND SAVE CHANNEL #
	JSP	R11,.+2	; ESTABLISH LOOP ADDR
	SOSLE	R1,MULCHN	; LOOP UNTIL CHANNEL=0
	JRST	CHNRLS	; RELEASE CHANNEL
	JRST	NULRET	; OR FINISH
CHNRLS:	SKIPN	R10,S$$CHT(R1)	; SKIP IF CHANNEL IN USE
	JRST	(R11)	; OTHERWISE RETURN
	SETZM	S$$CHT(R1)	; ZERO CHANNEL TABLE ENTRY
	MOVE	R9,R1	; SAVE CHANNEL NUMBER
	HRLZI	R1,(R1)	; FORM RELEAS CHAN, COMMAND
	LSH	R1,5
	ADD	R1,[RELEAS]
	XCT	R1	; AND EXECUTE
	SETZB	R7,R8	; INITIALIZE I/O CHANNEL FLAGS
	TRNN	R10,-1	; INPUT SIDE OPEN?
	JRST	RLSOUT	; NO, GO CHECK OUTPUT SIDE
	MOVEI	R1,-1(R10)	; POINTER TO BUFFER HEADER TABLE
	JSP	R6,S$$MRS	; RETURN BLOCK TO FREE STORAGE
	HRRZ	R1,(R1)	; POINTER TO BUFFERS
	JSP	R6,S$$MRS	; RETURN BLOCK
	MOVEI	R8,(R9)	; SET INPUT FLAG (CHAN #)
RLSOUT:	HLRZ	R1,R10	; GET OUTPUT SIDE
	JUMPE	R1,RLSASC	; SKIP IF OUTPUT SIDE IS NOT OPEN
	MOVEI	R1,-1(R1)	; POINTER TO BUFFER HEADER TABLE
	JSP	R6,S$$MRS	; RETURN BLOCK
	HRRZ	R1,(R1)	; POINTER TO BUFFERS
	JSP	R6,S$$MRS	; RETURN BLOCK
	MOVEI	R7,(R9)	; SET OUTPUT FLAG (CHAN # LSH 4)
	LSH	R7,4
RLSASC:	MOVE	R10,S$$AST	; GET ASSOC TABLE TOP POINTER
	ADDI	R10,1	; POINTER TO LAST ASSOCIATION ENTRY
	MOVE	R9,S$$ASB	; GET ASSOC. TABLE BOTTOM POINTER
	SUBI	R9,(R10)	; ASSOC. TABLE LENGTH
	LSH	R9,-2	; /4 = # OF ASSOCIATIONS
	JRST	.+2	; SKIP INTO LOOP
ASCLOP:	ADDI	R10,4	; POINTER TO NEXT ASSOCIATION ENTRY
	SKIPN	R6,(R10)	; IS IT ACTIVE?
	JRST	ASCEND	; NO, SKIP AND LOOP
	SKIPE	R5,1(R10)	; IS THERE NO OUTPUT ASSOCIATION?
	JUMPN	R7,.+2	; OR IS OUTPUT FLAG NOT SET?
	JRST	ASCINP	; YES, SKIP OVER
	MOVEI	R1,^O360	; EXTRACT OUTPUT CHANNEL #
	AND	R1,3(R10)
	CAIE	R1,(R7)	; IS IT SAME CHANNEL?
	JRST	ASCINP	; NO
	SETZB	R5,1(R10)	; YES, ERASE OUTPUT ASSOCIATION
	XORM	R1,3(R10)
ASCINP:	SKIPE	R4,2(R10)	; IS THERE NO INPUT ASSOCIATION?
	JUMPN	R8,.+2	; OR IS INPUT FLAG NOT SET?
	JRST	ASCDSC	; YES, SKIP OVER
	MOVEI	R1,^O17	; EXTRACT INPUT CHANNEL #
	AND	R1,3(R10)
	CAIE	R1,(R8)	; IS IT SAME CHANNEL?
	JRST	ASCDSC	; NO
	SETZB	R4,2(R10)	; YES, ERASE INPUT ASSOCIATION
	XORM	R1,3(R10)
ASCDSC:	JUMPN	R5,ASCEND	; LOOP IF OUTPUT ASSOC IS NOT 0
	JUMPN	R4,ASCEND	; LOOP IF INPUT ASSOC IS NOT 0
	SETZM	(R10)	; BOTH ZERO, RELEASE VARIABLE
	MOVS	R6,R6	; ASSOCIATION BY CHANGING NAME
	HLRM	R6,(R6)	; TO POINT TO LOCATION
ASCEND:	SOJG	R9,ASCLOP	; LOOP FOR EACH ENTRY
	JRST	(R11)	; RETURN
; STORAGE
MULCHN:	BLOCK	1
	PRGEND
	SUBTTL	P$$CLS	CLOSE(CHAN,INHIB,OUTHIB) PRIMITIVE FUNCTION

	ENTRY	P$$CLS
	EXTERN	S$$MKI,S$$PGL,S$$CHT
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 3.
	CLOSE(CHAN,INHIB,OUTHIB) CLOSES THE INPUT AND(OR) OUTPUT SIDE
OF THE SOFTWARE CHANNEL, AND RETURNS NULL. IF OUTHIB IS NON-NULL, THE
OUTPUT SIDE IS NOT CLOSED; IF INHIB IS NON-NULL, THE INPUT SIDE IS NOT
CLOSED/

P$$CLS:	MOVE	R8,[CLOSE]	; BARE CLOSE COMMAND
	POP	ES,R1	; GET OUTHIB
	SKIPE	R1	; IS IT NON-NULL?
	ADDI	R8,1	; YES, INHIBIT OUTPUT CLOSING
	POP	ES,R1	; GET INHIB
	SKIPE	R1	; IS IT NON-NULL?
	ADDI	R8,2	; YES, INHIBIT INPUT CLOSING
	POP	ES,R1	; GET CHANNEL #
	JSP	R7,S$$MKI	; MUST BE INTEGER
	CFERR	10,S$$PGL	; OR BAD ARG
	JUMPLE	R1,.+2	; IF NOT >0
	CAILE	R1,15	; OR IF >15
	CFERR	12,S$$PGL	; ILLEGAL UNIT
	SKIPN	S$$CHT(R1)	; HAS CHANNEL BEEN OPENED?
	JRST	NULRET	; NO, NO SENSE CLOSING
	ROT	R1,-13	; GET CHANNEL # INTO AC FIELD
	ADD	R8,R1
	XCT	R8	; EXECUTE CLOSE COMMMAND
NULRET:	SETZ	R1,	; RETURN NULL
	JRST	(R12)
	PRGEND
	SUBTTL	P$$LKF,P$$NTF LOOKUP(FILE,CHAN) AND ENTER(FILE,CHAN) PRIMITIVE FUNCTIONS

	ENTRY	P$$LKF,P$$NTF
	EXTERN	S$$MKI,S$$PGL,S$$CHT,S$$MKS,P$$OPN,S$$FLR
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 2.
	LOOKUP(FILE,CHAN) OPENS FILE FOR INPUT (READING) ON SOFTWARE CHANNEL, RETURNS CHANNEL, FAILS IF FILE NOT FOUND
	ENTER(FILE,CHAN) OPENS FILE FOR OUTPUT (WRITING) ON SOFTWARE CHANNEL, RETURNS CHANNEL
	IF CHANNEL IS 0, A PRELIMINARY OPEN('DSK') IS PERFORMED. IF INPUT
OR OUTPUT SIDE OF CHANNEL ALREADY SELECTS A FILE, THE OLD FILE IS CLOSED/

P$$LKF:	JSP	R11,P$$NTF+1	; LOOKUP, INDEX=0
P$$NTF:	JSP	R11,P$$NTF+1	; ENTER, INDEX=1
	SUBI	R11,P$$NTF
	POP	ES,R1	; GET CHAN #
	JSP	R7,S$$MKI	; MUST BE INTEGER
	CFERR	10,S$$PGL	; OR BAD ARG
	JUMPN	R1,CHKCHN	; SKIP OVER IF NONZERO
	PUSH	ES,DSKSTR	; OTHERWISE DO OPEN('DSK')
	PUSH	ES,R1
	HRL	R11,R12	; SAVE R11 AND R12
	MOVEM	R11,DSKSAV
	JSP	R12,P$$OPN
	MOVE	R11,DSKSAV	; RESTORE R11 AND R12
	HLRZ	R12,R11
	MOVEI	R1,(R1)	; GET CHANNEL #
CHKCHN:	JUMPL	R1,.+2	; IF <0
	CAILE	R1,15	; OR >15
	CFERR	12,S$$PGL	; BAD UNIT
	MOVE	R2,S$$CHT(R1)	; GET CHANNEL TABLE ENTRY
	XCT	[TRNN	R2,-1
		 TLNN	R2,-1](R11)	; TEST APPROPRIATE SIDE
	CFERR	12,S$$PGL	; APPROPRIATE SIDE NOT OPEN
	MOVEI	R10,(R1)	; SAVE CHANNEL#
	POP	ES,R1	; GET FILE NAME
	SETO	R0,	; CREATE STRING IF NECESSARY
	JSP	R7,S$$MKS
	CFERR	10,S$$PGL	; CANNOT DO
	JUMPE	R1,BADPRO	; BAD IF NULL
	HRRZ	R4,(R1)	; GET TOT CHARS IN STRING
	JUMPE	R4,BADPRO	; BAD IF ZERO
	SETZM	FILTBL	; INITIALIZE FILE TABLE
	SETZM	FILTBL+1
	SETZM	FILTBL+2
	SETZM	FILTBL+3
	MOVE	R2,[POINT 6,FILTBL]	; BYTE POINTER FOR FILE NAME
	MOVEI	R3,6	; MAX CHARS ALLOWED FOR FILE NAME
FILOOP:	ILDB	R0,R1	; GET CHAR
	SUBI	R0,^O40	; CONVERT TO SIXBIT
	JUMPL	R0,BADPRO
	CAILE	R0,^O77
	SUBI	R0,^O40
	CAIN	R0,'.'	; IS IT '.'?
	JRST	TRYEXT	; YES, GO LOOK FOR EXT
	CAIN	R0,'['	; NO, IS IT '['
	JRST	TRYPRJ	; YES,GO LOOK FOR PROJ,PROG #
	IDPB	R0,R2	; NO, PUT CHAR IN FILE NAME
	SOJLE	R4,FILFIN	; SKIP OUT IF NO MORE CHARS
	SOJG	R3,FILOOP	; KEEP LOOPING FOR SIX CHARS MAX
	ILDB	R0,R1	; GET NEXT CHAR
	CAIN	R0,"["	; IS IT "[" ?
	JRST	TRYPRJ	; YES, GO LOOK FOR PROJ,PROG #
	CAIE	R0,"."	; IS IT "."?
BADPRO:	CFERR	6,S$$PGL	; NO, BAD PROTOTYPE
TRYEXT:	SOJLE	R4,BADPRO	; ALSO BAD IF NO MORE CHARS AFTER "."
	MOVEI	R3,3	; MAX CHARS ALLOWED FOR EXT NAME
	MOVE	R2,[POINT 6,FILTBL+1]	; BYTE POINTER FOR FILE EXT
EXTLOP:	ILDB	R0,R1	; GET CHAR
	SUBI	R0,^O40	; CONVERT TO SIXBIT
	JUMPL	R0,BADPRO
	CAILE	R0,^O77
	SUBI	R0,^O40
	CAIN	R0,'['	; IS IT '[' ?
	JRST	TRYPRJ	; YES, GO LOOK FOR PROJ,PROG #
	CAIN	R0,'<'	; IS IT '<' ?
	JRST	TRYPRO	; YES, GO LOOK FOR PROTECTION
	IDPB	R0,R2	; PUT CHAR IN EXT
	SOJLE	R4,FILFIN	; SKIP OUT IF NO MORE CHARS
	SOJG	R3,EXTLOP	; LOOP FOR THREE CHARS MAX
	ILDB	R0,R1	; GET NEXT CHAR
	CAIE	R0,"["	; IS IT "["?
	JRST	BADPRO	; NO, BAD PROTOTYPE
TRYPRJ:	SOJLE	R4,BADPRO	; ALSO BAD IF NO MORE CHARS AFTER "["
	MOVEI	R3,6	; 6 CHASS MAX FOR PROJ #
	SETZ	R2,	; INITIAL VALUE FOR PROJ #
PRJLOP:	ILDB	R0,R1	; GET CHAR
	CAIN	R0,","	; IS IT ","?
	JRST	TRYPRG	; YES, GO LOOK FOR PROG #
	CAIL	R0,"0"	; NO, IS IT A DIGIT?
	CAILE	R0,"9"
	JRST	BADPRO	; NO, BAD PROTOTYPE
	SUBI	R0,"0"	; YES, CONVERT TO INTEGER
	IMULI	R2,10	; TOT=TOT*10+INT
	ADD	R2,R0
	SOJLE	R4,BADPRO	; BAD IF NO MORE CHARS
	SOJG	R3,PRJLOP	; LOOP FOR SIX CHARS MAX
	ILDB	R0,R1	; GET NEXT CHAR
	CAIE	R0,","	; IS IT ","?
	JRST	BADPRO	; NO, BAD PROTOTYPE
TRYPRG:	SOJLE	R4,BADPRO	; ALSO BAD IF NO MORE CHARS
	HRLZM	R2,FILTBL+3	; SAVE PROJ # IN LH OF FILE TABLE WORD
	MOVEI	R3,6	; 6 CHARS MAX FOR PROG #
	SETZ	R2,	; INITIAL VALUE FOR PROG #
PRGLOP:	ILDB	R0,R1	; GET CHAR
	CAIN	R0,"]"	; IS IT "]"?
	JRST	PRGFIN	; YES, END UP
	CAIL	R0,"0"	; IS IT A DIGIT
	CAILE	R0,"9"
	JRST	BADPRO	; NO
	SUBI	R0,"0"	; YES, CONVERT
	IMULI	R2,10	; TOTAL
	ADD	R2,R0
	SOJLE	R4,BADPRO	; BAD IF NO MORE CHARS
	SOJG	R3,PRGLOP	; LOOP FOR SIX CHARS MAX
	ILDB	R0,R1	; GET NEXT CHAR
	CAIE	R0,"]"	; IS IT "]"?
	JRST	BADPRO	; NO, BAD PROTOTYPE
PRGFIN:	HRRM	R2,FILTBL+3	; SAVE PROG # IN RH OF FILE TABLE WORD
	SOJLE	R4,FILFIN		;IF MORE, THEN MUST BE PROTECTION
	ILDB	R0,R1		;GET CHAR
	CAIE	R0,"<"		;PROT ?
	JRST	BADPRO		;LOSE
TRYPRO:	SOJLE	R4,BADPRO	;BAD IF NOT LAST CHAR
	SETZ	R2,		;PROTECTION REGISTER
	MOVEI	R3,4		;4 CHAR MAX
PROLOP:	ILDB	R0,R1		;GET A CHAR
	CAIL	R0,"0"		;DIGIT CHECK
	CAILE	R0,"7"
	JRST	PROFIN		;DONE
	SUBI	R0,"0"		;CONVERT TO BINARY
	IMULI	R2,8		;SHIFT
	ADD	R2,R0		;ADD
	SOJL	R4,BADPRO
	SOJG	R3,PROLOP
	ILDB	R0,R1
PROFIN:	CAIE	R0,">"	;END OF PROTECTION SPEC
	JRST	BADPRO		;NO - LOSE
	DPB	R2,[POINT 9,FILTBL+2,8]	;SET PROTECTION
	SOJG	R4,BADPRO	;> IS THE LAST CHAR OR ELSE
FILFIN:	HRRM	R10,RESULT	; SAVE CHANNEL # AS RESULT
	ROT	R10,-13	; FORM AC FIELD WITH CHANNEL #
	ADD	R10,[LOOKUP FILTBL
		     ENTER FILTBL](R11)	; FORM APPROPRIATE UUO
	XCT	R10	; EXECUTE LOOKUP OR ENTER COMMAND
	XCT	ERRRTN(R11)	; ERROR RETURN
	MOVE	R1,RESULT	; OK, RETURN CHANNEL #
	JRST	(R12)
ERRRTN:	JRST	S$$FLR	; FAIL IF LOOKUP
	CFERR	12,S$$PGL	; ILLEGAL I/O IF ENTER
; STORAGE
DSKSTR:	POINT	7,.+1,35
	BYTE	(2)2(16)2(18)3
	ASCII/DSK/
RESULT:	1B0
FILTBL:	REPEAT	4,<0>
	DSKSAV=FILTBL
	PRGEND
	SUBTTL	P$$OPN OPEN(DEV,CHAN) PRIMITIVE FUNCTION

	ENTRY	P$$OPN
	EXTERN	S$$MKI,S$$PGL,S$$CHT,S$$GNS,S$$GNP,.JBFF
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 2.
	OPEN(DEV,CHAN) OPENS A DEVICE FOR INPUT AND(OR) OUTPUT ON A
SOFTWARE CHANNEL AND ASSIGNS BUFFERS, AND RETURNS THE CHANNEL #/

P$$OPN:	POP	ES,R1	; GET CHANNEL
	JSP	R7,S$$MKI	; MUST BE INTEGER
	CFERR	10,S$$PGL	; OR IS BAD ARG
	JUMPL	R1,.+2	; IF <0
	CAILE	R1,15	; OR >15
	CFERR	12,S$$PGL	; ILLEGAL UNIT
	MOVEI	R11,S$$CHT(R1)	; GET POINTER TO ENTRY IN CHAN TABLE
	SKIPE	(R11)	; MUST BE UNUSED
BADUNT:	CFERR	12,S$$PGL	; OR IS A BAD UNIT
	JUMPN	R1,OPNCHN	; JUMP IF CHAN NOT =0
	HRLI	R11,-16	; OTHERWISE LOOK FOR AVAILABLE ONE
OPNCLP:	AOBJN	R11,.+2	; TRY ALL 15 CHANNELS
	UFERR	1,S$$PGL	; FATAL ERROR IF ALL CHANNELS ARE IN USE
	SKIPE	(R11)	; IS CHANNEL AVAILABLE?
	JRST	OPNCLP	; NO, LOOP
	MOVEI	R1,(R11)	; YES, GET CHANNEL #
	SUBI	R1,S$$CHT
OPNCHN:	HRRM	R1,OPNANS	; SAVE CHANNEL # AS RESULT
	ROT	R1,-13	; FORM AC FIELD FOR UUOS
	MOVEM	R1,OPNDCH	; AND SAVE
	POP	ES,R1	; GET DEVICE PROTOTYPE STRING
	TLNE	R1,^O770000	; IS IT A STRING?
	CFERR	10,S$$PGL	; NO
	JUMPE	R1,BADPRO	; SKIP OUT IF NULL
	SETZM	DEVNAM	; CLEAR DEVICE NAME
	MOVE	R2,[POINT 6,DEVNAM]	; SET UP SIXBIT POINTER
	HRRZ	R3,(R1)	; GET CHAR COUNT
	MOVEI	R4,6	; MAX CHARS FOR DEVICE NAME
	SOJL	R3,BADPRO	; SKIP OUT IF 0 CHARS
DEVLOP:	ILDB	R0,R1	; GET NEXT CHAR
	SUBI	R0,^O40	; CONVERT TO SIXBIT
	JUMPL	R0,BADPRO
	CAILE	R0,^O77
	SUBI	R0,^O40
	CAIN	R0,'('	; IS IT LEFT PAREN?
	JRST	BUFSPC	; YES, DECODE BUFFER SPECIFICATION
	SOJL	R4,BADPRO	; NO, ERROR IF >6 CHARS
	IDPB	R0,R2	; FORM DEVICE NAME
	SOJGE	R3,DEVLOP	; LOOP FOR EACH CHAR
	MOVE	R10,[XWD 2,2]	; DEFAULT BUFFER SPECIFICATION
DEVCHK:	MOVE	R0,DEVNAM	; GET DEVICE NAME
	DEVCHR	R0,	; GET CHARACTERISTICS
	JUMPE	R0,BADUNT	; DEVICE NOT FOUND
	TRNE	R0,1B19	; HAS DEVICE BEEN INIT'ED?
	TLNE	R0,1B19	; YES, IS IT A FILE STRUCTURE?
	JRST	.+2	; NOT INIT'ED OR IS FILE STRUCTURE
	CFERR	12,S$$PGL	; NOT FILE STRUCTURE, CAN'T OPEN TWICE
	TLNN	R0,1B34	; DOES DEVICE ALLOW INPUT?
	HLRI	R10,	; NO, NO INPUT BUFFERS
	TLNN	R0,1B35	; DOES DEVICE ALLOW OUTPUT?
	HLLI	R10,	; NO, NO OUTPUT BUFFERS
	SETZ	R9,	; INITIALIZE OBUF,IBUF
	TLNN	R10,-1	; ANY OUTPUT BUFFERS?
	JRST	INPHDR	; NO
	MOVEI	R0,4	; GET BLOCK FOR OUTPUT BUFFER HEADER TABLE
	JSP	R6,S$$GNS
	HRLZI	R9,1(R1)	; POINTER TO FIRST WORD OF HEADER
INPHDR:	TRNN	R10,-1	; ANY INPUT BUFFERS?
	JRST	OPNOPN	; NO
	MOVEI	R0,4	; GET BLOCK FOR INPUT BUFFER HEADER TABLE
	JSP	R6,S$$GNS
	HRRI	R9,1(R1)	; POINTER TO FIRST WORD OF HEADER
OPNOPN:	MOVEM	R9,(R11)	; SAVE POINTERS IN CHANNEL TABLE
	MOVEM	R9,DEVNAM+1	; AND DEVICE SPECIFICATION
	MOVE	R0,[OPEN DEVNAM-1]	; OPEN DEVICE
	ADD	R0,OPNDCH
	XCT	R0
	CFERR	12,S$$PGL	; IF ERROR, ILLEG UNIT
	SETZ	R8,	; INITIALIZE BUFFER SIZE
	HLRZ	R9,R9	; OUTPUT BUFFER HEADER TABLE POINTER
	JUMPE	R9,INPBUF	; SKIP IF 0
	MOVE	R11,[OUTBUF 1]	; UUO CALL FOR OUTPUT BUFFER SETUP
	HLRZ	R0,R10	; NUMBER OF BUFFERS
	JSP	R7,MAKBUF	; MAKE BUFFERS
INPBUF:	HRRZ	R9,DEVNAM+1	; SAME FOR INPUT BUFFERS
	JUMPE	R9,OPNFIN
	MOVE	R11,[INBUF 1]
	HRRZ	R0,R10
	JSP	R7,MAKBUF
OPNFIN:	MOVE	R1,OPNANS	; RETURN CHANNEL #
	JRST	(R12)
; MAKE BUFFER RING
MAKBUF:	ADD	R11,OPNDCH	; INSERT CHANNEL # IN BUFFER UUO
	JUMPN	R8,MAKBU1	; JUMP IF BUFFER SIZE KNOWN
	MOVE	R8,.JBFF	; SAVE .JBFF
	XCT	R11	; MAKE 1 DUMMY BUFFER
	EXCH	R8,.JBFF	; RESTORE .JBFF
	SUB	R8,.JBFF	; CALCULATE BUFFER SIZE
	SETZM	(R9)	; RESTORE HEADER TABLE
	HRLZI	R1,^O700
	MOVEM	R1,1(R9)
	SETZM	2(R9)
MAKBU1:	HRR	R11,R0	; SET # OF BUFFERS IN UUO CALL
	IMULI	R0,(R8)	; # OF BUFFERS * SIZE + 1
	ADDI	R0,1
	JSP	R6,S$$GNS	; GET BLOCK FOR BUFFERS
	HRRM	R1,-1(R9)	; SAVE PTR TO BUFFER BLOCK IN HEADER TABLE
	ADDI	R1,1	; START OF FIRST BUFFER
	EXCH	R1,.JBFF	; SAVE .JBFF
	XCT	R11	; DO UUO
	MOVEM	R1,.JBFF	; RESTORE .JBFF
	JRST	(R7)	; RETURN

; DECODE BUFFER SPEC, WITH PTR IN R1, CHAR COUNT IN R3
BUFSPC:	JSP	R4,S$$GNP	; GET NEXT NUMERICAL PARAMETER
BADPRO:	CFERR	6,S$$PGL	; NO DELIMETER FOUND
	JUMPL	R2,BADPRO	; PARAMETER NEGATIVE
	HRLZI	R10,(R2)	; # OF OUTPUT BUFFERS
	CAIN	R0,","	; IS DELIMETER A COMMA?
	JRST	BUFSP1	; YES, GO FOR SECOND PARAMETER
BUFSP0:	CAIN	R0,")"	; NO, IS DELIMETER A RPAREN?
	JUMPE	R3,DEVCHK	; YES, OK IF NO MORE CHARS
	CFERR	6,S$$PGL	; MORE CHARS OR NOT ")", ERROR
BUFSP1:	JSP	R4,S$$GNP	; GET NEXT NUMERICAL PARAMETER
	CFERR	6,S$$PGL	; NO DELIMITER
	JUMPL	R2,BADPRO	; ERROR IF NEG PAR
	HRRI	R10,(R2)	; # OF INPUT BUFFERS
	JRST	BUFSP0	; CHECK FOR PROPER ENDING
; STORAGE
OPNANS:	1B0
OPNDCH:	BLOCK	1
	0
DEVNAM:	BLOCK	2
	SUBTTL	S$$NIO NORMAL I/O ROUTINES

	ENTRY	S$$NIO
	EXTERN	S$$IOI,S$$IIX,S$$IOX,S$$FLR

	COMMENT/ THESE ROUTINES PERFORM INPUT AND OUTPUT ON DEVICES OTHER THAN THE
CONTROLLING TTY OR NON-TTYCAL INPUT AND OUTPUT ON THE CONTROLLING TELETYPE.
THEY ARE REQUIRED ONLY IF A SOFTWARE CHANNEL IS OPENED AND THUS ARE IN-
CLUDED IN THIS MODULE FOR THAT REASON/

; NORMAL LINE MODE INPUT
NIOLMI:	HRRI	R9,0	; START COUNT AT 0
	HRRZ	R8,3(R8)	; GET INPUT CHANNEL #
	ANDI	R8,^O17
	MOVEM	R8,VIOCHN	; SAVE
	HRRZ	R8,S$$CHT(R8)	; GET HEADER BLOCK POINTER
	EXCH	R10,1(R8)	; HEADER BYTE PTR
	EXCH	R11,2(R8)	; HEADER BYTE COUNT
	MOVE	[XWD NLILOP,NLICHR]	; MOVE LOOP INTO R2 - R8
	BLT	NLIEND
	JRST	NLICHR	; START LOOP
NLILOP:	PHASE	2
NLICHR:	SOJL	R11,NEWIBF	; R2: DECREMENT BUF BYTE COUNT
	ILDB	R0,R10	; R3: GET NEXT BYTE FROM BUF
	CAIG	R0,^O15	; R4: TEST FOR NULL OR CR
	JRST	NLIFIN	; R5: BY JUMPING OUT OF LOOP
NLICON:	IDPB	R0,R1	; R6: PUT CHAR IN STRING
	AOBJN	R9,NLICHR	; R7: LOOP UNTIL ASSOC LEN EXHAUSTED
NLIEND:	JRST	NLIWST	; R8: THROW AWAY REST OF LINE
	DEPHASE
NLIFIN:	JUMPE	R0,NLICHR	; KEEP GOING IF NULL
	CAIE	R0,^O15	; IS IT CR?
	JRST	NLICON	; NO, KEEP GOING
NEWIBR:	SOJL	R11,NEWIB1	; DECREMENT BUF BYTE COUNT
	ILDB	R0,R10	; GET NEXT CHAR
	JUMPE	R0,.-2	; IGNORE IF NULL OTHERWISE MUST BE LF
	MOVE	R8,VIOCHN	; GET CHAN #
	HRRZ	R8,S$$CHT(R8)	; GET BUFFER HEADER PTR
	EXCH	R10,1(R8)	; RESTORE HEADER BYTE POINTER
	EXCH	R11,2(R8)	; RESTORE HEADER BYTE COUNT
	JRST	S$$IIX	; FINISH UP INPUT SEQUENCE
NLIWST:	MOVE	R6,.+1	; SET UP LOOP TO THOW AWAY REST OF LINE
	JRST	NLICHR
NEWIB1:	MOVE	R2,[JRST NEWIBR]	; MODIFY LOOP SO RETURN IS TO NEWIBR
NEWIBF:	MOVE	R8,VIOCHN	; GET CHAN #
	DPB	R8,[POINT 4,NEWIB2,12]	; PUT IN APPROPRIATE
	DPB	R8,[POINT 4,NEWIB3,12]	; UUO CALLS
	HRRZ	R8,S$$CHT(R8)	; GET BUFFER HEADER PTR
	EXCH	R10,1(R8)	; RESTORE R10 AND R11
	EXCH	R11,2(R8)
NEWIB2:	IN	.-.,	; READ IN NEXT BUFFER
	JRST	NEWIOK	; TRANSMISSION OK
NEWIB3:	STATZ	.-.,^O740000	; CHECK STATUS
	CFERR	11,S$$IOI+1	; ERROR
VIOEOF:	SETZM	@S$$IOI	; EOF, SET VAL TO NULL
	JRST	S$$FLR	; FAIL
NEWIOK:	EXCH	R10,1(R8)	; GET HEADER BYTE PTR
	EXCH	R11,2(R8)	; GET HEADER BYTE COUNT
	MOVE	R8,NLIFIN-1	; RESTORE LAST INSTRUCTION WORD OF LOOP
	JRST	NLICHR	; GO TO BEGINNING OF LOOP

; NORMAL CHARACTER MODE INPUT
NIOCMI:	HRRZI	R9,1	; 1 CHARACTER
	HRRZ	R8,3(R8)	; GET INPUT CHANNEL #
	ANDI	R8,^O17
	HRRZ	R7,S$$CHT(R8)	; GET BUFFER HEADER TABLE POINTER
NCICHR:	SOSGE	2(R7)	; DECREMENT BYTE COUNT
	JRST	NEWIBC	; NEED NEW BUFFER
	ILDB	R0,1(R7)	; LOAD CHAR
	JUMPE	R0,NCICHR	; LOOP IF NULL
	IDPB	R0,R1	; OTHERWISE, PUT IN STRING
	HRRM	R9,-1(R1)	; SET CHAR COUNT TO 1
	JRST	S$$IIX+2	; GO RESTORE IN INPUT SEQUENCE
NEWIBC:	DPB	R8,[POINT 4,NEWIB4,12]	; PUT CHANNEL # IN APPROPRIATE
	DPB	R8,[POINT 4,NEWIB5,12]	; UUO CALLS
NEWIB4:	IN	.-.,	; READ IN NEXT BUFFER
	JRST	NCICHR	; TRANSMISSION OK
NEWIB5:	STATZ	.-.,^O740000	; CHECK STATUS
	CFERR	11,S$$IOI+1	; ERROR
	JRST	VIOEOF	; EOF
; NORMAL LINE MODE OUTPUT
NIOLMO:	HRRI	R9,0	; START COUNT AT 0
	MOVE	[XWD NLOLOP,NLOCHR]	; MOVE LOOP INTO R2 - R7
	BLT	NLOEND
	HRRZ	R8,3(R8)	; GET OUTPUT CHANNEL #
	LSH	R8,-4
	MOVEM	R8,VIOCHN	; SAVE
	HLRZ	R8,S$$CHT(R8)	; GET BUFFER HEADER TABLE POINTER
	EXCH	R10,1(R8)	; GET BYTE PTR
	EXCH	R11,2(R8)	; GET BYTE COUNT
	JUMPE	R1,CRLFNM	; SKIP OUT IF NULL STRING
	HRRZ	R8,(R1)	; GET CHAR COUNT
	JUMPE	R8,CRLFNM	; SKIP OUT IF 0
	JRST	NLOCHR	; START LOOP
NLOLOP:	PHASE	2
NLOCHR:	SOJL	R11,NEWOBF	; R2: GET NEW BUFFER IF OUT OF CHARS
	ILDB	R0,R1	; R3: GET CHAR FROM STRING
	IDPB	R0,R10	; R4: PUT CHAR IN BUFFER
	SOJE	R8,CRLFNM	; R5: SKIP OUT IF STRING EXHAUSTED
	AOBJN	R9,NLOCHR	; R6: LOOP IF WITHIN ASSOC LEN
NLOEND:	JRST	ASCLNM	; R7: OTHERWISE, PUT OUT EXTRA CR,LF
	DEPHASE
CRLFNM:	ADDI	R5,CRLFND-CRLFNM	; COME BACK TO CRLFND
	MOVE	R1,CRLFST	; GET CR,LF STRING PTR
	MOVEI	R8,2	; 2 CHARS
	MOVE	R6,.+1	; DON'T WORRY ABOUT ASSOC LEN
	JRST	NLOCHR	; GO TO LOOP
CRLFND:	MOVE	R8,VIOCHN	; GET OUTPUT CHAN #
	HLRZ	R8,S$$CHT(R8)	; GET BUFFER HEADER TABLE PTR
	EXCH	R10,1(R8)	; RESTORE BYTE PTR
	EXCH	R11,2(R8)	; RESTORE CHAR COUNT
	JRST	S$$IOX	; FINISH UP OUTPUT SEQUENCE
ASCLNM:	MOVEM	R1,ASCLR1	; SAVE R1 AND R8
	MOVEM	R8,ASCLR8
	ADDI	R5,ASCLND-CRLFNM	; COME BACK TO ASCLND
	JRST	CRLFNM+1	; GET IN A CR,LF SEQUENCE
ASCLND:	MOVE	R1,ASCLR1	; RESTORE R1 AND R8
	MOVE	R8,ASCLR8
	SUBI	R5,ASCLND-CRLFNM	; RESTORE NORMAL EXIT FROM LOOP
	MOVE	R6,CRLFNM-2	; RESTORE ASSOC LEN TEST
	MOVNI	R9,(R9)	; GET -ASSOC LEN,0 INTO R9
	HRLZI	R9,(R9)
	JRST	NLOCHR	; GO BACK TO LOOP
NEWOBF:	MOVE	R2,VIOCHN	; GET OUTPUT CHAN #
	DPB	R2,[POINT 4,NEWOB1,12]	; PUT IN UUO CALL
	HLRZ	R2,S$$CHT(R2)	; GET BUFFER HEADER TABLE POINTER
	EXCH	R10,1(R2)	; RESTORE R10 AND R11
	EXCH	R11,2(R2)
NEWOB1:	OUT	.-.,	; OUTPUT BUFFER
	JRST	.+2	; TRANSMISSION OK
	UFERR	11,S$$IOI+1	; OUTPUT ERROR
	EXCH	R10,1(R2)	; GET BYTE PTR
	EXCH	R11,2(R2)	; GET BYTE COUNT
	MOVE	R2,NLOLOP	; RESTORE FIRST WORD OF LOOP
	JRST	NLOCHR	; RETURN TO LOOP

; NORMAL CHARACTER MODE OUTPUT
NIOCMO:	JUMPE	R1,S$$IOX	; SKIP OUT IF NULL
	HRRZ	R7,(R1)	; GET CHAR COUNT
	JUMPE	R7,S$$IOX	; SKIP OUT IF 0
	HRRZ	R8,3(R8)	; GET OUTPUT CHANNEL #
	LSH	R8,-4
	MOVEM	R8,VIOCHN	; SAVE
	HLRZ	R8,S$$CHT(R8)	; GET BUFFER HEADER TABLE POINTER
	EXCH	R10,1(R8)	; GET BYTE PTR
	EXCH	R11,2(R8)	; GET BYTE COUNT
	MOVE	[XWD NCOLOP,NCOCHR]	; MOVE LOOP INTO R2 - R6
	BLT	NCOEND
	JRST	NCOCHR	; JUMP INTO LOOP
NCOLOP:	PHASE	2
NCOCHR:	SOJL	R11,NEWOBF	; R2: GET NEW BUFFER IF NO MORE CHARS
	ILDB	R0,R1	; R3: GET CHAR FROM STRING
	IDPB	R0,R10	; R4: PUT CHAR IN BUFFER
	SOJN	R7,NCOCHR	; R5: LOOP UNTIL STRING IS EXHAUSTED
NCOEND:	JRST	CRLFND+2	; R6: RESTORE BYTE PTR, COUNT, AND QUIT
	DEPHASE

; STORAGE
S$$NIO:	XWD	NIOLMO,NIOLMI	; NORMAL LINE MODE OUTPUT/INPUT
	XWD	NIOCMO,NIOCMI	; NORMAL CHAR MODE OUTPUT/INPUT
VIOCHN:	BLOCK	1
ASCLR1:	BLOCK	1
ASCLR8:	BLOCK	1
CRLFST:	POINT	7,.+1	; CR,LF SEQUENCE
	BYTE	(7)^O15,^O12
	PRGEND
	SUBTTL	P$$INP,P$$OUT INPUT() AND OUTPUT() PRIMITIVE FUNCTIONS

	ENTRY	P$$INP,P$$OUT
	EXTERN	S$$MKI,S$$PGL,S$$CHT,S$$AST,S$$ASB,S$$NIO
	EXTERN	S$$LKV,S$$MRS,S$$GNS
	RADIX	10
	SEARCH	S$$NDF

	COMMENT/
CALL:	FUNCTION CALL, WITH ARGUMENTS EQUALIZED TO 3.
	INPUT(VARNAM,CHAN,LENGTH) CREATES AN INPUT ASSOCIATION BETWEEN
A VARIABLE AND A SOFTWARE CHANNEL, IN EITHER CHARACTER MODE OR LINE MODE
WITH ASSOCIATION LENGTH SPECIFIED, AND RETURNS NULL
	OUTPUT(VARNAM,CHAN,LENGTH) IS LIKE 'INPUT()', BUT CREATES AN OUT-
PUT ASSOCIATION INSTEAD
	LENGTH > 0 INDICATES LINE MODE
	LENGTH = 0 INDICATES LINE MODE WITH DEFAULT LENGTH
	LENGTH < 0 OR NOT INTEGER INDICATES CHARACTER MODE
	CHANNEL = 0 INDICATES TELETYPE (TTYCAL) INPUT AND OUTPUT
	CHANNEL > 0 INDICATES NORMAL BUFFERED OUTPUT AND INPUT ON THAT
SOFTWARE CHANNEL
	CHANNEL < 0 OR NOT INTEGER INDICATES THAT THE APPROPRIATE
ASSOCIATION IS TO BE DISCONNECTED (BUT THE VARIABLE IS NOT DETACHED)
	IF AN ASSOCIATION ALREADY EXISTS, THE NEW ONE REPLACES IT/

P$$INP:	JSP	R11,P$$OUT+1	; 'INPUT', INDEX = 0
P$$OUT:	JSP	R11,P$$OUT+1	; 'OUTPUT', INDEX = 1
	SUBI	R11,P$$OUT

; DETERMINE LENGTH
	POP	ES,R1	; GET LENGTH
	JSP	R7,S$$MKI	; IS IT INTEGER?
	SETO	R1,	; NO, SET = -1
	JUMPN	R1,.+2	; IS IT 0?
	MOVEI	R1,P$ALEN	; YES, SET = DEFAULT ASSOC LEN
	MOVEM	R1,SAVLEN	; SAVE LENGTH

; DETERMINE CHANNEL
	POP	ES,R1	; GET CHAN #
	JSP	R7,S$$MKI	; IS IT INTEGER?
	SETO	R1,	; NO, SET = -1
	CAILE	R1,15	; IS IT > 15?
	CFERR	12,S$$PGL	; YES, ILLEGAL UNIT
	MOVEM	R1,SAVCHN	; SAVE CHANNEL #
; DETERMINE VARIABLE
	POP	ES,R1	; GET VARNAM
	JSP	R10,S$$LKV	; LOOKUP VARIABLE
	MOVE	R1,(R2)	; GET NAME DESCR FOR VARIABLE
	TLNE	R1,3B23	; IS IT DEDICATED?
	CFERR	10,S$$PGL	; YES, ERROR
	HRRZI	R1,(R1)	; FORM ADDRESS ONLY
	CAIL	R1,^O776000	; IS IT A TRAP ADDR?
	HRREI	R1,(R1)	; YES, MAKE NEG
	SKIPL	R10,SAVCHN	; GET CHAN # AND SKIP IF < 0
	JRST	NEWASC	; OTHERWISE GO TO NEW ASSOCIATION SECTION

; DELETE OLD ASSOCIATION
	JUMPGE	R1,NULRET	; FINISH IF NOT ASSOCIATED ALREADY
	ASH	R1,2	; OTHERWISE COMPUTE ASSOC TABLE ENTRY PTR
	ADD	R1,S$$ASB
	XCT	[SETZM	2(R1)
		 SETZM	1(R1)](R11)	; AND ELIMINATE APPROPRIATE
	JRST	NULRET	; ASSOCIATION AND RETURN NULL

; CHECK FOR OLD ASSOCIATION
NEWASC:	JUMPE	R10,.+4	; SKIP OVER IF CHAN # IS 0
	SKIPE	R3,S$$CHT(R10)	; TEST IF APPROPRIATE SIDE OPEN
	XCT	[TRNN	R3,-1
		 TLNN	R3,-1](R11)
	CFERR	12,S$$PGL	; NO, BAD UNIT
	JUMPGE	R1,CRTASC	; CREATE NEW ASSOCIATION IF ADDR > 0
	ASH	R1,2	; OTHERWISE COMPUTE ASSOCIATION TABLE ENTRY PTR
	ADD	R1,S$$ASB
	JRST	SAVASC	; AND GO SAVE ASSOCIATION

; CREATE NEW ASSOCIATION
CRTASC:	MOVE	R3,S$$AST	; ASSOC TBL TOP PTR
	MOVE	R4,S$$ASB	; COMPUTE -TOT # OF ASSOC ENTRIES
	SUBI	R4,1(R3)
	ASH	R4,-2
	MOVN	R4,R4
	HRLI	R3,(R4)	; AND SAVE FOR AOBJ COUNT
CRTLOP:	SKIPN	1(R3)	; IS ENTRY AVAILABLE?
	JRST	CRTFND	; YES
	ADDI	R3,3	; OTHERWISE POINT TO NEXT ENTRY
	AOBJN	R3,CRTLOP	; AND LOOP
; EXPAND ASSOCIATION TABLE
	MOVEM	R2,SAVCHN	; NO FREE ENTRIES, SAVE POINTER TO NAME
	MOVE	R1,S$$AST	; GET OLD ASSOC TABLE BLOCK
	HLRZ	R0,(R1)	; MAKE NEW ONE OF SIZE =
	ANDI	R0,^O177777	; OLD SIZE +
	HRRZ	R7,(R1)	; EXTENSION SIZE
	ADDI	R0,(R7)
	JSP	R6,S$$GNS
	HRRM	R7,(R1)	; SAVE EXTENSION SIZE IN NEW BLOCK
	MOVEI	R2,2(R1)	; ZERO ALL NEW ADDITIONAL ENTRIES
	HRLI	R2,1(R1)
	SETZM	1(R1)
	ADDI	R7,(R1)
	BLT	R2,(R7)
	ADDI	R0,(R1)	; NEW TABLE BASE POINTER
	EXCH	R1,S$$AST	; SAVE NEW TABLE TOP POINTER
	JSP	R6,S$$MRS	; RETURN OLD BLOCK
	HRRZI	R2,1(R7)	; MOVE REMAINING ENTRIES FROM OLD TABLE
	HRLI	R2,1(R1)	; TO NEW ONE
	MOVEM	R0,S$$ASB	; AND SAVE NEW TABLE BASE POINTER
	MOVE	R1,R0
	BLT	R2,-1(R1)
	MOVE	R2,SAVCHN	; RESTORE PTR TO NAME
	HRRZ	R1,(R2)	; AND PTR TO VARIABLE
	JRST	CRTASC	; AND GO FIND ENTRY

; NEW ENTRY SPACE FOUND
CRTFND:	HLRM	R3,(R2)	; SAVE ENT^Y INDEX IN NAME DESCR
	HRLI	R1,(R2)	; AND NAME POYNTER, VAR POINTER
	MOVEM	R1,1(R3)	; IN FIRST WORD OF ENTRY
	MOVEI	R1,1(R3)	; POINTER TO ENTRY
; DETERMINE TYPE OF I/O
SAVASC:	MOVEI	R2,S$$NIO	; NORMAL I/O ROUTINES POINTER
	JUMPN	R10,.+2	; IS CHANNEL 0?
	MOVEI	R2,S$$ASB+1	; YES, POINT TO TTYCAL ROUTINES
	SKIPGE	R3,SAVLEN	; IS IT LINE MODE?
	ADDI	R2,1	; NO, <0, CHAR MODE, DIFFERENT I/O ROUTINES
	XCT	[HRRZ	R4,(R2)
		 HLRZ	R4,(R2)](R11)	; GET APPROPRIATE ROUTINE
	JUMPL	R3,.+3	; SKIP IF CHAR MODE
	MOVNI	R5,(R3)	; OTHERWISE LOAD -LENGTH
	HRLI	R4,(R5)

; SAVE ASSOCIATION INFO IN ENTRY
	XCT	[MOVEM	R4,2(R1)
		 MOVEM	R4,1(R1)](R11)	; SAVE IN ENTRY
	MOVEI	R9,^O17	; CHANNEL BYTE MASK
	XCT	[JRST	SAVINP
		 LSHC	R9,4](R11)	; PREPARE FOR ENTRY MODIFICATION
SAVINR:	ANDCAM	R9,3(R1)	; CLEAR CHANNEL BYTE, ETC
	ADDM	R10,3(R1)	; SET CHANNEL BYTE, ETC
NULRET:	SETZ	R1,	; RETURN NULL
	JRST	(R12)
SAVINP:	JUMPGE	R3,.+2	; SKIP IF LINE MODE
	AOJA	R3,.+2	; SET R3=0 FOR CHAR MODE
	MUL	R3,[^F0.2B0]	; COMPUTE # WORDS IN INPUT STRING BLOCK
	HRLI	R10,2(R3)
	HRROI	R9,(R9)	; MODIFY CHANNEL BYTE MASK
	JRST	SAVINR	; GO BACK TO SEQUENCE
; STORAGE
SAVLEN:	BLOCK	1
SAVCHN:	BLOCK	1
	END