;
; **********************************************************************
		.TITLE	CHGUIC
; this is a program to change the owner uic of a file
; it must be installed with privilege LOG_IO
; this file must be linked w/ sys$useful:error
;
;***********************************************************************
;
;
;
$DSCDEF
.PSECT STRUCTP,LONG
INFAB::	$FAB	FAC=PUT,NAM=NAMBLK,FOP=NAM		;fab to open file with
NAMBLK::	$NAM	RSA=STRING,RSS=NAM$C_MAXRSS,ESA=STRING,ESS=NAM$C_MAXRSS
STRING:	.BLKB NAM$C_MAXRSS

PROXAB:	$XABPRO
CONVERT_DESC:	.LONG 0
		.LONG 0
STORAGE::	.LONG 0				;storage
FLAG:	.LONG 0
GETCMD:	$CLIREQDESC -				;input so cli can return info on cmd line
			RQTYPE = CLI$K_GETCMD
DESCRIPTOR:	.BLKL 2				;descriptor for command line
SYNTAX:: .ASCID /ILLEGAL COMMAND LINE/<13><10>
.EVEN
;
PROMPT_DESC:	.ASCID /$_FILE NAME:/	;prompt
;
; register usage
;
; R0 and R1 are scratch
; R6 and R7 are used to contain the description of the file spec
;	as it goes through several changes (device and dir are stripped)
;	R6 is the length and R7 is the address
; R8 is used once for scratch
; R9 is used to point to the nam block temporarily
; R10 is used to point to the fib temporarily
; R11 is used to point to the commonly used fab (infab)
; R0,R1,R6,R7,R8 are clobbered in parse, but nothing has happened before it
;
.PSECT CODE
START::
	.WORD 0
	MOVAL	INFAB,R11
;
; call parse to get the file spec and the uic
;
	BSBW	PARSE
;
;
	$PARSE	FAB=R11,ERR=REPORT_ERROR
MORE:	$SEARCH	FAB=R11
	CMPL	R0,#RMS$_NMF
	BEQL	DONE
	BLBS	R0,CONT
	MOVL	R11,R10
	BSBW	REPORT
	RET
CONT:
	$OPEN FAB=R11,ERR=REPORT_ERROR
;
; modify the uic on the close
;
	TSTL	PROXAB+XAB$L_UIC
	BEQL	10$
	MOVAL	PROXAB,FAB$L_XAB(R11)
10$:
	$CLOSE	FAB=R11,ERR=REPORT_ERROR
	CLRL	FAB$L_XAB(R11)

	BITL	#NAM$M_WILDCARD,NAMBLK+NAM$L_FNB
	BNEQ	MORE
DONE:
	MOVL	#1,R0
	RET
;
; this is a routine to get the command line and parse it
; output is one file name, with the descriptor in infab
; and an uic value
;
GET_NUM:
; this is a subroutine to pick the number out of the switch
; it is passed back in the longword storage
;
	MOVL	R1,CONVERT_DESC+4			;save addr of digit
5$:	MOVB	(R1)+,R0
	CMPB	R0,#^A/0/
	BLSS	10$
	CMPB	R0,#^A/9/
	BGTR	10$
	BRB	5$
10$:
	SUBL3	CONVERT_DESC+4,R1,CONVERT_DESC
	DECL	CONVERT_DESC
	PUSHAL	STORAGE
	PUSHAL	CONVERT_DESC
	CALLS	#2,FOR$CNV_IN_O
	BLBS	R0,A
	PUSHL	R0
	CALLS	#1,LIB$SIGNAL
	RET
A:
	RSB
;
; on to the main stuff
;
PARSE::
	CLRW	FLAG
	PUSHAB	W^GETCMD
	CALLS	#1,@CLI$A_UTILSERV(AP)
	MOVQ	W^GETCMD+CLI$Q_RQDESC,DESCRIPTOR
	TSTL	DESCRIPTOR
	BNEQ	1$
	BRW	PROMPT_FIRST
1$:
	LOCC	#^A%/%,DESCRIPTOR,@DESCRIPTOR+4		;is there a switch?
	MOVL	R0,R7				;save len of rest of str
	TSTL	R0
	BNEQ	3$
	BRW	NOSWITCH
3$:
	MOVL	R1,R6			;r6 points to whole origin string
	LOCC	#^A/=/,R0,(R1)				;find the colon
	TSTL	R0
	BNEQ	FINE
	MOVL	R6,R1
	MOVL	R7,R0					;restore r0,r1
	LOCC	#^A/:/,R0,(R1)			; is there an =?
	TSTL	R0
	BNEQ	FINE
SYNERR:
	PUSHAL	SYNTAX
	CALLS	#1,LIB$PUT_OUTPUT
	RET
FINE:
	INCL	R1					;advance over colon
	CMPB	(R1),#^A/[/
	BNEQ	NOBRACK
	INCL	R1				;skip it
	INCL	FLAG				;set flag
NOBRACK:
	BSBW	GET_NUM
	MOVW	STORAGE,XAB$W_GRP+PROXAB
	INCL	R1				;skip over comma
	BSBW	GET_NUM
	MOVW	STORAGE,XAB$W_MBM+PROXAB
	BLBC	FLAG,NOBRACK1			;if no lbrack, then no right
	CMPB	(R1),#^A/]/
	BNEQ	SYNERR				;report error
	INCL	R1				;skip it
NOBRACK1:
	MOVL	R1,R8				;r8 points to rest of string
	DECL	R1
	MOVL	DESCRIPTOR+4,R7			;addr of whole str
	ADDL2	DESCRIPTOR,R7			;last byte of whole str
	SUBL2	R8,R7				;get size of rest of str
	INCL	R7
	SUBL2	R8,DESCRIPTOR			;adjust descriptor
	ADDL2	R6,DESCRIPTOR
	BGEQ	20$
	CLRL	DESCRIPTOR
20$:
	CMPL	R6,DESCRIPTOR+4
	BNEQ	40$
	MOVL	R8,DESCRIPTOR+4			;adjust beginning of str,if necc
	INCL	DESCRIPTOR+4
	DECL	DESCRIPTOR
	BRB	45$
40$:
	INCL	DESCRIPTOR
45$:
	TSTL	DESCRIPTOR			;may not be any more
	BLEQ	PROMPT_FIRST
;
;
; have at least one file spec, get it
;
NOSWITCH:
	MOVL	DESCRIPTOR+4,R1
	ADDL2	DESCRIPTOR,R1
100$:	SUBL3	DESCRIPTOR+4,R1,R0
	MOVB	R0,FAB$B_FNS(R11)
	MOVL	DESCRIPTOR+4,FAB$L_FNA(R11)
	RSB
;
; need to prompt for a file -- prompt away
;
PROMPT_FIRST:
	CLRQ	DESCRIPTOR
	MOVB	#DSC$K_CLASS_D,DESCRIPTOR+DSC$B_CLASS
	PUSHAL	PROMPT_DESC
	PUSHAL	DESCRIPTOR
	CALLS	#2,LIB$GET_INPUT
	MOVZWL	DESCRIPTOR+DSC$W_LENGTH,R0
	MOVB	R0,FAB$B_FNS(R11)
	MOVL	DESCRIPTOR+4,FAB$L_FNA(R11)
;
; got the file spec, return with it
;
	RSB
.END START