.TITLE	PCACP - PAPER TAPE READER/PUNCH ACP
	.IDENT	/V02/

;++
;
; PCACP - PAPER TAPE READER/PUNCH ACP
;
;	THE PAPER TAPE ACP IS INTENDED TO SERVE AS A MODEL FROM
;	WHICH MORE USEFUL ACPS CAN BE CONSTRUCTED.  THE ACP ONLY
;	SERVES THE MOUNT, ACPCONTROL, AND WRITEOF I/O FUNCTION CODES.
;
; PROGRAMMER
;
;	VIK MUIZNIEKS   JULY -- 1979
;
;--
;
;	DEFINE SYMBOLS AND OFFSETS (SOME FROM LIB.MLB)
;
	$AQBDEF
	$JPIDEF
	$UCBDEF
	$VCBDEF
	$IODEF
	$SSDEF
	$IRPDEF
	$IPLDEF
	$PRDEF
;
;	DEFINE CONSTANTS USED BY THE ACP
;
PC_ACP_TYPE=200					; PAPER TAPE ACP TYPE
;
;	LOCAL STORAGE
;
AQB_HEAD: .LONG					; AQB HEADER ADDRESS
PID:	.BLKL	1				; ACP PROCESS ID
;
;	LIST OF ITEMS FOR $GETJPI TO RETRIEVE
;
GETLIST:.WORD	4				; LENGTH OF BUFFER
	.WORD	JPI$_PID			; REQUEST PID
	.LONG	PID				; ADDR. TO RECEIVE PID
	.LONG	0				; NO LENGTH REQUIRED
	.LONG	0				; END OF GETLIST
;
;	ADDRESSES FOR LOCK WORKING SET SYSTEM SERVICE
;
LKWSET:	.LONG	START_LOCK			; STARTING ADDRESS
	.LONG	END_LOCK			; ENDING ADDRESS
;
;	ENTRY POINT INTO ACP
;
START:	.WORD	0				; NULL ENTRY MASK
	$CMKRNL_S	B^BEGIN			; CHANGE MODE TO KERNEL
	RET					; GET HERE ONLY IF ERROR
BEGIN:	.WORD	0				; SAVE NO REGISTERS
	$GETJPI_S	ITMLST=GETLIST		; GET ACP PID
	MOVAB	G^IOC$GL_AQBLIST,R1		; GET ACP LIST HEAD
	MOVL	(R1),R0				; POINT TO FIRST AQB
10$:	CMPL	W^PID,AQB$L_ACPPID(R0)		; FOUND RIGHT AQB?
	BEQL	FOUND				; IF EQL, YES
	MOVL	AQB$L_LINK(R0),R0		; GET NEXT LINK
	BNEQ	10$				; AND LOOP
	MOVL	#SS$_NOAQB,R0			; AQB NOT FOUND
	RET
FOUND:
	MOVL	R0,AQB_HEAD			; SAVE AQB ADDRESS
	BBSC	#AQB$V_CREATING,AQB$B_STATUS(R0),10$ ; FOR SYNCH.
	MOVZWL	#SS$_WRONGACP,R0		; RETURN ERROR STATUS
	RET					; IF NOT IN SYNCH
10$:	$LKWSET_S	W^LKWSET		; LOCK IODONE IN W.S.
			;
			;#############################################
			;#############################################
			; THIS IS WHERE YOU WOULD PUT ANY OTHER ONE-
			; TIME INITIALIZATION CODE (E.G., ASSIGNING
			; CHANNELS TO DEVICES, INITIALIZING QUEUES,
			; COUNTERS, POINTERS, ETC.
			;#############################################
			;#############################################
			;
	BRW	ACP_MAIN			; TRY TO DEQUE IRP
HIBER:	$HIBER_S				; WAIT FOR IRP
ACP_MAIN:
	MOVL	AQB_HEAD,R2			; GET AQB ADDRESS
	REMQUE	@(R2),R3			; LOOK FOR IRP
	BVC	10$				; IF VC, FOUND IRP
;
;	NOTHING IN QUEUE, SEE IF TIME TO DISMOUNT
;
	TSTB	AQB$B_MNTCNT(R2)		; ANY VOLUMES MOUNTED?
	BNEQ	HIBER				; IF NEQ, YES
	BSBW	CHK_ACP_DONE			; TIME TO DISMOUNT?
	BRB	ACP_MAIN			; DIDN'T DISMOUNT SINCE
						; AN IRP IN AQB QUEUE
10$:
;
;	THERE WAS AN IRP IN THE AQB QUEUE
;
	MOVL	IRP$L_UCB(R3),R5		; GET UCB ADDRESS
	MOVW	IRP$W_FUNC(R3),R7		; GET I/O FUNC. CODE
;
;	CHECK I/O FUNCTION CODE
;
	CMPZV	S^#IO$V_FCODE,S^#IO$S_FCODE,R7,-; CHECK FOR MOUNT
		S^#IO$_MOUNT			; FUNCTION CODE
	BEQL	MOUNT				; FOUND MOUNT IF EQL
	CMPZV	S^#IO$V_FCODE,S^#IO$S_FCODE,R7,-; CHECK FOR WRITEOF
		S^#IO$_WRITEOF			; FUNCTION CODE
	BEQL	WRITEOF				; FOUND WRITEOF IF EQL
	CMPZV	S^#IO$V_FCODE,S^#IO$S_FCODE,R7,-; CHECK FOR ACPCONTROL
		S^#IO$_ACPCONTROL		; FUNCTION CODE
	BEQL	ACPCONTROL			; FOUND IF EQUAL
	MOVL	#SS$_ILLIOFUNC,R0		; I/O FUNC ILLEGAL
	BSBW	BAD_IO				; REPORT IT
	BRW	ACP_MAIN			; GET NEXT IRP
MOUNT:	MOVL	#SS$_WRONGACP,R0		; ASSUME WRONG ACP
	CMPB	#PC_ACP_TYPE,AQB$B_ACPTYPE(R2)	; CHECK ACP TYPE
	BNEQ	10$				; IF NEQ, ERROR
	BISL	#DEV$M_MNT,UCB$L_DEVCHAR(R5)	; SET MOUNTED BIT
	BSBW	GOOD_IO				; QUEUE SUC. IRP
	BRW	ACP_MAIN			; GET NEXT IRP
10$:	BSBW	BAD_IO				; ERROR IN IRP
	BRW	ACP_MAIN			; GET NEXT IRP
WRITEOF:
	MOVW	#IO$_WRITEVBLK,IRP$W_FUNC(R3)	; CHANGE FUNCTION CODE
			;
			;###############################################
			;###############################################
			; HERE IS WHERE YOU WOULD EXTRACT, MODIFY, OR
			; INSERT FIELDS IN THE IRP, AND DO WHATEVER IT
			; IS THAT YOUR ACP DOES (MANAGE QUEUES, ISSUE
			; QIOS, ETC.).  IT IS AT THIS POINT WHERE THE
			; "ACP-SPECIFIC" PARTS OF YOUR ACP ARE PLACED.
			;###############################################
			;###############################################
			;
	JSB	G^EXE$INSIOQ			; QUEUE IRP TO DRIVER
						; AT START I/O ENTRY PT.
						; (MUST HAVE R3=IRP ADDR
						; AND R5=UCB ADDRESS)
	MOVL	UCB$L_VCB(R5),R0		; GET VCB ADDRESS
	DECW	VCB$W_TRANS(R0)			; ANOTHER TRANS. DONE
	BSBW	DMT_CHK				; CHECK FOR DISMOUNT
						; (NOTE IOPOST INVOKED
						; BY DRIVER)
	BRW	ACP_MAIN			; GET NEXT IRP
ACPCONTROL:
	BSBW	GOOD_IO				; COMPLETE IMMEDIATELY
			;
			; ACPCONTROL QIO USED TO AWAKEN ACP FROM
			; HIBERNATION SO THAT ACP WILL DISMOUNT
			; ITSELF WHEN DISMOUNT BIT SET IN UCB BY
			; DISMOUNT IMAGE (PCDMT).
			;
	BRW	ACP_MAIN			; PROCESS NEXT IRP IF
						; ACP NOT DISMOUNTING
;
; CHK_ACP_DONE
;
;	THIS SUBROUTINE CHECKS TO SEE IF THE ACP SHOULD BE
;	DISMOUNTED. IF SO, IT RELEASES SYSTEM RESOURCES, AND
;	DELETES THE ACP PROCESS.  IF THE ACP SHOULD NOT BE
;	DISMOUNTED, IT SIMPLY RETURNS.
;
; CALLED VIA BSB INSTRUCTION
;
; INPUTS:
;
;	R2 = AQB ADDRESS
;
; SIDE EFFECTS:
;
;	ACP MAY BE DELETED
;	R0 AND R1 DESTROYED
;
CHK_ACP_DONE:
	CALLS	#0,W^LOCKDB			; LOCK I/O DATA BASE
	CMPL	AQB$L_ACPQFL(R2),R2		; ANY I/O IN QUEUE?
	BNEQ	100$				; IF NEQ, YES
;
;	NO MORE I/O -- DELETE ACP AFTER REMOVING AQB FROM LIST
;
	MOVAB	G^IOC$GL_AQBLIST,R1		; GET LIST ADDRESS
	MOVL	(R1),R0				; GET 1ST AQB POINTER
	CMPL	R2,R0				; FOUND RIGHT AQB?
	BNEQ	20$				; IF NEQ, NO
	MOVL	AQB$L_LINK(R2),(R1)		; RELINK
	BRB	40$				; DEALLOCATE AQB
20$:	CMPL	AQB$L_LINK(R0),R2		; FOUND AQB?
	BEQL	30$				; IF EQL, YES
	MOVL	AQB$L_LINK(R0),R0		; GET NEXT AQB
	BRB	20$				; LOOP
30$:	MOVL	AQB$L_LINK(R2),AQB$L_LINK(R0)	; RELINK
40$:	MOVL	R2,R0				; LOCATE AQB
	JSB	G^EXE$DEANONPAGED		; AND DEALLOCATE
	CALLS	#0,W^UNLOCKDB			; UNLOCK I/O DATA BASE
	$DELPRC_S				; ALL DONE - TERMINATE
100$:	CALLS	#0,W^UNLOCKDB			; UNLOCK I/O DATA BASE
	RSB					; RETURN, SINCE ACP 
						; NOT DELETED
;
; GOOD_IO 
; BAD_IO
;
;	THESE ROUTINES QUEUE AN IRP TO IOPOST.  GOOD_IO IS USED IF
;	A SUCCESS STATUS CODE IS TO BE RETURNED TO THE USER.  BAD_IO
;	IS USED IF AN ERROR STATUS IS TO BE RETURNED TO THE USER.
;	SINCE IPL WILL BE RAISED TO SYNCH, THE ROUTINES ARE LOCKED
;	INTO THE WORKING SET (TO AVOID TAKING A PAGE FAULT ABOVE
;	IPL 2, WHICH CAUSES A SYSTEM BUGCHECK).
;
; CALLED VIA BSB
;
; INPUTS:
;
;	R5 = ADDRESS OF UCB
;	R3 = ADDRESS OF IRP
;	R0 = ERROR STATUS CODE (IN BAD_IO CASE)
;
; SIDE EFFECTS:
;
;	I/O POSTED TO USER
;	UCB AND VCB FIELDS UPDATED TO REFLECT I/O OPERATION
;	R0 AND R1 DESTROYED
;
START_LOCK:					; LABEL FOR LKWSET
GOOD_IO:
	MOVZWL	#SS$_NORMAL,R0			; SET UP FOR IOSB
BAD_IO:
	CLRL	R1				; NO DEV. DEP. INFO.
	MOVQ	R0,IRP$L_MEDIA(R3)		; RECORD IOSB IN IRP
	INCL	UCB$L_OPCNT(R5)			; ANOTHER I/O COMPLETE
	MOVL	UCB$L_VCB(R5),R0		; GET VCB ADDRESS
	DECW	VCB$W_TRANS(R0)			; ANOTHER TRANS. DONE
;
;	POST I/O TO USER
;
	MOVAL	G^IOC$GL_PSBL,R1		; GET IOPOST Q LISTHEAD
	INSQUE	(R3),@(R1)			; QUEUE IRP FOR IOPOST
	BNEQ	DMT_CHK				; IF NEQ, Q NOT EMPTY
	SOFTINT	#IPL$_IOPOST			; REQUEST IOPOST INT.
;
;	ENTRY POINT FOR CHECKING TO SEE IF ACP IS MARKED FOR DISMOUNT
;	CALLED WHEN AN IRP IS NOT PLACED ONTO THE IOPOST
;	QUEUE BY THE ACP.
;
DMT_CHK:BBC	S^#DEV$V_DMT,UCB$L_DEVCHAR(R5),20$ ; IF BC, NOT MARKED
						; FOR DISMOUNT
	PUSHL	R4				; SAVE R4
	CALLS	#0,W^LOCKDB			; LOCK I/O DATABASE
	SETIPL	#IPL$_SYNCH			; RAISE TO SYNCH
	MOVL	UCB$L_VCB(R5),R0		; GET VCB ADDRESS
	MOVL	VCB$L_AQB(R0),R4		; GET AQB ADDRESS
	CMPW	VCB$W_TRANS(R0),#1		; IS ACP IDLE?
	BNEQ	15$				; IF NEQ, NO
	BICL	#DEV$M_MNT!DEV$M_DMT,UCB$L_DEVCHAR(R5) ; DEVICE DISM.
	CLRL	UCB$L_VCB(R5)			; NO MORE VCB
	JSB	G^EXE$DEANONPAGED		; DEALLOCATE VCB
	DECB	AQB$B_MNTCNT(R4)		; ONE LESS VOLUME MNT.
15$:	POPL	R4				; RESTORE R4
	CALLS	#0,W^UNLOCKDB			; UNLOCK I/O DATA BASE
20$:	RSB					; RETURN TO PROCESSING
LOCKDB:		.WORD	^M<R2,R3,R4,R5>		; SAVE REGISTERS
	MOVAL	G^IOC$GL_MUTEX,R0		; GET I/O DATABASE MUTEX
	MOVL	G^SCH$GL_CURPCB,R4		; GET PCB ADDRESS
	JSB	G^SCH$LOCKW			; LOCK MUTEX
	RET
UNLOCKDB: 	.WORD	^M<R2,R3,R4,R5>		; SAVE REGISTERS
	MOVAL	G^IOC$GL_MUTEX,R0		; GET I/O DATABASE MUTEX
	MOVL	G^SCH$GL_CURPCB,R4		; GET PCB ADDRESS
	JSB	G^SCH$UNLOCK			; UNLOCK MUTEX
	SETIPL	#0				; LOWER IPL
	RET
END_LOCK:					; LABEL FOR LKWSET
	.END	START