;	VGUARD - used to set/reset VTAM ownership
;
;       Copyright [c] Noel Alaska Systems Technology, 1983.
 
VMAJOR	=	2.			; version equates
VMINOR	=	2.
VSUB	=	0.
VEDIT	=	0.			; CHANGE EACH EDIT <-----------
VWHO	=	0.
 
        SEARCH  SYS                     ; AMOS librarys
        SEARCH  SYSSYM
	SEARCH	TRM
	SEARCH	VTAMEQ			; My library
 
        DSECT
        .=0				; define impure area
QBEG:	BLKL	1
MINE:	BLKL	1
WORKA:	BLKW	10			; impure area
        EVEN
IMPURE  =       .
        .=0
        PSECT

BEGIN:  PHDR    -1,-1,PH$REE!PH$REU
        GETIMP  IMPURE,A4               ; get memory

	BYP				; bypass spaces/tabs
	LIN				; anything entered?
	JEQ	WHAT			;   NO
	LEA	A1,WORKA(A4)		;   YES - save it
	PACK

	JOBIDX	A0			; set JCB pointer
	MOV	A0,MINE(A4)

	MOV	TRMIDC,A1		; find VTAM.IDV
	MOV	A1,D7
1$:	MOV	D7,A1
	CMMW	#[VTA],4(A1)
	BNE	2$
	CMMW	#[M  ],6(A1)
	BEQ	3$
2$:	MOV	@A1,D7
	BNE	1$
	TYPECR	<?VTAM.IDV not found>
	EXIT

3$:	ADD	#14,A1			; point to IDV itself 
	ADDW	@A1,A1			; addr comm area
	JLOCK
	TST	XM1010(A1)		; is EM1010 exit setup yet?
	BNE	4$			;   YES
	MOV	50,XM1010(A1)		; save real 1010 emulate vector
	MOV	OF1010(A1),D7		; put in mine
	ADD	A1,D7
	MOV	D7,50
4$:	JUNLOK
	PEA	HPOQ(A1)		; set QBEG pointer
	POP	QBEG(A4)
	VLOK


QOFF:	CMMW	#[OFF],WORKA(A4)
	BNE	QON
	MOV	QBEG(A4),A3		; point to HPO queue
1$:	MOV	@A3,D7			; get next on it
	JEQ	QOK			;   quit if end found
	MOV	D7,A3
	BITL	#QBGARD,QBFLG(A3)	; is this a VGUARD?
	BEQ	1$			;   NO  - continue thru
	CMM	QBJCB(A3),MINE(A4)	;   YES - correct job?
	BNE	1$			; 	  NO  - continue thru
	BICL	#QBGARD,QBFLG(A3)	;	  YES - turn off guard
	BITL	#QBCTLD,QBFLG(A3)	; is this a controlled job?
	JNE	QOK			;   YES - leave block alone	
	MOV	QBEG(A4),A0		;   NO  - free block
	CALL	QDEL
	QRET	A3
	JMP	QOK


QON:	CMMW	#[ON ],WORKA(A4)	; turn VGUARD on
	BNE	QME
	MOV	QBEG(A4),A3		; point to HPO queue
1$:	MOV	@A3,D7			; get next on it
	BEQ	2$			;   quit if end found
	MOV	D7,A3
	BITL	#QBGARD!QBCTLD,QBFLG(A3) ; is this a VGUARD?
	BEQ	1$			;   NO  - continue thru
	CMM	QBJCB(A3),MINE(A4)	;   YES - correct job?
	BNE	1$			; 	  NO  - continue thru
	BITL	#QBCTLD,QBFLG(A3)
	BNE	CTLD
	BR	QOK
2$:	MOV	QBEG(A4),A3		; point back to queue start
	QADD	A3			; put another block on chain
	SUB	#4,A3			; adjust pointer
	MOV	MINE(A4),QBJCB(A3)	; store jobs JCB addr
	MOV	#QBGARD,QBFLG(A3)	; set type
	BR	QOK

QME:	CMMW	#[ME ],WORKA(A4)	; turn VGUARD on for all except
	JNE	WHAT			; the current controlling job
	MOV	QBEG(A4),A3		; point to HPO queue
1$:	MOV	@A3,D7			; get next on it
	BEQ	UNCTL			;   quit if end found
	MOV	D7,A3
	BITL	#QBGARD!QBCTLD,QBFLG(A3) ; is this a VGUARD?
	BEQ	1$			;   NO  - continue thru
	CMM	QBJCB(A3),MINE(A4)	;   YES - correct job?
	BNE	1$			; 	  NO  - continue thru
	BITL	#QBCTLD,QBFLG(A3)
	BEQ	UNCTL
	BISL	#QBGARD,QBFLG(A3)

QOK:	VUNLK
	TYPECR	<%ok>
	EXIT

CTLD:	VUNLK
	TYPECR	<?ON option invalid, job controlled by VTAM.>
	EXIT

UNCTL:	VUNLK
	TYPECR	<?ME option invalid, job not controlled by VTAM.>
	EXIT

WHAT:	VUNLK
	TYPECR	<%Command Format is VGUARD ON>
	TYPECR	<              - or VGUARD OFF>
	TYPECR	<              - or VGUARD ME>
	EXIT

; routine to remove a queue block from linked list (prior to QRET)
; A3 --> queue block to unchain, A0 --> base of chain it's on
QDEL:	CMP	A3,@A0			; is this the right one?
	BEQ	1$			;   YES - go free/rechain
	MOV	@A0,A0			; save fwd pointer
	MOV	A0,D7			; make sure not zero
	BNE	QDEL			; if not zero, loop
	RTN
1$:	MOV	@A3,@A0			; rechain rest
	RTN

	EVEN
	END