.TITLE PBFIL
;
;	THIS FILE CONTAINS A SET OF FORTRAN CALLABLE SUBROUTINES TO USE
;	LK11 PUSHBUTTON BOX VIA THE PB: DRIVER.
;
;	CALLING PROCEDURES:
;
;		CALL PBATT(LUN,[IOST],[IDS])
;
;			ATTACHES THE PB: UNIT, SPECIFIED BY THE "LUN" ARGUMENT
;			LUN:  LOGICAL UNIT NUMBER
;			IOST: I/O STATUS IN LOW ORDER BYTE (OPTIONAL)
;			IDS:  DIRECTIVE STATUS (OPTIONAL)
;
;		CALL PBDET(LUN,[IOST],[IDS])
;
;			DETACHES THE PB: UNIT.
;			SAME ARGUMENTS AS IN PBATT.
;
;		CALL PBKIL(LUN,[IOST],[IDS])
;
;			KILLS OUTSTANDING I/O ON LOGICAL UNIT NUMBER "LUN".
;			SAME ARGUMENTS AS IN PBATT.
;
;		CALL PBSET(LUN,[IOST],[IDS])
;
;			SET UNIT, ASSIGNED TO "LUN".
;			SAME ARGUMENTS AS IN PBATT.
;
;		CALL PBCLR(LUN,[IOST],[IDS])
;
;			CLEARS UNIT, ASSIGNED TO "LUN".
;			SAME ARGUMENTS AS IN PBATT.
;
;		IF(PBSTAT(LUN,[IOST],[IDS])) GO TO 10
;		OR: CALL PBSTAT(LUN,[IOST],[IDS],[STAT])
;
;			"PBSTAT" IS A LOGICAL FUNCTION AND WILL REFLECT
;			THE STATUS OF THE UNIT SPECIFIED [ON/OFF].
;			IF THE SUBROUTINE IS USED, THE LOGICAL "STAT" WILL
;			CONTAIN THE STATUS.
;			SAME ARGUMENTS AS IN PBATT.
;
;		IF(PBRAL(LUN,[IOST],[IDS])) GO TO 10
;		OR: CALL PBRAL(LUN,[IOST],[IDS],[IVAL])
;
;			"PBRAL" IS AN INTEGER FUNCTION WHICH CONTAINS
;			THE 16 BIT STATUS OF THE LK11.
;			IF THE SUBROUTINE IS USED, "IVAL" REFLECTS THIS
;			STATUS.
;			SAME ARGUMENTS AS IN PBATT.
;
;		CALL PBAST(LUN,IEFN,[AST],[IDS])
;
;			A CALL TO THIS ROUTINE WILL INITIATE AN I/O REQUEST,
;			WHICH WILL BE COMPLETED BY PUSHING THE BUTTON, SPECIFIED
;			BY THE "LUN" ARGUMENT. AT COMPLETION THE EVENTFLAG WILL
;			BE SET AND AN USER SUPPLIED AST ROUTINE WILL BE ENTERED,
;			IF WANTED.
;			THE I/O STATUS WILL BE RETURNED AS ARGUMENT IN THE AST
;			ROUTINE.
;
;			LUN:  LOGICAL UNIT NUMBER
;			IEFN: EVENT FLAG NUMBER
;			AST:  ADDRESS OF AST ROUTINE (OPTIONAL)
;			IDS:  DIRECTIVE STATUS (OPTIONAL)
;
;
;******************************************************************************
;
	.MCALL QIO$S,ASTX$S,GLUN$S
	.GLOBL PBSET,PBCLR,PBSTAT,PBAST,PBATT,PBDET,PBKIL,PBRAL
;
;
SET:	.WORD 0				;LOCAL STORAGE FOR PBSET AND PBCLR
STAT:	.WORD 0				;LOCATION TO RECEIVE THE UNIT STATUS
IOST:	.BLKW 2				;I/O STATUS BLOCK
;
;
PBATT:	TSTB (R5)			;IF NUM OF ARG = 0, RETURN
	BLE RTS
	QIO$S #IO.ATT,@2(R5),,,#IOST	;ELSE ATTACH UNIT
;
;	COMMON EXIT OF SEVERAL ROUTINES
;
COMRTS:	CMPB #1,(R5)			;NUMBER OF ARGUMENTS SPECIFIED = 1??
	BEQ RTS				;IF EQ YES, SO RETURN TO CALLER
	CMP #-1,4(R5)			;DUMMY ARGUMENT??
	BEQ N0				;IF EQ YES, SO DON'T FILL IT
	MOV IOST,@4(R5)			;IF NOT RETURN I/O STATUS
N0:	CMPB #2,(R5)			;NUM OF ARG = 2??
	BEQ RTS				;IF EQ YES, SO RETURN
	CMP #-1,6(R5)			;DUMMY ARGUMENT??
	BEQ RTS				;IF EQ YES, SO RETURN
	MOV $DSW,@6(R5)			;IF NOT RETURN $DSW ALSO
RTS:	RTS PC				;RETURN TO CALLER
;
;
PBDET:	TSTB (R5)				;IF NUM OF ARGUMENTS = 0, RETURN
	BLE RTS
	QIO$S #IO.DET,@2(R5),,,#IOST		;ELSE DETACH UNIT
	BR COMRTS			;BRANCH TO COMMON RETURN
;
;
PBKIL:	TSTB (R5)			;IF NUM OF ARG = 0, RETURN
	BLE RTS
	QIO$S #IO.KIL,@2(R5),,,#IOST	;KILL THE OUTSTANDING I/O
	GLUN$S @2(R5),#LUNBUF		;GET LUN INFO
	MOV R4,-(SP)			;SAVE R4
	MOV LUNBUF+2,R4			;GET UNIT NUMBER
	BIC #177760,R4			;0 >= R4 <= 15
	ASL R4				;R4 = 0,2,4....
	MOV R4,-(SP)
	ASL R4				;R4 = 0,4,10....
	ADD (SP)+,R4			;R4=0,6,14....
	CLR IOST0+4(R4)			;CLEAR AST ADDRESS LOCATION FOR UNIT
	MOV (SP)+,R4
	BR COMRTS			;BRANCH TO COMMON RETURN
;
;
PBSET:	TSTB (R5)			;IF NUM OF ARG = 0, RETURN
	BLE RTS
	MOV #-1,SET			;SET VALUE TO .TRUE.
DOIT:	QIO$S #IO.WVB,@2(R5),,,#IOST,,<#SET,#2>	;SET/RESET STATUS OF UNIT
	BR COMRTS			;BRANCH TO COMMON RETURN
;
;
PBCLR:	CLR SET				;SET VALUE TO .FALSE.
	BR DOIT				;AND ACTIVATE DRIVER
;
;
PBSTAT:	TSTB (R5)			;IF NUM OF ARG = 0, RETURN
	BLE RTS
	QIO$S #IO.RVB,@2(R5),,,#IOST,,<#STAT,#2>	;GET STATUS
PBS0:	MOV STAT,R0			;RETURN VALUE
	CMPB #4,(R5)			;MORE THAN 3 ARGUMENTS??
	BGT N1			;IF GT NO, SO IT WAS A FUNCTION CALL
	CMP #-1,10(R5)			;DUMMY ARGUMENT??
	BEQ N1				;IF EQ YES, SO DON'T FILL IT
	MOV STAT,@10(R5)		;YES, SO COPY STATUS INTO 4TH ARGUMENT.
N1:	JMP COMRTS			;BRANCH TO COMMON RETURN
;
;
PBRAL:	TSTB (R5)			;IF NUM OF ARG = 0, RETURN
	BLE RTS
	QIO$S #IO.RAL,@2(R5),,,#IOST,,<#STAT,#2>	;GET 16-BIT STATUS
	BR PBS0				;RETURN STATUS TO USER
;
;
PBAST:	CMPB #1,(R5)			;IF NUM OF ARG < 2, RETURN
	BGE RTSPC
	GLUN$S @2(R5),#LUNBUF		;GET LUN INFO
	MOV R4,-(SP)			;SAVE R4
	MOV LUNBUF+2,R4			;GET UNIT NUMBER
	BIC #177760,R4			;MAKE SURE R4 LIES BETWEEN 0 AND 15
	ASL R4				;R4 = 0,2,4,.....
	MOV R4,-(SP)			;SAVE R4
	ASL R4				;R4 = 0,4,10,....
	ADD (SP)+,R4			;R4 = 0,6,14,.... (=6*UNIT)
	TST IOST0+4(R4)			;SEE IF LOCATION IS FREE (=0)
	BEQ FREE			;IF EQ YES
	MOV #IE.IOP,$DSW		;SET I/O IN PROGRESS ERROR CODE
	BR RETDSW			;RETURN CODE IF WANTED.
FREE:	MOV #-1,IOST0+4(R4)		;PRESET AST ADDRESS LOCATION (=-1)
	CMPB #2,(R5)			;AST ADDRESS SPECIFIED??
	BGE QIO				;IF GE NO
	MOV 6(R5),IOST0+4(R4)		;INSERT AST ADDRESS IN TABEL
QIO:	ADD #IOST0,R4
	QIO$S #IO.CON,@2(R5),@4(R5),,R4,#AST	;CONNECT UNIT
RETDSW:	CMPB #3,(R5)			;NUM OF ARGUMENTS > 3??
	BGE RESTR4			;IF GE NO
	CMP #-1,10(R5)			;DUMMY ARGUMENT??
	BEQ RESTR4			;IF EQ YES, SO DON'T RETURN $DSW
	MOV $DSW,@10(R5)		;RETURN $DSW TO CALLER
RESTR4:	MOV (SP)+,R4			;RESTORE R4
RTSPC:	RTS PC				;RETURN TO CALLER
;
;	I/O STATUS AND AST ADDRESS TABEL OF ALL 16 UNITS
;
IOST0:	.BLKW 2				;I/O STATUS OF UNIT 0
	.WORD 0				;LOCATION FOR AST ADDRESS ON UNIT 0
IOST1:	.BLKW 2				;SAME FOR UNIT 1
	.WORD 0				;SAME FOR UNIT 1
IOST2:	.BLKW 2				;ETC......
	.WORD 0	
IOST3:	.BLKW 2
	.WORD 0	
IOST4:	.BLKW 2
	.WORD 0	
IOST5:	.BLKW 2
	.WORD 0	
IOST6:	.BLKW 2
	.WORD 0	
IOST7:	.BLKW 2
	.WORD 0	
IOST10:	.BLKW 2
	.WORD 0	
IOST11:	.BLKW 2
	.WORD 0	
IOST12:	.BLKW 2
	.WORD 0	
IOST13:	.BLKW 2
	.WORD 0	
IOST14:	.BLKW 2
	.WORD 0	
IOST15:	.BLKW 2
	.WORD 0	
IOST16:	.BLKW 2
	.WORD 0	
IOST17:	.BLKW 2
	.WORD 0	
;
;	ENTRY POINT FOR ALL AST'S SPECIFIED.
;	HERE WE HAVE TO FIND OUT WHICH UNIT'S I/O REQUEST IS COMPLETED NOW.
;	BY MEANS OF THE I/O STATUS AND AST ADDRESS TABLE WE ARE ABLE TO
;	CALL THE AST ROUTINE WHICH BELONGS TO THE I/O STATUS BLOCK, THE
;	ADDRESS OF WHICH IS RETURNED ON THE STACK.
;	HOWEVER, IF THIS LOCATION CONTAINS A 0, DON'T DO IT.
;	WE ALSO HAVE TO SET THE AST ADDRESS LOCATION FREE (=0).
;
;
AST:	MOV (SP),TEMP			;SAVE I/O STATUS ADDRESS
	MOV R5,(SP)			;SAVE R5
	MOV TEMP,R5			;R5 = I/O STATUS ADDRESS
	MOV (R5),ARG1			;RETURN I/O STATUS AS ARGUMENT
					;FOR USERS AST ROUTINE.
	MOV 4(R5),ASTADR		;GET USERS AST ROUTINE ADDRESS
	CLR 4(R5)			;SET LOCATION FREE FOR NEXT REQUEST
	CMP#-1,ASTADR			;IF -1, EXIT AST (DUMMY OR NO ARGUMENT)
	BEQ ASTEX
	MOV #ARGBLK,R5			;ELSE SETUP ARGUMENT POINTER
	JSR PC,@ASTADR			;AND CALL USERS ROUTINE
ASTEX:	MOV (SP)+,R5			;RESTORE R5 AND CLEAN STACK
	ASTX$S				;AST EXIT
;
LUNBUF:	.BLKW 6				;LOCAL STORAGE FOR LUN INFO
ASTADR:	.WORD 0				;STORAGE FOR USER'S AST ROUTINE ADDRESS
ARGBLK:	.WORD 1				;ARGUMENT LIST FOR USERS AST ROUTINE
					;NUMBER OF ARGUMENTS = 1
	.WORD ARG1			;1ST ARG: ADDRESS OF I/O STATUS BLOCK
ARG1:	.WORD 0				;CONTAINS I/O STATUS
TEMP:	.WORD 0				;LOCAL STORAGE
;
;
	.END