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