<![CDATA[
/* 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 SEARCHR GENERIC
(SEARCHR_all_graphic WHEN ( GRAPHIC, GRAPHIC),
SEARCHR_all_graphic WHEN ( GRAPHIC, *),
SEARCHR_all_graphic WHEN (*, GRAPHIC),
SEARCHR_all_bit WHEN ( BIT, BIT),
SEARCHR_all WHEN (*,*),
SEARCHR_sub_graphic WHEN ( GRAPHIC, GRAPHIC, *),
SEARCHR_sub_graphic WHEN ( GRAPHIC, *, *),
SEARCHR_sub_graphic WHEN (*, GRAPHIC, *),
SEARCHR_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 right-most. */
/* The search is performed from right to left. */
SEARCHR_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, L, Lsub) 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 simpler. */
DO;
DO J = LENGTH(String) TO 1 BY -1;
IF SUBSTR(String, J, 1) = Sub THEN
RETURN (J);
END;
RETURN (0);
END;
/* 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 (from the right-hand end). */
DO J = LENGTH (STRING) TO 1 BY -1;
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 SEARCHR_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 right-most. */
/* The search is performed from right to left, commencing from character position POSITION. */
SEARCHR_sub:
PROCEDURE (STRING, SUB, POSITION) OPTIONS (REORDER)
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,
SUBSTR) BUILTIN;
DECLARE (J, K, L, Lsub) FIXED BINARY (31);
IF (Position > LENGTH (String)) | (Position < 0) THEN
DO;
SIGNAL STRINGRANGE;
RETURN (0);
END;
Lsub = LENGTH (SUB);
IF Lsub = 0 THEN RETURN (0); /* Nothing with which to search. */
L = LENGTH (STRING);
IF L = 0 THEN RETURN (0); /* There's nothing to search. */
IF Position = 0 THEN
RETURN (0);
IF LENGTH (SUB) = 1 THEN
DO; /* Looking for one character is simpler. */
DO J = POSITION TO 1 BY -1;
IF SUBSTR (STRING, J, 1) = SUB THEN
RETURN (J);
END;
RETURN (0);
END;
/* PERFORM THE SEARCH. */
K = SEARCHR_all (SUBSTR (STRING, 1, POSITION), SUB );
RETURN (K);
END SEARCHR_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 right-most. */
/* The search is performed from right to left. */
SEARCHR_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);
DO J = LENGTH(String) TO 1 BY -1;
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 SEARCHR_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 right-most. */
/* The search is performed from left to right, commencing from graphic character position */
/* POSITION. */
SEARCHR_sub_graphic:
PROCEDURE (STRING, SUB, POSITION) OPTIONS (REORDER)
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)) | (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);
DO J = Position TO 1 BY -1;
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 SEARCHR_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. The search is conducted from the right. */
SEARCHR_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. */
DO;
DO J = LENGTH(String) TO 1 BY -1;
IF SUBSTR(String, J, 1) = Sub THEN
RETURN (J);
END;
RETURN (0);
END;
/* 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 (LENGTH(String)); /* 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
DO J = LENGTH(String) TO 1 BY -1;
IF SUBSTR(String, 1, 1) THEN
RETURN (J);
END;
ELSE
DO J = LENGTH(String) TO 1 BY -1;
IF ^SUBSTR(String, 1, 1) THEN
RETURN (J);
END;
RETURN (0);
END SEARCHR_all_bit;
]]>