;GIVE.MAR	-	MACRO program to print to SYS$OUTPUT the device
;			protection code associated with the specified 
;			terminal (default terminal - SYS$OUTPUT).
;			"A" represents that access to the terminal is
;			possible for that class of user.
;			GIVE.CLD must be used with $ SET COMMAND in order
;			to define the DCL interface to this image
;
;		Written by:	Clair Garman
;				Educational Services
;				Digital Equipment Corporation
;				Washington, DC
;
	.TITLE	GIVE
;
	.PSECT	DATA	PIC,NOEXE,LONG,NOSHR,WRT
;
	$DVIDEF
	$DSCDEF
	$CLIDEF
FAB:	$FAB	FAC=<PUT>,RAT=<CR>
RAB:	$RAB	FAB=FAB,RBF=OUTBUF,RSZ=OUTBUF_SIZE
;
TT_NAME_DESC:	.WORD
		.BYTE
		.BYTE	DSC$K_CLASS_D
		.LONG
OUTPUT_NAME_DESC:.WORD
		.BYTE
		.BYTE	DSC$K_CLASS_D
		.LONG
ITEM_LIST:	.WORD	4		;Length of return buffer
		.WORD	DVI$_VPROT	;Give protectection code for device
		.LONG	PROTECTION	;Return buffer address
		.LONG			;Return length address
		.LONG			;Terminator
PROTECTION:	.LONG
IOSB:		.BLKL	2
OUTBUF_DESC:	.LONG	OUTBUF_SIZE
		.ADDRESS OUTBUF
OUTBUF:		.ASCII	/SYSTEM=/
SYS_PROT:	.BYTE
		.ASCII	/, OWNER=/
OWN_PROT:	.BYTE
		.ASCII	/, GROUP=/
GRP_PROT:	.BYTE
		.ASCII	/, WORLD=/
WOR_PROT:	.BYTE
OUTBUF_SIZE	= .-OUTBUF
		.BLKB	4		;Padding for null access
TERMINAL:	.ASCID	/TERMINAL/
OUTPUT_QUAL:	.ASCID	/OUTPUT/
SYS_OUTPUT:	.ASCII	/SYS$OUTPUT:/
SYS_OUTPUT_SIZE = . - SYS_OUTPUT
;
	.PSECT	CODE	PIC,EXE,LONG,SHR,NOWRT
;
GIVE:	.WORD
;
	PUSHAL	TT_NAME_DESC			;Output buffer
	PUSHAL	TERMINAL			;Input - .CLD Label
	CALLS	#2,G^CLI$GET_VALUE			;Get terminal 
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
;
	$GETDVI_S	EFN=#1,IOSB=IOSB,-	;Get terminal protection code
	   DEVNAM=TT_NAME_DESC,ITMLST=ITEM_LIST
		BLBS	R0,.+10
			PUSHL	R0	
			CALLS	#1,G^LIB$STOP
	$WAITFR_S	EFN=#1			;Synchronize $GETDVI
		BLBS	R0,.+10
			PUSHL	R0
			CALLS	#1,G^LIB$STOP
		CMPW	#1,L^IOSB
			BEQL	.+15
			MOVZWL	L^IOSB,-(SP)
 			CALLS	#1,G^LIB$STOP
;
;Check the protection code and conditionally place A (access) into output
;	message
;
S:	BITW	#^X1,PROTECTION			;Was R bit set for SYSTEM?
	BNEQ	O				;If NEQ, not set
	MOVB	#^A/A/,SYS_PROT			;Since EQL, access allowed
O:	BITW	#^X10,PROTECTION		;Was R bit set for OWNER?
	BNEQ	G				;If NEQ, not set
	MOVB	#^A/A/,OWN_PROT			;Since EQL, access allowed
G:	BITW	#^X100,PROTECTION		;Was R bit set for GROUP?
	BNEQ	W				;If NEQ, not set
	MOVB	#^A/A/,GRP_PROT			;Since EQL, access allowed
W:	BITW	#^X1000,PROTECTION		;Was R bit set for WORLD?
	BNEQ	OUTPUT				;If NEQ, not set
	MOVB	#^A/A/,WOR_PROT			;Since EQL, access allowed
OUTPUT:
	PUSHAL	OUTPUT_QUAL			;Was /OUTPUT specified on cmd?
	CALLS	#1,G^CLI$PRESENT
	CMPL	#CLI$_PRESENT,R0
	BEQL	OUTPUT_THERE			;If EQL, specified
;
	$FAB_STORE	FAB=FAB,-		;Put default into FAB
			FNA=SYS_OUTPUT,-
			FNS=#SYS_OUTPUT_SIZE
	BRB	WRITE_OUTPUT
OUTPUT_THERE:
	PUSHAL	OUTPUT_NAME_DESC		;Find the /OUTPUT value
	PUSHAL	OUTPUT_QUAL
	CALLS	#2,G^CLI$GET_VALUE
	$FAB_STORE	FAB=FAB,-		;Put value into FAB
			FNS=OUTPUT_NAME_DESC,-
			FNA=@OUTPUT_NAME_DESC+4
WRITE_OUTPUT:
	$CREATE		FAB=FAB,ERR=RMSERR	;Write the protection code
	$CONNECT	RAB=RAB,ERR=RMSERR
	$PUT		RAB=RAB,ERR=RMSERR
	$CLOSE		FAB=FAB,ERR=RMSERR
;
	MOVL	#SS$_NORMAL,R0			;Status return
	RET					;Exit main routine
;
RMSERR:	.WORD
	MOVL	4(AP),R2
	PUSHL	FAB$L_STV(R2)
	PUSHL	FAB$L_STS(R2)
	CALLS	#2,G^LIB$STOP
;
	.END	GIVE