.TITLE	IOSYS	I/O subsystem 
	.IDENT	/01.25/
;
; This is a simple packet-oriented I/O subsystem for GRUMPF.
; All I/O is done with packets and all packets are associated with some
; I/O channel, I/O channel 0 is a control channel. An I/O channel is just
; an index into an array of structures containing subroutine pointers and
; arguments for these subroutines, this array is private to a job.
;
; I/O Request Packet (IORQP) format:
;	IO$CH	Byte containing I/O channel number
;	IO$FUN	Byte containing the function code
;	IO$OFS	Word containing an offset in the I/O channel
;	IO$SIZ	Word containing the size of IO$DAT in bytes
;	IO$DAT	IO$SIZ bytes of data, at least one word
;
; Device structure format:
;	D$TYPE	RAD50 word containing the device type
;	D$NUM	RAD50 word containing the device number
;	D$NAME	RAD50 word containing the device name
;	D$IORQ	pointer to I/O request packet handler
;	D$INFO	pointer to a device information string
;	D$OPEN	pointer to a "open" routine, sets carry if device busy
;
; system calls provided:
;	$ASSOC	associates an interrupt handler with an interrupt vector
;	$DISSOC	dissociates an interrupt handler from an interrupt vector
;	$IOREQ	issues an I/O request
;	$IODONE	clears an I/O channel (used by driver CLOSE routines)
;
; well-known I/O functions:
;	$READ 	Read a block of data. Arguments are IORQP buffer, data buffer
;		size and data buffer address. If used on I/O channel 0,
;		IO$SIZ/SIZE$D device table entries will be copied into the
;		data buffer, beginning with entry IO$OFS, leaving IO$OFS
;		"pointing" to the following entry.
;	$WRIT	Write a block of data. Arguments are IORQP buffer, data buffer
;		size and data buffer address. If used on I/O channel 0, the
;		contents of the data buffer are used as a new device table
;		entry. The data buffer size has to be SIZE$D, or else an error
;		will occur. IO$OFS is not affected.
;	$SEEK	Change IO$OFS. Argument is a count of blocks or bytes or
;		something else. If used on channel 0, the count is interpreted
;		as block count (one block = one device table entry)
;	$OPEN	Opens an I/O channel. There are three arguments NAM, NUM and
;		TYPE, which serve as addresses of the name, number and type
;		strings respectivly of the device to be opened when used on
;		channel 0. The new I/O channel number is returned in R0.
;	$CLOS	Closes an I/O channel. There are no arguments. If used on
;		channel 0, the jobs old I/O channel list is freed if it exists
;		and a new one is created.
;	$BSIZ	Return the block size of the device associated to the I/O
;		channel. If used on channel 0, SIZE$D is returned.
;	$MODE	set some mode bits of the device
;
; All these I/O functions are called through macros which fill in the arguments
; into the IORQP and then call the $IOREQ system call.
;
; well-known I/O error status codes:
;	IO$OK	equals 0, no error. The I/O request was successfully processed.
;	IO$INV	invalid request or data in I/O request packet
;	IO$BSY	device, driver or system busy
;	IO$INT	internal error occured while processing the request
;	IO$EOF	end-of-file (or -device) reached
;
; additional macros:
;	.DEVCTL	device structure format
;	.IOSYS	I/O request packet format
;	.IOFUNC	well-known I/O functions
;	.IOERR	well-known I/O errors
;	.IOCLR	clears the IORQP given as argument
;	.IOHND	creates a primitve IOREQ handler
;	.IOTAB	creates a jump table for the IOREQ handler
;	.DEV	creates a device structure
;
; tunable constants:
;	NDEV	maximum number of devices
;	NCHAN	maximum number of I/O channels per job
;
; 29-AUG-2005	H. Rosenfeld	fixed bug in GETDEV
; 27-MAY-2005	H. Rosenfeld	return error codes in R0 instead of writing
;				them in IO$DAT
; 22-MAY-2005	H. Rosenfeld	changed $OPEN semantics to return new channel
;				number instead of changing the packet, wake up
;				for device after REGDEV
; 17-MAY-2005	H. Rosenfeld	fix ASSOC, setting of PSW got lost somewhen in
;				january
; 06-MAY-2005	H. Rosenfeld	fix bug in IODONE
; 05-MAY-2005	H. Rosenfeld	add $MODE I/O function & $IODONE syscall
; 03-MAY-2005	H. Rosenfeld	use system call priorites
; 28-APR-2005	H. Rosenfeld	added .DEV macro, fixed bug in IOOPEN (channel
;				number calculation), fixed bug in .IOHND
; 22-APR-2005	H. Rosenfeld	added .IOHND and .IOTAB, removed private POOL
;				(the device structures are not copied)
; 17-APR-2005	H. Rosenfeld	the I/O channel array is now partiton, not a
;				pool buffer, the driver open routine will
;				be called with the device structure as argument
; 11-APR-2005	H. Rosenfeld	changed to use private POOL partition
; 08-APR-2005	H. Rosenfeld	adapt to change of .IMAGE macro
; 06-MAR-2005	H. Rosenfeld	make use of new .IMAGE macro
; 29-JAN-2005	H. Rosenfeld	modified the system calls and I/O routines to
;				make use of the new calling standard
; 07-DEC-2004	H. Rosenfeld	fixed another bug in IOOPEN (stack corruption
;				on unsuccessful return of driver open routine)
; 06-DEC-2004	H. Rosenfeld	changed syscalls to reflect changes to $SYS
;				fixed bug in IOOPEN, wrong adressing of driver
;				open routine, wrong assignment of I/O channel
;				to IORQP
; 03-DEC-2004	H. Rosenfeld	fixed bug in IOCTL (R1 corruption)
;				added support for driver OPEN routine
; 28-NOV-2004	H. Rosenfeld
;
	.ENABL	REG
	.LIST	ME
	.NLIST	CND
	.LIBRARY	/JOBCTL.SML/
	.LIBRARY	/SYSCLL.SML/
	.LIBRARY	/CALL.SML/
	.LIBRARY	/MEMORY.SML/
	.MCALL	$M$ALLO,$M$FREE
	.MCALL	.CALL,.ENTRY,.RETRN,.IMAGE
	.MCALL	$SYS,$REGSYS
	.MCALL	$CURJOB,$DONE,$TERM
	.MCALL	.JOBCTL

	.MACRO	.IOSYS
		IO$CH=0
		IO$FUN=1
		IO$OFS=2
		IO$SIZ=4
		IO$DAT=6
	.ENDM

	.MACRO	.IOFUNC
		IO$RDB=0
		IO$WRB=1
		IO$SKB=2
		IO$OPN=3
		IO$CLS=4
		IO$BSZ=5
		IO$MOD=6
	.ENDM

	.MACRO	.DEVCTL
		D$TYPE=0
		D$NUM=2
		D$NAME=4
		D$IORQ=6
		D$INFO=10
		D$OPEN=12

		SIZE$D=14
	.ENDM

	.MACRO	.DEV	TYP,NUM,NAM,IORQ,INFO,OPEN
		.WORD	TYP
		.WORD	NUM
		.WORD	NAM
		.WORD	IORQ
		.WORD	INFO
		.WORD	OPEN
	.ENDM

	.MACRO	.IOERR
		IO$OK=0
		IO$INV=-1
		IO$BSY=-2
		IO$INT=-3
		IO$EOF=-4
	.ENDM

	.MACRO	.IOCLR	IORQP
		MOV	R0,-(SP)
		MOV	IORQP,R0
		CLR	(R0)
		CLR	IO$OFS(R0)
		CLR	IO$SIZ(R0)
		MOV	(SP)+,R0
	.ENDM

	.MACRO	.IOHND	?RANGE
		MOV	2(R5),R0
		MOVB	IO$FUN(R0),R0
		ASL	R0
		CMP	R0,#IO$END-IO$TAB
		BHI	RANGE
		JMP	@IO$TAB(R0)
	RANGE:	SEC
		RTS	R5
	.ENDM

	.MACRO	.IOTAB	H1,H2,H3,H4,H5,H6,H7,H8,H9
		.NARG	I$ARGC
		.IF EQ	I$ARGC
			.ERROR	; no arguments to .IOTAB
			.MEXIT
		.ENDC
		IO$TAB:
		.IIF NB	<H1>	.WORD	H1
		.IIF NB	<H2>	.WORD	H2
		.IIF NB	<H3>	.WORD	H3
		.IIF NB	<H4>	.WORD	H4
		.IIF NB	<H5>	.WORD	H5
		.IIF NB	<H6>	.WORD	H6
		.IIF NB	<H7>	.WORD	H7
		.IIF NB	<H8>	.WORD	H8
		.IIF NB	<H9>	.WORD	H9
		IO$END:
	.ENDM

	.MACRO	.IOCHN
		CH$HND=0
		CH$ARG=2

		SIZE$C=4
	.ENDM

	.DEVCTL
	.IOSYS
	.IOERR
	.IOFUNC
	.IOCHN
	.JOBCTL

	NDEV=20
	NCHAN=20

	.IMAGE	IOSYS

	.CSECT

; I/O system initialization
; clear device table, register system calls
IOSYS:	MOV	#DEVTAB,R0
	MOV	#NDEV,R1	; clear DEVTAB
1$:	CLR	(R0)+
	SOB	R1,1$
	$REGSYS	#^RASS,#^ROC,#ASSOC,#0
	$REGSYS	#^RIOR,#^REQ,#IOREQ$,#0
	$REGSYS	#^RDIS,#^RSOC,#DISSOC,#0
	$REGSYS	#^RIOD,#^RONE,#IODONE,#0
	$TERM			; terminate

; ASSOC, associate interrupt handler with vector
; input: vector, handler address, PSW for handler
; output: handler & PSW is registered for vector
; return: none

	.MACRO	$ASSOC	VEC HND PSW
		$SYS	#^RASS,#^ROC,VEC,HND,PSW
	.ENDM

ASSOC:	.ENTRY
	MOV	6(R5),R0	; first argument: vector
	INC	R0
	BIC	#1,R0		; make it word-aligned
	CMP	#400,R0		; is it inside the vector area?
	BLOS	1$		; nay, error
	MOV	10(R5),(R0)+	; second argument: handler address
	MOV	12(R5),(R0)+	; third argument: PSW for handler
1$:	.RETRN

; DISSOC, dissociate handler from vector
; input: vector
; output: generic handler is registered for vector
; return: none

	.MACRO	$DISSOC	VEC
		$SYS	#^RDIS,#^RSOC,VEC
	.ENDM

DISSOC:	.ENTRY
	MOV	6(R5),R0	; argument: vector
	INC	R0
	BIC	#1,R0		; make it word-aligned
	CMP	#400,R0		; is it inside the vector area?
	BLOS	1$		; nay, error
	MOV	#GENHND,(R0)+	; use a generic handler
	CLR	(R0)+		; at priority level 0
1$:	.RETRN

; IODONE, clear I/O channel
; input: I/O request packet
; output: I/O channel of packet is cleared
; return: none

	.MACRO	$IODONE	IORQP
		$SYS	#^RIOD,#^RONE,IORQP
	.ENDM

IODONE:	.ENTRY
	MOV	6(R5),R4	; argument: I/O request packet
	MOVB	IO$CH(R4),R3	; get I/O channel number
	DEC	R3		; channel 0 has no entry, so decrement
	CMP	R3,#NCHAN	; inside valid range?
	BLO	1$		; yea, go on
	.RETRN
1$:	MOV	#SIZE$C,R2	; get size of a I/O channel
	MUL	R2,R3		; to create offset in I/O channel array
	$CURJOB			; get current job
	TST	R0		; no current job?
	BNE	2$		; nay, go on
	.RETRN
2$:	MOV	J$IOCH(R0),R2	; get I/O channel array
	ADD	R3,R2		; add offset
	CLR	CH$HND(R2)	; clear handler and argument
	CLR	CH$ARG(R2)
	.RETRN

; IOREQ, issue I/O request
; input: I/O request packet
; output: depends on function called
; return: carry set on unknown function or illegal I/O channel,R0 set to IO$INV
;         depends on function called otherwise

	.MACRO	$IOREQ	IORQP
		$SYS	#^RIOR,#^REQ,IORQP,#0
	.ENDM

	.MACRO	$READ	IORQP BSIZ BADR
		MOV	R5,-(SP)
		MOV	IORQP,R5
		MOVB	#IO$RDB,IO$FUN(R5)
		MOV	#4,IO$SIZ(R5)
		MOV	BSIZ,IO$DAT(R5)
		MOV	BADR,IO$DAT+2(R5)
		MOV	(SP)+,R5
		$IOREQ	IORQP
	.ENDM

	.MACRO	$WRIT	IORQP BSIZ BADR
		MOV	R5,-(SP)
		MOV	IORQP,R5
		MOVB	#IO$WRB,IO$FUN(R5)
		MOV	#4,IO$SIZ(R5)
		MOV	BSIZ,IO$DAT(R5)
		MOV	BADR,IO$DAT+2(R5)
		MOV	(SP)+,R5
		$IOREQ	IORQP
	.ENDM

	.MACRO	$SEEK	IORQP BCNT
		MOV	R5,-(SP)
		MOV	IORQP,R5
		MOVB	#IO$SKB,IO$FUN(R5)
		MOV	#2,IO$SIZ(R5)
		MOV	BCNT,IO$DAT(R5)
		MOV	(SP)+,R5
		$IOREQ	IORQP
	.ENDM
	
	.MACRO	$OPEN	IORQP NAM NUM TYPE
		MOV	R5,-(SP)
		MOV	IORQP,R5
		MOVB	#IO$OPN,IO$FUN(R5)
		MOV	#6,IO$SIZ(R5)
		MOV	NAM,IO$DAT(R5)
		MOV	NUM,IO$DAT+2(R5)
		MOV	TYPE,IO$DAT+4(R5)
		MOV	(SP)+,R5
		$IOREQ	IORQP
	.ENDM

	.MACRO	$CLOS	IORQP
		MOV	R5,-(SP)
		MOV	IORQP,R5
		MOVB	#IO$CLS,IO$FUN(R5)
		MOV	#2,IO$SIZ(R5)
		MOV	(SP)+,R5
		$IOREQ	IORQP
	.ENDM

	.MACRO	$BSIZ	IORQP
		MOV	R5,-(SP)
		MOV	IORQP,R5
		MOVB	#IO$BSZ,IO$FUN(R5)
		MOV	#2,IO$SIZ(R5)
		MOV	(SP)+,R5
		$IOREQ	IORQP
	.ENDM

	.MACRO	$MODE	IORQP,MODE
		MOV	R5,-(SP)
		MOV	IORQP,R5
		MOVB	#IO$MOD,IO$FUN(R5)
		MOV	#2,IO$SIZ(R5)
		MOV	MODE,IO$DAT(R5)
		MOV	(SP)+,R5
		$IOREQ	IORQP
	.ENDM

; The I/O request dispatcher will not use .ENTRY, this is supposed to be done
; by the I/O request handler for the selected channel. This means that no
; registers other than R0 and R1 may be changed.
IOREQ$:	TST	4(R5)		; test second argument
	BNE	1$		; nonzero? -> error
	MOV	2(R5),R0	; first argument: I/O request packet
	INC	R0
	BIC	#1,R0		; make it word-aligned
	MOV	R0,R1
	TSTB	(R1)		; check I/O channel number
	BEQ	IOCTL		; shortcut to IOCTL if zero
	MOVB	(R1),R0		; get I/O channel number
	DEC	R0		; channel 0 has no entry, so decrement
	CMP	#NCHAN,R0	; inside valid range?
	BLOS	1$		; nay, error
	ASH	#2,R0		; shift to create offset
	MOV	R0,-(SP)	; store for later use
	$CURJOB			; get current job
	MOV	R0,R1
	MOV	(SP)+,R0	; restore I/O channel number
	TST	R1		; test current job
	BEQ	2$		; no job? -> error
	MOV	J$IOCH(R1),R1	; get I/O channel array
	BEQ	2$		; no I/O channels? -> error
	ADD	R1,R0		; add offset
	MOV	CH$ARG(R0),4(R5); save handler argument as second argument
	MOV	CH$HND(R0),R0	; get handler address
	BEQ	2$		; no handler? -> error
	JMP	(R0)		; dispatch to handler
2$:	MOV	2(R5),R1	; restore I/O request packet
1$:	MOV	#IO$INV,R0	; this was an invalid request
	SEC			; indicate error
	RTS	R5

; IOCTL, I/O request handler for I/O channel 0
IOCTL:	MOVB	IO$FUN(R1),R0	; get I/O function number
	ASL	R0		; shift to create offset
	CMP	R0,#IO$END-IO$TAB	; inside valid range?
	BHI	1$		; nay, error
	JMP	@IO$TAB(R0)	; dispatch to I/O function
1$:	MOV	#IO$INV,R0	; this was an invalid request
	SEC			; indicate error
	RTS	R5

; GETDEV, READ function for channel 0
; input: output buffer and buffer size
; output: device structures in output buffer
; return: carry set on error, cleared otherwise,
;         R0 number of device structures read
GETDEV:	.ENTRY
	MOV	6(R5),R0	; first argument: I/O request packet
	CMP	IO$SIZ(R0),#4	; READ should have a size of 4
	BNE	1$		; unequal? -> error
	SUB	#SIZE$D,IO$DAT(R0)	; is the buffer large enough?
	BMI	1$		; nay, error
	CLR	-(SP)		; read count
4$:	MOV	IO$OFS(R0),R3	; resume any previous read
	CMP	#NDEV,R3	; no more devices left?
	BLOS	2$		; yea, return EOF
	ASL	R3		; shift to create offset
	MOV	DEVTAB(R3),R3	; get device structure
	BEQ	2$		; zero entry? return EOF
	MOV	IO$DAT+2(R0),R2	; get output buffer
	MOV	#SIZE$D,R1
3$:	MOVB	(R3)+,(R2)+	; copy device structure
	SOB	R1,3$
	INC	IO$OFS(R0)	; increment offset for subsequent reads
	INC	(SP)		; increment read count
	SUB	#SIZE$D,IO$DAT(R0)	; more to read?
	BPL	4$		; yea, read another
	MOV	(SP)+,R0	; return read count
	CLC			; no error
	.RETRN
2$:	MOV	#IO$EOF,R0	; EOF was reached
	SEC			; indicate error
	.RETRN
1$:	MOV	#IO$INV,R0	; this was an invalid request
	SEC			; indicate error
	.RETRN

; REGDEV, WRITE function for I/O channel 0
; input: pointer to device structure, size of device structure
; output: pointer to device structure is saved in device table, device name
;         event will be $DONE
; return: carry set on error, cleared otherwise
REGDEV:	.ENTRY
	MOV	6(R5),R4	; argument: I/O request packet
	CMP	IO$SIZ(R4),#4	; WRIT should have a size of 4
	BNE	1$		; unequal -> error
	CMP	#SIZE$D,IO$DAT(R4)	; size of a device structure?
	BNE	1$		; nay, error
	CLR	R1
3$:	TST	DEVTAB(R1)	; free device table entry?
	BEQ	2$		; yea, insert here
	ADD	#2,R1		; get next entry
	CMP	R1,#NDEV*2	; end of table?
	BNE	3$		; nay, continue
	MOV	#IO$BSY,R0	; no free entry found
	SEC			; indicate error
	.RETRN
2$:	MOV	IO$DAT+2(R4),DEVTAB(R1)	; save pointer to device structure 
					; no copy is made
	MOV	DEVTAB(R1),R4	; get device
	$DONE	D$NAME(R4),D$NUM(R4)
	CLR	R0		; no error
	CLC
	.RETRN
1$:	MOV	#IO$INV,R0	; invalid request
	SEC			; indicate error
	.RETRN

; IOINIT, CLOSE routine for I/O channel 0
; input: none
; output: new I/O channel array allocated for job, old one returned to system
;         if it existed
; return: carry set on error, cleared otherwise
IOINIT:	.ENTRY
	MOV	6(R5),R4	; argument: I/O request packet
	CMP	#2,IO$SIZ(R4)	; CLOS should have a size of 2
	BNE	1$		; unequal -> error
	$CURJOB			; get current job
	TST	R0
	BEQ	1$		; no job? -> error
	MOV	R0,R3
	TST	J$IOCH(R3)	; test I/O channel array
	BEQ	2$		; don't free channel list if unexistant
	$M$FREE	J$IOCH(R3)	; free I/O channel array
2$:	$M$ALLO	#0,#NCHAN*SIZE$C,#^RUSR,#^RIOC,#^RHAN	; allocate new array
	BCC	3$		; continue if no error
	MOV	#IO$INT,R0	; internal error
	BR	5$		; get out
3$:	MOV	R0,J$IOCH(R3)	; save new array in job structure
	MOV	#NCHAN,R1
6$:	CLR	(R0)+		; clear new I/O channel array
	CLR	(R0)+
	SOB	R1,6$
	CLR	R0		; no error
	CLC
	.RETRN
1$:	MOV	#IO$INV,R0	; invalid request
5$:	SEC			; indicate error
	.RETRN

; IOOPEN, OPEN function for I/O channel 0
; input: device name, number and type
; output: device is opened, I/O channel created
; return: carry set on error, cleared otherwise
;         R0 new I/O channel number
IOOPEN:	.ENTRY
	MOV	6(R5),R4	; argument: I/O request packet
	CMP	#6,IO$SIZ(R4)	; OPEN should have a size of 6
	BNE	1$		; unequal -> error
	$CURJOB			; get current job
	TST	R0
	BEQ	1$		; no job? -> error
	MOV	R0,R3
	TST	J$IOCH(R3)
	BEQ	1$		; no I/O channel array? -> error
	MOV	J$IOCH(R3),R3
	MOV	#NCHAN,R0
2$:	TST	(R3)+		; search first free channel
	BEQ	3$		; found, use it
	TST	(R3)+
	SOB	R0,2$
	BR	1$
3$:	TST	-(R3)		; rewind to free channel
	MOV	R0,-(SP)	; save for later reuse
	MOV	#DEVTAB,R1
	MOV	#NDEV,R0
4$:	MOV	(R1)+,R2	; look for matching device
	CMP	IO$DAT(R4),D$NAME(R2)
	BNE	5$
	CMP	IO$DAT+2(R4),D$NUM(R2)
	BNE	5$
	CMP	IO$DAT+4(R4),D$TYPE(R2)
	BEQ	6$
5$:	SOB	R0,4$
	BR	1$		; no matching device found? error
6$:	.CALL	@D$OPEN(R2),R2	; call driver open routine
	BCS	7$		; abort on error
	MOV	D$IORQ(R2),CH$HND(R3)	; use driver I/O request handler
	MOV	R0,CH$ARG(R3)	; use driver supplied argument
	MOV	#NCHAN+1,R0
	SUB	(SP)+,R0	; calculate I/O channel number
	CLC			; no error

	.RETRN
7$:	MOV	#IO$BSY,R0	; request aborted, system busy
	SEC			; indicate error
	.RETRN
1$:	MOV	#IO$INV,R0	; invalid request
	SEC			; indicate error
	.RETRN

; IOBSIZ, BSIZE function for I/O channel 0
; input: none
; output: none
; return: carry set on error, cleared otherwise
;         R0 size of device structure
IOBSIZ:	.ENTRY
	MOV	6(R5),R0	; argument: I/O request packet
	CMP	#2,IO$SIZ(R0)	; BSIZ should have a size of 2
	BNE	1$		; unequal -> error
	MOV	#SIZE$D,R0	; return size of device structure
	CLC			; no error
	.RETRN
1$:	MOV	#IO$INV,R0	; invalid request
	SEC			; indicate error
	.RETRN

; IOSEEK, SEEK function for I/O channel 0
; input: number of blocks to seek
; output: offset in I/O request packet adjusted by seek amount
; return: carry set on error, cleared otherwise
IOSEEK:	.ENTRY
	MOV	6(R5),R0	; argument: I/O request packet
	CMP	#2,IO$SIZ(R0)	; SEEK should have a size of 2
	BNE	1$		; unequal -> error
	ADD	IO$DAT(R0),IO$OFS(R0)	; adjust offset
	CLC			; no error
	.RETRN
1$:	MOV	#IO$INV,R0	; invalid request
	SEC			; indicate error
	.RETRN

GENHND:	RTI

	.PSECT	DATA
	.IOTAB	GETDEV,REGDEV,IOSEEK,IOOPEN,IOINIT,IOBSIZ
DEVTAB::.BLKW	NDEV
	.END	IOSYS