.MCALL	.MODULE
.MODULE	IFWILD,VERSION=03,COMMENT=<IFWILD/SYSLIB>,IDENT=NO,LIB=YES

; Copyright (c) 1998 by Mentec, Inc., Nashua, NH.
; All rights reserved
;
; This software is furnished under a license for use only on a
; single computer system and  may  be  copied  only  with  the
; inclusion of the above copyright notice.  This software,  or
; any other copies thereof, may not be provided  or  otherwise
; made available to any other person except for  use  on  such
; system and to one who agrees to these license  terms.  Title
; to  and  ownership of the software shall at all times remain
; in Mentec, Inc.
;
; The information in this document is subject to change without
; notice and should not be construed as a commitment by Digital
; Equipment Corporation, or Mentec, Inc.
;
; Digital and Mentec  assume  no  responsibility for the use or
; reliability of its software on equipment which is not supplied
; by Digital  or Mentec,  and listed  in the  Software  Product
; Description.
.SBTTL	FORTRAN-callable Wildcard Filespec Match
;
; MODULE:
;
;	IFWILD	- Do a wildcard filespec match
;
; FUNCTIONAL DESCRIPTION:
;
;  This function compares two ASCII strings -- one a "test" string,
;  and the other a wildcard "match" string.  The test string should
;  contain an RT-11 file specification, without a device field.  The
;  match string can contain up to eight wildcard specifications
;  separated by commas.  The strings are compared according to wildcard
;  rules.
;
;  If a match is detected, a POSITIVE bitmap is returned,  indicating
;  which filespecs in the match string list matched.  If no match is 
;  detected, then FALSE (-1) is returned.
;
;
; CALLING SEQUENCE:
;
;	BYTE TEST(N), MATCH(N)
;	BYTE EXPLCT
;	INTEGER*2 I
;	...
;	I = IFWILD( TEST, MATCH [,EXPLCT])
;
;
; PASSED ARGUMENTS:
;
;	TEST	- BYTE or CHARACTER test filespec string
;	MATCH	- BYTE or CHARACTER match filespec string
;	[EXPLCT]- BYTE or CHARACTER
;		  'E' designates EXPLICIT
;		  'I' designates IMPLICIT
;		  anything else or not supplied causes the
;		  current system value to be used (SET WILD)
;
; RETURNED ARGUMENT VALUES:
;
;	<none>
;
; RETURNED FUNCTION VALUE
;
;	I = Positive integer	indicates SUCCESSFUL MATCH
;	    (filespec bitmap 	[ + 256, if EXTENSION part was EXACT])
;	    		    [ and + 512, if NAME part was EXACT])
;
; The filespec bitmap indicates which of up to eight filespecs
; in the match string caused a MATCH to occur.  Bit-0 corresponds
; to the first filespec, bit-1 to the next, and so forth, up to
; bit-7.
;
;   or
;	I = -1			NO MATCH
;	I = -2			ERROR
;
;
; EXAMPLES:
;
;    TEST		MATCH				RETURNED VALUE
;
;    MYFILE.DAT		*				TRUE (1)
;    MYFILE.DAT		*.*				TRUE (1)
;    MYFILE.DAT		*.DAT				TRUE (256+1)
;    MYFILE.DAT		*ILE.*				TRUE (1)
;    MYFILE.DAT		M*.*				TRUE (1)
;    MYFILE.DAT		M*.				FALSE (-1)
;    MYFILE.DAT		N*.*,M*.*			TRUE (1)
;    MYFILE.DAT		N*.*				FALSE (-1)
;    MYFILE.DAT		MYFIL%.DAT			TRUE (256+1)
;    MYFILE.DAT		MYFJL%.DAT			FALSE (-1)
;    MYFILE.DAT		MYFILE.DAT			TRUE (512+256+1)
;    A.B                A.B,*.TXT,C			TRUE (1)
;    LETTER.TXT		A.B,*.TXT,C			TRUE (256+2)
;    C.DAT		A.B,*.TXT,C			TRUE (4)
;
;-
; EXTERNAL REFERENCES:
;
	.GLOBL	$SYSLB
	.GLOBL	$NXADR
;
.SBTTL	Macro Definitions and References

	.MCALL	.GVAL

	.MACRO	......
	.ENDM


.SBTTL	Definitions and Equates

PROGDF	=:	452			; RMON Fixed offset
WILDBY	=:	PROGDF+2		; Wild Implicit/Explicit byte

NULL	=:	0			; NULL character
TAB	=:	11			; TAB character
LF	=:	12			; LINEFEED character
CR	=:	15			; CARRIAGERETURN character
DOT	=:	'.			; DOT character
COMMA	=:	',			; COMMA character
BLANK	=:	40			; SPACE character

NCNAME	=:	6			; number of chars in filename field
EXCT.E	=:	400			; EXACT_EXTENSION bit
EXCT.N	=:	1000			; EXACT_NAME bit
EXCT.T	=:	2000			; TENTATIVE EXACT_NAME (not returned)

.SBTTL	Data

	.PSECT	SYS$S,D

AREA:	.BLKW	2			; area for .GVAL
IMPEXP:	.WORD	0			; Implicit/Explicit wildcard indicator

TTBL:	.BYTE	BLANK,COMMA,DOT,CR,LF,TAB,NULL		; terminator table
NULPTR:	.BYTE	0
	.EVEN

.SBTTL	IFWILD Code

	.PSECT	SYS$I,I
	.ENABL	LSB

IFWILD::				; FORTRAN-compatible entry
	MOV	(R5)+,R4		; Get argument count
	CALL	$NXADR			; Get TEST string address
	BCS	170$			; error if not supplied.
	MOV	R0,-(SP)		; Put TEST pointer on stack
	CALL	$NXADR			; Get MATCH string address
	BCS	160$			; error if not supplied.
	MOV	R0,R2			; Put MATCH pointer in R2
	CALL	$NXADR			; Get IMPLICIT/EXPLICIT specifier
	BCS	10$			; Get RMON value if not there.
	MOVB	@R0,IMPEXP		; Get supplied character
	BR	30$

; Get wildcard EXPLICIT or IMPLICIT information from RMON

10$:	CLR	R1
	.GVAL	#AREA,#WILDBY		; Get system's wildcard (IM,EX)PLICIT
	TSTB	R0			; Implicit (1) or Explicit (0)?
	BNE	20$			; Branch if Implicit (default)
	MOV	#'E,R1			; Get code for EXPLICIT
20$:	MOV	R1,IMPEXP		; Store appropriate code locally.

; Begin testing filename field

30$:	CLR	-(SP)			; Allocate filespec bitmap
	MOV	#1,R4			; Initialize filespec bit no.

40$:	MOV	2(SP),R1		; Get TEST string address
	CALL	TSPART			; Test filename fields
	BMI	100$			; If no match, look for next entry.
	BNE	50$			; If not exact match, branch.
	BIS	#EXCT.T,@SP		; Tentative EXACT filename match
50$:	MOV	R1,R3			; save TEST string's EXT ptr
	MOV	R2,R1			; point to MATCH string,
	CALL	LKFDOT			; look for DOT in match string.
	BNE	80$			; None.  Call it a match.

	MOV	R1,R2			; save MATCH string EXT ptr
	MOV	R3,R1			; point to TEST string again,
	CALL	LKFDOT			; look for DOT in TEST string.
	BNE	60$			; No DOT.  If comma, check next spec.
; DOTs have been found in both the MATCH (R2) and TEST (R1) strings.
; These registers now point just beyond the dots.
; Call ISWILD on the extension fields.

	MOVB	@R2,R0			; check MATCH string for null ext.
	CALL	SLEOI$			; check for terminator
	BNE	70$			; If not, branch to do normal compare.
	MOVB	@R1,R0			; check TEST string for null ext.
	CALL	SLEOI$			; check for terminator
	BEQ	80$			; If so, it's a match.
60$:	MOV	R2,R1			; Otherwise, point to MATCH string,
	BR	120$			;  and look for another spec.
	............

70$:	CALL	TSPART			; test extension parts
	BMI	100$			; branch if no match
	BNE	80$			; branch if wildcard match
	BIS	#EXCT.E,@SP		; set "exact" ext. match bit
80$:	BIT	#EXCT.T,@SP		; Did name part match EXACTLY?
	BEQ	90$			; branch if not.
	BIS	#EXCT.N,@SP		; set EXACT_NAME_MATCH bit
90$:	BIS	R4,@SP			; set "matched filespec" bit

; After a TEST filespec has failed, look for a comma in MATCH string,
; indicating that there is another test filespec in the string.  
; If there is, point to it and try again.

100$:	MOV	R2,R1			; In MATCH string,
110$:	CALL	LKFDOT			; look for next DOT, COMMA, or NULL
	BEQ	110$			; ignore DOTs
120$:	BIC	#EXCT.T,@SP		; clear tentative EXACT bit,
	CMPB	@R1,#COMMA		; comma found?
	BNE	140$			; No.  Time to return.
130$:	INC	R1			; bypass blanks
	CMPB	@R1,#BLANK
	BEQ	130$
	ASL	R4			; Shift bit (filespec) number
	MOV	R1,R2			; Let R2 point to new match section,
	BR	40$			; and try next filespec.
	............

140$:	MOV	(SP)+,R0		; get match bitmap
	BNE	150$
	DEC	R0			; Return -1 on no matches.
150$:	TST	(SP)+			; Fix SP
	RETURN
	............

160$:	TST	(SP)+			; Fix SP
170$:	MOV	#-2.,R0			; ERROR return
	RETURN
.SBTTL	LKFDOT - Look For Dot (or other delimiter)

; Look for DOT in string pointed to by R1.  Return with R1 pointing
; to the character immediately following the DOT found.  Return with
; Z-bit set (use BEQ) if successful, otherwise Z-bit clear (use BNE).
;
; Uses R0

LKFDOT:					; LOOK_FOR_DOT
	MOV	#NCNAME+1,R0		; within seven characters,
180$:	TSTB	@R1			; is it a NULL?
	BEQ	190$			; If so, it sure the heck ain't no DOT
	CMPB	@R1,#COMMA		; is it a COMMA?
	BEQ	190$			; Treat as end of filespec.
	CMPB	(R1)+,#DOT		; is it a DOT? (move R1 down the line)
	BEQ	200$			; (Z bit is set for return)
	DEC	R0			; count down...
	BGT	180$			; check next character until hopeless.
190$:	INC	R0			; NO_MATCH return (clears Z-bit)
200$:	RETURN

; Test name or extension part of filespec for match

TSPART:	MOV	R4,-(SP)		; save R4
	MOV	#IMPEXP,-(SP)		; store address of IMPL/EXPL indicator
	MOV	#$NOARG,-(SP)		; CASE-sensitivity NOT specified
	MOV	#TTBL,-(SP)		; terminator list specified
	MOV	R2,-(SP)		; MATCH string pointer
	MOV	R1,-(SP)		; TEST string pointer
	MOV	#5,-(SP)		; 5 arguments
	MOV	SP,R5
	CALL	ISWILD			; use SYSLIB's wildcard string tester
	TST	(SP)+			; recover stack ptr and regs
	MOV	(SP)+,R1
	MOV	(SP)+,R2
	ADD	#6,SP			; account for TTBL and CASE
	MOV	(SP)+,R4		; restore R4
	TST	R0			; check return value
	RETURN

	.DSABL	LSB

.SBTTL	SLEOI$	Test for End-of-Item

; Subroutine SLEOI$ - tests character in R0 for "end of item" character.
;	(see terminator table below)
;
;	Returns R0=0 (Z-bit set, N-bit clear) if TRUE, 
;	or R0=-1 (Z-bit clear, N-bit set) if FALSE.


SLEOI$:	CMPB	R0,#60
	BHIS	NO			; take shortcut if alphanumeric
	MOV	R1,-(SP)		; Save working register...
	MOV	#TTBL,R1		; R1 -> terminator table
T1:	CMPB	R0,(R1)			; check character against table entry
	BNE	T2
	MOV	(SP)+,R1
YES:	CLR	R0			; Answer is YES.
	RETURN

T2:	TSTB	(R1)+			; end of table?
	BNE	T1			; continue if not.
	MOV	(SP)+,R1
NO:	MOV	#-1,R0			; else, answer is NO
	RETURN

	.END