/* Copyright (c) 1995 by R. A. Vowels, from "Introduction to PL/I, Algorithms, and */
/* Structured Programming". Permission is given to reproduce and to use these procedures */
/* as part of a program, and to include them as part of a larger work to be sold for profit. */
/* However, the user is not permitted to sell the procedures separately. Provided always */
/* that these procedures and this copyright notice are reproduced in full. */
DECLARE SEARCH GENERIC
(SEARCH_all_graphic WHEN ( GRAPHIC, GRAPHIC),
SEARCH_all_graphic WHEN ( GRAPHIC, *),
SEARCH_all_graphic WHEN (*, GRAPHIC),
SEARCH_all_bit WHEN ( BIT, BIT),
SEARCH_all WHEN (*,*),
SEARCH_sub_graphic WHEN ( GRAPHIC, GRAPHIC, *),
SEARCH_sub_graphic WHEN ( GRAPHIC, *, *),
SEARCH_sub_graphic WHEN (*, GRAPHIC, *),
SEARCH_sub_bit WHEN ( BIT, BIT, *),
SEARCH_sub WHEN (*,*,*) );
/* This function procedure searches the first string STRING for any characters given in the */
/* second string SUB. If there are any such characters, the function returns the position */
/* of the left-most. */
SEARCH_all:
PROCEDURE (STRING, SUB) OPTIONS (REORDER)
RETURNS (FIXED BINARY (31));
/* INCOMING: STRING = the string to be searched; */
/* SUB = contains characters to look for. */
DECLARE (STRING, SUB) CHARACTER (*);
DECLARE (LENGTH, SUBSTR,
UNSPEC, INDEX) BUILTIN;
DECLARE Table (0:255) BIT (1) STATIC ALIGNED;
DECLARE (J, K) FIXED BINARY (31);
IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */
RETURN (0);
IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */
RETURN (0);
IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */
RETURN (INDEX (STRING, SUB));
/* SETS UP A LOOK-UP TABLE (which is independent of the character set). */
Table = '0'B; /* All entries are FALSE. */
DO J = 1 TO LENGTH (Sub);
K = UNSPEC (SUBSTR (Sub, J, 1));
Table (K) = '1'B; /* Table(k) is TRUE for each character in SUB. */
END;
/* CONDUCT THE SEARCH. */
DO J = 1 TO LENGTH (STRING);
K = UNSPEC (SUBSTR (STRING, J, 1));
IF Table(K) THEN /* TRUE when a SUB character matches one in */
RETURN (J); /* STRING. */
END;
RETURN (0); /* Unsuccessful search. */
END SEARCH_all;
/* This function procedure searches the first string STRING for any characters given in the */
/* second string SUB. If there are any such characters, the function returns the position */
/* of the left-most. */
/* The search is performed from left to right, commencing from character position */
/* POSITION. */
SEARCH_sub:
PROCEDURE (STRING, SUB, POSITION) RETURNS (FIXED BINARY (31));
/* INCOMING: STRING = the string to be searched; */
/* SUB = contains characters to look for; */
/* POSITION = where to start the search (measured from the left-hand end of */
/* STRING). */
DECLARE (STRING, SUB) CHARACTER (*);
DECLARE POSITION FIXED BINARY (31);
DECLARE (LENGTH, INDEX) BUILTIN;
DECLARE K FIXED BINARY (31);
IF (Position > LENGTH (String)+1) | (Position <= 0) THEN
DO;
SIGNAL STRINGRANGE;
RETURN (0);
END;
IF LENGTH (STRING) = 0 THEN RETURN (0);
K = SEARCH_all ( SUBSTR (STRING, POSITION), SUB);
IF K = 0 THEN RETURN (0);
RETURN (POSITION+K-1);
END SEARCH_sub;
/* This function procedure searches the first string STRING for any characters given in the */
/* second string SUB. If there are any such characters, the function returns the position */
/* of the left-most. */
SEARCH_all_graphic:
PROCEDURE (STRING, SUB) OPTIONS (REORDER)
RETURNS ( FIXED BINARY (31));
/* INCOMING: STRING = the string to be searched; */
/* SUB = contains characters to look for. */
DECLARE (STRING, SUB) GRAPHIC (*);
DECLARE (LENGTH,
SUBSTR,
INDEX) BUILTIN;
DECLARE (J, K) FIXED BINARY (31);
DECLARE Ch GRAPHIC (1);
IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */
RETURN (0);
IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */
RETURN (0);
IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */
RETURN (INDEX (STRING, SUB));
DO J = 1 TO LENGTH(String);
Ch = SUBSTR(String, J, 1); /* Select one graphic character from the string to*/
/* be searched. */
K = INDEX (Sub, Ch); /* Check whether it is one of those on our search list.*/
IF K ^= 0 THEN /* If it is, we are done. */
RETURN (J);
END;
RETURN (0); /* The search was unsuccessful. */
END SEARCH_all_graphic;
/* This function procedure searches the first string STRING for any graphic characters */
/* given in the second string SUB. If there are any such graphic characters, the function */
/* returns the position of the left-most. */
/* The search is performed from left to right, commencing from graphic character position */
/* POSITION. */
SEARCH_sub_graphic:
PROCEDURE (STRING, SUB, POSITION) RETURNS (FIXED BINARY (31));
/* INCOMING: STRING = the string to be searched; */
/* SUB = contains characters to look for; */
/* POSITION = where to start the search (measured from the left-hand end of */
/* STRING). */
DECLARE (STRING, SUB) GRAPHIC (*);
DECLARE POSITION FIXED BINARY (31);
DECLARE (LENGTH, SUBSTR,
INDEX) BUILTIN;
DECLARE (J, K) FIXED BINARY (31);
DECLARE Ch GRAPHIC (1);
IF (Position > LENGTH (String)+1) | (Position <= 0) THEN
DO;
SIGNAL STRINGRANGE;
RETURN (0);
END;
IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */
RETURN (0);
IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */
RETURN (0);
IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */
RETURN (INDEX (SUBSTR (STRING, Position), SUB)+Position-1);
DO J = Position TO LENGTH(String);
Ch = SUBSTR(String, J, 1); /* Select one graphic character from the string to */
/* be searched. */
K = INDEX (Sub, Ch); /* Check whether it is one of those on our search list.*/
IF K ^= 0 THEN /* If it is, we are done. */
RETURN (J);
END;
RETURN (0); /* The search was unsuccessful. */
END SEARCH_sub_graphic;
/* This function procedure searches the first string STRING for any bits given in the */
/* second string SUB. If there are any such bits, the function returns the position */
/* of the left-most. */
SEARCH_all_bit:
PROCEDURE (STRING, SUB) OPTIONS (REORDER)
RETURNS ( FIXED BINARY (31));
/* INCOMING: STRING = the string to be searched; */
/* SUB = contains bits to look for. */
DECLARE (STRING, SUB) BIT (*);
DECLARE (LENGTH, SUBSTR,
INDEX) BUILTIN;
DECLARE (J, K) FIXED BINARY (31);
IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */
RETURN (0);
IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */
RETURN (0);
IF LENGTH (SUB) = 1 THEN /* Looking for one bit is fast. */
RETURN (INDEX (STRING, SUB));
/* When we come here, SUB has 2 or more bits. */
K = INDEX (SUB, ^SUBSTR(SUB, 1, 1)); /* Look for a bit of the opposite kind. */
IF K > 0 THEN /* No need for a search -- the key SUB consists */
/* of both 0 and 1. */
RETURN (1); /* Always get a match at position 1. */
/* The pattern SUB contains either all ones or all zeros. */
/* CONDUCT THE SEARCH. */
IF SUBSTR(SUB, 1, 1) THEN
RETURN (INDEX(STRING, '1'B));
ELSE
RETURN (INDEX(STRING, '0'B));
END SEARCH_all_bit;
/* This function procedure searches the first string STRING for any bits given in the */
/* second string SUB. If there are any such bits, the function returns the position */
/* of the left-most. */
SEARCH_sub_bit:
PROCEDURE (String, Sub, Position) OPTIONS (REORDER)
RETURNS ( FIXED BINARY (31));
/* INCOMING: STRING = the string to be searched; */
/* SUB = contains bits to look for. */
DECLARE (String, Sub) BIT (*);
DECLARE (LENGTH, SUBSTR,
INDEX) BUILTIN;
DECLARE (J, K) FIXED BINARY (31);
IF (Position > LENGTH (String)+1) | (Position <= 0) THEN
DO;
SIGNAL STRINGRANGE;
RETURN (0);
END;
IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */
RETURN (0);
IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */
RETURN (0);
IF Position = LENGTH(String)+1 THEN
RETURN (0);
IF LENGTH (SUB) = 1 THEN /* Looking for one bit is fast. */
RETURN (INDEX(SUBSTR(STRING, Position), SUB)+Position-1);
/* When we come here, SUB has 2 or more bits. */
K = INDEX (SUBSTR(String, Position), ^SUBSTR(SUB, 1, 1));
/* Look for a bit of the opposite kind. */
IF K > 0 THEN /* No need for a search -- the key SUB consists */
/* of both 0 and 1. */
RETURN (Position); /* Always get a match at position "Position". */
/* The pattern SUB contains either all ones or all zeros. */
/* CONDUCT THE SEARCH. */
IF SUBSTR(SUB, 1, 1) THEN
RETURN (INDEX(SUBSTR(STRING, Position), '1'B)+Position-1);
ELSE
RETURN (INDEX(SUBSTR(STRING, Position), '0'B)+Position-1);
END SEARCH_sub_bit;