.TITLE	RMS_PARSE Invoke the $PARSE and $SEARCH services
	.IDENT	/V02.02/

;++RMSPARSE.MAR
;
; Facility: 
;	Fermilab Accelerator Control System (ACNET) Routines for
;	High Level Language access to RMS services.
;
; Abstract:
;	Provide High Level Language programs with access to the RMS $PARSE
;	and $SEARCH services to allow easy parsing of file specifications
;	and wild card processing.
;
; Environment:
;	Module stored in FERMILIB.OLB and linked in users' programs.
;
;--
;
; Modification History:
;
; Author: F. Nagy			Creation date: 20-Sep-82
;
; V01.00  20-Sep-82	FJN	Gotten from Spring '82 SIG tape, written at
;				Institute for Cancer Research
; V02.00  22-Sep-82	FJN	Expanded to handle all flavors of string
;				descriptors on input and output.  Added
;				routines RMS_ANYWILD and RMS_xxxSPEC
; V02.01  24-Sep-82	FJN	Add optional arguments to return lengths of the
;				output strings.
; V02.02  15-Apr-83	FJN	Standardize help comments
;
	.PAGE
	.SUBTITLE	Declarations

;
; Include Files:
;
;	NONE
;
; Library Macros:
;
	.NOCROSS
	$NAMDEF				;Define offsets and max-size constants
	.CROSS
;
; Local Macros:
;
	.MACRO	GET.STRING  input_descr,out_byt_len,out_txt_addr,error
					;Get input string using the input
					;  string descriptor
	MOVAQ	input_descr,R0		;Get address of input descriptor
	JSB	G^LIB$ANALYZE_SDESC_R2	;Analyze the descriptor, returning:
	BLBC	R0,error		;  status code (branch to error code),
	MOVB	R1,out_byt_len		;  string length (treat as byte), and
	MOVL	R2,out_txt_addr		;  address of the string's text.
	.ENDM	GET.STRING

	.MACRO	RTN.STRING  in_byt_len,in_txt_addr,output_descr,error
					;Return string given the output string
					;  descriptor
	MOVZBW	in_byt_len,R0		;Get string length
	MOVAB	in_txt_addr,R1		;  and address of string's text
	MOVAQ	output_descr,R2		;Address of output descriptor
	JSB	G^LIB$SCOPY_R_DX6	;Copy string to output
	.IF NOT_BLANK  error
	  BLBC	R0,error		;Test for error if label given
	.ENDC	;error<>BLANK
	.ENDM	RTN.STRING
;
; Equated Symbols:
;
nargs = 0				;Offset to number of arguments
fil_spec = 4				;Offset to the address of the string
					;  descriptor of the file specification
					;  to be "parsed"
dft_spec = 8				;Offset to the address of the string
					;  descriptor of the default file
					;  specification.
exp_spec = 12				;Offset to the address of the string
					;  descriptor in which the expanded
					;  file specification is to be returned
exp_len = 16				;Offset to the address of a word in
					;  which the length of the expanded
					;  file specification is returned
res_spec = 4				;Offset to the address of the string
					;  descriptor in which the resultant
					;  file specification is to be returned
res_len = 8				;Offset to the address of a word in
					;  which the length of the resultant
					;  file specification is returned
fnsts = 4				;Offset to the address of a longword in
					;  which the file name status bits are
					;  returned

	.PAGE
	.SUBTITLE	Impure data storage
;
; Read/write (inpure) local data program section
;
	.PSECT	_RMS_DATA,PIC,USR,CON,REL,LCL,NOSHR,NOEXE,WRT,RD

;
; Declare internal space for the resulting string text
;
EXP_TEXT:
	.BLKB	NAM$C_MAXRSS		;For expanded file string
RES_TEXT:
	.BLKB	NAM$C_MAXRSS		;For resultant file string

;
; NAMe block to return expanded string specification used in $PARSE and
; $SEARCH
;
RMS_GZ__PARSE.NAM::			;Allow access from other RMS modules
NAMB:	$NAM	ESA=EXP_TEXT,ESS=NAM$C_MAXRSS,-
		RSA=RES_TEXT,RSS=NAM$C_MAXRSS
;
; File Access Block to be used by $PARSE
;
RMS_GZ__PARSE.FAB::			;Allow access from other RMS modules
FABB:	$FAB	NAM=NAMB

;
; Program section for code
;
	.PSECT	_RMS_CODE,PIC,USR,CON,REL,LCL,SHR,EXE,NOWRT,RD
	.SHOW	BINARY

	.PAGE
	.SUBTITLE RMS_PARSE to invoke $PARSE service for a file specification

;+0RMS_PARSE
;
; Functional Description:
;	Provide a clean interface to the RMS $PARSE service for High Level
;	Languages which need primarily to put defaults into a file
;	specification.
;
; Calling Sequence:
;	status = RMS_PARSE(file_spec [,dft_spec] [,exp_spec] [,exp_len])
;
; Input Parameters:
;	file_spec - address of a string descriptor of the file specification to
;		    be parsed (may include wild cards).
;	dft_spec - (optional) address of a string descriptor of a second file
;		   specification for default resolution.
;
; Implicit Inputs:
;	NONE
;
; Output Parameters:
;	status - VMS completion status code returned in register R0.
;	exp_spec - (optional) address of a string descriptor in which the
;		   expanded file specification resulting from logical name
;		   translation and file specification default resolution,
;		   process defaults and related file resolution is to be
;		   returned.
;	exp_len - (optional) address of a word in which the length of the
;		  expanded file specification string is returned.
;
; Implicit Outputs:
;	NAMB and FABB are left from the $PARSE service as input for $SEARCH or
;	for other routines to interrogate.
;
; Condition Codes:
;	RMS$_NORMAL	Operation successful (expanded string not required).
;	SS$_NORMAL	Operation successful (expanded string returned).
;	LIB$_STRTRU	Success, expanded string truncated to fit in output
;			parameter string.
;	LIB$_FATERRLIB	Fatal internal library error.
;	LIB$_INSVIRMEM	Insufficient virtual memory.
;	LIB$_INVSTRDES	Invalid string descriptor.
;	RMS$_DNF	Directory not found.
;	RMS$_DNR	Device not ready or not mounted.
;	RMS$_WCC	Invalid wild card context value
;
; Side Effects:
;
;-
;+ RMS_PARSE
; Provide High Level Language access to the RMS $PARSE service to allow
; the parsing (include default resolution) of file specifications.  In
; addition the RMS_PARSE routine prepares a file specification containing
; wilcards for the RMS_SEARCH routine.
;
; status.wlc.v = RMS_PARSE(file_spec.rt.dx [,dft_spec.rt.dx]
;                          [,rtn_spec.wt.dx] [,rtn_len.ww.r])
;
;  status     completion status code.  Passed by value.
;
;  file_spec  file specification string to be parsed (may include wild
;             cards).  Passed by descriptor.
;
;  dft_spec   (optional) a second file specification string to provide
;             defaults.  Passed by descriptor.
;
;  rtn_spec   (optional) returns the expanded file specification string.
;             Passed by descriptor.
;
;  rtn_len    (optional) word in which the length of the expanded file
;             specification string is be returned.  Passed by reference.
;
;2 Condition_codes
;
;  RMS$_NORMAL     Success (no rtn_spec argument).
;  SS$_NORMAL      Success (expanded specification returned in rtn_spec).
;  LIB$_STRTRU     Success, expanded string truncated to fit in output
;                  parameter string (rtn_spec).
;  LIB$_FATERRLIB  Fatal internal library error.
;  LIB$_INSVIRMEM  Insufficient virtual memory.
;  LIB$_INVSTRDES  Invalid string descriptor.
;  RMS$_DNF        Directory not found.
;  RMS$_DNR        Device not ready or not mounted.
;  RMS$_WCC        Invalid wild card context value
; 
;-

	.ENTRY	RMS_PARSE,^M<R2,R3,R4,R5,R6>
;
	MOVAB	FABB,R3			;Get address of FAB
;
; Move address and length of file specification into FAB
;
	GET.STRING  @fil_spec(AP),FAB$B_FNS(R3),FAB$L_FNA(R3),99$
	$FAB_STORE FAB=(R3),DNS=#0	;Init FAB to no default file spec.
	CMPB	#2,nargs(AP)		;Was dft_spec argument specified?
	BGTR	10$			;If not, then skip to parse file spec.
;
; Else move address and length of default file specification into FAB
;
	TSTL	dft_spec(AP)		;Is there a default string specified?
	BEQL	10$			;If defaulted treat as no defaults
	GET.STRING  @dft_spec(AP),FAB$B_DNS(R3),FAB$L_DNA(R3),99$
;
; Now "parse" the file specification (fill in the NAM block).
;
10$:	MOVL	FAB$L_NAM(R3),R4	;Get address of the NAM block
	$PARSE 	FAB=(R3)
;
; Clear items in FAB and NAM that may have been set by an external module
; before calling RMS_PARSE.
;
	CLRL	FAB$L_FOP(R3)		;Clear OFP file option
	CLRL	NAM$L_RLF(R4)		;Clear related NAM block address
	BLBC	R0,99$			;Immediate exit if $PARSE error
;
; File specification successfully parsed, attempt to return expanded file
; specification string.
;
	CMPB	nargs(AP),#3		;Is the expanded string wanted?
	BLSSU	99$			;If not, just exit
	BEQL	20$			;If 3 args, just return the string
	TSTL	exp_len(AP)		;4 args, was length defaulted?
	BEQL	20$			;If so, go work on string return
	MOVZBW	NAM$B_ESL(R4),@exp_len(AP) ;Return string length in 4th arg
20$:	TSTL	exp_spec(AP)		;Was the expanded string defaulted?
	BEQL	99$			;If defaulted, treat as not given
	RTN.STRING  NAM$B_ESL(R4),@NAM$L_ESA(R4),@exp_spec(AP)
;
99$:	RET

	.PAGE
	.SUBTITLE RMS_SEARCH to provide wild card processing

;+0RMS_SEARCH
;
; Functional Description:
;	Invoke the RMS $SEARCH service to provide wild card processing.
;
; Calling Sequence:
;	status = RMS_SEARCH( res_spec [,res_len] )
;
; Input Parameters:
;	NONE
;
; Implicit Inputs:
;	NAM block setup (NAMB) by the RMS_PARSE call.
;
; Output Parameters:
;	status - completions status code returned in register R0.
;	res_spec - address of a string descriptor in which the resultant
;		   file specification string (all wild card characters
;		   and defaults resolved) is returned.
;	res_len - (optional) address of a word in which the length of the
;		  resultant file specification string is returned.
;
; Implicit Outputs:
;	NAM block is changed to reflect new wildcard context.
;
; Condition Codes:
;	SS$_NORMAL	Operation successful.
;	LIB$_STRTRU	Success, resultant string truncated to fit in output
;			parameter string.
;	LIB$_FATERRLIB	Fatal internal library error.
;	LIB$_INSVIRMEM	Insufficient virtual memory.
;	LIB$_INVSTRDES	Invalid string descriptor.
;	RMS$_DNF	Directory not found
;	RMS$_DNR	Device not ready or not mounted
;	RMS$_FND	ACP file or directory lookup failed
;	RMS$_FNF	File not found
;	RMS$_NMF	No more files found (search completion)
;	RMS$_PRV	Insufficient privilege or file protection violation
;	RMS$_WCC	Invalid wild card context value
;
; Side Effects:
;	RMS_PARSE must be called before this routine.
;
;-
;+ RMS_SEARCH
; Provide High Level Language access to the RMS $SEARCH service to process
; wild cards in file specifications.  Before RMS_SEARCH can be called, the
; RMS_PARSE routine must be called to initialize internal storage.
;
; status.wlc.v = RMS_SEARCH( res_spec.wt.dx [,res_len.ww.r] )
;
;  status    completion status code.  Passed by value.
;
;  res_spec  returns the resultant file specification (with all wild
;            cards and defaults resolved).  Passed by descriptor.
;
;  res_len   (optional) word in which the length of the resultant file
;            specification string is returned.  Passed by reference.
;
; To process wildcard file specifications, call RMS_PARSE to initialize
; the internal storage then call RMS_SEARCH in a loop.  Each call to
; RMS_SEARCH will return a valid file specification until the status of
; RMS$_NMF is returned.  This status code (an error) indicates that the
; wild card search has been exhausted.
;
;2 Condition_codes
;
;  SS$_NORMAL      Operation successful.
;  LIB$_STRTRU     Success, resultant string truncated to fit in output
;                  parameter string (res_spec).
;  LIB$_FATERRLIB  Fatal internal library error.
;  LIB$_INSVIRMEM  Insufficient virtual memory.
;  LIB$_INVSTRDES  Invalid string descriptor.
;  RMS$_DNF        Directory not found
;  RMS$_DNR        Device not ready or not mounted
;  RMS$_FND        ACP file or directory lookup failed
;  RMS$_FNF        File not found
;  RMS$_NMF        No more files found (wildcard search completion)
;  RMS$_PRV        Insufficient privilege or file protection violation
;  RMS$_WCC        Invalid wild card context value
;
;-

	.ENTRY	RMS_SEARCH,^M<R2,R3,R4,R5,R6>
;
	MOVAB	FABB,R3			;Get address of FAB
;
; Invoke RMS $SEARCH service to process wild card context
;
	$SEARCH	FAB=(R3)
	BLBC	R0,99$			;Take immediate exit on error
	MOVL	FAB$L_NAM(R3),R4	;Get address of the NAM block
	CMPB	nargs(AP),#2		;Is there a return length argument?
	BLSSU	10$			;If not, just return string
	TSTL	res_len(AP)		;Yes, was it defaulted?
	BEQL	10$			;If so, again just return string
	MOVZBW	NAM$B_RSL(R4),@res_len(AP) ;Else return string length in it
10$:	RTN.STRING  NAM$B_RSL(R4),@NAM$L_RSA(R4),@res_spec(AP)
99$:	RET

	.PAGE
	.SUBTITLE RMS_ANYWILD

;+0RMS_ANYWILD
;
; Functional Description:
;	Used after a RMS_PARSE call to test if there were any wild cards
;	specified in the file specification.
;
; Calling Sequence:
;	wildcard = RMS_ANYWILD( [fil_nam_stat] )
;
; Input Parameters:
;	NONE
;
; Implicit Inputs:
;	NAMB - NAM block filled by $PARSE service
;
; Output Parameters:
;	wildcard - TRUE (1) is returned if the file specification included
;		   one or more wildcards, otherwise FALSE (0) is returned.
;	fil_nam_stat - (optional) address of a longword in which the file
;		       name status bits are to be returned.
;
; Implicit Outputs:
;	NONE
;
; Condition Codes:
;	NONE
;
; Side Effects:
;	Can only be called after a call to RMS_PARSE.
;
;-
;+ RMS_ANYWILD
; After a call to RMS_PARSE, test if there were any wild cards in the
; parsed file specification.
;
; result.wlu.v = RMS_ANYWILD( [fil_nam_sts.wlu.r] )
;
;  result       a longword value of TRUE (-1) is returned if the parsed
;               file specification included any wildcards.  Otherwise
;               the value of FALSE (0) is returned.  Passed by value.
;
;  fil_nam_sts  (optional) longword in which the file name status bits
;               are returned.  Passed by reference.
;
;-

	.ENTRY	RMS_ANYWILD,^M<>
;
	MOVL	NAMB+NAM$L_FNB,R1	;Get file name status from NAM block
	CLRL	R0			;Init to FALSE=no wildcards
	TSTB	nargs(AP)		;Were any arguments specified?
	BNEQ	10$			;If not, just return function value
	TSTL	fnsts(AP)		;Was the argument defaulted?
	BEQL	10$			;If defaulted, treat as not there
	MOVL	R1,@fnsts(AP)		;Return file name status bits
10$:	BBC	#NAM$V_WILDCARD,R1,20$	;If no wildcards, just exit
	MCOML	#0,R0			;Return TRUE as wildcards seen
20$:	RET

	.END