Google
 

Trailing-Edge - PDP-10 Archives - bb-h138f-bm - 7-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) DIGITAL EQUIPMENT CORPORATION 1981, 1988.  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:	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