Google
 

Trailing-Edge - PDP-10 Archives - BB-AE97C-BM - sources/uexacase.bli
There are 10 other files named uexacase.bli in the archive. Click here to see a list.
 %TITLE 'UEXACASE - exact case matching'
MODULE UEXACASE (				! Exact case matching
		IDENT = '3-003'			! File: UEXACASE.BLI Edit: CJG3003
		) =
BEGIN
!
!			  COPYRIGHT (c) 1981, 1985 BY
!	      DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
!		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 WHICH IS NOT SUPPLIED BY DIGITAL.
!

!++
! FACILITY:	EDT -- The DEC Standard Editor
!
! ABSTRACT:
!
!	Exact case matching.
!
! ENVIRONMENT:	Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: February 7, 1978
!
! MODIFIED BY:
!
! 1-001	- Original.  DJS 19-FEB-1981.  This module was created by
!	extracting routine EDT$$STR_CMP  from module UTIL.
! 1-002	- Regularize headers.  JBS 11-Mar-1981
! 1-003	- Add a parameter, to eliminate the other string compare routines,
!	   and add two new search types.  This amounts to support of the
!	   DEC Multinational character set.  JBS 20-Jul-1982
! 1-004	- Put VT220 support under a conditional.  JBS 10-Feb-1983
! 1-005	- Make unimplemented searches = general.  JBS 14-Feb-1983
! 3-001 - Add support for SET SEARCH IGNORE. CJG 2-Nov-1983
! 3-002 - Remove VT220 conditional to speed up code. CJG 25-Nov-1983
! 3-003 - Modify ASSERT macro to include error code. CJG 30-Jan-1984
!--

%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!

REQUIRE 'EDTSRC:TRAROUNAM';

FORWARD ROUTINE
    EDT$$STR_CMP;

!
! INCLUDE FILES:
!

REQUIRE 'EDTSRC:EDTREQ';

LIBRARY 'EDTSRC:TRANSLATE';

!
! MACROS:
!
!	NONE
!
! EQUATED SYMBOLS:
!
!	NONE
!
! OWN STORAGE:
!
!	NONE
!
! EXTERNAL REFERENCES:
!
!	In the routine
%SBTTL 'EDT$$STR_CMP  - exact case matching'

GLOBAL ROUTINE EDT$$STR_CMP (			! Exact case matching
	SOURCE, 				! Pointer to source string
	OBJECT, 				! Pointer to object string
	OBJ_LEN,				! Length of both strings
	MATCH					! Type of match
    ) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	This routine compares two strings of equal length.  There are several
!	types of comparison that can be done.
!
! FORMAL PARAMETERS:
!
!  SOURCE		Pointer to the source string.
!
!  OBJECT		Pointer to the object string.
!
!  OBJ_LEN		Length of both strings.
!
!  MATCH		The type of matching: 0 = general, 1 = exact, 2 = WPS,
!			 3 = case_insensitive, 4 = diacritical_insensitive
!
! IMPLICIT INPUTS:
!
!	NONE
!
! IMPLICIT OUTPUTS:
!
!	NONE
!
! ROUTINE VALUE:
!
!	Returns one if the strings match, zero if not.
!
! SIDE EFFECTS:
!
!	NONE
!
!--

    BEGIN

    BIND
	GENERAL_TABLE = UPLIT (CHAR_GENERAL_TAB) : VECTOR [256],
	CI_TABLE = UPLIT (CHAR_CI_TAB) : VECTOR [256],
	DI_TABLE = UPLIT (CHAR_DI_TAB) : VECTOR [256];


    EXTERNAL
	CHAR_INFO : BLOCKVECTOR [256, 1],	! Information about characters
	IGN_LEN,			!Length of IGNORE string
	IGN_PTR;			!Pointer to IGNORE string

    CASE .MATCH FROM 0 TO 4 OF
	SET

	[0] : 				! General: disregard both the case of letters and diacritical marks
	    BEGIN

	    LOCAL
		SP,
		OP;

	    OP = .OBJECT;
	    SP = .SOURCE;
	    ASSERT (7, (.SP NEQA 0) AND (.OP NEQA 0));

	    DECR I FROM .OBJ_LEN - 1 TO 0 DO
		BEGIN

		LOCAL
		    SC,
		    OC;

		IF (.IGN_LEN EQL 0)
		THEN
		    BEGIN
		    SC = CH$RCHAR_A (SP);
		    OC = CH$RCHAR_A (OP);
		    END
		ELSE
		    BEGIN
		    DO SC = CH$RCHAR_A (SP)
			WHILE NOT CH$FAIL (CH$FIND_CH (.IGN_LEN, .IGN_PTR, .SC));
		    WHILE 1 DO
			BEGIN
		        OC = CH$RCHAR_A (OP);
			IF CH$FAIL (CH$FIND_CH (.IGN_LEN, .IGN_PTR, .OC)) THEN EXITLOOP;
			I = .I - 1;
			IF (.I LEQ 0) THEN RETURN (1);
			END;
		    END;

		IF (.GENERAL_TABLE [.SC] NEQ .GENERAL_TABLE [.OC]) THEN RETURN (0);

		END;

	    END;

	[1] : 					! Exact match

	    IF ( NOT CH$EQL (.OBJ_LEN, .SOURCE, .OBJ_LEN, .OBJECT)) THEN RETURN (0);

	[2] :
!+
! WPS matching: if the object (model) character is a lower case letter,
! the source character may be either upper or lower case.
! Otherwise, an exact match is required.
!-
	    BEGIN

	    LOCAL
		SP,
		OP,
		OC;

	    OP = .OBJECT;
	    SP = .SOURCE;
	    ASSERT (7, (.SP NEQA 0) AND (.OP NEQA 0));

	    DECR I FROM .OBJ_LEN - 1 TO 0 DO
		BEGIN
		OC = CH$RCHAR_A (OP);

		IF .CHAR_INFO [.OC, CI_LC]	! If OC is lower case
		THEN
		    BEGIN

		    IF (.CI_TABLE [.OC] NEQ .CI_TABLE [CH$RCHAR_A (SP)]) THEN RETURN (0);

		    END
		ELSE
		    BEGIN

		    IF (.OC NEQ CH$RCHAR_A (SP)) THEN RETURN (0);

		    END;

		END;

	    END;

	[3] : 					! Case-insensitive matching
	    BEGIN

	    LOCAL
		SP,
		OP;

	    OP = .OBJECT;
	    SP = .SOURCE;
	    ASSERT (7, (.SP NEQA 0) AND (.OP NEQA 0));

	    DECR I FROM .OBJ_LEN - 1 TO 0 DO
		BEGIN

		IF (.CI_TABLE [CH$RCHAR_A (SP)] NEQ .CI_TABLE [CH$RCHAR_A (OP)]) THEN RETURN (0);

		END;

	    END;

	[4] : 					! Diacritical-insensitive matching
	    BEGIN

	    LOCAL
		SP,
		OP;

	    OP = .OBJECT;
	    SP = .SOURCE;
	    ASSERT (7, (.SP NEQA 0) AND (.OP NEQA 0));

	    DECR I FROM .OBJ_LEN - 1 TO 0 DO
		BEGIN

		IF (.DI_TABLE [CH$RCHAR_A (SP)] NEQ .DI_TABLE [CH$RCHAR_A (OP)]) THEN RETURN (0);

		END;

	    END;

	[OUTRANGE] :
	    ASSERT (3, 0);
	TES;

    RETURN (1);
    END;


END
ELUDOM