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