/* REXX PROGRAM */
/*--------------------------------------------------------------*/
/* THIS PROGRAM WILL COUNT THE NUMBER OF BYTES PRESENT IN */
/* A RANGE OF INPUT ( BOUNDED BY THE LINE COMMAND 'C' OR 'CC').*/
/* THE OUTPUT WILL BE DISPLAYED ON THE UPPER RIGHT SIDE OF THE */
/* SCREEN. */
/*to run: ALTLIB ACT APPL(CLIST) DS('T01.E014806.CLIST') */
/*ALLOC FI(SYSEXEC) DA('t01.e014806.clist') SHR REUSE*/
/*--------------------------------------------------------------*/
/* TRACE I*/
SUM = 0
VALUE = 0
OCC_1_LVL = 99
OCC_1_TIMES = 1
OCC_2_LVL = 99
OCC_2_TIMES = 1
OCC_3_LVL = 99
OCC_3_TIMES = 1
OCC_4_LVL = 99
OCC_4_TIMES = 1
OCC_5_LVL = 99
OCC_5_TIMES = 1
ADDRESS ISREDIT
'ISREDIT MACRO NOPROCESS'
ADDRESS ISPEXEC
'ISPEXEC CONTROL ERRORS RETURN'
ADDRESS ISREDIT
'ISREDIT PROCESS RANGE C CC'
SELECT
WHEN RC = 4 THEN
DO
ZEDSMSG = 'ENTER C OR CC'
ZEDLMSG = 'ENTER A C OR CC ON LINE'
ADDRESS ISPEXEC
'ISPEXEC SETMSG MSG(ISRZ001)'
EXIT 12
END
WHEN RC > 4 THEN
EXIT RC
OTHERWISE NOP
END
/* GET FIRST AND LAST LINE OF THE INPUT */
ADDRESS ISREDIT
'ISREDIT (FIRST) = LINENUM .ZFRANGE'
'ISREDIT (LAST) = LINENUM .ZLRANGE'
PREV_REC = ''
DO LPTR = FIRST TO LAST
ADDRESS ISREDIT
'ISREDIT (REC) = LINE' LPTR
/* LINE IS COMMENTED OUT */
IF SUBSTR(REC,7,1) = '*' THEN
DO
ITERATE
END
/* OMIT LINE 1-7 AND 73-80 */
REC = SUBSTR(REC,8,65)
/* SAY 'REC =' REC */
WORD_CNT = WORDS(REC)
IF WORD_CNT = 0 THEN
ITERATE
/* THIS CHECKS IF LAST CHAR IN THE RECORD IS A PERIOD */
IF SUBSTR(WORD(REC,WORD_CNT),WORDLENGTH(REC,WORD_CNT),1) ^= '.' THEN
DO
PREV_REC = PREV_REC || ' ' || REC
ITERATE
END
ELSE
DO
REC = PREV_REC || ' ' || REC
PREV_REC = ''
END
/* GET LEVEL NUMBER */
LEVEL = WORD(REC,1)
/* SAY 'LVL=' LEVEL */
IF LEVEL = 88 THEN
ITERATE
CALL CLEAN_UP_OCCURS_ARRAY /* INITIALIZE OCCURS ARRAY IF */
/* POSSIBLE DUE TO NEW LEVEL NO */
/* CHECK IF PART OF A REDEFINES */
IF REDEFINES_ACTIVE = 'YES' THEN
DO
IF LEVEL > REDEFINES_LEVEL THEN
ITERATE
ELSE
REDEFINES_ACTIVE = 'NO'
END
/* LINE IS A REDEFINES LINE */
IF INDEX(REC,' REDEFINE ') > 0,
| INDEX(REC,' REDEFINES ') > 0 THEN
DO
REDEFINES_ACTIVE = 'YES'
REDEFINES_LEVEL = LEVEL
ITERATE
END
/* LINE IS AN OCCURS LINE */
IF INDEX(REC,' OCCURS ') > 0,
| INDEX(REC,' OCCUR ') > 0 THEN
CALL SAVE_OCCURS_IN_ARRAY /* INITIALIZE OCCURS ARRAY IF */
/* POSSIBLE DUE TO NEW LEVEL NO */
/* GET POSITION OF 'PIC' */
PIC_POS = WORDPOS(' PIC ',REC)
IF PIC_POS = 0 THEN
/* GET POSITION OF 'PICTURE' */
PIC_POS = WORDPOS(' PICTURE ',REC)
IF PIC_POS = 0 THEN
DO
VALUE = 0
END
ELSE
DO
/* GET VALUE AFTER 'PIC' */
PIC_VALUE_WORD = WORD(REC,PIC_POS + 1)
VALUE = 0
CALL PIC_VALUE
END
/* SAY '#1' LEVEL OCC_1_LVL OCC_1_TIMES */
/* SAY '#2' LEVEL OCC_2_LVL OCC_2_TIMES */
/* SAY '#3' LEVEL OCC_3_LVL OCC_3_TIMES */
/* SAY '#4' LEVEL OCC_4_LVL OCC_4_TIMES */
/* SAY '#5' LEVEL OCC_5_LVL OCC_5_TIMES */
IF LEVEL > OCC_1_LVL,
| ( LEVEL = OCC_1_LVL,
& LPTR = OCC_1_LINE ) THEN
VALUE = VALUE * OCC_1_TIMES
IF LEVEL > OCC_2_LVL,
| ( LEVEL = OCC_2_LVL,
& LPTR = OCC_2_LINE ) THEN
VALUE = VALUE * OCC_2_TIMES
IF LEVEL > OCC_3_LVL,
| ( LEVEL = OCC_3_LVL,
& LPTR = OCC_3_LINE ) THEN
VALUE = VALUE * OCC_3_TIMES
IF LEVEL > OCC_4_LVL,
| ( LEVEL = OCC_4_LVL,
& LPTR = OCC_4_LINE ) THEN
VALUE = VALUE * OCC_4_TIMES
IF LEVEL > OCC_5_LVL,
| ( LEVEL = OCC_5_LVL,
& LPTR = OCC_5_LINE ) THEN
VALUE = VALUE * OCC_5_TIMES
/* SAY 'VALUE = ' VALUE */
SUM = SUM + VALUE
END
/* SAY SUM */
ZEDSMSG = SUM || ' BYTE(S)'
ZEDLMSG = 'TOTAL NUMBER OF BYTE(S) IS' SUM
ADDRESS ISPEXEC
'ISPEXEC SETMSG MSG(ISRZ001)'
EXIT
/*************************/
/* END OF PROGRAM */
/*************************/
/*************************/
/* ROUTINE TO COUNT THE */
/* PICTURE IN A LINE */
/*************************/
PIC_VALUE:
VALUE = 0
VALUE_IN_PAREN = 0
DO W1 = 1 TO LENGTH(PIC_VALUE_WORD)
/* SAY SUBSTR(PIC_VALUE_WORD,W1,1) */
SELECT
WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = ' ' THEN
ITERATE
WHEN LOOK_FOR_CLOSE_PAREN = 'YES' THEN
DO
IF SUBSTR(PIC_VALUE_WORD,W1,1) ^= ')' THEN
ITERATE
ELSE
DO
LOOK_FOR_CLOSE_PAREN = 'NO'
ITERATE
END
END
WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = 'S' THEN
DO
ITERATE
END
WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = 'V' THEN
DO
ITERATE
END
WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = '(' THEN
DO
VALUE = VALUE - 1
OPEN_PAREN_FOUND = 'YES'
ITERATE
END
WHEN OPEN_PAREN_FOUND = 'YES' THEN
DO
RPAREN_POS = INDEX(PIC_VALUE_WORD,')',W1)
VALUE_IN_PAREN = SUBSTR(PIC_VALUE_WORD,W1,RPAREN_POS - W1)
VALUE = VALUE + VALUE_IN_PAREN
OPEN_PAREN_FOUND = 'NO'
LOOK_FOR_CLOSE_PAREN = 'YES'
ITERATE
END
WHEN SUBSTR(PIC_VALUE_WORD,W1,1) = '.' THEN
DO
IF W1 = LENGTH(PIC_VALUE_WORD) THEN
DO
ITERATE
END
ELSE
VALUE = VALUE + 1
END
OTHERWISE VALUE = VALUE + 1
END
END
/* SAY 'VALUE = ' || VALUE */
IF SUBSTR(PIC_VALUE_WORD,1,1) = 'S',
| SUBSTR(PIC_VALUE_WORD,1,1) = 'V',
| SUBSTR(PIC_VALUE_WORD,1,1) = '9' THEN
DO
SELECT
WHEN INDEX(REC,' COMP ') > 0, /* COMP OR COMP-4 */
| INDEX(REC,' COMP.') > 0,
| INDEX(REC,' COMP-4 ') > 0,
| INDEX(REC,' COMP-4.') > 0 THEN
DO
SELECT
WHEN VALUE <= 4 THEN
VALUE = 2
WHEN VALUE <= 9 THEN
VALUE = 4
OTHERWISE
VALUE = 8
END
END
WHEN INDEX(REC,' COMP-3 ') > 0, /* COMP-3 */
| INDEX(REC,' COMP-3.') > 0 THEN
VALUE = (VALUE % 2) + 1
WHEN INDEX(REC,' COMP-1 ') > 0, /* COMP-1 */
| INDEX(REC,' COMP-1.') > 0 THEN
VALUE = 4
WHEN INDEX(REC,' COMP-2 ') > 0, /* COMP-2 */
| INDEX(REC,' COMP-2.') > 0 THEN
VALUE = 8
OTHERWISE NOP
END
END
RETURN
/* END OF PIC_VALUE ROUTINE */
/*************************/
/* ROUTINE TO CLEAN UP */
/* THE OCCURS ARRAY */
/*************************/
CLEAN_UP_OCCURS_ARRAY:
IF LEVEL <= OCC_1_LVL THEN
DO
OCC_1_LVL = 99
OCC_1_TIMES = 1
OCC_1_LINE = 0
END
IF LEVEL <= OCC_2_LVL THEN
DO
OCC_2_LVL = 99
OCC_2_TIMES = 1
OCC_2_LINE = 0
END
IF LEVEL <= OCC_3_LVL THEN
DO
OCC_3_LVL = 99
OCC_3_TIMES = 1
OCC_3_LINE = 0
END
IF LEVEL <= OCC_4_LVL THEN
DO
OCC_4_LVL = 99
OCC_4_TIMES = 1
OCC_4_LINE = 0
END
IF LEVEL <= OCC_5_LVL THEN
DO
OCC_5_LVL = 99
OCC_5_TIMES = 1
OCC_5_LINE = 0
END
RETURN
/* END OF CLEAN_UP_OCCURS_ARRAY ROUTINE */
/*************************/
/* ROUTINE TO SAVE IN */
/* OCCURS ARRAY */
/*************************/
SAVE_OCCURS_IN_ARRAY:
OCCURS_WORD_POS = WORDPOS(' OCCURS ',REC)
IF OCCURS_WORD_POS = 0 THEN
OCCURS_WORD_POS = WORDPOS(' OCCUR ',REC)
TIMES = WORD(REC,OCCURS_WORD_POS + 1)
DO
SELECT
WHEN OCC_1_LVL = 99 THEN
DO
OCC_1_LVL = LEVEL
OCC_1_TIMES = TIMES
OCC_1_LINE = LPTR
END
WHEN OCC_2_LVL = 99 THEN
DO
OCC_2_LVL = LEVEL
OCC_2_TIMES = TIMES
OCC_2_LINE = LPTR
END
WHEN OCC_3_LVL = 99 THEN
DO
OCC_3_LVL = LEVEL
OCC_3_TIMES = TIMES
OCC_3_LINE = LPTR
END
WHEN OCC_4_LVL = 99 THEN
DO
OCC_4_LVL = LEVEL
OCC_4_TIMES = TIMES
OCC_4_LINE = LPTR
END
WHEN OCC_5_LVL = 99 THEN
DO
OCC_5_LVL = LEVEL
OCC_5_TIMES = TIMES
OCC_5_LINE = LPTR
END
OTHERWISE
SAY 'ERROR ===> ARRAY EXCEEDED (MORE THAN 5)'
END
END
RETURN
/* END OF SAVE_OCCURS_IN_ARRAY ROUTINE */
