.MCALL	.MODULE
.MODULE	ISWILD,VERSION=05,COMMENT=<SYSLIB/ISWILD>,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.
;++
;
;	Edit	Who	Date		Description of modification
;	----	---	----		---------------------------
;	001	WLD	05-OCT-90	Fix comment describing calling
;					sequence to ISWILD
;--
.SBTTL	FORTRAN-callable System Library Routine
;
; MODULE:
;
;	ISWILD	- Wildcard String Match
;
; FUNCTIONAL DESCRIPTION:
;
;  This function compares two ASCII strings -- one a "match" string, 
;  and the other a "test" string.  It returns an integer value that
;  indicates whether the test string satisfies a wildcard match against
;  the match string.  An exact match returns 0; a wildcard match
;  returns 1.
;
;  Examples:        Match String       Test String       Result
;
;                    "TEST"              "TEST"           YES (0)
;                    "T*"                "TEST"           YES (1)
;                    "T*"                "BEST"           NO  (-1)
;                    "*T"                "BEST"           YES (1)
;
; CALLING SEQUENCE:
;
;	BYTE TEST(N), MATCH(N)
;	...
;	I = ISWILD( TEST, MATCH [,TERMS [,CASE [,EXPIMP]]])
;
; PASSED ARGUMENTS:
;
;	TEST	- BYTE or CHARACTER test string
;	MATCH	- BYTE or CHARACTER match string
;	TERMS	- Optional string of valid terminator characters
;	CASE	- Optional case-treatment indicator
;	EXPIMP	- Optional EXPLICIT/IMPLICIT indicator
;
; RETURNED ARGUMENT VALUES:
;
;	<none>
;
; RETURNED FUNCTION VALUE:
;
;	I =  0			Indicates SUCCESSFUL EXACT MATCH
;	I =  1			Indicates SUCCESSFUL WILDCARD MATCH
;	I = -1			NO MATCH
;	I = -2			INVALID ARGUMENTS
;
;
; EXTERNALS:
;
	.GLOBL	$SYSLB			; SYSLIB version and other globals
	.GLOBL	$NXADR			; Retrieves next argument address
;
; EXTERNALLY REFERENCED ENTRY POINT:
;
	.GLOBL	SLEOI$			; Check for end-of-string character
;
;
; NOTE: This module should not use stored impure data -- 
;	The code is RECURSIVE.
;
.SBTTL	ISWILD algorithm in C
;
;	/* wildcard pattern match */
;	/* Recursive solution */
;
;	#define MAXLEN	12
;	#define BLANK	' '
;	#define DOT	'.'
;	#define STAR	'*'
;	#define PERCENT	'%'
;	#define COMMA	','
;	#define EXACT	0
;	#define WILD	1
;	#define NO_MATCH -1
;
;	SHORT iswild( test, match)
;	BYTE test[];
;	BYTE match[];
;	    {
;	    BYTE *p1, *p2;
;	    BYTE *q1, *q2;
;	    BYTE c;
;	    SHORT e_of_ts;		/* end of test string indicator */
;	    SHORT ret_val;		/* return value */
;
;	/* Begin wildcard match test. */
;
;	    ret_val = EXACT;
;	    p1 = match;
;	    while (*p1 == STAR) { ++p1; ret_val = WILD; }
;	    if (tsteoi(*p1)) return ret_val;
;	    q1 = test;
;
;	    do
;		{
;		p2 = p1;  q2 = q1;
;		FOREVER
;		    {
;		    e_of_ts = tsteoi(*q2);
;		    if (tsteoi((c = *p2))) 
;			if (e_of_ts) return ret_val;
;			else break;
;	
;		    if (c == STAR) return (iswild( q2, p2));
;		    if (c == *q2 OR (c == PERCENT AND NOT e_of_ts))
;			{ p2++; q2++; ret_val = WILD }
;		    else
;			break;
;		    }
;		} while ( p1 > match AND NOT tsteoi(*++q1));
;	    return NO_MATCH;
;	    }
;
.SBTTL	ALGORITHM (continued)
;
;	SHORT tsteoi(c)	/* test character for end of name field */
;	BYTE c;
;	    {
;	    switch (c)
;		{
;		case EOS:
;		case BLANK:
;		case DOT:
;		case COMMA:
;		    return YES;
;	
;		default:
;		    return NO;
;		}
;	    }
;	
.SBTTL	ISWILD	Definitions and Equates

; ASCII Character values

	NULL	=: 0
	TAB	=: 11
	LF	=: 12
	CR	=: 15
	BLANK	=: 40
	PERCENT	=: 45
	STAR	=: 52
	COMMA	=: 54
	DOT	=: 56

; Function Return values

	BADARG	=: -2			; Bad/missing argument
	NOMATCH	=: -1			; "Not a match" return
	EXACT	=: 0			; "Exact match" return
	WILD	=: 1			; "Wildcard match" return

; Offsets to local impure area

	i.exp	=: 0
	i.cas	=: 2
	i.trm	=: 4
	i.mat	=: 6
	i.tst	=: 10
	i.res	=: 12
	impsiz	=: 14

.SBTTL	Macro references and Definitions

	.MCALL	.ASSUME

; Indicate unconditional branch

	.MACRO	......
	.ENDM	......
.SBTTL	Impure area description

;	The following impure structure is placed on the stack
;	for the life of the routine.  It is available for access
;	at any recursion depth because R5 points to it, and is not
;	altered once the structure is set up.
;
;	+---------------------------------------+
;	|	Implicit/Explicit Switch	| <-R5  I.EXP = 0
;	+---------------------------------------+
;	|	CASE Sensitivity Switch		| I.CAS = 2
;	+---------------------------------------+
;	|	TERMINATOR string pointer	| I.TRM = 4
;	+---------------------------------------+
;	|	MATCH string pointer		| I.MAT = 6
;	+---------------------------------------+
;	|	TEST string pointer		| I.TST = 10
;	+---------------------------------------+
;	|	Result Code			| I.RES = 12
;	+---------------------------------------+
.SBTTL	ISWILD Code

	.PSECT	SYS$I,I
	.ENABL	LSB

ISWILD::				; FORTRAN-callable entry point
	CMPB	@R5,#2			; At least two arguments?
	BGE	6$
4$:	MOV	#BADARG,R0		; Error return if not.
	RETURN
	............

6$:	MOV	(R5)+,R4		; Get arg count
	CALL	$NXADR			; Get TEST string address
	BCS	4$			; Error if not supplied.

	mov	sp,r2
	sub	#impsiz,sp		; Allocate impure area
	MOV	R0,-(r2)		; store TEST string pointer

	mov	#nulptr,r0		; assume local null pointer
	CALL	$NXADR			; Get MATCH string address
	mov	r0,-(r2)		; save MATCH string pointer

	mov	#nulptr,r0		; assume default terminator pointer
	call	$nxadr			; get terminator string (if there)
	mov	r0,-(r2)		; store pointer in impure area

	call	GETASW			; get CASE switch

	call	GETASW			; get IMPLICIT/EXPLICIT switch

	mov	r2,r5			; use R5 to point to impure area
	mov	i.mat(r5),R1		; Let R1 point to match string
;	tstb	@r1			; match string NULL?
	movb	@r1,r0
	call	SLEOI$			; match string a terminator?
	bmi	10$			; branch if not.
	mov	#wild,r0		; If so, assume WILD match.
	cmpb	i.exp(r5),#'E		; EXPLICIT specified?
	bne	20$			; return WILD_MATCH if not
	mov	#nomatch,r0		; otherwise NULL is NOMATCH
	br	20$
	............

10$:	mov	i.tst(r5),R3		; Let R3 point to test string

; Call the recursive wildcard routine.

	call	ISWREC			; do recursive wildcard match

20$:	add	#impsiz,sp		; recover stack space
	return				; return to caller
	............

; Service routine GETASW - Gets switch argument character.

GETASW:	clrb	-(r2)			; clear out high byte
	call	$nxadr			; get switch address
	bcs	74$
	movb	@r0,-(r2)		; get switch character
	bicb	#40,(r2)		; make indicator upper case
	br	75$
74$:	movb	#'U,-(r2)		; if not supplied, default
75$:	return
	............

	.DSABL	LSB

; R1 -> MATCH string
; R3 -> TEST string

	.ENABL	LSB

ISWREC:					; Recursive entry
	mov	r1,-(sp)		; save pointer to this level's match
	CLR	-(SP)			; allocate space for return value
10$:	CMPB	@R1,#STAR		; while (*p1 == STAR) ++p1;
	BNE	20$
	MOV	#WILD,(SP)		; indicate WILDCARD match here
	INC	R1			; point to next char in match string
	BR	10$			; eat any adjacent *'s
	......

20$:	MOVB	@R1,R0			; get char from MATCH string
	CALL	SLEOI$			; end of string?
	BPL	YESM			; if (SLEOI$(*p1)) return YES

30$:	MOV	R1,R2			; do { p2=p1, q2=q1
	MOV	R3,R4
					; FOREVER...
40$:	MOVB	@R2,R0			; is (r2) (*p2) a 
	CALL	SLEOI$			;  terminating character?
	BMI	50$			; branch if not
	MOVB	@R4,R0			; if so, test (r4) (*q2)
	CALL	SLEOI$
	BPL	YESM			; if so, it's a match.
	BR	80$
	......
50$:	CMPB	@R2,#STAR		; is match char a STAR?
	BNE	60$
	MOV	#WILD,(SP)		; declare WILD at this level,
	MOV	R2,R1			; then do
	MOV	R4,R3
	CALL	ISWREC			; recursive call.
	TST	R0			; what happened?
	BMI	NOM			; if nomatch return below.
YESM:	MOV	(SP)+,R0		; get return code
	MOV	(SP)+,R1
	RETURN
	......

60$:	CMPB	@R2,#PERCENT		; if match char is '%',
	BNE	64$
	MOVB	@R4,R0			;  and test char is end-of-item,
	CALL	SLEOI$
	BPL	80$			; It is. Doesn't pass; break out.
	MOV	#WILD,(SP)		; indicate WILDCARD match here
	CMPB	(R2)+,(R4)+		; Does pass.  Advance pointers.
	BR	40$			; and loop around to check next one.

64$:	MOVB	(R2)+,R0		; get match char,
	CALL	UCASE			; convert to upper case
	MOV	R0,-(SP)		; save result,
	MOVB	(R4)+,R0		; get test char,
	CALL	UCASE			; convert to upper case,
	CMP	(SP)+,R0		; compare the two...
	BEQ	40$			; return to FOREVER

; end do.  "While" part comes next:

80$:	CMP	R1,2(SP)		; was '*' skipped over?
	BLOS	NOM			; branch out if no
	INC	R3			; point to next character
	MOVB	@R3,R0			; get SLEOI$(*++q1)
	CALL	SLEOI$			; is it "end-of-string" character?
	BMI	30$			; keep do_ing.
NOM:	TST	(SP)+			; reclaim success code
	MOV	(SP)+,R1
	BR	NO			; fall through.

	.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.
;
;; This function is called by both ISWILD (local) and IFWILD (external)

	.ENABL	LSB

SLEOI$::				; Global entry - called from IFWILD.
	MOV	R1,-(SP)		; Save working register...
	MOV	I.TRM(R5),R1		; R1 -> terminator table
10$:	CMPB	R0,@R1			; check character against table entry
	BNE	20$
	MOV	(SP)+,R1
				.ASSUME EXACT EQ 0
YES:	CLR	R0			; Answer is YES.
	RETURN

20$:	TSTB	(R1)+			; end of table?
	BNE	10$			; continue if not.
	MOV	(SP)+,R1
NO:	MOV	#NOMATCH,R0		; else, answer is NO
	RETURN

.SBTTL	UCASE  Convert character to UPPER case

; Convert the character in R0 to UPPER case.

UCASE:	CMPB	I.CAS(R5),#'U		; CASE sensitivity requested?
	BNE	90$			; branch if so.
	CMPB	R0,#'a			; Is it a lower case character?
	BLT	90$
	CMPB	R0,#'z
	BGT	90$
	BIC	#177440,R0		; make it UPPER case.
90$:	RETURN

	.DSABL	LSB

.SBTTL	Pure Data - String Terminator Table

	.PSECT	SYS$S,D

NULPTR:	.BYTE	NULL
	.EVEN

	.END