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