Google
 

Trailing-Edge - PDP-10 Archives - BB-H138F-BM_1988 - 7-sources/diuwld.b36
There are 4 other files named diuwld.b36 in the archive. Click here to see a list.
%TITLE 'DIUWLD - Preform wildarded string match'

MODULE diuwld (
             IDENT = '257',
             ENTRY(
                   wild_match           ! Check for wildcard match
                   )
             )=
BEGIN

!	COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1986.
!	ALL RIGHTS RESERVED.
!
!	THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED  AND
!	COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND 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.  NO TITLE TO AND OWNERSHIP OF  THE
!	SOFTWARE IS HEREBY TRANSFERRED.
!
!	THE INFORMATION IN THIS SOFTWARE IS  SUBJECT  TO  CHANGE  WITHOUT
!	NOTICE  AND  SHOULD  NOT  BE CONSTRUED AS A COMMITMENT BY DIGITAL
!	EQUIPMENT CORPORATION.
!
!	DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR  RELIABILITY  OF
!	ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
!
! FACILITY:     DIU (Data Interchange Utility for TOPS-10/20)
!
! ABSTRACT:     This module provides wildcard string matching.
!
! ENVIRONMENT:  TOPS-10 V7.02 or TOPS-20 V6.1, XPORT-10, BLISS-36 V4
!
! AUTHOR: Larry Campbell,                CREATION DATE: March 11, 1982
!
!  257  Change library BLI:MONSYM to just MONSYM.
!       Gregory A. Scott 7-Jul-86
!
!  253  Rename file to DIUWLD.
!       Gregory A. Scott 1-Jul-86
!
! 03 - Create code to emulate the WILD% JSYS on TOPS-10
!      [Doug Rayner, 14-Aug-85]
!--

%IF %SWITCHES (TOPS20)
%THEN
     LIBRARY 'MONSYM';                  ! TOPS-20 ONLY
%ELSE
     LIBRARY 'BLI:XPORT';               ! TOPS-10 ONLY
     LIBRARY 'DIU';
%FI

GLOBAL ROUTINE wild_match (wild_string, match_string) =
!++
! FUNCTIONAL DESCRIPTION:
!   This routine performs a wildcard string compare.  On TOPS-20 use the
! WILD% JSYS.  On TOPS-10 we have emulated the WILD% JSYS in BLISS.
!
! FORMAL PARAMETERS:
!   wild_string         - character pointer to wildcard string to test
!   match_string        - character pointer to string to match against
!
! IMPLICIT INPUTS:
!   NONE
!
! IMPLICIT OUTPUTS:
!   NONE
!
! ROUTINE VALUE and
! COMPLETION CODES:
!   1   - strings match
!   0   - strings do not match
!
! SIDE EFFECTS:
!   NONE
!
!--
%IF %SWITCHES (TOPS20)
%THEN                                   ! TOPS-20 VERSION OF WILD_MATCH ROUTINE
    BEGIN

    BUILTIN
        JSYS;

    REGISTER
        ac1 = 1,
        ac2 = 2,
        ac3 = 3;

    ac1 = $WLSTR;                       ! Wild string function code
    ac2 = .wild_string;
    ac3 = .match_string;

    JSYS (0, WILD_, ac1, ac2, ac3);

    RETURN (.ac1 EQL 0)

    END;                                ! End of wild_match
%ELSE                                   ! TOPS-10 VERSION OF WILD_MATCH ROUTINE

    BEGIN

    LOCAL
	wild_length,
	match_length,
	result,
	wild_delim,
	match_delim,
	wild_descr : $STR_DESCRIPTOR(CLASS=DYNAMIC_BOUNDED),
	match_descr : $STR_DESCRIPTOR(CLASS=DYNAMIC_BOUNDED);
    !
    ! Find length of strings and watch out for zero length
    !
    wild_length = ASCIZ_LEN(.wild_string);
    match_length = ASCIZ_LEN(.match_string);
    IF .match_length EQL 0
    THEN
	BEGIN
	IF .wild_length EQL 0
	THEN
	    RETURN(1)
	ELSE
	    RETURN(0);
	END;
    !
    ! Initialize string descriptors for the two strings
    !
    $STR_DESC_INIT(DESC=wild_descr, CLASS=DYNAMIC_BOUNDED);
    $STR_DESC_INIT(DESC=match_descr, CLASS=DYNAMIC_BOUNDED);
    !
    ! Copy the strings and convert to upper-case so we remain case insensitive.
    !
    $STR_COPY(
	STRING=$STR_FORMAT((.wild_length + 1, .wild_string), UP_CASE),
	TARGET=wild_descr);
    $STR_COPY(
	STRING=$STR_FORMAT((.match_length + 1, .match_string), UP_CASE),
	TARGET=match_descr);
    !
    ! So that we can use REMAINDER scanning below, zero string lengths
    !
    wild_descr[STR$H_LENGTH] = match_descr[STR$H_LENGTH] = 0;
    !
    ! Now, interpret the wildcarding
    !
    result = (WHILE 1 DO
	!
	! Look for the next wildcard character
	!
	BEGIN
	$STR_SCAN(REMAINDER=wild_descr, SUBSTRING=wild_descr,
	    DELIMITER=wild_delim, STOP=%CHAR(%C'*',%C'?',%C'%',0));
	!
	! Make sure the substrings before the next wild char match.
	!
	IF NOT $STR_EQL(STRING1=wild_descr,
	    STRING2=(.wild_descr[STR$H_LENGTH],
		CH$PLUS(.match_descr[STR$A_POINTER],
			.match_descr[STR$H_LENGTH])))
	THEN
	    EXITLOOP(0);
	!
	! Match so far.  Move wild_string past wildcard character, and move
	!  match_string over the matched sub-string, if any.
	!
	IF .wild_descr[STR$H_LENGTH] GTR 0
	THEN
	    $STR_SCAN(REMAINDER=match_descr, FIND=wild_descr,
		DELIMITER=match_delim, SUBSTRING=match_descr);

	wild_descr[STR$H_LENGTH] =	! Update wild string length
	    .wild_descr[STR$H_LENGTH] + 1;
	!
	! Act on the particular wildcard character
	!
	SELECT .wild_delim OF
	SET

	[0]:
	    !
	    ! At end of wild string.  If also at end of match string, we
	    !  win, else we loose.
	    !
	    IF .match_delim EQL 0
	    THEN
		EXITLOOP(1)
	    ELSE
		EXITLOOP(0);

	[%C'?', %C'%']:
	    !
	    ! Wild character.  Advance match string one character
	    !  (unless at the end of the match string) and continue the scan.
	    !
	    IF .match_delim NEQ 0
	    THEN
		BEGIN
		match_descr[STR$H_LENGTH] = .match_descr[STR$H_LENGTH] + 1;
		match_delim = CH$RCHAR(CH$PLUS(.match_descr[STR$A_POINTER],
						.match_descr[STR$H_LENGTH]));
		END;

	[%C'*']:
	    !
	    ! Scan to next wild character.
	    !
	    BEGIN
	    $STR_SCAN(REMAINDER=wild_descr, SUBSTRING=wild_descr,
		DELIMITER=wild_delim, STOP=%CHAR(%C'*',%C'?',%C'%',0));
	    !
	    ! If at end of wild string, we have a match
	    !
	    IF .wild_descr[STR$H_LENGTH] EQL 0
	    THEN
		IF .wild_delim EQL 0
		THEN
		    EXITLOOP(1)
		ELSE
		    EXITLOOP(0);
	    !
	    ! Find this substring in the match string. If found, continue scan,
	    !  else, match fails
	    !
	    IF NOT $STR_SCAN(REMAINDER=match_descr, FIND=wild_descr,
		DELIMITER=match_delim, SUBSTRING=match_descr)
	    THEN
		EXITLOOP(0);
	    END;
	TES;

	END);				! End of DO forever

    !
    ! Release the memory used by the dynamic strings
    !
    $XPO_FREE_MEM(STRING=wild_descr);
    $XPO_FREE_MEM(STRING=match_descr);
    !
    ! Return result
    !
    RETURN(.result);
    END;                                ! End of wild_match

%FI                                     ! END OF TOPS-10 / TOPS-20 CONDITIONAL


END                                     ! End of module
ELUDOM