<![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 VERIFY3 GENERIC
(VERIFY_sub_graphic WHEN (GRAPHIC,GRAPHIC,*),
VERIFY_sub_graphic WHEN (GRAPHIC,*,*),
VERIFY_sub_graphic WHEN (*, GRAPHIC,*),
VERIFY_sub WHEN (*,*,*) );
/* This function procedure searches the first string STRING for any characters that do */
/* not exist in 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. */
VERIFY_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 Table (0:255) BIT (1) STATIC ALIGNED;
DECLARE (J, K) FIXED BINARY (31);
IF (Position > LENGTH (String)+1 ) | (Position <= 0) THEN
DO;
SIGNAL STRINGRANGE;
RETURN (0);
END;
IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */
RETURN (0);
IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */
RETURN (Position);
IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */
DO;
DO J = POSITION TO LENGTH(String);
IF SUBSTR(STRING, J, 1) ^= SUB THEN
RETURN (J);
END;
RETURN (0); /* Unsuccessful search. */
END;
/* SETS UP A LOOK-UP TABLE (which is independent of character set). */
Table = '1'B; /* All entries are TRUE. */
DO J = 1 TO LENGTH (Sub);
K = UNSPEC (SUBSTR (Sub, J, 1));
Table (K) = '0'B; /* Table(k) is FALSE for each character in SUB. */
END;
/* CONDUCT THE SEARCH (forwards). */
DO J = POSITION TO LENGTH(String);
K = UNSPEC (SUBSTR (STRING, J, 1));
IF Table(K) THEN /* TRUE when a SUB character does not match one */
RETURN (J); /* in STRING. */
END;
RETURN (0); /* Unsuccessful search. */
END VERIFY_sub;
/* This function procedure searches the first string STRING for any characters that do */
/* not exist in 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. */
/* See the note for VERIFYR for the strategy for GRAPHIC strings. */
VERIFY_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 Table (0:65535) BIT (1) STATIC ALIGNED INITIAL ( (65536)(1)'1'B ),
Table_Set BIT(1) STATIC INITIAL ( '1'B);
DECLARE (J, K, L) FIXED BINARY (31);
IF (Position > LENGTH (String)+1 ) | (Position <= 0) THEN
DO;
SIGNAL STRINGRANGE;
RETURN (0);
END;
IF LENGTH (STRING) = 0 THEN /* There's nothing to search. */
RETURN (0);
IF LENGTH (SUB) = 0 THEN /* Nothing with which to search. */
RETURN (Position);
IF LENGTH (SUB) = 1 THEN /* Looking for one character is fast. */
DO;
DO J = POSITION TO LENGTH(String);
IF SUBSTR(STRING, J, 1) ^= SUB THEN
RETURN (J);
END;
RETURN (0); /* Unsuccessful search. */
END;
/* SETS UP A LOOK-UP TABLE (which is independent of character set). */
IF ^Table_Set THEN
Table = '1'B; /* All entries are TRUE. */
Table_Set = '0'B;
DO J = 1 TO LENGTH (Sub);
K = UNSPEC (SUBSTR (Sub, J, 1));
Table (K) = '0'B; /* Table(k) is FALSE for each character in SUB. */
END;
/* CONDUCT THE SEARCH (forwards). */
DO J = POSITION TO LENGTH(String);
K = UNSPEC (SUBSTR (STRING, J, 1));
IF Table(K) THEN /* TRUE when a SUB character does not match one */
DO; /* in STRING. */
DO L = 1 TO LENGTH (Sub);
K = UNSPEC (SUBSTR (Sub, L, 1));
Table (K) = '1'B; /* Table(k) is TRUE for each character in SUB. */
END;
Table_Set = '1'B;
RETURN (J);
END;
END;
/* RESTORE THE LOOLUP TABLE */
DO L = 1 TO LENGTH (Sub);
K = UNSPEC (SUBSTR (Sub, L, 1));
Table (K) = '1'B; /* Table(k) is TRUE for each character in SUB. */
END;
Table_Set = '1'B;
RETURN (0); /* Unsuccessful search. */
END VERIFY_sub_graphic;
]]>