.TITLE	SYSIN		
; JEFFREY KODOSKY	ARL	SEP76
;
; SUBR
; ENTRY:	1 ARG		<STR>
; EXIT:		1 ARG		<N>
; ERRORS:	(IO1, ILLEGAL FILE SPECIFICATION/CHANNEL NUMBER)
;		(IO2, ATTEMPT TO OPEN TOO MANY CHANNELS)
;		(IO3, DEVICE HANDLER-I/O BUFFER SPACE EXHAUSTED)
; CALLS:	(OPENI, SUBSET OF LOOKUP FUNCTION)
;		I2ATM
	.GLOBL	SYSIN,ZSYSIN,ILINK,QI2ATM,INSYS,FLGTBL,SUBSYS
SYSIN:	JSR	PC,OPENI	;OPEN A CHANNEL FOR INPUT
	ASL	R3
	MOVB	INSYS,-(SP)
	MOVB	@SP,FLGTBL+1(R3)	;LINK TO PREVIOUS SYSIN
	.IF	DF,RSTS
	TSTB 	FLGTBL(R3)	; IF NECESSARY	(DRW  26-SEPT-80)
	BNE	.+6
	INCB	FLGTBL(R3)	; FLAG PREVIOUS SYSIN UNAVAILABLE 
				; BY PLACING 1 IN LOW BYTE (DRW 26-SEPT-80)
	.ENDC
	ASR	R3
	MOVB	R3,INSYS	;UPDATE SYSIN
	CLRB	1(SP)
	QI2ATM
	.WORD	0		;RETURN PREVIOUS CHANNEL NUMBER
;
;
;
;
; UTILITY:	REVERT TO PREVIOUS SYSIN
; ENTRY:	NO ARGS
; EXIT:		NO ARGS
;		C BIT SET IF NO MORE SYSIN
; ERRORS:	(IO3, DEVICE HANDLER-I/O SPACE EXHAUSTED)
; CALLS:	(LINK, SUBSET OF CLOSE FUNCTION)
ILINK:	MOVB	INSYS,R3
	JSR	PC,LINK
	MOVB	R3,INSYS
	BCS	1$
	ASL	R3
	TST	SUBSYS		; BE SURE TO ALWAYS CLEAR SUBSYS FLAG IF FILE
	BMI	2$		; IS NOT FROM INITIAL CSI STRING (DRW 7-DEC-80)
	TST	FLGTBL(R3)
	BGE	1$
2$:	CLR	SUBSYS	;IF DOWN TO LAST SYSIN THEN SUBSYSTEMS
1$:	JMP	@-(R4)	;MUST HAVE BEEN READ IN ALREADY
ZSYSIN=.-SYSIN
	.PAGE
; SUBR:		SYSOUT
; ENTRY:	1 ARG		<STR>
; EXIT:		1 ARG		<N> OR NIL
; ERRORS:	(IO1, ILLEGAL FILE SPECIFICATION/CHANNEL NUMBER)
;		(IO2, ATTEMPT TO OPEN TOO MANY CHANNELS)
;		(IO3, DEVICE HANDLER-I/O BUFFER SPACE EXHAUSTED)
;		(IO4, ATTEMPT TO CLOSE SYSOUT)
; CALLS:	(OPENO, SUBSET OF ENTER FUNCTION)
;		(LINK, SUBSET OF CLOSE FUNCTION)
;		I2ATM
;		PRNT
	.GLOBL	SYSOUT,ZSYSOUT,OUTSYS,QPRNT
SYSOUT:	TST	@R5
	BEQ	OLINK
	JSR	PC,OPENO	;OPEN A NEW CHANNEL FOR OUTPUT
	ASL	R3
	MOVB	OUTSYS,-(SP)
	MOVB	@SP,FLGTBL+1(R3)	;LINK TO PREVIOUS SYSOUT
	ASR	R3
	MOVB	R3,OUTSYS	;UPDATE SYSOUT
	CLRB	1(SP)
	QI2ATM
	.WORD	0	;RETURN PREVIOUS CHANNEL NUMBER
OLINK:	CLR	R3	;OUTPUT ANY PARTIAL BUFFER
	QPRNT
	MOVB	OUTSYS,R3
	JSR	PC,LINK
	MOVB	R3,OUTSYS	;UPDATE SYSOUT
	JMP	@-(R4)
ZSYSOUT=.-SYSOUT
	.PAGE
; SUBR:		LOOKUP
; ENTRY:	1 ARG		<STR>
; EXIT:		1 ARG		<N>
; ERRORS:	IO1, ILLEGAL FILE SPECIFICATION/CHANNEL NUMBER
;		IO2, ATTEMPT TO OPEN TOO MANY CHANNELS
;		(IO3, DEVICE HANDLER-I/O BUFFER SPACE EXHAUSTED)
; CALLS:	I2ATM
;		ALLOCATE, MEMORY ALLOCATOR
;		(ATM2ASCII)
;		.LOOKUP
;		.CSISPC
;		.FETCH
;		.DSTATUS
	.MCALL	.LOOKUP,.FETCH,.CSISPC,.DSTATUS
	.GLOBL	LOOKUP,ZLOOKUP,QI2ATM,QALLOCATE,QIO1ERR,QIO2ERR
	.GLOBL	DEFEXT,AREA,BLKTBL,BFRTBL,PTRTBL,DEVTBL,QATM2ASCII
LOOKUP:	JSR	PC,OPENI
	MOV	R3,-(SP)
	ASL	R3
	INCB	FLGTBL(R3)	;NOTE THAT CHANNEL WAS LOOKUP'D
	QI2ATM		;RETURN CHANNEL NUMBER
	.WORD	0
; OPEN A NEW CHANNEL FOR INPUT VIA .LOOKUP (POP <STR> @R5 AND RETURN
;	CHANNEL NUMBER IN R3)
OPENI:	JSR	PC,CSII	;GET DVBLK (R1--->DVBLK,C SET IF BAD CS)
	BCC	1$
9$:	QIO1ERR		;BAD COMMAND STRING
1$:	JSR	PC,CHANL	;GET A FREE CHANNEL
	BCC	2$
	QIO2ERR		;TOO MANY CHANNELS
2$:	CMP	@R1,(PC)+
	.RAD50	/TT/
	BEQ	OPENI2	;JUMP IF USING TT
	MOV	R3,-(SP);ELSE SAVE CHANNEL
	JSR	PC,FETCH;BRING IN HANDLER
	BCS	9$
	.LOOKUP	#AREA,@SP,R1	;OPEN THE FILE
	BCS	9$
	MOV	R1,-(SP);SAVE DVBLK POINTER
	MOV	#256.,R3;FETCH A BUFFER
	QALLOCATE
	MOV	R3,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R3;R2--->BUFFER,R1--->DVBLK,R3=CH#
	ASL	R3
	MOV	#177401,FLGTBL(R3)	;INIT CHANNEL USE FLAG
	CLR	BLKTBL(R3)	;REL BLOCK 0
	MOV	R2,BFRTBL(R3)
	CLR	PTRTBL(R3)	;BUFFER IS EMPTY
	BR	.+4
OPENI2:	ASL	R3
	MOV	@R1,DEVTBL(R3)
	ASR	R3
	TST	(R5)+	;POP <STR>
	RTS	PC	;RETURN CHANNEL NUMBER
ZLOOKUP=.-LOOKUP
	.PAGE
; SUBR:		ENTER
; ENTRY:	1 ARG		<STR>
; EXIT:		1 ARG		<N>
; ERRORS:	IO1, ILLEGAL FILE SPECIFICATION/CHANNEL NUMBER
;		IO2, ATTEMPT TO OPEN TOO MANY CHANNELS
;		(IO3, DEVICE HANDLER-I/O BUFFER SPACE EXHAUSTED)
; CALLS:	I2ATM
;		ALLOCATE
;		(ATM2ASCII)
;		.ENTER
;		.FETCH
;		.CSISPC
;		.DSTATUS
	.MCALL	.ENTER
	.GLOBL	ENTER,ZENTER
ENTER:	JSR	PC,OPENO	;OPEN A CHANNEL FOR OUTPUT
	MOV	R3,-(SP)
	ASL	R3
	DECB	FLGTBL(R3)	;NOTE THAT CHANNEL WAS ENTER'D
	QI2ATM
	.WORD	0	;RETURN CHANNEL NUMBER
; OPEN A NEW CHANNEL FOR OUTPUT VIA .ENTER (POP <STR> AND RETURN
;	CHANNEL NUMBER IN R3)
OPENO:	JSR	PC,CSIO	;GET DEVBLK
	BCC	1$
9$:	QIO1ERR
1$:	JSR	PC,CHANL	;GET A FREE CHANNEL
	BCC	2$
	QIO2ERR
2$:	CMP	@R1,(PC)+
	.RAD50	/TT/
	BEQ	OPENO2	;JUMP IF USING TT
	MOV	R3,-(SP)
	MOV	R1,-(SP)
	JSR	PC,FETCH	;FETCH IN HANDLER
	BCS	9$
	.ENTER	#AREA,2(SP),R1,#0	;OPEN THE FILE
	BCS	9$
	MOV	#256.,R3	;FETCH A BUFFER
	QALLOCATE
	MOV	R3,R2
	MOV	(SP)+,R1
	MOV	(SP)+,R3
	ASL	R3
	MOV	#-1,FLGTBL(R3)	;INIT CHANNEL USE FLAG
	CLR	BLKTBL(R3)	;REL BLOCK 0
	MOV	R2,BFRTBL(R3)
	CLR	PTRTBL(R3)	;EMPTY BUFFER
	BR	.+4
OPENO2:	ASL	R3
	MOV	@R1,DEVTBL(R3)
	ASR	R3
	TST	(R5)+	;POP <STR>
	RTS	PC	;RETURN CHANNEL NUMBER
ZENTER=.-ENTER
	.PAGE
; SUBR:		INPUT
; ENTRY:	1 ARG		<N>
; EXIT:		1 ARG		<S>
; ERRORS:	IO1, ILLEGAL FILE SPECIFICATION/CHANNEL NUMBER
; CALLS:	READ
;		ATM2N
;		RI
	.GLOBL	INPUT,ZINPUT,QATM2N,QRI,QREAD
INPUT:	MOV	@R5,-(R5)
	QATM2N
	BCC	.+4
	QRI
	MOV	(SP)+,R3
	CMP	R3,#9.
	BLO	1$
9$:	QIO1ERR
1$:	ASL	R3
	TSTB	FLGTBL(R3)
	BLE	9$	;ERROR IF NOT OPENED FOR INPUT
	TST	(R5)+	;POP <N>
	ASR	R3
	MOVB	R3,INSYS+1	;SET UP CURRENT INPUT CHANNEL
	QREAD		;AND READ AN S-EXPRESSION
	.WORD	0
ZINPUT=.-INPUT
;
;
;
; SUBR:		OUTPUT
; ENTRY:	2 ARGS		<N>;<S>
; EXIT:		1 ARG		<S>
; ERRORS:	IO1, ILLEGAL FILE SPECIFICATION/CHANNEL NUMBER
; CALLS:	PRINT
;		ATM2N
;		RI
	.GLOBL	OUTPUT,ZOUTPUT,QPRINT
OUTPUT:	MOV	@R5,-(R5)
	QATM2N
	BCC	.+4
	QRI
	MOV	(SP)+,R3
	CMP	R3,#9.
	BLO	1$
9$:	QIO1ERR
1$:	ASL	R3
	TSTB	FLGTBL(R3)
	BPL	9$	;ERROR IF NOT OPENED FOR OUTPUT
	TST	(R5)+	;POP <N>
	ASR	R3
	MOVB	R3,OUTSYS+1	;SET UP CURRENT OUTPUT CHANNEL
	QPRINT		;AND PRINT <S>
	.WORD	0
ZOUTPUT=.-OUTPUT
	.PAGE
; SUBR:		CLOSE
; ENTRY:	1 ARG		<N>
; EXIT:		1 ARG		NIL
; ERRORS:	IO1, ILLEGAL FILE SPECIFICATION/CHANNEL NUMBER
; CALLS:	ATM2N
;		RI
;		RELEASE, MEMORY RECLAIMER
;		.DSTATUS
;		.CLOSE
;		.RELEASE
	.MCALL	.CLOSE,.RELEASE
	.GLOBL	CLOSE,ZCLOSE,FSTART,QRELEASE
CLOSE:	MOV	@R5,-(R5)
	QATM2N
	BCC	.+4
	QRI
	MOV	(SP)+,R3
	CMP	R3,#9.
	BLO	1$
9$:	QIO1ERR
1$:	ASL	R3
	MOVB	FLGTBL(R3),R1
	CMP	R1,#2
	BEQ	4$
	CMP	R1,#-2
	BNE	9$	;ERROR IF NOT LOOKUP'D OR ENTER'D
	MOV	R3,-(SP)
	ASR	R3
	MOVB	R3,OUTSYS+1
	CLR	R3
	QPRNT		;WRITE ANY EXISTING PARTIAL BUFFER
	MOV	(SP)+,R3
	MOVB	#-1,OUTSYS+1
4$:	ASR	R3
	CLR	@R5
	JSR	PC,RELEASE
	JMP	@-(R4)
; LINK TO NEXT SYSIN OR SYSOUT CHANNEL
LINK:	JSR	PC,RELEASE
	BCS	LINK03	;JUMP IF NO NEXT CHANNEL
	MOV	R3,R2
	ASL	R2
	TST	BFRTBL(R2)
	BNE	LINK02	;JUMP IF LINKED CHANNEL HAS A BUFFER ALREADY
	CMP	DEVTBL(R2),(PC)+
	.RAD50	/TT/
	BEQ	LINK02	;JUMP IF NO BUFFER REQUIRED
	MOV	R3,-(SP)
	MOV	#256.,R3
	QALLOCATE	;ACQUIRE A NEW BUFFER
	MOV	R3,R2
	MOV	(SP)+,R3
	ASL	R3
	MOV	R2,BFRTBL(R3)
	CLR	PTRTBL(R3)	;NEW BUFFER IS EMPTY
	ASR	R3
LINK02:	CLC
LINK03:	RTS	PC	;RETRUN LINKED CHANNEL NUMBER
; RELEASE BUFFER AND HANDLER ASSOCIATED WITH CHANNEL R3
;	(RETURN LINKED CHANNEL IN R3, C BIT SET IF NONE)
RELEASE:MOV	R3,R2
	ASL	R2
	MOV	DEVTBL(R2),R1
	CMP	R1,(PC)+
	.RAD50	/TT/
	BEQ	REL05	;JUMP IF DEVICE IS TT:
	.CLOSE	R3
	CLR	DEVTBL(R2)
	MOV	#16.,R2	;CHECK IF ANY OTHER CHANNEL USING THAT
1$:	TSTB	FLGTBL(R2)	;DEVICE
	BEQ	5$
	MOV	R1,R0	;SEARCH OBJECT
	SUB	DEVTBL(R2),R0	;COMPARE WITH NEXT ENTRY
	BLO	5$
	BEQ	REL03	;JUMP IF EXACT MATCH
	SUB	(PC)+,R0
	.RAD50	/  0/
	BLO	5$	;JUMP IF OUT OF UNIT 0-7 RANGE
	CMP	R0,#7
	BLOS	REL03	;JUMP IF DIFFERENT UNIT OF SAME DEVICE USED
5$:	SUB	#2,R2
	BPL	1$
	MOV	#AREA,R2	;RELEASE THE HANDLER
	MOV	R1,-(SP)
	.DSTATUS	R2,SP
	MOV	4(R2),R2	;HANDLER ADDRESS (OF LQE)
	CMP	R2,FSTART
	BHI	REL02	;JUMP IF HANDLER NOT FETCHED BY LISP
	.RELEASE	SP
	MOV	R3,@SP
	SUB	#6,R2
	MOV	R2,R3
	QRELEASE	;RECLAIM HANDLER SPACE
	MOV	@SP,R3
REL02:	TST	(SP)+
REL03:	MOV	R3,R2
	ASL	R2
REL05:	MOV	FLGTBL(R2),-(SP)
	CLR	FLGTBL(R2)
	MOV	BFRTBL(R2),R3
	BEQ	.+4
	QRELEASE
	CLRB	@SP
	SWAB	@SP
	MOVB	(SP)+,R3
	BPL	.+4
	SEC
	RTS	PC	;RETURN LINKED CHANNEL
ZCLOSE=.-CLOSE
	.PAGE
; BRING IN HANDLER IF NECESSARY (R1--->DEVBLK ;  R2,R3 DESTROYED)
FETCH:	MOV	#AREA,R2
	.DSTATUS	R2,R1
	BCS	1$
	MOV	2(R2),R3	;HANDLER SIZE
	ASR	R3	;IN WORDS
	MOV	4(R2),R2	;ENTRY (ADDR OF LQE)
	BNE	1$	;JUMP IF ITS ALREADY IN
	MOV	R1,-(SP)
	QALLOCATE	;FETCH A BUFFER FOR HANDLER
	MOV	(SP)+,R1
	.FETCH	R3,R1
1$:	RTS	PC
; FIND AN AVAILABLE CHANNEL AND INIT (C BIT SET IF NONE)
CHANL:	MOV	#16.,R3
1$:	TSTB	FLGTBL(R3)
	BEQ	2$
	SUB	#2,R3
	BPL	1$
	SEC
	RTS	PC
2$:	CLR	PTRTBL(R3)
	CLR	BFRTBL(R3)
	CLR	BLKTBL(R3)
	CLR	DEVTBL(R3)
	ASR	R3
	RTS	PC
; PROCESS FILE SPEC (LEAVE <STR> @R5 AND RETURN R1--->DEVBLK)
CSII:	CLR	-(SP)
	BR	CSI
CSIO:	MOV	PC,-(SP)	;NON ZERO FLAG
CSI:	MOV	@R5,-(R5)
	QATM2ASCII
	BCC	4$
	TST	(R5)+	;POP EXTRA COPY
	BR	CSIERR
4$:	BPL	CSIERR	;MUST BE STRING
	INC	R3	;BUMP PAST '
	TST	@SP
	BEQ	CSI01	;JUMP IF INPUT SPEC
	MOV	R3,R2	;ELSE FIND END OF STRING TO INSERT =
10$:	TSTB	(R2)+
	BNE	10$
	CLRB	@R2
	MOVB	#'=,-(R2)
CSI01:	MOV	SP,R2	;REMEMBER STACK
	MOV	R3,R1
	BIC	#1,R1
	.CSISPC	R1,#DEFEXT,R3	;OVERLAY STRING WITH DESCRIPTOR BLOCK
	MOV	R2,SP	;IGNORE SWITCHES
	BCC	CSI04
CSIERR:	TST	(SP)+	;POP I/O FLAG
	SEC
	RTS	PC	;RETURN C BIT FOR BAD COMMAND STRING
CSI04:	TST	(SP)+
	BNE	1$	;JUMP IF OUTPUT SPEC
	ADD	#15.*2,R1	;BUMP TO FIRST INPUT SPEC
1$:	RTS	PC
	.END