<![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. */
/* Revised 12 October 2001. */
DECLARE TALLY GENERIC
(TALLY_graphic WHEN (GRAPHIC, GRAPHIC),
TALLY_graphic WHEN (GRAPHIC, *),
TALLY_graphic WHEN (*, GRAPHIC),
TALLY_char WHEN (CHARACTER, CHARACTER),
TALLY_char WHEN (CHARACTER, *),
TALLY_char WHEN (*, CHARACTER),
TALLY_bit WHEN (BIT, BIT),
TALLY_char WHEN (*, *) );
/* This function procedure counts the number of times that string SUB occurs in string STRING. */
TALLY_char:
PROCEDURE (STRING, SUB) OPTIONS (REORDER)
RETURNS (FIXED BINARY (31));
/* INCOMING: STRING = the character string to be searched; */
/* SUB = the character string for which we are searching. */
DECLARE (STRING, SUB) CHARACTER (*);
DECLARE (TOTAL, POSITION) FIXED BINARY (31);
IF (LENGTH (STRING) = 0) | (LENGTH (SUB) = 0) THEN
RETURN (0);
TOTAL = 0; POSITION = 1;
DO WHILE (POSITION <= LENGTH (STRING) );
POSITION = INDEX (STRING, SUB, POSITION) + 1;
IF POSITION = 1 THEN LEAVE;
TOTAL = TOTAL + 1;
END;
RETURN (TOTAL);
END TALLY_char;
/* This function procedure counts the number of times that string SUB occurs in string STRING. */
TALLY_graphic:
PROCEDURE (STRING, SUB) OPTIONS (REORDER)
RETURNS (FIXED BINARY (31));
/* INCOMING: STRING = the character string to be searched; */
/* SUB = the character string for which we are searching. */
DECLARE (STRING, SUB) GRAPHIC (*);
DECLARE (TOTAL, POSITION) FIXED BINARY (31);
IF (LENGTH (STRING) = 0) | (LENGTH (SUB) = 0) THEN
RETURN (0);
TOTAL = 0; POSITION = 1;
DO WHILE (POSITION <= LENGTH (STRING) );
POSITION = INDEX (STRING, SUB, POSITION) + 1;
IF POSITION = 1 THEN LEAVE;
TOTAL = TOTAL + 1;
END;
RETURN (TOTAL);
END TALLY_graphic;
/* This function procedure counts the number of times that bit string SUB occurs in bit */
/* string STRING. */
TALLY_bit:
PROCEDURE (STRING, SUB) OPTIONS (REORDER)
RETURNS (FIXED BINARY (31));
/* INCOMING: STRING = the bit string to be searched; */
/* SUB = the bit string for which we are searching. */
DECLARE (STRING, SUB) BIT (*) ALIGNED;
DECLARE (TOTAL, POSITION,
J) FIXED BINARY (31);
/* A look-up table for converting bit patterns to number of bits. */
/* The look-up is 8 bits wide. */
DECLARE TABLE (0:255) FIXED BINARY (7) STATIC INITIAL (
0, 1, 1, 2, 1, 2, 2, 3, 1, 2, 2, 3, 2, 3, 3, 4,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
1, 2, 2, 3, 2, 3, 3, 4, 2, 3, 3, 4, 3, 4, 4, 5,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
2, 3, 3, 4, 3, 4, 4, 5, 3, 4, 4, 5, 4, 5, 5, 6,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
3, 4, 4, 5, 4, 5, 5, 6, 4, 5, 5, 6, 5, 6, 6, 7,
4, 5, 5, 6, 5, 6, 6, 7, 5, 6, 6, 7, 6, 7, 7, 8 );
DECLARE LIMIT FIXED BINARY (31);
DECLARE B8 BIT(8) ALIGNED;
IF (LENGTH (STRING) = 0) | (LENGTH (SUB) = 0) THEN
RETURN (0);
IF LENGTH (SUB) = 1 THEN /* This case amounts to counting 0 or 1 bits. */
DO;
IF SUB = '1'B THEN /* Fast count, 8-bits at a time. */
DO;
TOTAL = 0;
Limit = DIVIDE(LENGTH (STRING), 8, 15, 0)*8;
DO J = 1 TO Limit BY 8;
B8 = SUBSTR(STRING, J, 8);
(NOFIXEDOVERFLOW):
TOTAL = TOTAL + TABLE(B8);
END;
/* The last few bits are counted one-at-a-time. */
DO J = Limit+1 TO LENGTH (STRING);
IF SUBSTR (STRING, J, 1) = SUB THEN
TOTAL = TOTAL + 1;
END;
RETURN (TOTAL);
END;
TOTAL = 0;
DO J = 1 TO LENGTH (STRING);
IF SUBSTR (STRING, J, 1) = SUB THEN
TOTAL = TOTAL + 1;
END;
RETURN (TOTAL);
END;
TOTAL = 0; POSITION = 1;
DO WHILE (POSITION <= LENGTH (STRING) );
POSITION = INDEX (STRING, SUB, POSITION) + 1;
IF POSITION = 1 THEN LEAVE;
TOTAL = TOTAL + 1;
END;
RETURN (TOTAL);
END TALLY_bit;
]]>