Trailing-Edge
-
PDP-10 Archives
-
bb-h138f-bm
-
7-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) 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:
!
! 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