Trailing-Edge
-
PDP-10 Archives
-
bb-r775d-bm_tops20_ks_upd_4
-
sources/chmschstr.bli
There are 11 other files named chmschstr.bli in the archive. Click here to see a list.
%TITLE 'CHMSCHSTR - search for a string'
MODULE CHMSCHSTR ( ! Search for a string
IDENT = '3-005' ! File: CHMSCHSTR.BLI Edit: GB3005
) =
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:
!
! This module scans text looking for the search string.
!
! ENVIRONMENT: Runs at any access mode - AST reentrant
!
! AUTHOR: Bob Kushlis, CREATION DATE: Unknown
!
! MODIFIED BY:
!
! 1-001 - Original. DJS 04-Feb-1981. This module was created by
! extracting the routine EDT$$STR_SEA from module CHANGE.BLI.
! 1-002 - Regularize header. JBS 03-Mar-1981
! 1-003 - Don't check for control C so frequently. JBS 28-Jul-1981
! 1-004 - Add new WPS search. STS 05-Oct-1981 (note added 24-May-1982)
! 1-005 - Set a flag if control C actually aborts something. JBS 24-May-1982
! 1-006 - Remove EDT$$A_STR_CMP. JBS 20-Jul-1982
! 1-007 - Remove reference to EDT$$TST_CHALFA, it is not used. JBS 20-Jul-1982
! 1-008 - Do some work on performance. JBS 04-Jan-1983
! 1-009 - Add conditionals for VT220 support. JBS 11-Feb-1983
! 3-001 - Make quoted characters right justified with %C. GB 24-Mar-1983
! 3-002 - Fix problem with forward searches. GB 7-Apr-1983
! 3-003 - Add updates from V3 sources. GB 27-Apr-1983
! 3-004 - Revise code to speed up searches. GB 2--Jun-1983
! 3-005 - Remove VT220 conditional to speed up code. CJG 25-Nov-1983
!--
%SBTTL 'Declarations'
!
! TABLE OF CONTENTS:
!
REQUIRE 'EDTSRC:TRAROUNAM';
FORWARD ROUTINE
EDT$$STR_SEA;
!
! INCLUDE FILES:
!
REQUIRE 'EDTSRC:EDTREQ';
LIBRARY 'EDTSRC:TRANSLATE';
!
! MACROS:
!
! NONE
!
! EQUATED SYMBOLS:
!
! NONE
!
! OWN STORAGE:
!
! NONE
!
! EXTERNAL REFERENCES:
!
! In the routine
%SBTTL 'EDT$$STR_SEA - search for a string'
GLOBAL ROUTINE EDT$$STR_SEA ( ! Search for a string
ADDR, ! Pointer to the model string
LEN, ! Length of the model string
DIR ! Direction to search
) =
!++
! FUNCTIONAL DESCRIPTION:
!
! Search the text for a given string.
!
! FORMAL PARAMETERS:
!
! ADDR Pointer to the string to find
!
! LEN Length of the string to find
!
! DIR Direction in which to search
!
! IMPLICIT INPUTS:
!
! EXCT_MATCH
! CUR_BUF
! WK_LN
!
! IMPLICIT OUTPUTS:
!
! CUR_BUF
! CC_DONE
!
! ROUTINE VALUE:
!
! 0 Not found
! 1 Found
! 2 Terminated by control C
!
! SIDE EFFECTS:
!
! NONE
!
!--
BEGIN
EXTERNAL ROUTINE
EDT$$CHK_CC, ! Check to see if a CTRL/C has been typed
EDT$$RD_NXTLN, ! Move forward a line
EDT$$RD_PRVLN, ! Move backward a line
EDT$$STR_CMP; ! Compare two strings of equal length
EXTERNAL
EXCT_MATCH, ! Exact search or no.
CUR_BUF : REF TBCB_BLOCK, ! The current buffer tbcb
WK_LN : REF LIN_BLOCK, ! Current line pointer
CC_DONE; ! Set to 1 if control C actually aborted something
BIND
GENERAL_TABLE = UPLIT (CHAR_GENERAL_TAB) : VECTOR [256];
LOCAL
REM,
LP,
LE,
SP,
FC,
L_LEN, ! Local copy of length parameter
P_GEN_TABLE : REF VECTOR [256]; ! Pointer to table declared above
!+
! Remember the first character so we can avoid compares
! when first characters cannot possibly match.
!-
FC = CH$RCHAR (.ADDR);
!+
! Get a pointer to the translate table, to speed access to it.
!-
P_GEN_TABLE = GENERAL_TABLE [0];
!+
! Get a local copy of the length parameter, to speed tests of it.
!-
L_LEN = .LEN;
SP = CH$PTR (WK_LN [LIN_TEXT], 0, BYTE_SIZE);
LP = CH$PLUS (.SP, .CUR_BUF [TBCB_CHAR_POS]);
REM = .WK_LN [LIN_LENGTH] - .CUR_BUF [TBCB_CHAR_POS];
WHILE 1 DO
BEGIN
IF (.REM GEQ .L_LEN)
THEN
!+
! Perform a quick test for feasibility; this will avoid calling EDT$$STR_CMP for many
! non-matches.
!-
IF (.P_GEN_TABLE [CH$RCHAR (.LP)] EQL .P_GEN_TABLE [.FC])
THEN
IF EDT$$STR_CMP (.LP, .ADDR, .L_LEN, .EXCT_MATCH)
THEN
BEGIN
CUR_BUF [TBCB_CHAR_POS] = CH$DIFF (.LP, .SP);
RETURN (1);
END;
IF (.DIR EQL DIR_BACKWARD)
THEN
IF (.LP EQL .SP)
THEN
BEGIN
IF ( NOT EDT$$RD_PRVLN ()) THEN RETURN (0);
IF EDT$$CHK_CC ()
THEN
BEGIN
CC_DONE = 1;
RETURN (2);
END;
SP = CH$PTR (WK_LN [LIN_TEXT], 0, BYTE_SIZE);
LP = CH$PLUS (.SP, .WK_LN [LIN_LENGTH]);
REM = 0;
END
ELSE
BEGIN
LP = CH$PLUS (.LP, -1);
REM = .REM + 1;
END
ELSE
IF (.REM LEQ .L_LEN)
THEN
BEGIN
IF ( NOT EDT$$RD_NXTLN ()) THEN RETURN (0);
IF EDT$$CHK_CC ()
THEN
BEGIN
CC_DONE = 1;
RETURN (2);
END;
LP = SP = CH$PTR (WK_LN [LIN_TEXT], 0, BYTE_SIZE);
REM = .WK_LN [LIN_LENGTH];
END
ELSE
BEGIN
LP = CH$PLUS (.LP, 1);
REM = .REM - 1;
END
END
END; ! of routine EDT$$STR_SEA
END
ELUDOM