Copyright © 2003 Bob’s Best Corporation
Charles River Ma.
-All rights reserved-
Company and product names are trademarks or registered trademarks
of their respective owners.
Mention of these products does not constitute a recommendation of those
products, nor an endorsement. Bob’s Best Corporation does not assume
responsibility
with regard to the performance these products.
Intended Audience
This
document is directed toward programmers who want to understand how to use
PL/I
or see what another programmer has done.
This manual documents:
· General information about the PL/I language.
· Sample programs that are useful for reviewing PL/I statement syntax and programming style, and that may be worth including in your own work.
· CICS information about the Transaction Server, techniques to log error information, and tips to avoid programming errors.
· An introduction to DB2 with a few programming tips and basic error-return value information.
· A description of the more frequently used PL/I built-in functions.
· Some of the frequently returned PL/I error codes.
· Some pretty neat programs for CICS, EXCI and MQSeries.
This manual is the product of many years' learning the hard way. It's also a labor of love for a language that is much richer and easier to code in than any other I have worked with. I hope you find your time well spent in going through the material.
Heed this advice or be prepared to work long weekends:
1. KEEP THY PROGRAM SIMPLE.
2. FANCY STUFF WITH POINTER VARIABLES LEADS TO ETERNAL DAMNATION.
3. COVET THY NEIGHBOR'S CODE - BUT ONLY IF IT WORKS.
4. ASSIGN TEXT TO TEXT AND NUMBER TO NUMBER BECAUSE GOD WANTS IT THAT WAY.
5. READ THE COMPILER WARNINGS - IT COULD SAVE YOUR LOVE LIFE!
6. WHEN ALL ELSE FAILS, ASK FOR HELP PRIOR TO THE PRODUCTION DATE.
7. A GOOD COMPILE WILL NOT OVERRIDE HOW MACHINE INSTRUCTIONS WORK.
· YOU CANNOT DIVIDE BY 0.
· THERE ARE ONLY 8 BITS IN A BYTE.
· YOU CAN ONLY MODIFY STORAGE WITHIN YOUR OWN PROGRAM.
8. BLASPHEMY OF THE OPERATING SYSTEM RARELY WORKS. LOOK AT THINE OWN EFFORTS.
9. HONOR THY ERROR CONDITIONS OR REMAIN IN PURGATORY FOREVER.
When reading this, please only use the program examples for exact syntax. While I have tried to make all the program statements correct, they have not been compiled. There are sample programs throughout that you can review, remembering Free Advice #3. If you find code you like or want to modify, cut and paste it to a TSO screen.
ISQUARE: PROC OPTIONS(MAIN); GET DATA(I); I=I**2; PUT DATA(I); END ISQUARE;
ß program name & beginning àß program statements àß end à
Every program has beginning and ending statements. In between, each program has all the elements found in any language: variable definitions, functions, subroutines, and other logic. The sample shown above is about the simplest PL/I program that can be written. It presents the most basic elements of the language, and includes input, logic, and output. It's pretty much self-documenting and does not have a lot of wasted text.
There are coding examples plus some insight on good and bad usage. Again, the ordering of topics and lack of explanation of basic concepts (such as opening files) assumes an experienced reader. If you don't know:
· How to design and write a program in some language, and
· How to use MVS JCL or TSO
…this is not the place to start. If you have a great deal of PL/I experience, focus on the comments about technique.
YOURNAME: PROC OPTIONS(MAIN); START OF PROGRAM
.
.
.
END
YOURNAME; END OF PROGRAM
The coding workspace comprises columns 2-71, and is completely free-form. Column 1 is reserved for printer control. Programs start and end as shown above (YOURNAME is the 7‑character program name, of which the first two characters represent the business area at Bob’s Best).
%[anything] is a preprocessor option - an option that's used during the source-code setup phase preceding the actual compile. Preprocessor statements are covered under Preprocessor Options.
PL/I
has very few reserved words. In general, the compiler can figure out
the
reserved words from your usage, but avoid
using reserved words as variable names.
Here are a few syntax rules you should be aware of:
· Beware of the compiler defaults! PL/I tries to make everything work its way.
· You can mix data definitions and logic but don't do it! The programmer who maintains the code may know where you live.
· Statements end in a semicolon ( ; ).
· Comments start with /* and end with */.
· Names start with a letter. AvOiD mixed case as a matter of practice, although the PL/I compiler accepts mixed case just fine.
· Use underscores ( _ ) in names. Do not use hyphens ( - ) in names.
· Use a single apostrophe ( ' ) to start and end character-string values.
A program's style and visual appearance are important. No matter how perfect it is, someone will change it or throw it away. Balance clarity, brevity, and performance in your work
Some programmers like to have a lot of white space in their program's source listing. Others, like me, try to keep logical blocks to a size that fits on a screen. I will do things that appall the white space programmers. My reason is simple: when I page back and forth in TSO, I forget what was on the previous screen. The fewer instructions I write, and the less white space I leave, the easier it is to follow the one-screen rule. You are not paid by the line, how fast the program runs, or any other single measurement.
A number of different programming styles are illustrated in this manual. Try to take the best of each. Often more than one statement is placed on a single line, to make reading faster. This was not done as a style endorsement. Moderation and common sense will never get you in trouble. Trying to show you know every form of PL/I statement, and writing logic only a rocket scientist can follow, will not improve your advancement opportunities.
Data definitions can be explicit or implicit:
· Explicit (with DECLARE (DCL) keyword) - DCL A_NUM FIXED BINARY(31).
· Implicit (like Fortran BINARY or FLOAT) - Use without an explicit definition.
The explicit definitions take this form:
DCL variable-name data-type INIT(init-value) [storage-class] [alignment]
Where:
· DCL is followed by the name of the variable you're defining. With VisualAge PL/I names may be up to 100 characters long. This is to make programs more readable. Who would find names this long more readable I have no idea.
· data-type indicates the type of data field you're defining. Data types that can be used as dates can be given the DATE attribute and then are eligible for the neat date arithmetic instructions that are available. They may also be given a VALUE instead of an initial value when they are being used as a constant in the program. This will help the compiler generate faster running code. Be careful with both of these and read the fine print from IBM before using.
· The keyword INIT initializes the field to the specified init-value (where that value must be appropriate to the specified data type). The initialization may be performed by a restricted expression. Restricted expressions are run time functions that the compiler can resolve such as using the address or length of another variable.
· The storage-class is almost never used. The default, AUTOMATIC, is generally fine.
· The alignment controls whether fields align on byte boundaries, as described with the data-type values below.
Each data definition requires that you specify the field's data type. The possible values are described below:
|
Data Type |
Example and Notes |
|
BIT |
BIT (count-of-bits) - Little switches all in a row. DCL YES BIT(1) INIT('1'B); use in IF YES THEN DO or to set up hexadecimal fields, as in: DCL LOWERCASE_A BIT(8) INIT('10000001'B); BIT is a way to avoid using lowercase or to set up non-printable characters. It's also good for switches. Don't set up a complex bit-driven logic where the logic flow depends on combinations of BIT switches being on or off. That is a 60s style of doing things. It is just too hard to follow or read in a storage printout. Never start or end
a
data structure with a bit string. |
|
CHAR |
CHAR(99) - Any of 256 eight-bit combinations . VisualAge PL/I allows the use of * in the name field. This is the “filler” field syntax. It may be used with all data types. |
|
PIC |
PIC'99' The field length is the length inside the quotes, specified as a series of Zs (for alphabetic, as in PIC 'ZZZ') or 9s (for numeric, as in PIC '999.99'). The number of Z and 9 characters determines the size of the numeric field. You can use any of the following symbols as described: $ and the decimal point ( . )
are cosmetic. Up to 31 digits of precision permitted with VisualAge PL/I. |
|
FIXED BINARY |
FIXED BIN(15) - Careful, it's limited to 32767. Use FIXED BINARY(31). Be a big spender - always use 31 bits. With VisualAge PL/I fixed binary fields may be up to 63 bits of precision Also UNSIGNED is supported as in UNSIGNED FIXED BIN(8) to talk to the C languages. |
|
FIXED DECIMAL |
FIXED DEC(total-digits, decimal-digits) an OS/390 packed decimal number such as
+123 becomes hex'123C' = +123 in two bytes inside the
machine The total-digits should be an odd number as in the examples
below: DCL BY_100s FIXED DEC(5,-2); specifies a scaling factor of -2. BY_100s can be from -99999*100 to 99999*100, in increments of 100. Up to 31 digits of precision are available with VisualAge PL/I |
|
FLOAT |
Floating point decimal and binary numbers. |
|
POINTER |
Addressing variable (must point to the right place!). |
Place BINARY fields together at the beginning of a data structure, or learn about slack bytes. Slack bytes are a vestige of the S/360, a computer from the far distant past. Binary fields had to start on even-byte storage boundaries for the binary math operations to work, so PL/I will place them there. If BINARY fields are in the middle of a data structure, PL/I adds slack bytes for free whenever you don't consider alignment. This can kill in two ways:
· If the copybook used for a file happens to align correctly, there is no slack in program one. Program two in a set may not be as lucky. You get to find the problem.
· The same can happen with overlay definitions in CICS programs sharing a common communications area definition.
The compiler will tell if it has added slack bytes to structures. Look for "/*PADDING*/" in the output listing to see if this occurred.
Define structures as:
· ALIGNED so the BINARY fields are on even-byte boundaries, or
· UNALIGNED where fields are placed without alignment consideration. This is seen most often in CICS maps. For an UNALIGNED structure, make sure any structure that's redefined over it uses BASED addressing also, and is defined as UNALIGNED.
Read the section on POINTER variables to learn about the use of BASED addressing in variable definitions. Incorrect use of BASED addressing is a leading cause of storage protection errors. With a storage protection error, the program dies and you get a late night phone call.
OFFSET is another form of addressing variable, and is the relative distance from a specific POINTER.
AREA is a defined area of storage in which to use pointers and offsets. It's the playpen.
ALLOCATE and FREE are the statements to buy and sell real estate within the AREA. Explain the Theory of Relativity and use OFFSET, but only in programs supported by other programmers who also understand it and have a PhD in physics. Most application programmers do not see or use absolute and relative addressing. It represents a level of abstraction that takes experience to deal with and may be difficult to debug. For every ALLOCATE statement have a FREE to return the storage to MVS. ALLOCATE in a DO loop is a debugging opportunity waiting to happen especially if the amount of storage available to request is not bounded by an AREA definition.
DATA STRUCTURES DCL 1 I_AM_A_STRUCTURE,
2 IN_THE_STRUCTURE,
3
I_AM_AN_ELEMENT CHAR(10);
Refer to an element in the data structure like this (for example): I_AM_A_STRUCTURE.IN_THE_STRUCTURE.I_AM_AN_ELEMENT. You only need to qualify to a level that avoids confusing the compiler.
ARRAYS(9,8,7,6,5) FIXED DEC(7,4); a multi-dimensional
array
Do not overlay arrays on top of arrays by using BASED addressing - unless you really like reading manuals and working weekends. Business programs that make extensive use of multi-dimensional arrays can be difficult to maintain. Nested DO loops with incrementing indexes are hard to follow, and should be avoided (or kept to a minimum).
DCL ALPHABET CHAR(26) INIT('ABC');
DCL BIN_NUMBER FIXED BIN(31) INIT(99);
DCL PIC_NUMBER PIC'99V.99' INIT(99.9);
Note the V in the PIC DECLARE statement above for the logical placement of the decimal point. The period is for "looks" only.
By the end of this document, be inspired to read the PL/I manuals before undertaking assignments that have to do with money or space flight.
|
A neat
trick: Define a variable FIXIT [DCL
FIXIT PIC'99999' INIT(9999);].
Then
use FIXIT if there is an incomplete definition of what should be done to a
data element [WHOKNOWS=FIXIT].
This
will always compile and the target can be alphabetic or numeric. Come back later and remove the FIXITs
when
fleshing out the logic. |
DCL FIX_NUMBER FIXED DEC(7,2)
INIT(99.9);
DCL BIT_ON BIT(1) INIT('1'B); DCL BIT_YES BIT(1) DEF BIT_ON;
DCL
YES BIT(1) DEF BIT_YES Incorrect!
DEF and POSITION are not used very often. Do not define over a DEF as is attempted with YES above. Refer to the original variable in the DEF. In this case, BIT_ON. POSITION allows defining a variable starting at a position in a string.
DCL 1 MY_STRUCT, 2 J FIXED, 2 A
CHAR(2);
UNION is another syntax key work to redefine the same storage. The advantage it has over the traditional method of redefining using ‘ Bstruc BASED(ADDR(Astruc)), ‘ syntax is it allows all the redefines to be done in the original definition so you don’t hunt through the listing for the true meaning of a variable. The syntax is as follows:
DCL 1 EXAMPLE,
2 NAME_GAME UNION, the whole
3 AS_1_FIELD,
5 TOTAL_NAME CHAR(32),
3 IN_PARTS,
is
the sum of the parts
5 FIRST CHAR(10),
5 MIDDLE CHAR(10),
5 LAST CHAR(10)
5 * CHAR(2), can’t use the last two characters
Needless to say overlaying character fields on floating point fields or other aberrations is not recommended.
MY_STRUCT = ' '; will not work to initialize numeric fields. Use '' to initialize both numeric and alphabetic fields in a structure. '' is the absence of a data value.
By the way - J in this case will be a FIXED DECIMAL field, not BINARY. Be explicit in element definitions.
DCL STRING_OF_SOME_LENGTH CHAR(100)
VARYING;
This is a field to hold a variable-length string of data. PL/I always knows how long the string is because it's defining a two-byte counter field for PL/I's internal instruction use in front of the string which reserves 100 bytes of storage. Think of it as a structure with a FIXED BIN(15) field and a CHAR(100) field. Do not attempt to change or address the length portion of the definition. Use VARYINGZ to get a string with a one byte counter.
Refer to the examples later in the document before using variable-length character strings.
Never use a variable-length character string in a structure, or have it defined BASED on the location of another variable. The address of the variable-length string is the length portion of the string, not the character string itself. PL/I always uses the length when doing assignment statements and will give the expected results. It's best to initialize the string to a length of zero (0).
NULL_THE_STRING =''; will do the trick. Use LENGTH(BIG_STRING) to get the string's current length. Make complex examples as shown below at your own risk.
STRUCTURES OF ARRAYS DCL 1
STRUCTURE,
2 ARRAY(10) 3 FIELD(5)
ARRAYS OF
STRUCTURES DCL 1 ARRAY(10), 2 STRUC, 3
TABLE(10)
Choose from the following keywords to assign a storage class (not required and, in fact, almost never used):
|
Storage Class Keyword |
|
|
STATIC |
Field stays defined. Don't link-edit very large static arrays unless taking a long lunch. Use ARRAY(*) = A_VALUE to initialize a large array at execution time. |
|
AUTOMATIC |
Field is defined when the program/routine is invoked. · In CICS, always leave all fields AUTOMATIC. · In subroutines, default to AUTOMATIC, then the storage is reinitialized on every entry to the subroutine. This is the correct way to use subroutine internal variables. |
|
CONTROLLED |
Do not use this, because its debugging is difficult. |
Labels are nice. Use a lot of them but never in a GOTO statement. They can be about 30 characters long and end with a colon. Think of them as comments on the listing's left side. Avoid label variables if you plan to stay at your job.
Label examples: START:
END_OF_JOB:
JAIL:
GOTO JAIL;
END JAIL;
|
A neat
trick: Start LABEL and subroutine
names with Pnn_<descriptive_name>, as in P01_, P02_, etc. It's easier to go
through the listing knowing the relative location of names. |
Operators are like royalty. There are rules for who gets served first:
|
Operator |
Description |
|
= |
Assignment - Place the value of the variable on the right in the variable on the left. |
|
+ |
Add - Like the abacus. Remember the order rules. ** is first followed by * / + - |
|
- |
Subtract - See Add. |
|
/ |
Divide - See Add. |
|
* |
Multiply - See Add. |
|
** |
Exponentiation - Always is performed first. |
|
|| |
Concatenate - Put two strings together into one big string. |
|
( ) |
Order (precedence) - Control the order in which the math operators take place. The compiler always does what is inside the parentheses first. Use these to override the royalty default rules. Make sure to match the parentheses (you should have the same number of left and right parentheses). |
|
-> |
Pointer - Define where a variable is located in memory. Often used by programmers who remember the 60s. MY_POINTER->B says to use the value of MY_POINTER to address B. |
With these you get two operations for the price of one and the
opportunity
to confuse anyone not familiar with this syntax. Here are some examples.
They
should be enough to discourage use of complex
operators.
X +=1 is the same as X =X +(1)
X *=Y +Z is the same as X =X*(Y
+Z)
X *=Y +Z is NOT
equivalent to X =X*Y +Z
X(function())+=1 is NOT
equivalent to
X(function())=X(function())+1
|
Operator |
Description |
|
+= |
Add then assign |
|
-= |
Subtract then assign |
|
*= |
Multiply then assign |
|
/= |
Divide then assign |
|
**= |
Exponentiation then assign |
|
¬= |
Exclusive-or then assign |
|
||= |
Concatenate then assign |
|
&= |
And then assign |
|
|= |
Or then assign |
You should create the shell of your program first, with empty or incomplete subroutines. Then start testing the program flow prior to completion of all the detailed logic definition. Testing the shell for error handling is a good way to check out the code that never gets executed until production (when it's too late). One MAIN procedure with optional embedded subroutines makes a program.
When developing a program, all the blocks of important logic should be placed in individual subroutines for three reasons:
1. This technique allows you write and maintain the complex stuff in one place.
2. PL/I has a wonderful facility to tell which subroutine, by name, had an execution error.
3. This style of programming lets you drill down as you flesh out the logic.
PL/I subroutines are like paragraphs in COBOL. The PL/I name for a subroutine is a procedure. Procedures can have more than one entry and/or exit point. Procedures can also be bundled into PACKAGES. A PACKAGE controls what information about the procedure and its variables is externalized to the outside world. The execution performance of procedures with imbedded internal procedures can benefit by being placed into a package. This is true when internal procedures do not use any variables from a parent procedure. In a PACKAGE the internal subroutines are removed from the parent to become peers. As shown in the examples bundled subroutines is a programming style I like to use. Therefore some of my code may get a makeover.
Note: There are not many reasons to have routines with secondary entries. It's best to have one entry point and one exit point.
name: PROC;
statements END
[name];
MYROUTINE: PROC [(PARAMETERS)] [RETURNS(DATA
TYPE(length))];
Clever logic goes here
END MYROUTINE;
PARAMETERS pass data to the procedure for
processing
To invoke a procedure:
· CALL MY_PROCEDURE; if no parameters.
· CALL MY_PROCEDURE (PARM1); if there is a parameter (shown here as with the PARM1 variable). Parameters such as PARM1 deliver data to a procedure.
To use the routine as a function:
I = MYROUTINE();
Code subroutines that serve as functions and do not have parameters with ( ) after the name, as shown above. This way they will not be confused with a variable, even though the result is that they act like a variable. More information will be provided on functions in the following material. Think of a function as a subroutine where the returned value is logically treated as a variable or constant would be as in the assignment statement coded above.
BEGIN blocks and functions are from the same family tree as procedures.
· BEGIN;….END; is like a procedure. It's rarely used for other than error-condition processing.
Built-in functions are PL/I-provided subroutines that do neat things. There are many examples of these in the following pages. Built-in functions are called pseudo-variables, or functions, because they return a single value that looks and acts like a variable. In any syntax, a variable may be replaced with a built-in function.
Declare built-in functions as follows (to define the three functions shown in parentheses):
DCL (DATETIME, HIGH, LOW) BUILTIN;
Some built-in functions work at compile time, if the compiler can figure out what they mean. For example:
SHORT = SUBSTR(LONG,1,4); 1 is where to start. 4 is the assigned length.
This example uses the built-in SUBSTR to assign a portion of LONG's contents to SHORT. If the start and length values are constant, the compiler can figure out what to do.
ABS is another built-in function that returns the absolute value of the variable.
I = -1;
J = ABS(I); J will always be positive (1 here). Learn to use these.
RETURN is the command to exit from a procedure. If there is not a RETURN command, control passes to the statement following the CALL after the last statement in the procedure is executed.
Returning data makes the procedure act like a variable. This is sometimes called a pseudo-variable because the results of the execution can be used just like a variable of the type defined in the RETURN clause of the PROC statement.
|
Return Statement |
Description |
|
RETURN; |
Exits a procedure. |
|
RETURN(A_VALUE); |
Exits and returns a value to the invoking code. This is the function-style procedure. |
|
RETURN(MY_FUNCTION(ABS(I-J+K))); |
Uses a built-in function in the return logic. |
Of course silly statements like GOTO and error conditions (ON conditions) break the rules. Try not to break the rules. In fact, the rules for handling error conditions can be in individual procedures.
Subroutine greatest hints:
· Define working variables within subroutines for loop counters and switches.
· Use subroutines like functions: X=BOILING_POINT(WATER);
· Pass parameters to subroutines explicitly.
· Use subroutines to break up long runs of logic. Keep big thoughts to one page.
· Avoid writing the same code over and over. Call a subroutine instead.
· Don't play U-boat commander. Diving too deep into nested subroutines leads to confusion.
Subroutine parameters are the data elements that are passed to the subroutine. They can be modified by the subroutine. When defined inside the routine, as below, the definitions really are for storage outside the routine. This can ruin your day.
I = 2;
CALL
MY_PROC(I);
MYPROC: PROC(J);
DCL J FIXED BIN;
J is really the variable I outside
the PROC
DCL K FIXED BIN; K is
redefined every time routine is entered
J =4;
END MY_PROC;
The variable I will equal 4. Treat subroutine parameters as read-only! But before you get too upset, the OPTIONS option of the PROCEDURE statement controls how parameters are passed. The options include BYVALUE and BYADDR. There is a lengthy discussion of these in the IBM manuals. For procedures that will be propagated to numerous programs or have a very high level of reuse, clever use of OPTIONS will be rewarded.
Names of variables, procedures, etc., defined in the OPTIONS(MAIN) PROC are known to all procedures. Names defined in a subroutine are only known to the subroutine (and to any subroutines that are nested within it).
In other words, below knows what is above but above does not know what is below.
YourName ENTRY defines a procedure entry point. Think of it as a side door to a room full of code. Over the years I have become fonder of this technique. Remember to have a proper RETURN supporting each entry point. Many programmers have not used this technique when building subroutines, so be careful when it comes to maintenance. This is good for "system" routines where the true source code can be hidden.
Now that you understand the concept of subroutines and variables, here are a few thoughts on program construction:
· Focus on how easy a program is to work with, NOT how fast it will run. The compiler will make it fast, given half a chance.
· Major data areas (data record definitions) should be in the main section of the program.
· Other variables should, for the most part, be defined in the subroutine where they are used. This lets you reuse the names and not worry about the contents being set somewhere else. This is really true for switches and counters. These variables will (unless declared static, something you should not do) be recreated and reset upon entering the routine. Thus there's never a question of knowing the starting values.
· Where possible, use subroutines like functions and have them return a value. It's easier to isolate problems or to add enhancements this way. Different return variable types serve different needs. For example:
Þ Routines that return a true or false indicator: use BIT(1).
Þ Three-way switches - indicating, for example, found, not found, or error: use FIXED BINARY.
Þ Use a BINARY or DECIMAL number when a true numeric data value is required.
Þ Use CHAR for text string returns.
Þ PIC is nice to use to return some numeric values because the result can be used as a character string or a number.
Using subroutines as functions is done many times in the examples. It's a very useful and powerful tool. If the returned value is incorrect there is no question as to the source of the error.
DCL DEPTS FILE RECORD INPUT;
DCL BACKUP FILE RECORD OUTPUT;
DCL MASTER
FILE RECORD UPDATE KEYED;
DCL SYSPRINT FILE STREAM OUTPUT;
Traditionally, the record length, blocking, etc., is set in the JCL DD statement for the file name.
Example: //MASTER DD DCB=etc.
Read a manual for ENV options for VSAM or to include record length and record format.
OPEN and CLOSE are optional but useful. Never use OPEN or CLOSE in CICS programs. The TITLE option of OPEN identifies the DD statement to use. This, within an IF, is a very clever way to select files at execution time.
SYSPRINT is the default file for DEBUG statements, as in PUT DATA(I). SYSPRINT is included for free when coding a PUT statement without a file name. Most programmers define it in their source code.
I have always found the documentation on the use of (*) in a parameter definition to be difficult to understand. It's covered in the IBM PL/I Programmers Guide. If you cannot copy from an existing program, a visit to the local PL/I guru is in order.
The linkage editor is a very powerful tool to keep programmers from improving common routines. The definitions below indicate that the linkage editor - and not the compiler - will provide these routines to the program. The compiler posts a memo for the linkage editor and assumes good things will happen.
The bad, unexpected, or exceptional happens, and YOU can do something about it!
Here are the three most common ON conditions encountered. Read on to understand how this process really works. It's very important.
ON ERROR [SNAP] BEGIN; SNAP is a type of DUMP and is
optional
ON ERROR
SYSTEM; in case you foul up the error logic
/* ADD REALLY CLEVER
LOGIC HERE */
END; /***
END ON ERROR SNAP BEGIN
***/
ON KEY(MASTER)
MASTER_NOT_FOUND
= '1'B; VSAM record key not found in
read.
ON ENDFILE(INPUT) EOF =
'1'B; At the end of an
input
file.
When multiple instructions are needed for conditional logic, use BEGIN and END. The CONDITION scope is the same as subroutines for variable-definition rules. In general, it's best not to get too clever in ON-condition routines for a number of reasons:
They are expensive subroutine calls in terms of the processing needed to execute, so don't use them like a subroutine.
It's not always easy to trap the conditions that caused them.
You really pay the piper when there are logic errors in them. In general, it's best to record what caused the condition to occur and then exit the program.
Use ON ENDFILE and ON KEY conditions as needed. Having special ON-condition error logic in subroutines that do specialized functions such as VSAM file I/O or mathematics is a good practice. This is a topic to spend some time on in a real PL/I manual to understand.
Hint: Be careful! If you write ON-condition code incorrectly, the result is often an infinite loop.
What we are talking about is controlled and uncontrolled exceptions to normal processing by the program, where the machine can't carry out the program instructions (either physically or logically). Do something and the program terminates or, even worse, produces incorrect results. SIGNAL ERROR is a general unconditional surrender. It gives control to the PL/I error handler to end the program. Either you can provide logic to handle specific conditions on SIGNAL ERROR, or the program ends and tells where the error occurred. There are exceptions to this that can be very nasty. Specific conditions can also be SIGNALed. This is rarely done.
The conditions causing these errors are named (ON the condition). They have a value that is available in the ONCODE pseudo-variable returned as a BINARY(15) value by the built-in function. Some conditions return data or other information via other ONxxxx built-in functions. They can be informative and useful, such as ON ENDFILE; correctable (ON SIZE), or in most cases, spell death for the program.
You can specify whether or not some conditions are enabled or disabled. If a condition is enabled (condition), having the condition executes an action. If a condition is disabled (as through a NO condition, such as NOSIZE), having the condition does not execute an action. Enabling and disabling can be specified for the eligible conditions by a condition prefix. For example:
(SIZE):
MYLABEL: X=(VERYBIG**5) /
(VERYSMALL*.0000001);
A condition in a prefix indicates that the condition is enabled or disabled (NO condition) within the scope of the prefix. A condition prefix can go on any executable statement. Scope follows the general PL/I rules for variables and procedures. Keep the scope as limited as possible, because entry into the conditional processing is like a GOTO, in that you may not know where you came from. When the logic exits the ON unit without terminating the program, the logic returns to the instruction that follows the invoking call. This is great for ON ENDFILE, but not so good for mathematical errors.
Some conditions are always enabled unless they are explicitly disabled by condition prefixes. Others are always disabled unless they are explicitly enabled by condition prefixes. Still others are always enabled and cannot be disabled.
|
DEFAULT |
EXPLICIT |
USE |
|
CONVERSION |
NOCONVERSION |
Tried to convert data formats. Usually a blank to a number. |
|
FIXEDOVERFLOW |
FIXEDOVERFLOW |
Calculation bucket overflowed for decimal or binary math. |
|
OVERFLOW |
OVERFLOW |
Floating point calculation bucket can't hold the number. |
|
ZERODIVIDE |
ZERODIVIDE |
Could not do in 3rd grade - still can't. |
|
NOSIZE |
SIZE |
Result bucket too small for number. |
|
NOSUBSCRIPTRANGE |
SUBSCRIPTRANGE |
An index is outside of the array boundary. |
Conditions that are detected by the compiler are reported and do not raise the condition when the program is executed. Example: DCL ONEPLACE FIXED DEC(1); ONEPLACE = 999; results in a compiler message whether SIZE is enabled or not. Think of the flow errors as happening during the calculation process. SIZE means the result is too big for the target field. Notice that SIZE is disabled as the default, and loses the high order digits. Not nice if it happens to your paycheck.
This is not a very good structured-programming example, but it does have some interesting statement formats. It also shows how to go about condition handling in a subroutine. The logic is simple and specific. Notice the use of REVERT; it turns off the ON unit until the subroutine is done. Be careful using REVERT statements. The ON CONVERSION is to catch a non-numeric going into R, O, or A. Sometimes programs will change a blank to a zero and move on. GO TO is correct syntax, as is GOTO. More examples of ON-condition logic will be presented later.
INPUT: PROCEDURE;
ON CONVERSION
BEGIN;
IF ONCODE = 624
& ONCHAR = ' ' oncodes 600 to
639
apply
THEN DO; ONCHAR = '
';
GO TO ERR1; END;
ELSE GO TO TOOBAD;
END;
ON
SUBSCRIPTRANGE GO TO ERR2;
IN1: READ INTO (SOMESTRUCTURE) FILE (NEWDATA);
IF SNO = 9999 THEN RETURN;
IN2: GET EDIT (R,O,A)(3 P'999') STRING (GOSSIP);
(SUBSCRIPTRANGE):
TABLE((O-OK)/OINK,(A-AWHAT)/AINT_IT_A_SHAME) = R;
GO TO IN1; DONE2LATE: IF VERIFY(R,'1234567890')>0
THEN CALL PANIC;
ERR2: ON
SUBSCRIPTRANGE GO TO TOOBAD; CALL SENDAMESSAFE(2); GO TO IN1;
ERR1: REVERT
CONVERSION; CALL
SENDAMESSAGE(1); GO TO
IN2;
END INPUT;
Always check data from a questionable source, like a
terminal
user or a Unix feed, before using it in a statement that results in a
numeric
field. Use the VERIFY built-in
function
before the assignment, or ON CONVERSION after.
It's simpler to do something before
the error occurs, than to deal with it after. DO not use REVERT in the
overall program ON ERROR BEGIN block of code.
In ASSIGNMENT (=) statements, PL/I can convert almost any data type to another. You may not like the result, but that's the way it works!
Think before mixing character and numeric operands. Remember that the CHAR field that will almost always only contain numbers will cause trouble. The PL/I compiler tells where conversions take place as informational messages. The compiler will assume attributes for variables that are not explicitly defined. They are always numeric. Always review the compiler warnings to find out what PL/I has done. The results are often not in your favor, and tend to show up at the worst time.
Be careful! Always check that any character (CHAR) field being converted to a numeric consists only of numbers.
The following logic will help. It uses a built-in function that tells where the first character other than the ones listed is found.
IF
VERIFY(yourfield,'0123456789')>0
THEN
CALL YOU_HAVE_A_PROBLEM;
DCL 1 LEFT_HAND, 2 THUMB CHAR(1);
DCL 1 RIGHT_HAND 2 THUMB CHAR(1);
same as DCL 1 RIGHT_HAND LIKE LEFT_HAND;
Here are some shortcuts that will make debugging harder. When making structure-level assignments such as LEFT_HAND = RIGHT_HAND, you save typing but lose any knowledge of the underlying data definitions. It is the same for STRING assignments. If you're using them, it's best to lock in the structure definitions by using the LIKE above or same %INCLUDE [copy code]. STRING is a built-in function that saves coding your own concatenation of fields. It does a brute force move with regard to data structure.
LEFT_HAND = RIGHT_HAND;
IF STRUCTURES ARE IDENTICAL
LEFT_HAND = RIGHT_HAND, BY NAME;
MOVE TO LIKE NAMED FIELDS
STRING(LEFT_HAND) = STRING(RIGHT_HAND);
WHEN ALL FIELDS ARE CHAR
Hint: Try to avoid the above. It makes variable-impact analysis difficult. If management wants to add one position to the "pay to employee" field, it's in your best interest that they identify all programs using this field ASAP.
LEFT_HAND.THUMB
= RIGHT_HAND.THUMB; = COBOL's THUMB OF LEFT_HAND syntax.
DCL LONGSTRING CHAR(10) INIT('1234567890');
SHORTSTRING = SUBSTR(LONGSTRING,2,5);
SHORTSTRING is 23456
SHORTSTRING = LONGSTRING;
SHORTSTRING is 12345
A,B,C,D =
THE_ALPHABET; saves lines when A,B,C,D have same
definition.
ARRAY1 = ARRAY2*ARRAY3; For Math
PhDs
only. Remember most business
application programmers are not math
majors.
These examples are for programmers who like to work weekends
X =A <=B; X is '1'B true if A is less than B; otherwise, the''B false is
assigned.
X =A <=B; X is '1'B if A is less than B ; otherwise, ''B is
assigned.
X =A =B; the = means assign to X; the second equal symbol is the
comparison
of A to B. The value '1'B is assigned to X if A is equal to B ;
otherwise,the
value ''B is assigned. This is
X=(A=B)
assign based on the compare in plain PL/I.
IF statements decompose into a bit test. THEN is BIT ON (‘1’B). ELSE is BIT OFF (‘0’B or ‘’B depending on whose book you read).
IF (A=B) (A|B&C) (A=B) | (C=0)
Use
the ( )
to
force the order of operations just like you did in 4th-grade math
class.
IF A=C|B<5&D=J=Z<=Q Might not work the way you want!
IF BIT_TEST THEN… ELSE… test of BIT_TEST BIT(1) variable
|
Operator |
Meaning |
|
= |
Equal to |
|
> |
Greater than |
|
< |
Less than |
|
<= |
Less than or equal to |
|
>= |
Greater than or equal to |
|
& |
AND |
|
| |
OR |
|
¬ |
NOT |
|
¬= |
NOT EQUAL |
The = can be misleading,
because it's used for both assigning values and as a logical test
operator. For compound IF
statements,
the compiler must be able to pair the THEN and ELSE clauses. Therefore, whenever nesting, use the null
ELSE (ELSE;) or, rarely, THEN;.
Failure to pair the THEN and
ELSE
clauses can be a difficult error to detect.
The example below is incorrect.
There should be a null ELSE for the IF FUN. Have the most likely condition as the THEN
clause.
IF SOMETHING
THEN IF FUN
THEN CALL
DO_SOMETHING; ELSE; is missing The ELSE here if tied to IF FUN not IF
SOMETHING by the compiler. So much for
visual intention.
ELSE IS_IN_THE_WRONG_PLACE = YES;
IF (GTO_DELTA=5) & (RETURN_TO_DEPART='N') a classic if statement
THEN PUT LIST('RETURN=
'||ORIG_DTE||'
'||ORIG_TIM||' '||APPL_KVL);
IF THIS_IS_TRUE = YES
THEN CALL YOU_ARE_RIGHT;
ELSE CALL YOU_ARE_WRONG;
Never mix ANDs(&) and Ors(|) in IF statements such as, A & B | C. You or the next programmer will get it wrong! IF (A|B) & (C|D) & X is OK because the ORs are inside ( ). All the outer tests are ANDs. (A&B) | (C&D) is also correct.
IF MYFUNCTION() = 0 THEN functions act like data elements
IF SHORTSTRING = SUBSTR(LONGSTRING,1,5)
THEN
IF ABC = (A+B+C) THEN
Hint: STRING comparison variables are padded with blanks to the length of the longest variable in the compare. Other than IF THE_STRING = ' ', don't compare character strings of unequal length.
The THEN and ELSE clauses of an IF statement have to end with a semicolon ( ; ). PL/I is not like COBOL, where ending the ELSE with a period ends the IF group of statements.
THEN [label:]DO; GROUP OF STATEMENTS END [label];
Use the SELECT statement when there are a large number of different conditions to test for. It's much easier to read than nested IF statements, and much safer to use. Too many nested IF statements get maintenance programmers in trouble, and are very difficult to understand and change. Never have the nesting be over one printed page in length. Too many WHEN…DO…ENDS make the code difficult to read:
[label:]
SELECT(BOOZE);
WHEN('BEER') CALL
USE_BIG_GLASS;
WHEN('GIN')DO; MARTINI = GIN||OLIVE; CALL STIR;
END;
WHEN(BOURBON,RYE,NOT_TAXED)
ITS_AMERICAN = YES;
WHEN(WINE) IF RED
THEN CALL
SELECT_GLASS('RED');
ELSE CALL
SELECT_GLASS('WHITE');
WHEN(WATER); /* IGNORE */
OTHERWISE
DO; /*SOMETHING ELSE */ END;
END [label]; /* SELECT
*/
Using a label on a SELECT or a DO statement is a nice way to document the scope of the logic. This also helps the compiler report the location of missing END statements accurately.
A1:
SELECT(SOME) WHEN… OTHERWISE… END
A1;
DO I = 1 TO
9 BY
3;
I = I-3; USE THIS TO
KEEP
THE PROGRAM RUNNING forever!
IF SOMETHING THEN LEAVE; This
will end the loop
I = 99; This
will also end the loop
END;
Do not have the end value of a DO counter variable be the largest number the variable data type can support. For example a FIXED DEC(3,0) counter should not be used in a TO 999 statement.
DO WHILE(¬EOF); Same condition 2 ways.
<logic here> The results will NOT be the
same.
END;
DO UNTIL(EOF);
<logic here>
END;
You can put a label in front of the DO and after the END, as in:
X: DO… END X;
WHILE tests at the start of the loop.
UNTIL tests at the end of the loop. Always executes once, and often executes 1x too many.
Consider avoiding the use of DO UNTIL and have one
less thing in life to remember.
DO NAME = 'TOM','DICK','HARRY';
DO confusions - These (below) are all valid, but not seen very often (for good reason).
DO I=1 REPEAT 2*I UNTIL(I=128); 1,2,4,8,16,32,64,128 ARE VALUES OF I
DO I=1 TO 10, 10 TO 1 BY -1;
DO I=1 TO 9, 10 REPEAT 2*I UNTIL(I=100);
All loops must come to an end. Make sure the proper tests, such as an upper limit, end of file, or other bullet-proofing logic is present. LEAVE is not often used to exit loops. Most programmers seem to just set the counter to a higher value than the DO calls for. You will also see a RETURN inside the loop.
Using RETURN this way is a lawyer's GOTO. The RETURN is an exit from the subroutine, not just the DO loop. For example in DO I = 1 to 10; I = 999; END; the I = 999; will work fine to stop the loop.. By using a very far-out number, your intention cannot be confused. Just stay within the range of numbers the counter supports. 99999 will not work with a BIN(15) counter.
READ FILE(INPUT) INTO(INRECORD);
WRITE FILE(OUTPUT) FROM(OUTRECORD);
REWRITE FILE(MASTER) FROM(BASE_RECORD);
Make sure INTO( ) and FROM( ) record areas are large enough.
Read the IBM reference manual for variable-length VSAM processing. It is not easy to understand - study a sample that works.
Keyed READs and WRITEs are easy. Just read the manual for syntax.
Have ON conditions to handle duplicate key and for no-record-found file conditions.
LOCATE mode I/O is the most efficient in PL/I, but is not used very often. Most programmers do just READ and WRITE. LOCATE READ is easy to understand, whereas the WRITE is not. See the LOCATE mode example in the sample program chapter.
GET and PUT statements are stream I/O (like a stream of water). Instead of records, there's a flow of data to process. You will rarely see GET in a business application unless the input data is without a well-defined format. There are all sorts of data-formatting options, as described in the PL/I manuals:
GET with the data-description options can do some nice things to handle nasty problems, such as moving decimal points.
PUT is generally used for debugging or simple logging. Various types of PUT statements are illustrated in the following sections, including the one on DEBUG. SKIP or PAGE after the PUT goes to the next line or page.
Classic READ syntax.
You can make a nice living knowing just this! Remember to initialize EOF and use the ON ENDFILE ON Unit.
ON ENDFILE(INPUT) EOF = '1'B;
READ FILE(INPUT) INTO(INRECORD);
READLOOP: DO WHILE(EOF='0'B)
I=J+2;
/*add the
really clever logic here just like the statement above */
WRITE FILE(OUTPUT)
FROM(OUTRECORD);
READ FILE(INPUT)
INTO(INRECORD);
END READLOOP; /* DO WHILE */;
END_OF_JOB:
Classic READ Syntax. Remember to handle all possible conditions, not just the expected ones such as the ON KEY ON Unit.
ON KEY(INPUT) NOTFOUND =
'1'B; This executes when the record is not
found
NOTFOUND =
'0'B; /* IN CASE OF A NOT FOUND LAST TIME
*/
READ FILE(INPUT) INTO(INRECORD) KEY(SOMEWHERE);
IF NOTFOUND /* ON KEY LOGIC EXECUTED
*/
THEN DO /* SOMETHING USEFUL */ END;
ELSE WRITE FILE(OUTPUT)
FROM(OUTRECORD);
Now that the language has been covered, this additional material on handling errors will be easier to follow. Error handling frequently does not get enough attention during program development.
ON
ZERODIVIDE
This sample program shows how the ON unit can be used. In this case, there are two division statements that put the results in the same variable. The program just forces the result to be 0. The program is happy to run with the ON unit. Remove the ON unit, and the program will enter the ON ERROR routine then abend. In the case of division by zero, the divide fails and the result field is not altered. In every program with calculations, test for division by zero, overflows, and the other bad things that numbers can do.
KKZERO:
PROC OPTIONS(MAIN);
DCL (I,J,K) FLOAT INIT(9999999999);
DCL ONCODE BUILTIN;
DCL SYSPRINT FILE STREAM OUTPUT;
ON ERROR BEGIN; ON ERROR SYSTEM;
good
programmers will convert
PUT LIST('ONCODE='||ONCODE); ONCODE to a PIC field for printing
PUT DATA(I,J,K); END; BINARY fields are safe in PUT
DATA. PIC and FIXED DECIMAL fields are
not.
ON ZERODIVIDE BEGIN;
PUT
LIST('ZERO DIVIDE ON CONDITION');
K
= 0;
PUT
DATA(I,J,K);
END;
J = 333;
K = I/J;
better code if
J>0
then K=I/J
PUT SKIP DATA(I,J,K);
PUT LIST('DIVIDE BY 0');
J=0;
K = I/J;
PUT SKIP DATA(I,J,K);
END KKZERO;
Lost the numbers and don't know where to find them? This may help:
dcl pic_9_of_5_pos
pic'99999'
dcl char_of_10_pos
char(10) init('1234567890')
dcl fixed_of_10_pos fixed
dec(10)
init(1234567890)
pic_9_of_5_pos = char_of_10_pos; pic_9_of_5_pos
will = 67890
pic_9_of_5_pos = fixed_of_10_pos;
pic_9_of_5_pos will = 67890
The compiler can detect this; however, the detection switch is usually turned off in production programs.
The Exclusive OR example is just the frosting on the cake. The important topic is the math.
KKBOB: PROC OPTIONS(MAIN);
DCL SYSPRINT FILE STREAM OUTPUT;
DCL(BOOL,ONCODE,ONLOC) BUILTIN; /*BONUS - USING BOOL FUNCTION FOR */
DCL A BIT(8) INIT('11110000'B); /*EXCLUSIVE OR COULD USE ON CHAR OR
*/
DCL B BIT(8) INIT('10101010'B); /* NUMERIC DATA */
DCL C BIT(8) INIT('00000000'B); /* BOOL BUILTIN does heavy lifting
*/
DCL Z BIT(4) INIT('0110'B); /* THIS IS AN EXCLUSIVE OR */
DCL (I,J,K) FIXED BIN(15);
DCL VALUE PIC'99999999';
ON ERROR BEGIN; ON ERROR SYSTEM;
VALUE
= ONCODE;
PUT SKIP
EDIT('@'||ONLOC||' OF '||VALUE)(A); END;
PUT SKIP DATA(A,B);
C = A&B;
PUT SKIP DATA(C); /* AND */
C = A|B;
PUT SKIP DATA(C); /* OR */
C = BOOL(A,B,Z); PUT SKIP
DATA(C); /* EXCLUSIVE
OR
*/
K=9000;
CALL SIZE_ERROR;
CALL FIXED_OVER_ERROR;
SIZE_ERROR: PROC;
Size
is
a logical error. Target is too small for result.
ON SIZE BEGIN; PUT SKIP
LIST('SIZE ERROR'); END;
I = 32000+32000; /* SIZE
ERROR
CAUGHT AT COMPLILE TIME */
(SIZE): I = 32000+K; /* FORCE CATCHING SIZE ERROR IN EXECUTION */
PUT DATA(I);
END SIZE_ERROR;
FIXED_OVER_ERROR: PROC;
Overflow
is a machine error. The operation cannot be performed.
I = 32000; J = 1000;
K = I**J; /* THIS WILL NOT FIT IN 16 BITS */
PUT DATA(K);
END FIXED_OVER_ERROR;
END KKBOB;
Treat PIC variables as numbers in all but I/O operations. Always initialize PIC fields. Don't forget the sign unless you're real positive about everything. An "S" tells PL/I to put a sign in front of the number: PIC'999' has no sign, but PIC'S999' does.
When doing compares, consider overlaying the PIC definition with a CHAR string. It's also good to test a PIC value as a CHAR string for blanks instead of zeros. Know where the data has been. VisualAge PL/I has some new built-ins to help validate data content.
If you're doing many numeric operations, assign the value to a FIXED DEC variable for the math. Be sure to place the data back into the PIC field when you're done, or you'll have wasted a lot of time.
DCL NUM PIC'9'; DCL CHR
CHAR(1) DEF NUM; IF CHR='
' THEN CALL PANIC()
Be careful with numeric variables in PL/I. Size errors, undefined variables, and having blanks in the data can really hurt.
DCL WORKING FILE RECORD;
This is a nice way to handle an
OPEN FILE(WORKING) OUTPUT;
internal
file. Don't need to worry
CALL FILL_IT_UP; about running out of storage and
can
CLOSE FILE(WORKING); avoid a
second program.
OPEN FILE(WORKING) INPUT;
CALL DRAIN_IT;
STRUCTURE = ''; sets CHAR
fields
to blank and numeric fields to 0
Below are various ways to initialize arrays. Only one does the entire array:
A(1) = 1; FIRST ELEMENT
A=1; only initializes FIRST ELEMENT
A(*) = 1; ALL
ELEMENTS
Hint: Be careful when initializing arrays:
DCL CHAR_ARRAY(5) CHAR(1)INIT(' ');
Initializes
CHAR_ARRAY(1)INIT(' ', 'A'); does
first
2 elements or for all try INIT((5)' ');
(5) and everyone will know you read the manual.
Use the next INIT CALL SETUP(5) and no one will work with
you.
Setup initializes 5
elements. You get to write SETUP.
This statement does something, but no one cares:
A=(B/3(C**8))/J+1-7*9(COS(SOME_ANGLE))+(K|L&M) ;
Make it readable, please! There are better things to do in life than figure out something like this. Break the process into multiple steps, add comments, and it may even work correctly the first time.
Learn the rules or use parentheses ( ). Using ( ) is easier to remember!
This is an easy way to remove unwanted characters from a string. Also the ability to add incrementally to a string is useful.
NULL is a built-in function to test for, or assign, the absence of a pointer address value. It is not 0. In the example below, it's used to test that a pointer has been passed to the procedure.
DCL MAKE_SMALL CHAR(200) VARYING;
1CRUNCH:PROC(FROM_WHERE);
DCL FROM_WHERE PTR; This is never set so the logic has a bug
DCL NOW_LARGE(200) CHAR(0001)
BASED(FROM_WHERE);
DCL (J) FIXED BIN(15) INIT(0);
DCL (NULL) BUILTIN;
MAKE_SMALL
=
'';
IF FROM_WHERE = NULL() THEN
RETURN; remember never trust a
pointer
DO J=1 TO 200; IF NOW_LARGE(J) ¬='
'
THEN
MAKE_SMALL=MAKE_SMALL||NOW_LARGE(J);
END;
END CRUNCH;
Recursive routines are easy to code in PL/I. Knowing when to code them is the trick, because it can't go around forever. They are best used in the privacy of your own home. This, however, is a neat use. This is an example of a procedure where the OPTION(BYVALUE) on the PROC statement could be used. The procedure does not modify the input parameter.
TOPEGADATE: PROC(INDAY)
RETURNS(CHAR(9)) RECURSIVE;
DCL INDAY CHAR(8);
DCL MYDATE CHAR(8) INIT('');
DCL 1 TODAY_STRUC
BASED(ADDR(MYDATE)),
2 WHOCARES CHAR(2),
2 YY CHAR(2),
2 MM CHAR(2),
2 DD CHAR(2);
DCL NEW_MONTH CHAR(3)
INIT(' ');
DCL (VERIFY,DATETIME,DATE) BUILTIN;
IF VERIFY(INDAY,'0123456789')> 0
THEN MYDATE=DATETIME; this
is the system's clock date and time
ELSE MYDATE=INDAY;
SELECT (MM);
WHEN ('01') NEW_MONTH = 'JAN'; WHEN ('02') NEW_MONTH = 'FEB';
WHEN ('03') NEW_MONTH = 'MAR'; WHEN ('04') NEW_MONTH = 'APR';
WHEN ('05') NEW_MONTH = 'MAY'; WHEN ('06') NEW_MONTH = 'JUN';
WHEN ('07') NEW_MONTH = 'JUL'; WHEN ('08') NEW_MONTH = 'AUG';
WHEN ('09') NEW_MONTH = 'SEP'; WHEN ('10') NEW_MONTH = 'OCT';
WHEN ('11') NEW_MONTH = 'NOV'; WHEN ('12') NEW_MONTH = 'DEC';
notice the recursive call is with a
built-in value that will work and exit!
OTHERWISE RETURN(TOPEGADATE(DATETIME));
bad input use today and
END; go around again
RETURN(DD||'-'||NEW_MONTH||'-'||YY);
END TOPEGADATE;
The CICS command response option, RESP( ), is easy to use in PL/I. I think it's simpler than trying to keep handle conditions under control. Simply respond to error conditions right where they occur. CICS will provide the correct binary value for testing with DFHRESP(condition name). Don't hard-code binary CICS response values. Don't test for an actual numeric value in a CICS response. The compiler puts in the correct number for the DFHRESP(xxxx) part of the source statement.
DCL CICS_RESP FIXED BIN(31)
INIT(0);
EXEC CICS START TRANSID('GMJ4') FROM(WS_DFH_GATEWAY)
LENGTH(STG(WS_DFH_GATEWAY)) QUEUE(TS_QUEUE_NAME)
RESP
(CICS_RESP);
IF CICS_RESP = DFHRESP(NORMAL) THEN
RETURN; ELSE DO;
DCL BIG_FLOAT FLOAT
DECIMAL;
DCL LITTLE_BINARY FIXED
BIN(15);
DCL SIX_PACK FIXED
DECIMAL(6,2);
DCL FIX_IS_IN FIXED
DECIMAL(15,3);
DCL PICTURE_THE_RESULT
PIC'9999999V.99999';
PICTURE_THE_RESULT =
((BIG_FLOAT/LITTLE_BINARY)*SIX_PACK)/FIX_IS_IN);
The result will not be what is expected. Why, you ask? Intermediate results - that's why!
PL/I figures out the answer for the intermediate result to a precision that it determines before the answer is placed in the assignment statement result field. It doesn't care what you want!
You can control the precision in two ways:
Know the intermediate result rules table for arithmetic operations.
Use the built-in functions (ADD, DIVIDE, MULTIPLY) to control precision.
Read Chapter 3 in the IBM PL/I Language Reference manual. Beware of multiplying or dividing mixed data types, or precision when working in FIXED DECIMAL. It only takes a minute to understand the table. Using the built-ins is even faster to code.
Hint: If you lose the pennies, look for an undeclared variable that has defaulted to DECIMAL FLOAT or FIXED BIN. Floating point is only interested in big numbers. The last few digits to the right of the decimal point just get in the way. Usually it will be a totaling bucket that you almost remembered the name of when coding the total subroutine.
Not that you will ever need these, BUT…
The ONCODE, ONLOC, and ONCHAR built-in functions are useful. Check them out. They provide the what and where for error-condition analysis.
PUT SKIP(1) EDIT('MY VALUES HERE = '||ORIGIN_TIME)(A);
PUT DATA(A_BIG_STRUCTURE); ALL elements.
Can't be a BASED structure.
PUT DATA() Every variable in the
program. USE IF YOU HATE TREES!
Don't use DATA(variable) on BASED variables - it was the rule until VisualAge came along! Now this will compile but if the data content is incorrect the program fails. So do this:
PUT EDIT('X='||X)(A); or better PUT LIST(‘X=’||X); assuming X is char data
Read the IBM Language Reference manual on variations of the PUT DATA statement to handle numeric data. Be careful of PUT DATA on structures unless you want to find all the FIXED DECIMAL and PIC fields that are not initialized while looking at an abend.
PUT LIST('I GOT TO HERE 1'); Always
works for me with logic flow problems
PL/I also has other tracing options that give all the subroutine names and data values (similar to COBOL). The HUGHES manual is not too clear on how to use it. In my experience, there is too much output. Also, PL/I tracing does not handle BASED variables.
LONG_DAY: PROC;
IF IT_WONT_WORK
THEN
DO;
CALL HELP;
CALL POLICE;
IM_OK_NOW = IT_WORKED;
CALL ON_TO_BETTER_THINGS;
END
LONG_DAY;
You forgot the END for the THEN DO. Guess where PL/I puts it? Right where it will do the most damage! This is a good point at which to cover the two schools of thought on using a procedure label on the END statement. If you don't use a procedure label on the END statement, the above error will be found, because the procedure will not have an end. With multiple errors of this type, it's difficult to find where they are missing. The level listing on the left side of the compile helps to figure this out. I put labels on the subroutine ends. It aids readability and limits the scope of missing END statements.
POINTER variables are addresses that can be set either at compile or execution time. They must be set to real estate that you own! At compile time, set the POINTER variable to the address of a non-based element or structure.
DCL P POINTER
DCL LOST_IN_SPACE CHAR(10)
BASED(P);
DCL PLANET_HOLLYWOOD CHAR(10);
ARNOLD = LOST_IN_SPACE; Will
not
work
P = ADDR(PLANET_HOLLYWOOD); Now P
contains an address
ARNOLD = LOST_IN_SPACE; still
won't
work ARNOLD defaults to numeric
Don't know what is in LOST_IN_SPACE
DCL ARNOLD
a
CHAR variable.
ALLOCATE (DQ) SET(P);
P->DQ = B->BBQ
BASEDed ASSIGNMENT
YOUR->BBQ = MY->BBQ;
Never trust a pointer, because it may not be set.
dcl wish pointer; A mixed case example for C
programmers.
call hope_and_pray(wish); PL/I is not case sensitive for commands
and
variable names.
hope_and_pray: proc(make_a_wish);
dcl Make_a_wish
pointer;
dcl what_data char(1) based(make_a_Wish);
IF make_A_wish = NULL() then
signal error;
To really hurt yourself, look at the example of stacks in the examples chapter.
BASED variable DECLAREs are just like pointer-addressed variables, in that they tell the compiler the exact storage address where a variable or structure resides. This is fine for redefining alphabetic fields, but be careful with structures and numeric fields. The two ways to define fields with BASED are illustrated below:
DCL MY_BASE CHAR(10);
DCL 1 MY_REDEFINE
BASED(ADDR(MY_BASE)),
2 FIRST_FIVE CHAR(5),
2 SECOND_FIVE CHAR(5);
DCL 1 MY_REDEFINE_WITH_POINTER BASED(MY_POINTER);
2 FIRST_FIVE CHAR(5),
2 A_VERY_BIG_PROBLEM CHAR(10);
DCL MY_POINTER
POINTER
INIT(ADDR(MY_BASE));
In both examples, the addressing is correct and PL/I will be happy. Notice A_VERY_BIG_PROBLEM has a length of 10. This presents the opportunity to overlay another of the program's variables. Not only is it a problem, to make matters worse PL/I sometimes rearranges where it stores variables so it may not be the next variable in the listing.
I hope you have a newfound respect for keeping track of variable addressing. This is a good time to point out that PL/I will only keep track of pointers for CONTROLLED storage. If you FREE allocated storage or do CICS FREEMAIN DATAPOINTER, PL/I removes your access to the storage but does not change the pointer value.
%PAGE; page
eject
%SKIP(99); skip 99 lines
%INCLUDE;
bring in copy code
%PRINT; %IF and lots
more
There are uses for the preprocessor. It can do more than page ejects and INCLUDE copy code. I use the preprocessor to add debug logic to the source. When the program is production-ready, I just set the preprocessor variable OFF and recompile. I don't have to remove statements. I also use preprocessors to include code for future use - code I want to have in the program but not execute.
Instead of %PAGE and %SKIP, I like to use 1 (page) or 0 (skip) for print control in column 1 of the source. This saves me lines when trying to stay within the one-screen, logical-block, programming style.
%IF D = 'ON' %THEN %DO; ERIN =
''; %END;
*PROCESS PREPROCESSOR
OPTIONS NEAT BUT NOT USED
OFTEN =è the*PROCESS starts
in
column 1, Program statements in column 2
PGMNAME: PROC OPTIONS (MAIN);
COMMENTS ON PROGRAM NAME
PROGRAMMER FUNCTION FIXES
FILE DEFINITIONS
EXTERNAL ENTRIES
RECORD LAYOUT FOR FILES
GLOBAL CONSTANTS
GLOBAL VARIABLES
FILE SWITCHES
TOTAL BUCKETS
FORMATTED DATES
ON ERROR BEGIN; /* good things to make debug easy */ END;
ON ENDFILE(INPUT) EOF = '1'B;
CALL INITIALIZATION;
CALL MAIN_LOGIC;
CALL END_LOGIC;
INITIALIZATION: PROC;
OPEN FILES
FORMAT DATE
INITIALIZE FIELDS
END INITIALIZATION;
MAIN_LOGIC: PROC;
READ FILE(INPUT) INTO
(IN_RECORD);
DO WHILE (EOF);
CALL COMPUTE;
CALL PRINT;
CALL READ_NEXT;
END /* DO WHILE */
END MAIN_LOGIC;
END_LOGIC: PROC;
CALL WRAP_UP
CLOSE FILES
END END_LOGIC;
COMPUTE: PROC; END
COMPUTE;
PRINT: PROC; END PRINT; See
the example of what to put here
READ_NEXT: PROC; END
READ_NEXT;
END PGMNAME;
JCL Parameters (PARM=) are a good way to pass control information to programs. Use them for simply overriding control, not as a replacement for a series of control cards. Also avoid the switch string of ones and zeros. Leave that to the Assembler programmers.
Some examples are for if the program is running in test or production, having a purge-all feature in a housekeeping program, or to turn on tracing. Think about having the default be the absence of a parameter. Also use the INDEX function to search for control strings to avoid positional errors.
//AQUA01E JOB
//*-------------------------------------------------------------------*
//* STEP01 - EXECUTE PROGRAM
KK3100 FOR TEST DATA ONLY *
//*-------------------------------------------------------------------*
//STEP01 EXEC
PGM=KK31001,REGION=4096K,PARM='/DEBUG'
read DEBUG into the program from the PARM=
above
PASSIT: PROC(PARMIN) OPTIONS(MAIN);
DCL
PARMIN CHAR(100)
VARYING;
PARMIN will have the string '/DEBUG’'. I = INDEX(PARMIN,'DEBUG'); tells there is a DEBUG and the location.
A parameter passed to the program is the classic example of a variable-length character string. In other words, it is a variable where the length is not known until execution time. The idea of testing parameter variables by looking for the string instead of at a specific location has a couple of advantages:
You can have free-form input for more than one value.
After all, no one remembers what the program needs when enhancing the production JCL.
The following information is partially a paraphrase of IBM copyrighted material. It's used within the guidelines IBM provides for customer usage.
Don’t declare very large structures and arrays as AUTOMATIC, the default storage class. Define them as BASED on a POINTER variable. At execution allocate them using the CICS GETMAIN SET(pointer) FLENGTH(length) command. This is a nice example because you can just set the pointer and forget it for the life of the program. Every program that issues a GETMAIN should issue a FREEMAIN even though CICS will free the storage when the task ends. Task end is not the same as program end.
DCL A(10,10) FLOAT and DCL B(100,10) CHAR(100) the bad way
DCL (APOINTER, BPOINTER)
POINTER; the good way
DCL A(10,10) FLOAT BASED(APOINTER),
B(100,10) CHAR(100) BASED(BPOINTER),
CSTG BUILTIN;
EXEC CICS GETMAIN SET(APOINTER) FLENGTH(CSTG(A));
EXEC CICS FREEMAIN DATAPOINTER(APOINTER);
EXEC CICS GETMAIN SET(BPOINTER) FLENGTH(CSTG(B));
Issue as few GETMAIN commands as possible. It's generally better for the program to add up its requirements and do one GETMAIN command than to do several smaller ones, unless the duration of these requirements vary greatly. Avoid use of the INITIMG and SHARED options on a GETMAIN command.
Define the elements
within a data structure in the approximate order in which they are referred
to. In PL/I, all the elements of one
row are stored, then the next row, and so on.
Define an array so that you can process it by row rather than by
column.
Avoid long searches
for data in tables. If the table is
sorted, consider a binary search or starting at the bottom and working
backward
in some cases.
Avoid being too fancy with navigation. Remember Hansel and Gretel's bread crumbs.
Use data structures
that can be addressed directly, such as arrays, rather than structures that
must be searched, such as chains.
Avoid methods that
simulate indirect addressing.
This will show the typing errors. For some programmers, it points out coding and logic errors as well. Here are OS PL/I and VisualAge examples. There are differences.
Look for errors here along with text. It gives the source line number and some text. Remember the source line number is not the line number of the source text; it's the expanded source after the copy code is included. Do ISPF finds using the output file f ' 99 '.
COMPILER DIAGNOSTIC MESSAGES
ERROR ID L STMT MESSAGE DESCRIPTION
WARNING DIAGNOSTIC MESSAGES PL/I loves warnings.
Most
may be ignored.
IEL0548I W 1, 1 PARAMETER TO PRIMARY ENTRY POINT OF MAIN PROCEDURE IS NOT
V
IEL0916I W 1 ITEM(S)
'PGMAW0MI.INSTRL','PGMAW0MI.TRANSF','PGMAW0MI.INSTR',
'PGMAW0MI.INSTR2I','PGMAW0MI.TIMEF','PGMAW0MI.NEXTF'
UNINITIALIZED
WHEN
USED IN THIS BLOCK.
IEL0885I W 92, 100, 101, 112, 139,
140, 141, 149, 151, 153, 157, 166
This shows where variables are used and how they're defined:
5668-910 IBM OS PL/I OPTIMIZING COMPILER
PGAW200:
PROC(DFHEIPTR,PTR_COMM_ARE
ATTRIBUTE AND CROSS-REFE…
DCL NO. IDENTIFIER ATTRIBUTES AND
REFERENCES
12 ABEND_COMMAREA ………BASED
(PTR_ABEND_AREA)
90,115,115,213
118 ABEND_ERROR /* STATEMENT LABEL
CONSTANT
*/
106
14 ADDR BUILTIN
71,73,86,105,109,114,119
This gives the length of the structure and its parts. Remember offsets start at 0, not 1. It will also identify slack bytes if they are present.
DCL NO. IDENTIFIER LVL DIMS OFFSET ELEMENT TOTAL
LENGTH
LENGTH
12 ABEND_COMMAREA 1 224
224
USER_ID 2 3
When someone else has an abend, use this to find out the instruction:
5668-910 IBM OS PL/I OPTIMIZING COMPILER
PGAW200:
PROC(DFHEIPTR,PTR_COMM_ARE
TABLES OF OFFSETS AND STATEMENT NUMBERS
WITHIN PROCEDURE
PGAW200
OFFSET (HEX) 0 1AA 1AA
1E8 1E8 1EC
1F6 200 212
STATEMENT NO. 1 72 74
75 76 79
80 97 98
WITHIN ON unit BLOCK 2
OFFSET (HEX) 0 64 6E
STATEMENT NO. 76 77 78
WITHIN PROCEDURE
A1000_ERROR_HANDLERS
Beware of these! Undefined variables can ruin your life. They occur from misspelling or the failure to declare the variable identifier. Undeclared names also appear as I (Information) level compiler diagnostic messages. Always look at these messages.
LOOK_OUT_FOR_ME = 1234567.8632;
wonder
what happened to the pennies?
5668-910 IBM OS PL/I OPTIMIZING COMPILER
DCL NO. IDENTIFIER ATTRIBUTES AND
REFERENCES
10 LINE7 AUTOMATIC UNALIGNED
INITIAL CHARACTER
1,72,80
******** LOOK_OUT_FOR_ME AUTOMATIC ALIGNED BINARY FIXED (15,0)
28
If you ignore compiler informational messages, you get called away from romantic weekends. It's that simple!
IEL0533I I NO 'DECLARE' STATEMENT(S) FOR 'LOOK_OUT_FOR_ME'
IEL0541I I 1, 86, 112 'ORDER'
OPTION APPLIES TO THIS BLOCK.
Matching up END statements with the correct DO is not always easy. The compiler tells when there are not enough of one type of statement (END or DO), and when there are too many of the other. The warning message is not very helpful unless the scope of the block of code is easy for the compiler to figure out.
What follows shows how to help the compiler by using labels on DO blocks. This is useful when there are multiple levels of nesting covering pages of the listing. Unless you like looking for Waldo, you are better off not making the mistake in the first place.
The good example:
13 1 0 IF EOF
THEN ABLOCK: DO;
14 1
1 IF GOOD
=
1
THEN DO; missing the END
15 1
2
GOOD = 2;
16 1
2 END ABLOCK;
IEL0385I W 16
MULTIPLE CLOSURE OF BLOCK. 1
EXTRA 'END' STATEMENT(S)
Here it is, without a
block label. Instead of looking at
line
16, the compiler refers to the end of program END statement line number,
line
45.
13 1
0 IF EOF
THEN DO;
14 1
1 IF GOOD
=
1
THEN DO;
missing
the END
15 1
2 GOOD = 2;
16 1
2 END;
thirty lines of code till the end
45 1
1 END KKP2TST;
IEL0385I W 45
MULTIPLE CLOSURE OF BLOCK. 1 EXTRA 'END' STATEMENT(S)
5655-B22
IBM(R) VisualAge(TM) PL/I for OS/390
V2.R2.M1 (Built:20010621)
Options Specified
Install:
Command:
A,AG,NEST,OF,OPT(2),STG,X,GS,OP,OBJ,S,
LIMITS(FIXEDDEC(31)),CSECT
Long
list of options from the Programmer’s Guide. There are occasions where
knowing
what these mean is useful. Since the VisualAge compiler supports multiple
platforms, some are very important for
compatibility.
WIDECHAR(BIGENDIAN)
WINDOW(1950)
+ XREF
5655-B22
IBM(R) VisualAge(TM) PL/I for OS/390
V2.R2.M1 (Built:20010621)
Compiler Source
Line.File LV NT
1.1 BOOKVI: PROC
OPTIONS(MAIN);
2.1 1 DCL USECOUNT FIXED BIN(31)
INIT(999);
3.1 1 DCL DEC11_0 FIXED DEC(11,0)
INIT(0);
4.1 1 DCL EIBTASKN FIXED DEC(9)
INIT(0);
5.1 1 DCL ROBBY CHAR VALUE('ROBBY AQUACODER');
6.1 1 DCL ERIN CHAR VALUE('ERIN AQUACODER');
7.1 1 DCL ONEHUNDREDDEC FIXED DEC VALUE(100);
8.1 1 DCL ONEHUNDREDBIN FIXED BIN VALUE(100);
9.1 1 DEC11_0 = EIBTASKN*100;
10.1 1 DEC11_0 = EIBTASKN*ONEHUNDREDDEC;
11.1 1 USECOUNT = USECOUNT*100;
12.1 1 USECOUNT =
USECOUNT*ONEHUNDREDBIN;
13.1 1 PUT SKIP LIST('ROBBY
AQUACODER');
14.1 1 PUT SKIP LIST(ROBBY);
15.1 1 ERIN=ROBBY;
16.1 1 END BOOKVI;
5655-B22
IBM(R) VisualAge(TM) PL/I for OS/390
V2.R2.M1 (Built:20010621)
Attribute/Xref Table
Line.File Identifier Attributes
1.1
BOOKVI CONSTANT
EXTERNAL ENTRY()
3.1 DEC11_0 AUTOMATIC FIXED DEC(11,0) INITIAL
Sets: 9.1 10.1
4.1 EIBTASKN AUTOMATIC FIXED DEC(9,0)
INITIAL
Refs: 9.1 10.1
6.1
ERIN CONSTANT
CHARACTER(10)
Sets: 15.1
8.1
ONEHUNDREDBIN CONSTANT
FIXED BIN(15,0)
Refs: 12.1
7.1
ONEHUNDREDDEC CONSTANT
FIXED DEC(5,0)
Refs: 10.1
5.1 ROBBY CONSTANT CHARACTER(11)
Refs: 14.1 15.1
+++++++ SYSPRINT CONSTANT EXTERNAL FILE STREAM
OUTPUT PRINT
Refs: 13.1 14.1
2.1 USECOUNT AUTOMATIC FIXED BIN(31,0)
INITIAL
Refs: 11.1 12.1
Sets: 11.1 12.1
5655-B22
IBM(R) VisualAge(TM) PL/I for OS/390
V2.R2.M1 (Built:20010621)
Compiler Messages
Message
Line.File Message
Description
IBM1667I S
15.1 Target in assignment is
NONASSIGNABLE.
File Reference Table
File Included From Name
1
SYS01220.T162156.RA000.AQUACODE.WRITE.H04
Component Return
Code Messages
(Total/Suppressed) Time
Compiler 12 3 / 2 0 secs
End of compilation of BOOKVI
<SIZE: RECS=185 BYTES=9345 >
Fine-tune the use and allocation of storage to make a program execute faster. Do this only in extreme cases, however, and only after researching it in the IBM PL/I manuals. This section shows where to control storage allocation, and how to view the program’s allocation-statistics report. It does not explain the process. This is not for beginners, but can be important for large, long-running programs.
Include the following DECLARE in your program as the first statement after the PROC OPTIONS(MAIN), so everyone knows that the default allocation is not being used and/or is being reported on. The RPTSTG(ON) option triggers the report. The RPTSTG option cannot be on for production. In CICS programs using STACK(,,ANY) and HEAP(,,ANY) in programs that run with 31 bit addressing and Language Environment will make variable storage definitions go above the 16 meg line where storage is more available. STACK is for regular variables. HEAP is for allocated or controlled variables. IBM says not to use PUT EDIT statements when using STACK this way. I have found simple PUT EDIT statements seem to work but the warning is there.
DCL PLIXOPT CHAR(255) VAR STATIC EXTERNAL
INIT ('STACK(4K),HEAP(4K),RPTSTG(ON)');
Change to RPTSTG(OFF) for production.
This is a comparison of the COBOL and PL/I languages. If you think in one, look across to the other to express yourself in that language. This only has the old COBOL, so clever new COBOL programmers will recognize even more in PL/I that they're already familiar with:
COBOL PL/I
FD NORMAL-FILE DCL AFILE FILE
RECORD INPUT
OUTPUT
UPDATE
01 RECORD-LAYOUT
DCL 01 RECORD_LAYOUT,
05 IF-CHARS PIC XXX
2 IF_CHARS CHAR(3),
05 IF-NUMERIC PIC 999 2 IF_NUMERIC
PIC'999',
COMP FIXED BINARY
COMP-1 FLOAT SINGLE
COMP-2 FLOAT DOUBLE
COMP-3 FIXED
DEC(PLACES,DEC)
COMP-4 FIXED BINARY
PARAGRAPH-NAME.
ROUTINE_NAME:
PARAGRAPH-NAME-EXIT EXIT END ROUTINE_NAME;
PERFORM A-NAME UNTIL EOF = 'Y'
DO UNTIL EOF = '1'B;
CALL A_NAME;
END; /* DO */
CALL 'HOME' USING ET
CALL HOME(ET);
OPEN INPUT IN-FILE
OPEN FILE(INFILE) INPUT;
CLOSE IN-FILE
CLOSE FILE(INFILE),
OUT-FILE.
FILE(OUTFILE);
MOVE SPACES TO SOMEWHERE
SOMEWHERE = ' ';
MOVE ZEROS TO ANUMBER ANUMBER = 0;
MOVE A OF ALPHABET TO PRINT
PRINT = ALPHABET.A;
COMPUTE A = (B/C)
A
=B/C;
ADD 1 TO NUMBER
NUMBER = NUMBER + 1;
ADD A TO B GIVING C
C
= A + B;
ADD A TO B C D.
NO SINGLE STATEMENT
DIVIDE A INTO B GIVING C
C= B/A; + SETUP ON SIZE
CONDITION FOR SIZE ON CONDITION
READ CARD-FILE
READ FILE(CARD) INTO(INPUT_AREA)
DATA AREA NOT LOCKED INTO FILE DEF.
WRITE REPORT AFTER ADVANCING 1 LINE
WRITE FILE(PRINT)FROM(OUTAREA)
NEED TO DO OWN LINE CONTROL
UNLESS USING PUTS( ON PAGE)
IF EOF
IF
EOF
MOVE A TO B THEN DO;
MOVE C TO D B = A;
ELSE
D = C;
MOVE E TO F END;
MOVE G TO H. ELSE DO;
F = E;
H = G;
END;
IF EOF
IF EOF
NEXT SENTENCE THEN;
ELSE ELSE B= B+A;
ADD A TO B.
SEARCH
INDEX OR VERIFY OR OWN CODE
STRING
|| OPERATOR A||B
SET INDEX
I
= 3
DISPLAY
3
FORMS OF PUT STATEMENT
ALTER AND GO TO
DON'T USE GOTO OR MODIFYING
LABEL
VARIABLES
ACCEPTS
PARAMETER INPUT PROCESSING
INSPECT
TRANSLATE FUNCTION WILL NOT
COUNT OCCURANCES. WRITE
CODE
UNSTRING
SUBSTR built-in FUNCTION
This chapter includes some complete programs and subroutines. It's a typical old New England attic. Browse it quickly then go back and pick up the treasures.
This example shows a program with all the JCL to run it. It's not interesting except it has many forms of subroutine calls. It also has a few bugs. Can you find them? It has all the source material including the database access control module and input control file. The material presented here is simply to show all the elements of a real production batch program in one place.
//KK600 JOB DELETE OLD RECORDS
//*-----------------------------------------------------
//STEP01 EXEC
PGM=KK60001,REGION=4096K
//DEPTS DD
DSN=CNTL(PGADAYS),DISP=SHR
//BACKUP DD
DSN=NULLFILE,UNIT=SYSDA,DISP=(MOD,KEEP,KEEP),
//
SPACE=(CYL,(1,1)),DCB=(LRECL=400,BLKSIZE=4000,RECFM=FB)
//SYSPRINT DD SYSOUT=*
//SYSOUT DD SYSOUT=*
//PLIDUMP DD SYSOUT=*
KK60001: PROC OPTIONS(MAIN);
/*--------------------------------------------------------------*/
/*
*/
/*
INPUT FILE: */
/*
DEPTS DEPT/APPL + DAYS
TO
DELETE */
/*
*/
/*
OUTPUT FILE: */
/*
BACKUP IMAGE OF PGA
RECORDS
DELETED */
/*
*/
/*--------------------------------------------------------------*/
/*************************************************************/
/*** FILE I/O AREA */
/*************************************************************/
DCL DEPTS FILE RECORD INPUT;
DCL BACKUP FILE RECORD OUTPUT;
DCL
RGPGA ENTRY
(*,*); access module to
database
DCL ABCODE FIXED BIN(31) INIT(9999),
SSABEND ENTRY (FIXED BIN(31));
/********************************************************************
/
/* THE DEPTS FILE RECORD AREA */
/********************************************************************
/
DCL DEPT_RECORD CHAR(80);
DCL 1 DEPTS_FIL_STRUC BASED(ADDR(DEPT_RECORD)),
3 DEPT_APPL CHAR(6),
3 DAYS_OLD PIC'999',
3 ARCHIVE CHAR(1);
1%PAGE; control block for DATA
access module
DCL 1 PGA_REQ_AREA, %INCLUDE DD1(TEDAMCOM);
DCL
PGA_RQ_ERR_CODE PIC '99'
DEF PGA_REQ_AREA.RQ_ERR_CODE;
DCL PGA_WORK_AREA CHAR(500)
BASED(ADDR(PGA_REQ_AREA.WORK_AREA));
DCL 1 STATUS_FL_STRUC BASED(ADDR(PGA_WORK_AREA)), %INCLUDE
DD1(PGADV1);
DCL 1 DCM_USER_AREA,
2 USER CHAR(32) INIT('KK60001'),
2 CPS_STUFF1 FIXED BIN(31) INIT(0),
2 CPS_STUFF2 FIXED BIN(31) INIT(0);
DCL BACKUP_STRING CHAR(400);
DCL 1 BACKUP_STRUC BASED(ADDR(BACKUP_STRING)),
2 BACKING_PGM CHAR(8)
INIT('KK60001'),
2 BACK_COST_CTR CHAR(6),
2 BACKING_DATE
CHAR(6),
2 SPARE_SPACE CHAR(30)
INIT(' '),
2 PGA_IMAGE
CHAR(350);
1%PAGE;
/********************************************************************
/
/* BUILTIN FUNCTIONS AND FILES */
/********************************************************************
/
DCL SYSPRINT EXTERNAL FILE PRINT;
DCL
(ADDR,ABS,LOW,CSTG,INDEX,TIME,DATE,MULTIPLY) BUILTIN;
DCL
(DIVIDE,ROUND,ONCODE,STG,SUBSTR,HIGH,STRING) BUILTIN;
/*******************************************************************/
/* MISCELLANEOUS WORK AREA
*/
/*******************************************************************/
DCL (I,J,K,L,M,N) FIXED BINARY(31) INIT(0);
DCL EOF BIT(1) INIT ('0'B);
DCL BIT_YES BIT(1) INIT ('1'B);
DCL BIT_ON BIT(1) INIT ('1'B);
DCL BIT_NO BIT(1) INIT ('0'B);
DCL BIT_OFF BIT(1) INIT ('0'B);
DCL SAMEDEPT BIT(1) INIT ('0'B);
DCL RECORDS_FOUND PIC'9999' INIT(0);
DCL CURDAY PIC'999999' INIT(0);
DCL RECDAY PIC'999999' INIT(0);
DCL HOLD_GTO_DATE PIC'99999' INIT(0);
DCL 1 TODAY,
3 YY PIC'99',
3 MM PIC'99',
3 DD PIC'99';
DCL DATE_STRING CHAR(6)
BASED(ADDR(TODAY));
DCL PGA_S_KEY CHAR(52);
DCL PGA_IN_ERROR CHAR(60) INIT(' ');
DCL 1 CONVERT_THE_DATE,
%INCLUDE DD1(WSGTOLNK);
DCL GTODATE ENTRY(*)
EXTERNAL;
1%PAGE;
/*******************************************************************/
/* MAIN
PROGRAM LOGIC */
/*******************************************************************/
%SKIP(1);
ON ENDFILE(DEPTS) EOF =
BIT_YES;
/*------------------------------------------------------------------*
/
/* SET ERROR PROCESSING */
/*------------------------------------------------------------------*
/
ON ERROR SNAP BEGIN;
ON ERROR SYSTEM;
IF ONCODE = 0 & ONCODE = 9
THEN DO;
PUT SKIP(2) EDIT ('PLI
PROGRAM
ERROR')(A);
PUT SKIP(1) EDIT ('ONCODE =
',ONCODE)(A,A);
ABCODE = 2000 + ONCODE;
END;
ELSE DO;
IF
PGA_REQ_AREA.RETURN_SUFFIX
= 'AA' THEN
PUT SKIP(2) LIST('PGA
FILE
DATAVIEW NOT FOUND');
ELSE IF
PGA_REQ_AREA.RETURN_SUFFIX = ' ' THEN DO;
PUT SKIP(2)
EDIT
('PGA FILE ERROR')(A);
PUT SKIP(1)
LIST
('CODE = '||PGA_RQ_ERR_CODE);
PUT SKIP(1)
EDIT
(PGA_REQ_AREA.REQUEST_AREA)(A);
ABCODE = 1000 +
PGA_RQ_ERR_CODE;
END;
END; /*ELSE DO*/
CALL SSABEND(ABCODE);
END; /*** END ON ERROR SNAP
BEGIN ***/
OPEN FILE(DEPTS);
DATE_STRING = DATE;
GTO_OPTION_CODE = 1;
GTO_MMDDYY =
MM||DD||YY;
CALL
GTODATE(CONVERT_THE_DATE);
HOLD_GTO_DATE = GTO_JUL1;
READ FILE(DEPTS) INTO
(DEPT_RECORD);
DO WHILE(EOF = BIT_NO);
IF DAYS_OLD < '000' | DAYS_OLD < 5 | DAYS_OLD >
300
THEN CALL BAD_DATE_LOGIC;
ELSE DO;
CALL READ_FIRST;
DO
WHILE(SAMEDEPT);
GTO_OPTION_CODE =
1;
GTO_MMDDYY =
ORIGIN_DATE||RIGHT_YEAR();
CALL
GTODATE(CONVERT_THE_DATE);
IF GTO_INVALID_FLAG = 1
THEN DO; /*
SKIP
RECS WITH BAD DATES */
PUT
SKIP(2)
EDIT
('PGA
RECORD
ORIGIN_DATE IN ERR')(A);
PGA_IN_ERROR
= COST_CTR_DEPT ||
COST_CTR_APPL || ' ' ||
ORIGIN_DATE || ' ' ||
ORIGIN_TIME || ' ' ||
APPL_KVL;
PUT SKIP
EDIT(PGA_IN_ERROR)(A);
END;
ELSE DO;
GTO_JUL2 =
HOLD_GTO_DATE; /*= TODAY*/
GTO_OPTION_CODE = 4; /*DAYS BETWEEN */
CALL GTODATE(CONVERT_THE_DATE);
IF
GTO_DELTA
> DAYS_OLD
THEN
CALL
DELETE_IT; ELSE CALL RELES_IT;
END;
CALL
READ_NEXT;
END; /* DO WHILE
*/
END; /* ELSE */
READ FILE(DEPTS) INTO
(DEPT_RECORD);
PGA_REQ_AREA.RQ_CMD =
'RELES'; database action
to release a record
not
being used
CALL RGPGA
(DCM_USER_AREA,PGA_REQ_AREA);
database i/o call
END;
ALL_DONE:
PUT SKIP(1) EDIT ('RECORDS FOUND
=
',RECORDS_FOUND)(A,A);
CLOSE FILE(DEPTS);
/* END OF MAIN PROGRAM */
RIGHT_YEAR: PROC RETURNS(PIC'99');
/* this code has a Yr 2000 bug */
IF MM <
SUBSTR(ORIGIN_DATE,1,2) /* CAN YOU FIND IT */
THEN RETURN(YY-1); ELSE RETURN(YY);
END;
BAD_DATE_LOGIC: PROC;
PUT SKIP LIST('BAD DATE FOR
'||DEPT_APPL||' DATE OF '||DAYS_OLD);
END;
READ_FIRST: PROC;
PGA_S_KEY = DEPT_APPL;
Use of the *PROCESS macro is great for the first few compiles, if you don't like to wade through a big listing. Do not use it for the final compile if the listings are stored for production programs. Remember, *PROCESS starts in column 1.
*PROCESS must be the first statement of the source.
*PROCESS NOSTMT,NOOFFSET,NOMAP,NOSTORAGE,NOAGGREGATE,X(S);
Use this to cut down
on
output from early compiles
KK200S1: PROC (PARMIN) OPTIONS (MAIN);
%SKIP(3);
CALL
PROCESS_MORE_TYPES('PROC','I');
CALL
PROCESS_MORE_TYPES('PROC','V');
CALL
PROCESS_MORE_TYPES('RAUT','N');
CALL PROCESS_MORE_TYPES('RAUT','D');
IF FIRST_RUN_OF_DAY &
WHAT_DAY()= 2 /* NEVER ON MONDAY */
THEN DO;
CALL PROCESS_MORE_TYPES('AUTR','I');
CALL
PROCESS_MORE_TYPES('AUTR','V');
CALL
PROCESS_MORE_TYPES('CAUT','D');
END;
RETURN; /* THIS EXITS FROM THE SUBROUTINE */
An example of a subroutine within a subroutine
PROCESS_MORE_TYPES:
PROC(STATUS,TYPE);
DCL STATUS CHAR(4); PARAMETER
DCL TYPE CHAR(1); PARAMETER
DCL IO FIXED BIN(31); INTERNAL DATA
EOF_RCR = '0'B;
More DATA access.
this is the setup followed by a call to a general purpose call to the
access module.
IO = 0;
DO WHILE (RCR_RECORD.STATUS
=
STATUS &
RCR_RECORD.RECORD_TYPE = TYPE & EOF_RCR);
IO = IO +1;
CALL
P1000_FIND_NEW_HOLDERS;
CALL
P0010_READ_RCR_FILE;
END; /* END DO WHILE
EOF_RCR =
'0'B */
PUT SKIP
DATA(STATUS,TYPE,IO);
END PROCESS_MORE_TYPES;
END P0200_PROCESS_ALL;
This is a nice example of a subroutine with multiple entry points and neat date routines. Even better, use it with a date, and + or - days that call the right routine (0 today, - yesterday, + tomorrow).
The subroutine in KKBOB is a good example of a general-purpose routine. The returned data format can be either alphabetic or numeric. The input is checked to ensure it's valid. If the input is not valid, it uses today's date. (You might not like this feature, so figure out how to change it!)
KKBOB: PROC OPTIONS(MAIN);
DCL SYSPRINT FILE STREAM
OUTPUT;
DCL(ONCODE,ONLOC) BUILTIN;
DCL FIRST_DATE CHAR(8) INIT('19991230');
ON ERROR BEGIN; ON ERROR SYSTEM; PUT
EDIT('ONCODE='||ONCODE||'IN'||
ONLOC)(A); END;
PUT SKIP
EDIT('TODAY='||TODAY(''))(A);
PUT SKIP
EDIT('YESTERDAY='||YESTERDAY(''))(A);
PUT SKIP
EDIT('TOMORROW='||TOMORROW(''))(A);
PUT SKIP EDIT('2 AGO ='||YESTERDAY(YESTERDAY('')))(A); 2 ways
to
do the same
thing
PUT SKIP EDIT('2 FROM
='||TOMORROW(TOMORROW('')))(A); the
second is a little easier
DO I=1 TO 2;
FIRST_DATE=TOMORROW(FIRST_DATE); END;
PUT SKIP DATA(FIRST_DATE); to code for
more
DO I=1 TO 2;
FIRST_DATE=YESTERDAY(FIRST_DATE); END;
PUT SKIP DATA(FIRST_DATE); than 2 days
WHAT_DAY:
TODAY: PROC(DAY) RETURNS(PIC'(8)9');
by returning PIC
DCL DAY CHAR(8); the date value can
DCL TODAY_CHAR CHAR(8); be used in math or for
DCL TODAY_PIC PIC'(8)9' BASED(ADDR(TODAY_CHAR)); display
DCL 1 TODAY_STRUC
BASED(ADDR(TODAY_CHAR)),
2 YYYY PIC'9999',
2 (MM, DD) PIC'99';
DCL 1 YEAR400_LEAPS BASED(ADDR(TODAY_CHAR)),
2 WHOCARES
PIC'99', or use * PIC’99’ as placeholder
2 DOUBLE00 PIC'99';
DCL (DATETIME,MOD,VERIFY)
BUILTIN;
TODAY_CHAR =
PARM_PASSED(); make sure the input
is
numeric!
RETURN(TODAY_PIC); never trust your input!
YESTERDAY: ENTRY(DAY)
RETURNS(PIC'(8)9');
TODAY_CHAR =
PARM_PASSED(); if there is a non numeric input
IF DD > 1 THEN
DD=DD -
1; the math operations would
abend
ELSE DO;
IF MM=1
THEN DO; YYYY=YYYY-1; MM=12; END;
ELSE MM=MM - 1;
DD=END_OF_MONTH(MM);
END;
RETURN(TODAY_PIC);
TOMORROW: ENTRY(DAY) RETURNS(PIC'(8)9');
TODAY_CHAR =
PARM_PASSED();
IF DD < 28 THEN DD =
DD+1;
ELSE IF DD <
END_OF_MONTH(MM) THEN DD = DD+ 1;
ELSE DO;
DD =
1;
IF MM =
12
THEN
DO; YYYY = YYYY+1; MM = 1; END;
ELSE
MM
= MM + 1;
END;
RETURN(TODAY_PIC);
END_OF_MONTH: PROC(MM)
RETURNS(PIC'99');
DCL MM PIC'99';
SELECT(MM);
WHEN(01,03,05,07,08,10,12)
RETURN(31);
WHEN(04,06,09,11) RETURN(30);
OTHERWISE
IF MOD(YYYY,4) = 0
THEN IF DOUBLE00 = 0
THEN IF MOD(YYYY,400)=0
THEN RETURN(29); ELSE RETURN(28);
ELSE RETURN(29);
ELSE RETURN(28);
END;
END END_OF_MONTH;
PARM_PASSED: PROC
RETURNS(CHAR(8)); make sure the
input
is numeric!
IF VERIFY(DAY,'0123456789')>0
THEN RETURN(DATETIME); ELSE RETURN(DAY);
END PARM_PASSED;
END WHAT_DAY;
END KKBOB;
The built-in functions DATE, DATETIME, and TIME can be used in CICS. The following subroutine mimics how they work using CICS commands. This is an exercise for college professors, because it reinforces some obscure concepts for using ENTRY statements, and subroutines within subroutines - plus, if milliseconds are needed, just add a few statements and fake milliseconds. They won't be exactly correct, but who can prove it… or cares?
Just remember to remove the DCL statements that are provided by the compiler for the DATETIME, DATE, and TIME built-in functions. Time, as provided by the CICS ASKTIME command, is only to the second. This is also how to replace the PL/I functions with better ones. Please only use your replacements at home.
DID_IT_WORK = DATETIME;
PUT SKIP EDIT('PGA8
RETURN='||DID_IT_WORK)(A); DID_IT_WORK = DATE;
PUT SKIP EDIT('PGA8
RETURN='||DID_IT_WORK)(A); DID_IT_WORK = TIME;
PUT SKIP EDIT('PGA8
RETURN='||DID_IT_WORK)(A);
BOBTIME: DATETIME:
PROC RETURNS(CHAR(14)); to names
for
same proc
DCL
YEAR_CICS FIXED
BIN(31);
DCL
CICS_RESP FIXED
BIN(15);
DCL
ABSTIME FIXED
DEC(15);
DCL
YYMMDD_CICS, TIME_CICS CHAR(8);
DCL
MY_DATETIME
CHAR(14);
DCL
YEAR_PIC
PIC'9999';
RETURN(DTE()); a couple secondary entry
points
notice
how
they call the embedded subroutine
DATE:
ENTRY RETURNS(CHAR(6)); RETURN(SUBSTR(DTE(),3,6));
TIME:
ENTRY RETURNS(CHAR(9)); RETURN(SUBSTR(DTE(),9,6)||'000');
DTE:
PROC RETURNS(CHAR(14)); an embedded subroutine
EXEC CICS ASKTIME
ABSTIME(ABSTIME);
EXEC CICS FORMATTIME
ABSTIME(ABSTIME)
YYMMDD(YYMMDD_CICS)
TIME(TIME_CICS)
YEAR(YEAR_CICS)
RESP(CICS_RESP);
IF CICS_RESP =
DFHRESP(NORMAL)
THEN DO;
YEAR_PIC =
YEAR_CICS;
RETURN(YEAR_PIC||SUBSTR(YYMMDD_CICS,3,4)
||SUBSTR(TIME_CICS,1,6));
END;
ELSE
RETURN('00000000000000');
END DTE;
END BOBTIME;
Here's
another CICS screen handling example.
This is useful to process repetitive lines in a map. Note the use of UNALIGNED. BMS map
definitions
have BINARY fields scattered throughout and must be UNALIGNED. In this
example, WHERE
is used in the subroutine and entries to establish addressing for individual
map lines.
MAP_ASSIGN: PROC(WHERE,WHICH); /* TO FROM SCREEN ASSIGNMENTS */
DCL WHERE
POINTER;
DCL WHICH FIXED BIN(15);
DCL 1 LINE_ON_MAP BASED(WHERE)
UNALIGNED,
2 DELETEL FIXED
BINARY
(15,0),
2 DELETEF CHARACTER
(1),
2 DELETE CHARACTER
(1),
2 QNAMEL FIXED
BINARY
(15,0),
2 QNAMEF CHARACTER
(1),
2 QNAME CHARACTER
(16),
2 ITEMNBL FIXED BINARY (15,0),
2 ITEMNBF CHARACTER
(1),
2 ITEMNB CHARACTER
(4),
2 QUENBRL FIXED
BINARY
(15,0),
2 QUENBRF CHARACTER
(1),
2 QUENBR CHARACTER
(4),
2 ADRESSL FIXED
BINARY
(15,0),
2 ADRESSF CHARACTER
(1),
2 ADRESS CHARACTER
(4),
2 LENGTHL FIXED
BINARY
(15,0),
2 LENGTHF CHARACTER
(1),
2 LENGTH CHARACTER
(8),
2 STATUSL FIXED
BINARY
(15,0),
2 STATUSF CHARACTER
(1),
2 STATUS CHARACTER
(12);
DELETE =
WS_DELETEI(WHICH);
QNAME = WS_QNAMEI(WHICH);
ITEMNB =
WS_ITEMNBI(WHICH);
QUENBR = WS_QUENBRI(WHICH);
ADRESS =
WS_ADRESSI(WHICH);
LENGTH = WS_LENGTHI(WHICH);
DELETEF = DFHBMFSE;
QNAMEF, ITEMNBF, QUENBRF,
ADRESSF,
LENGTHF = DFHBMPRF;
RETURN;
MAP_ASSIGN_IN: ENTRY(WHERE,WHICH);
WS_DELETEI(WHICH)= DELETE; WS_QNAMEI(WHICH) =
QNAME;
WS_ITEMNBI(WHICH)= ITEMNB; WS_QUENBRI(WHICH)=
QUENBR;
WS_ADRESSI(WHICH)= ADRESS; WS_LENGTHI(WHICH)=
LENGTH;
RETURN;
MAP_NULL: ENTRY(WHERE);
WS_COUNT =
WS_COUNT + 1;
COMM_AREA.FIRST_Q_CURRENT_SCRN
= '________';
COMM_AREA.FIRST_Q_NEXT_SCRN =
' ';
QNAME = '________'; ITEMNB = '____';
QUENBR = '____'; ADRESS = '____';
LENGTH = '______';
RETURN;
BUILD_LINE: ENTRY(WHERE);
DELETEF = DFHBMFSE; QNAME = MAKE_NAME;
ITEMNB =
TS_NUMITEMS; LENGTH
= TS_FLENGTH;
ADRESS = TS_MAINAUX; QUENBR =
LAST_TS_NUMBER_CNT_9;
STATUS = MAKE_CHAR;
QNAMEF, ITEMNBF, LENGTHF,
ADRESSF, QUENBRF, STATUSF = DFHBMPRF;
RETURN;
DELETE_LINE: ENTRY(WHERE,WHICH);
IF DELETE ¬= '_'
THEN DO;
DELETEF, STATUSF =
DFHBMPRF;
IF DELETE = '!'
| DELETE = 'L'
THEN DEL1: DO;
WS_D_OR_L(WHICH) = DELETE;
IF
DELETE = 'L'
THEN STATUS = '** LOOKED
*';
ELSE
STATUS = '** DELETED *';
DELETES_ENCOUNTERED =
'Y';
WS_DELETE_SW(WHICH)= 'Y';
END DEL1;
ELSE ERR1: DO;
DELETEL =
-1;
IF DELETE
= '
'
THEN DELETE = '_';
ELSE
DO;
STATUS = '*INPUT ERROR';
CALL
ERRTEXT(WHICH);
END;
END
ERR1;
END;
RETURN;
END MAP_ASSIGN;
This is typical logic for controlling page overflow in printing. NEW_PAGE is a nice, general subroutine that could be used in any program.
P5000_WRITE_AVAIL_REPORT:
PROC;
IF TP1_FUND = HOLD_OMNI
THEN;
ELSE DO;
H2_FUND='FUND:
'||TP1_FUND||' ZXZ FUND: '||OUTPUT_RECORD.FUND;
HOLD_OMNI = TP1_FUND;
CALL P5010_NEW_PAGE;
END; /* END DO */
IF BIN_LINE_COUNT > 55 THEN
CALL P5010_NEW_PAGE;
DTL_LINE = ''; blank the line
DTL_CUSIP =
TP1_ASSET_IDENT; set the report fields
DTL_DESC = TP1_DESCRIPTION;
DTL_AVAL_SHARES = TP1_AVAIL_SHARES;
DTL_ONLOAN_SHARES=TP2_LOAN_SHARES;
DTL_PEND_SHARES=TP3_PEND_SHARES;
DTL_INVEST_TYPE = ' '; this is overkill after blanking
line
CALL
P5020_WRITE_LINE(ADDR(DTL_LINE));
END P5000_WRITE_AVAIL_REPORT;
NEW_PAGE: PROC;
BIN_LINE_COUNT = 0; BIN_PAGE_COUNT = BIN_PAGE_COUNT + 1;
ED_PAGE_COUNT =
BIN_PAGE_COUNT; H2_PAGE = ED_PAGE_COUNT;
CALL
P5020_WRITE_LINE(ADDR(HEADING_1));
CALL
P5020_WRITE_LINE(ADDR(HEADING_2));
CALL
P5020_WRITE_LINE(ADDR(HEADING_2A));
CALL
P5020_WRITE_LINE(ADDR(HEADING_X));
CALL
P5020_WRITE_LINE(ADDR(HEADING_3));
CALL
P5020_WRITE_LINE(ADDR(HEADING_4));
END NEW_PAGE; this does a
nice
job of counting
P5020_WRITE_LINE:
PROC(REPORT_PTR); lines when carriage control is
DCL
REPORT_PTR
POINTER; used
DCL
REPORT_LINE
CHAR(133)
BASED(REPORT_PTR);
WRITE FILE (AVALRPT) FROM
(REPORT_LINE);
SELECT
(SUBSTR(REPORT_LINE,1,1)); all the ASA carriage control
WHEN ('1') BIN_LINE_COUNT =
1; characters
accounted for
WHEN (' ') BIN_LINE_COUNT =
BIN_LINE_COUNT + 1;
WHEN ('0') BIN_LINE_COUNT =
BIN_LINE_COUNT + 2;
WHEN ('-') BIN_LINE_COUNT =
BIN_LINE_COUNT + 3;
WHEN ('+') BIN_LINE_COUNT =
BIN_LINE_COUNT + 0;
OTHERWISE BIN_LINE_COUNT = BIN_LINE_COUNT + 1;
END; /* SELECT */
END P5020_WRITE_LINE;
This is a nice example because it tracks the push and pop of stack control. Make sure to control the allocation and de-allocation process. PL/I does not care, but MVS does. It either runs out of storage or tries to access storage that is not yours. Then MVS steps in and you are gone.
Don't use the coding techniques below in CICS programs. Use the CICS allocation routines. I hope the following example reinforces my warning about using POINTER variables.
This is a classic use of the technique but, again, is not to be debugged at three in the morning.
KK30999: PROC OPTIONS(MAIN);
DCL (NULL, ADDR,
ONLOC,ALLOCATION)
BUILTIN;
DCL MYPTR(10) POINTER, RESULT CHAR(60);
DCL 1 THE_STRUC
BASED(ADDR(RESULT)),
2 MESSAGE
CHAR(16),
2 AREA_PTR POINTER,
2 AREA_PTR_P PIC'ZZ999999999',
2 LEVEL_AT PIC'9',
2 AREA_DATA CHAR(06);
ON ERROR BEGIN; ON ERROR SYSTEM;
RESULT=ONLOC; PUT DATA(RESULT); END;
MYPTR(*) = NULL;
RESULT = STACK('PUSH',MYPTR(1)); PUT
SKIP DATA(RESULT);
MYPTR(1) = AREA_PTR;
RESULT = STACK('PUSH',MYPTR(2)); PUT
SKIP DATA(RESULT);
MYPTR(2) = AREA_PTR;
RESULT = STACK('PUSH',MYPTR(3)); PUT
SKIP DATA(RESULT);
MYPTR(3) = AREA_PTR;
RESULT = STACK('POP ',MYPTR(3)); PUT
SKIP DATA(RESULT);
RESULT = STACK('POP ',MYPTR(2)); PUT
SKIP DATA(RESULT);
RESULT = STACK('POP ',MYPTR(1)); PUT
SKIP DATA(RESULT);
STACK: PROC(TYPE,WHERE_IS_IT)
RETURNS(CHAR(60));
DCL TYPE CHAR(4), WHERE_IS_IT
PTR;
DCL CVT_PTR PTR; DCL CVT_BIN FIXED BIN(31) BASED(ADDR(CVT_PTR));
DCL THE_ADDR PIC'999999999999';
DCL NO_WHERE POINTER;
DCL LEVEL FIXED BIN(31) INIT(0)
STATIC;
DCL DATA_ADDR POINTER CONTROLLED;
DCL DATA_AREA CHAR(100)
CONTROLLED;
DCL DATA_PRNT CHAR(10), DATA_BYTE
PIC'9';
DCL DATA_STR CHAR(32) ALIGNED;
DCL 1 THE_STRUC
BASED(ADDR(DATA_STR)),
2 MESSAGE CHAR(16),
2 AREA_PTR POINTER,
2 AREA_PTR_P PIC'99999999999',
2 LEVEL_AT PIC'9',
2 AREA_DATA CHAR(06);
NO_WHERE = NULL;
SELECT(TYPE);
WHEN('PUSH') DO;
IF WHERE_IS_IT = NO_WHERE
THEN IF
ALLOCATION(DATA_AREA)
THEN IF WHERE_IS_IT =
ADDR(DATA_AREA)
THEN DO;
MESSAGE
='HAVE
AREA';
DATA_STR =
'
';
LEVEL_AT =
LEVEL;
RETURN(DATA_STR);
END;
ELSE RETURN
('AREA
MISMATCH');
ELSE RETURN ('NO ALLOCATION DONE');
ELSE DO;
LEVEL = LEVEL +
1;
IF LEVEL > 5
THEN
SIGNAL ERROR; ELSE;
ALLOCATE
DATA_AREA;
ALLOCATE
DATA_ADDR;
DATA_ADDR =
ADDR(DATA_AREA);
DATA_BYTE = LEVEL;
DATA_AREA =
DATA_BYTE||DATA_BYTE||DATA_BYTE;
DATA_STR = ' ';
LEVEL_AT = LEVEL;
CVT_PTR = DATA_ADDR;
AREA_PTR = DATA_ADDR;
AREA_PTR_P
=
CVT_BIN;
AREA_DATA =
DATA_AREA;
RETURN(DATA_STR);
END;
END; /*WHEN*/
WHEN('POP ') DO;
IF
ALLOCATION(DATA_AREA)
THEN IF LEVEL < 1
THEN RETURN('ERROR IN LEVEL LOGIC');
ELSE DO;
CVT_PTR =
WHERE_IS_IT;
THE_ADDR =
CVT_BIN;
PUT
EDIT('WHERE_IT_IS '||THE_ADDR)(A);
CVT_PTR = DATA_ADDR;
THE_ADDR =
CVT_BIN;
PUT
EDIT('DATA_ADDR '||THE_ADDR)(A);
IF
WHERE_IS_IT
= DATA_ADDR
THEN
RETURN('ERROR IN ADDR PTR LOGIC');
ELSE;
LEVEL =
LEVEL-1;
FREE
DATA_AREA;
FREE
DATA_ADDR;
RETURN('OK
FREE');
END;
ELSE RETURN('OK NO
FREE');
END; /*WHEN*/
OTHERWISE;
END; /*SELECT*/
END STACK;
END KK30999;
If you ever wanted to do matching record logic on not-quite-sorted data, here's your chance. The program also demonstrates LOCATE-mode I/O. In LOCATE mode, set up the write area with the LOCATE then fill the area with data. The actual moving of data to a file is done by the access method. The end-of-program CLOSE statement takes care of the last area of data.
*PROCESS
NOSTMT,NOOFFSET,NOMAP,NOSTORAGE,NOAGGREGATE,X(S);
KK200S6: PROC OPTIONS(MAIN);
/*--------------------------------------------------------------*/
/*
PROGRAM READS MFLOAD.SORTED AND COMPARES ALL RECORDS TO */
/* ALL RECORDS FROM PREV.
RUN AND REMOVES DUPLICATES
*/
/* */
/*
INPUT FILE: */
/* OLDREC NEW
HOLDERS FROM KK200 LAST RUN */
/* NEWREC NEW
HOLDERS FROM KK200 THIS RUN */
/* */
/*
OUTPUT FILE: */
/* OUTREC NON
DUPLICATE FROM KK200
*/
/* */
/*
NOTE: THIS PROGRAM USES LOCATE MODE I/O TO IMPROVE PERFORM. */
/*
IT WORKS OUT OF THE I/O BUFFER NOT PROGRAM WORK AREAS */
/*
DO NOT CHANGE THIS WITHOUT UNDERSTANDING LOCATE MODE I/O */
/* */
/* READ FILE(OLDREC)
SET(Q); ='S A READ INTO
*/
/* LOCATE OUT FILE(OUTREC)
SET(R);
OUT = NEW; ='S A WRITE FROM */
/*--------------------------------------------------------------*/
DCL NEWREC FILE RECORD INPUT;
DCL OLDREC FILE RECORD INPUT;
DCL OUTREC FILE RECORD OUTPUT;
DCL ABCODE FIXED
BIN(31)
INIT(9999), SSABEND ENTRY (FIXED BIN(31));
DCL 1 NEW BASED(P), %INCLUDE
DD1(KK200EXT);
/* IGNORE RECORD_SPARE */
DCL NEW_IMAGE CHAR(732) BASED(P);
/* TRACE INFO RUN DEPENDENT */
1%PAGE;
DCL 1 OLD BASED(Q) LIKE NEW;
DCL OLD_IMAGE CHAR(732) BASED(Q);
DCL 1 OUT BASED(R)
LIKE
NEW;
DCL (ADDR, HIGH, ONLOC, ONCODE,
SUBSTR) BUILTIN;
/* MISCELLANEOUS WORK AREA
*/
DCL (I,J,K,L,M,N) FIXED BINARY(31) INIT(0);
DCL NEW_EOF BIT(1) INIT ('0'B);
DCL OLD_EOF BIT(1) INIT ('0'B);
DCL BIT_YES BIT(1) INIT ('1'B);
DCL BIT_ON BIT(1) INIT ('1'B);
DCL BIT_NO BIT(1) INIT ('0'B);
DCL BIT_OFF BIT(1) INIT ('0'B);
DCL OLD_RAUT BIT(1) INIT ('0'B);
DCL NEW_RAUT BIT(1) INIT ('0'B);
DCL MATCH BIT(1) INIT ('0'B);
DCL (INS,OUTS,DELS) FIXED BIN(31) INIT(0);
DCL (P,Q,R) POINTER;
DCL HOLD_IMAGE(6000) CHAR(732);
DCL MAX_IMAGES FIXED BIN(31) INIT(0);
DCL OLD_ID CHAR(09);
/* MAIN
PROGRAM LOGIC */
ON ENDFILE(NEWREC) NEW_EOF = BIT_YES;
ON ENDFILE(OLDREC) OLD_EOF =
BIT_YES;
/* SET ERROR PROCESSING */
ON ERROR BEGIN;
ON ERROR SYSTEM;
IF ONCODE = 0 & ONCODE = 9
THEN
DO;
PUT SKIP(2) EDIT ('PLI
PROGRAM
ERROR')(A);
PUT SKIP(1) EDIT ('ONCODE = ',ONCODE)(A,A);
PUT SKIP(1) EDIT ('ONLOC =
',ONLOC)(A,A);
ABCODE = 2000 + ONCODE;
END;
CALL SSABEND(ABCODE);
END; /*** END ON ERROR SNAP
BEGIN ***/
1MAIN_START:
OPEN FILE(NEWREC), FILE(OLDREC),
FILE(OUTREC);
READ
FILE(OLDREC) SET(Q); structures
based
on pointers
READ FILE(NEWREC) SET(P); now have the data
IF NEW_EOF THEN
INS=INS+1;
IF NEW_EOF
THEN;
ELSE IF OLD_EOF
THEN CALL WRITE_REST_OF_NEW;
ELSE CALL
MATCH_LOGIC;
ALL_DONE:
PUT SKIP DATA(INS,OUTS,DELS);
CLOSE FILE(NEWREC), FILE(OLDREC),
FILE(OUTREC);
MATCH_LOGIC: PROC;
IF GET_RIGHT_RECORD()=0 THEN
RETURN; /* MATCH OLD&NEW KEYS
*/
OLD_ID = OLD_KEY();
DO WHILE(OLD_EOF);
IF OLD_ID = OLD_KEY() /* BUILD ARRAY OF OLD */
THEN DO; /* WITH SAME KEY */
MAX_IMAGES =
MAX_IMAGES + 1;
IF MAX_IMAGES >
6000
THEN DO;
PUT SKIP EDIT('EXCEEDS IMAGE
LIMITS')(A);
SIGNAL
ERROR;
END;
HOLD_IMAGE(MAX_IMAGES)
= OLD_IMAGE;
READ FILE(OLDREC)
SET(Q);
IF OLD_EOF /* LAST LOOK THEN WRITE */
THEN DO; /* REST OF NEW RECORDS */
CALL LOOK_FOR_A_MATCH;
IF
GET_RIGHT_RECORD() = 0 THEN RETURN;
END;
END;
ELSE DO; /* LOOK FOR NEW MATCH
TO
*/
CALL
LOOK_FOR_A_MATCH; /* OLD ARRAY
ENTRY */
IF
GET_RIGHT_RECORD()
= 0 /* LINE UP OLD&NEW */
THEN RETURN; /* AGAIN THEN
*/
OLD_ID =
OLD_KEY(); /* CONTINUE
LOOP */
MAX_IMAGES =
0;
END;
END; /*DO WHILE*/
RETURN;
GET_RIGHT_RECORD: PROC RETURNS(FIXED
BIN(31));
IF NEW_EOF THEN RETURN(0);
DO WHILE(OLD_KEY() =
NEW_KEY());
DO WHILE((OLD_KEY()
>
NEW_KEY()) & NEW_EOF);
CALL
NEW_WRITES_AND_READS;
END; /*DO WHILE*/
IF NEW_EOF THEN
RETURN(0);
DO WHILE((OLD_KEY() < NEW_KEY()));
READ FILE(OLDREC)
SET(Q);
IF OLD_EOF
THEN DO; CALL
WRITE_REST_OF_NEW; RETURN(0); END;
END; /*DO WHILE*/
END; /* DO WHILE OLD = NEW
*/
RETURN(1);
END GET_RIGHT_RECORD;
LOOK_FOR_A_MATCH: PROC;
DO WHILE(NEW_KEY() = OLD_ID
& NEW_EOF);
MATCH = BIT_OFF;
DO I = 1 TO
MAX_IMAGES;
IF NEW_IMAGE =
HOLD_IMAGE(I)
THEN DO;
MATCH = BIT_ON;
HOLD_IMAGE(I) =
HOLD_IMAGE(MAX_IMAGES);
MAX_IMAGES =
MAX_IMAGES - 1;
I = 9999;
PUT
EDIT('DUP='||NEW_KEY()||'FUND='||NEW.FUND)(A);
END;
END;
IF MATCH Here's
how LOCATE works
THEN DO; LOCATE
establishes where the write
OUTS=OUTS+1; is from. Fill the area after
it's established.
[OUT=NEW]
LOCATE OUT
FILE(OUTREC) SET(R); OUT=NEW; /*WRITE*/
END;
ELSE DELS =
DELS+1;
READ FILE(NEWREC)
SET(P);
IF NEW_EOF THEN
INS=INS+1;
END; /* DO WHILE MATCHING NEW
RECS TO ARRAY */
END LOOK_FOR_A_MATCH;
END MATCH_LOGIC;
NEW_WRITES_AND_READS: PROC;
OUTS=OUTS+1;
LOCATE
OUT
FILE(OUTREC) SET(R); OUT = NEW; /*WRITE*/
READ FILE(NEWREC) SET(P);
IF NEW_EOF THEN
INS=INS+1;
END NEW_WRITES_AND_READS;
WRITE_REST_OF_NEW: PROC;
DO WHILE(NEW_EOF); CALL NEW_WRITES_AND_READS; END; /*DO WHILE*/
END WRITE_REST_OF_NEW;
OLD_KEY: PROC
RETURNS(CHAR(09));
DCL THE_STRING CHAR(09);
THE_STRING = OLD.SSB_TRADE_ID;
RETURN(THE_STRING);
END OLD_KEY;
NEW_KEY: PROC
RETURNS(CHAR(09));
DCL THE_STRING CHAR(09);
THE_STRING = NEW.SSB_TRADE_ID;
RETURN(THE_STRING);
END NEW_KEY;
END KK200S6;
There are explicit rules for converting numeric to character fields, and character to numeric. As you can see here, they don't always work the way you would like. In general, these conversions should be avoided. Just say no to conversions!
DCL ONE_CHAR CHAR(1);
DCL FOUR_CHAR CHAR(4);
DCL THE_BITS CHAR(32);
ONE_CHAR = 1; PUT
DATA(ONE_CHAR); Don't do this or get bad data
THE_BITS = UNSPEC(ONE_CHAR); PUT
SKIP
DATA(THE_BITS);
FOUR_CHAR = 1; PUT SKIP
DATA(FOUR_CHAR);
THE_BITS = UNSPEC(FOUR_CHAR); PUT
DATA(THE_BITS);
ONE_CHAR = 2; PUT SKIP
DATA(ONE_CHAR);
THE_BITS = UNSPEC(ONE_CHAR); PUT
DATA(THE_BITS);
FOUR_CHAR = 2; PUT SKIP
DATA(ONE_CHAR);
THE_BITS = UNSPEC(FOUR_CHAR); PUT
DATA(THE_BITS);
Here are the results of the above logic:
ONE_CHAR=' ';
I told you you'd
get
bad results!
THE_BITS='01000000 ';
FOUR_CHAR=' 1';
THE_BITS='01000000010000000100000011110001';
The preprocessor "fleshes" out the source code that the compiler will actually receive to compile. In the example below, when %D = 'ON' within the PL/I program, the %IF D = 'ON' statements are generated by the preprocessor as part of the source code, and the compiler processes them along with the coded source. If %D = 'OFF', the other statements are generated instead (and processed by the compiler).
.
.
.
%DECLARE D CHARACTER;
%D =
'OFF'; or this can
specify
'ON'
KKROBBY: PROC
OPTIONS(MAIN);
DCL ERIN char(20);
%IF D = 'OFF'
%THEN %DO; ERIN = '';
%END;
%IF D = 'ON'
%THEN %DO; IF DEBUG_SW THEN
PUT
LIST('KK200S1'); %END;
.
.
To preprocess a PL/I program, include the *PROCESS macro either in the JCL override, or as the first line of the program's source code.
Allocate a variable amount of storage and place variable-length strings in it. This is good logic for data compression, and shows the power of working with variable-length strings. C programmers should not read this, because they may hate dealing with strings in C after seeing how easy it is in PL/I.
Here's the compressed record layout:
|-----data------crlf|--------------data----------crlf|-data-crlf|
DCL BYTES_IN_BUCKET FIXED BIN(31) INIT(0);
DCL BIG_BUCKET_SIZE FIXED BIN(31) INIT(0);
DCL BIG_BUCKET_RECORDS FIXED BIN(31) INIT(0);
DCL BIG_BUCKET_SPACE AREA(*)
CONTROLLED;
DCL IN_SPACE POINTER;
DCL BIG_BUCKET_DATA(81) CHAR(01) BASED(IN_SPACE);
DCL BIG_BUCKET_TEXT CHAR(81) BASED(IN_SPACE);
DCL EX_SPACE POINTER;
DCL EX_BUCKET_DATA(8000) CHAR(01) BASED(EX_SPACE);
BIG_BUCKET_RECORDS =
LINES_IN_DOC
* 2;
BIG_BUCKET_SIZE =
BIG_BUCKET_RECORDS*40;
ALLOCATE BIG_BUCKET_SPACE
AREA(BIG_BUCKET_SIZE);
IN_SPACE, EX_SPACE =
ADDR(BIG_BUCKET_SPACE);
BYTES_IN_BUCKET = 0;
The following logic is in a subroutine that has an 80-character line and a variable-length tag passed to it. The subroutine removes trailing blanks from the line, then adds the data to other data already in our space.
IF LINE_CHR = ' ' an empty line
note
TAGV has a variable-length
THEN BIG_STRING = TAGV||'
'||CRLF; field
up to 5 bytes
ELSE remove
all trailing blanks
DO J = 80 TO 1 BY -1;
IF LINE_POS(J) > ' '
THEN DO;
BIG_STRING=TAGV||SUBSTR(LINE_CHR,1,J)||CRLF;
J = 1;
END;
END;
I = LENGTH(BIG_STRING);
BYTES_IN_BUCKET = BYTES_IN_BUCKET
+
I;
IF BYTES_IN_BUCKET >
BIG_BUCKET_SIZE THEN SIGNAL ERROR;
BIG_BUCKET_TEXT = BIG_STRING;
IN_SPACE =
ADDR(BIG_BUCKET_DATA(I+1));
Remember - 2 BYTES OF LENGTH FIXED BIN(15) +
N
CHARACTERS OF DATA are used to define the storage for a variable declared
CHAR
VARYING.
The two loops compress blanks out of the string. The wrong way does not correctly account for the variable-length character-string field. Do you know why?
KK3NOEL: PROC OPTIONS(MAIN);
DCL THE_IN CHAR(400) VARYING
INIT('');
DCL PLACES(0:402) CHAR(1) BASED(ADDR(THE_IN));
DCL THE_OUTS CHAR(80) INIT('
');
DCL OUTS(080) CHAR(1) BASED(ADDR(THE_OUTS));
DCL LF CHAR(1) INIT('@');
DCL CR CHAR(1) INIT('#');
DCL (I,J,K) FIXED BIN(31) INIT(1);
THE_IN = ' TAG1:"1" ';
THE_IN = THE_IN ||'
TAG1:"2" ';
THE_IN = THE_IN ||'
TAG1:"33" ';
THE_IN = THE_IN ||' TAG1:"4
4" ';
THE_IN = THE_IN ||'
TAG1:"55555"';
J= LENGTH(THE_IN); PUT SKIP DATA(J);
PUT SKIP DATA(THE_IN);
DO I = 2 TO(J+2); /* THE RIGHT WAY */
IF K = 1 THEN DO WHILE(PLACES(I) = ' ');
I = I+1; END;
IF PLACES(I) = ':' &
PLACES(I+1)
= '"'
THEN DO; OUTS(K) = PLACES(I); I
=
I + 1; END;
ELSE IF PLACES(I) =
'"'
THEN DO;
OUTS(K) = LF;
OUTS(K+1) =
CR;
K = 0;
PUT SKIP
DATA(THE_OUTS);
THE_OUTS = '
';
END;
ELSE OUTS(K) =
PLACES(I);
K = K+1;
END;
K= 1;
DO I = 0 TO J; /* THE WRONG WAY
*/
IF K = 1 THEN DO WHILE(PLACES(I) = ' '); I = I+1; END;
IF PLACES(I) = ':' &
PLACES(I+1)
= '"'
THEN DO; OUTS(K) = PLACES(I); I
=
I + 1; END;
ELSE IF PLACES(I) =
'"'
THEN DO;
OUTS(K) = LF;
OUTS(K+1) =
CR;
K = 0;
PUT SKIP
DATA(THE_OUTS);
THE_OUTS = '
';
END;
ELSE OUTS(K) =
PLACES(I);
K = K+1;
END;
END KK3NOEL;
This is a good trick to pinpoint where a problem occurs without filling SYSPRINT or BLOG, a McKinney product that provides sysprint for CICS. files. It's easy to set up and will wrap when the string is full. Of course the cookies should be left at home when the program goes to production.
DCL BOB_TRAIL CHAR(100) VARYING INIT(''); cookie log string
When things go wrong, print the trace:
ON ERROR BEGIN; PUT SKIP
LIST('TRAIL='||BOB_TRAIL); END
Traces in the logic:
IF Q = NULL THEN DO;
CALL COOKIE('A'); place the cookie trail
Q =
HEAD_PTR;
PTR_POINTER = Q;
END;
IF ¬INPUTMODE THEN DO;
CALL COOKIE('B');
Update the trail string and wrap if it gets too long:
COOKIE: PROC(TRAIL);
DCL TRAIL CHAR(1);
DCL LENGTH BUILTIN;
DCL LEFT CHAR(10);
IF LENGTH(BOB_TRAIL)<100
THEN
BOB_TRAIL=BOB_TRAIL||TRAIL;
ELSE DO; this is the wrap logic
LEFT =
SUBSTR(BOB_TRAIL,(LENGTH(BOB_TRAIL)-10),10);
BOB_TRAIL=LEFT||TRAIL;
END;
END COOKIE;
Sorts within programs are generally only allowed in high-school programming classes. For a small array (not 10,000 entries), an in-storage sort may have value. Notice the liberal use of CICS SUSPEND to keep from hogging the CPU. It turns out that for very large arrays, even this technique will cause problems. Also, the call to the sort has the number of array elements that are in use, so the least possible work is done.
By the way - this places the keys in descending order; ascending-order sorts are left to the student.
DCL
SORT_POINTER
POINTER;
DCL 1 SORT_BY_SIZE(10000) BASED(SORT_POINTER),
2 SS_LENGTH PIC'99999999',
2 SS_QNAME CHAR(16),
2 SS_ITEM PIC'9999',
2 SS_ADRESS CHAR(4),
2 SS_STATUS CHAR(16);
SORT_IT: PROC(BUBBLES);
DCL BUBBLES FIXED BIN(31);
DCL 1 SORT_DATA(10000) BASED(SORT_POINTER),
2 THE_KEY CHAR(08),
2 THE_REST CHAR(40);
DCL SORT_STRING(10000) CHAR(48) BASED(SORT_POINTER);
DCL SORT_SAVE CHAR(48);
DCL I FIXED BIN(31) INIT(0);
DCL MORE_BUBBLES BIT(1) INIT('1'B);
DO WHILE(MORE_BUBBLES);
MORE_BUBBLES = '0'B;
DO I = 1 TO BUBBLES;
IF SORT_DATA(I).THE_KEY <
SORT_DATA.THE_KEY(I+1)
THEN DO;
SORT_SAVE =
SORT_STRING(I+1);
SORT_STRING(I+1) =
SORT_STRING(I);
SORT_STRING(I) = SORT_SAVE;
MORE_BUBBLES = '1'B;
EXEC
CICS SUSPEND;
END;
END;
EXEC
CICS
SUSPEND;
END;
END SORT_IT;
This example shows how to chain records together using OFFSET and AREA. It's pretty stupid, because nothing is really done with the forward - backward chains. The record design comes from a primitive CICS editor that allows the insertion of records into a file of JCL statements. Card insertion is done by:
1. Adding a new data structure to the PAGE field (defined as AREA).
2. Updating the AHEAD and BACK pointers of the prior, new, and following data structures.
This logic is left to the student. The other interesting part of this is the file definition for writing a variable-length record from a structure containing an AREA. The easiest way to think of OFFSET is as a pointer that contains an address within the AREA it's referencing. It really is an offset from the base address of the area. PL/I does all the instruction addressing magic behind the scenes.
JCLTEXT: PROC OPTIONS(MAIN);
DCL PDS FILE INPUT RECORD;
DCL VSAM FILE OUTPUT RECORD ENV(V
SCALARVARYING);
DCL (NULL, ADDR) BUILTIN;
DCL (EOF) FIXED BIN(31)
INIT(0);
DCL (WORK,NOW,PREV) OFFSET(PAGE)
INIT(NULL());
DCL CARD CHAR(80);
DCL 1 REC,
2 JOBNAME CHAR(8),
2 PAGE_EXTENTS FIXED BIN(15) INIT(0),
2 HEAD OFFSET(PAGE),
2 PAGE AREA(4928);
DCL 1 DATA BASED,
2 CARD_IMAGE CHAR(80) INIT('
EMPTY'),
2 AHEAD OFFSET(PAGE)
INIT(NULL()),
2 BACK OFFSET(PAGE)
INIT(NULL());
ON ENDFILE(PDS) EOF = 1;
READ FILE(PDS) INTO(CARD);
IF EOF = 0
THEN DO;
ALLOCATE DATA IN (PAGE) SET (WORK);
PAGE_EXTENTS = PAGE_EXTENTS
+
1;
PREV, NOW, HEAD = WORK; set to first
allocated DATA
HEAD->BACK = NULL();
only record therefore NULL
HEAD->AHEAD =
NULL(); the linking
offsets
END;
DO WHILE(EOF=0);
NOW->CARD_IMAGE = CARD; insert
the data
ALLOCATE DATA IN (PAGE) SET
(WORK); a
new
structure
PREV->AHEAD = WORK; previous
points to new
PAGE_EXTENTS = PAGE_EXTENTS +
1; count
of
cards
WORK->BACK = PREV; new
points to previous
WORK->AHEAD = NULL(); new
is end of chain
READ FILE(PDS) INTO(CARD);
IF EOF = 0 THEN NOW, PREV =
WORK; previous
done, prepare for next
ELSE PREV->AHEAD =
NULL(); not
needed no more cards
END;
IF WORK = NULL() THEN; ELSE WRITE
FILE(VSAM) FROM(REC);
END JCLTEXT;
The programs presented here are very basic but have interesting
properties.
They were developed to read and write text documents. The write program will
pack a document into one MQ record of up to 500,000 bytes. The read program
reads an MQ record of up to 500,000 bytes and turns it back into a text
document. These are nice samples. They show all the steps to write or read
MQ
records and have very little application logic. This allows calls with
function
parameters into other procedures and MQ programs to do all the control block
work. This approach is better for developing production systems. The
programs
are more of a student exercise to learn the fundamentals. If used with CICS
by
convert the MQ CALLs to LINKs. The programs must have logic to get the
correct
queue manager name based on the CICS region added.
The documents are FAXes with MCI control cards at the front and end of each document. Notice the program can take in records of 80 up to 200 bytes.
BROWSE - ZXZ
Z.LBN.CHGMAN.AQUA.#00.BAT(FAXMQ)
*PROCESS MACRO,NOINSOURCE;
FAXMQ: PROC(PARM)OPTIONS(MAIN);
DCL FAX FILE INPUT RECORD;
DCL SYSPRINT FILE OUTPUT STREAM;
DCL STRING_MAX FIXED
BIN(15) INIT(0);
DCL (II,JJ,KK) FIXED
BIN(15) INIT(0);
DCL BBINDEX FIXED
BIN(31) INIT(1);
DCL (BBMAX,EOF) FIXED
BIN(31) INIT(0);
DCL TAG_TRY FIXED
BIN(31) INIT(1000000);
DCL PARM
CHAR(100) VARYING;
DCL BIGBUF(500000) CHAR(1);
DCL TO_MQ_STRING
CHAR(8000) VARYING;
DCL CARD CHAR(200)VARYING;
/* USE STRUCT BELOW FOR VARCHAR ADDR */
DCL 1 CHEAT_BLOCK
BASED(ADDR(CARD)),
2 LEN_BIN FIXED
BIN(15),
2 TEXT_AREA CHAR(1);
/* NEED START ADDR ONLY */
DCL (ONCODE,ONLOC,ADDR,NULL,REPEAT,STG,HIGH,INDEX)
BUILTIN;
DCL (SUBSTR,LENGTH) BUILTIN;
DCL MQLIB ENTRY(POINTER);
%INCLUDE DD1(MQLIBP);
DCL MY_COMM LIKE QM_COMM;
DCL MY_DESCRIPTOR_PUT LIKE
MSG_DESCRIPTOR;
/* EVERY ENVIRONMENT HAS A
QM_NAME THIS IS THE UNIQUE MANAGER */
DCL QM_NAME CHAR(QM_QUEUE_LEN) INIT('MQDV');
/* YOUR OFFICAL QUEUE NAME
HAS THE MANAGER AS THE FIRST 4 CHARS */
DCL MYQ_NAME CHAR(QM_QUEUE_LEN) INIT('?????.????');
your MQ Q name
DCL MY_QH BIT(32);
DCL BY_PASS_CLOSE BIT(01) INIT('0'B);
ON ERROR BEGIN;
ON ERROR SYSTEM;
PUT SKIP LIST('ONCODE='||ONCODE||' AT='||ONLOC);
IF BY_PASS_CLOSE THEN GOTO END_ONERROR;
PUT SKIP LIST('ISSUE
BACKOUT');
MY_COMM.FUNCTION = QMBACKOUTTRANSACTION;
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE ¬= QM_SUCCESS THEN PUT SKIP
LIST('BACKOUT FAILED');
MY_COMM.FUNCTION = QMDISCONNECT;
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE ¬=
QM_SUCCESS
THEN PUT SKIP LIST('DISCONNECT FAILED');
END_ONERROR:
PUT SKIP LIST('GAME OVER');
END;
ON ENDFILE(FAX) EOF = 1;
1/*******************MAIN
LOGIC******************************/
II = LENGTH(PARM);
IF
II<4 THEN CALL PANIC('INVALID PARM');
JJ = INDEX(PARM,'MQ='); IF JJ=0 THEN CALL PANIC('NO MQ= PARM');
QM_NAME = SUBSTR(PARM,JJ+3,4); /* ASSIGN THE MQ SUBSYSTEM */
STRING_MAX = STG(TO_MQ_STRING) - 2; /* TEXT AREA LENGTH MAX */
TO_MQ_STRING = '';
QMIN ZXZ ESCRIPTOR(MY_DESCRIPTOR_PUT);
MY_COMM.FUNCTION =
QMCONNECT;
MY_COMM.CONNECTION_HANDLE = NULL_CONNECTION_HANDLE;
MY_COMM.OPTIONS = QM_NONE;
MY_COMM.NAME =
ADDR(QM_NAME);
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE ¬= QM_SUCCESS THEN CALL
PANIC('CONNECT');
MY_QH = MY_COMM.QUEUE_HANDLE;
MY_COMM.FUNCTION =
QMOPENQUEUE;
MY_COMM.OPTIONS = QM_OUTPUT;
MY_COMM.NAME =
ADDR(MYQ_NAME);
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE ¬= QM_SUCCESS THEN CALL PANIC('OPEN');
MY_QH = MY_COMM.QUEUE_HANDLE;
READ FILE(FAX) INTO(CARD);
DO WHILE(EOF=0);
CALL
PACK_FAX(ADDR(TEXT_AREA),LEN_BIN);
MQ
reads in here
READ FILE(FAX) INTO(CARD);
END;
MY_COMM.FUNCTION =
QMCLOSEQUEUE;
MY_COMM.QUEUE_HANDLE = MY_QH;
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE ¬= QM_SUCCESS THEN CALL PANIC('CLOSE');
MY_COMM.FUNCTION =
QMDISCONNECT;
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE ¬= QM_SUCCESS THEN CALL
PANIC('DISCONNECT');
1 PACK_FAX:
PROC(LINE_PTR,HOWMANY);
DCL LINE_PTR POINTER;
DCL LINE_POS(200)
CHAR(001) BASED(LINE_PTR);
DCL LINE_CHR
CHAR(200) BASED(LINE_PTR);
DCL LINE_DEBUG
CHAR(080) BASED(LINE_PTR);
DCL ENDOFMSG
CHAR(09) BASED(LINE_PTR);
DCL HOWMANY
FIXED
BIN(15);
DCL (I,J,K)
FIXED
BIN(31) INIT(0);
DCL (ADDR, SUBSTR, LENGTH, REPEAT, LOW, NULL) BUILTIN;
DCL HEXCR
BIT(08) ALIGNED
INIT('00001101'B);
DCL CR
CHAR(1) BASED(ADDR(HEXCR));
TAG_TRY = TAG_TRY+1;
IF TAG_TRY>1000005 THEN CALL PANIC('NO 1ASACC:');
IF ENDOFMSG = '1ASACC:
' /*THE START OF FAX*/
THEN DO;
/*QMBEGINTRANSACTION*/
TAG_TRY = 0;
/* LET GAMES BEGIN */
MY_COMM.FUNCTION
= QMBEGINTRANSACTION;
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE¬=QM_SUCCESS THEN CALL
PANIC('BEGIN');
END;
IF ENDOFMSG = ' ENDMSG: '
/*THE END OF FAX */
THEN DO;
TAG_TRY = 1000000;
/* LET NEW GAME BEGIN */
IF LENGTH(TO_MQ_STRING)<(STRING_MAX-10)
THEN TO_MQ_STRING=TO_MQ_STRING||' ENDMSG: ';
ELSE DO; CALL MQ_WRITE; TO_MQ_STRING=' ENDMSG: ';
END;
CALL MQ_WRITE;
MQ_WRITE just fills the buffer
QMIN ZXZ ESCRIPTOR(MY_DESCRIPTOR_PUT);
MY_COMM.FUNCTION = QMPUTMSG;
MY_COMM.QUEUE_HANDLE = MY_QH;
MY_COMM.DESCRIPTOR = ADDR(MY_DESCRIPTOR_PUT);
MY_COMM.MSG_BUFFER = ADDR(BIGBUF(1));
MY_COMM.BUF_LEN = BBMAX;
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE¬=QM_SUCCESS THEN CALL
PANIC('PUT');
BBMAX=0; BBINDEX=1;
TO_MQ_STRING='';
/* NULL THE STRING */
MY_COMM.FUNCTION
= QMCOMMITTRANSACTION;
CALL MQLIB(ADDR(MY_COMM));
IF MY_COMM.RETURN_CODE¬=QM_SUCCESS THEN CALL
PANIC('COMIT');
RETURN;
END;
K=LENGTH(TO_MQ_STRING)+HOWMANY+1; /*LENGTH STRING+INPUT+CR*/
IF K>STRING_MAX THEN CALL MQ_WRITE;
IF SUBSTR(LINE_CHR,1,HOWMANY) = ' '
THEN TO_MQ_STRING = TO_MQ_STRING||' '||CR;
ELSE DO J = HOWMANY TO 1 BY -1;
IF LINE_POS(J) > ' '
THEN
DO;
CALL CHAR_FIX;
TO_MQ_STRING=TO_MQ_STRING||SUBSTR(LINE_CHR,1,J)||CR;
J = 0;
END;
END;
CHAR_FIX: PROC;
DCL (BIT16,I) FIXED BIN(15) INIT(0);
DCL 1 THE_L_BITS
BASED(ADDR(BIT16)),
2 ALL_ZEROS
CHAR(1),
2 A_CHAR
CHAR(1);
APPLY_FIX:DO I = 1 TO J BY 1;
A_CHAR = LINE_POS(I); /* SET LAST HALF OF L
*/
SELECT; /*ONLY PRINTABLES PLEASE */
WHEN(BIT16<074) LINE_POS(I) = ' ';
WHEN(BIT16>080 & BIT16<090)
LINE_POS(I) =
' ';
WHEN(BIT16>097 & BIT16<106)
LINE_POS(I) =
' ';
WHEN(BIT16>111 & BIT16<122)
LINE_POS(I) =
' ';
WHEN(BIT16=128) LINE_POS(I) = ' ';
WHEN(BIT16>137 & BIT16<145)
LINE_POS(I) =
' ';
WHEN(BIT16>153 & BIT16<161)
LINE_POS(I) =
' ';
WHEN(BIT16>169 & BIT16<193)
LINE_POS(I) =
' ';
WHEN(BIT16>201 & BIT16<208)
LINE_POS(I) =
' ';
WHEN(BIT16>217 & BIT16<226)
LINE_POS(I) =
' ';
WHEN(BIT16>233 & BIT16<240)
LINE_POS(I) =
' ';
WHEN(BIT16>249) LINE_POS(I) = ' ';
OTHERWISE;
END; /*SELECT */
END APPLY_FIX;
END CHAR_FIX;
MQ_WRITE: PROC;
DCL PACK_LEN
FIXED BIN(15) INIT(0);
DCL (I,J)
FIXED BIN(31) INIT(0);
PACK_LEN = LENGTH(TO_MQ_STRING);
DO I = BBINDEX TO (BBINDEX+PACK_LEN)-1;
J=J+1;
BIGBUF(I)= SUBSTR(TO_MQ_STRING,J,1);
END;
BBINDEX=I;
BBMAX=I-1;
IF I<500000 THEN BIGBUF(I)=HIGH(1);
IF I>500000 THEN CALL PANIC('TOO BIG');
TO_MQ_STRING='';
END MQ_WRITE;
END PACK_FAX;
1 PANIC: PROC(TEXT);
DCL TEXT CHAR(20);
DCL CODE PIC'ZZZZZ9999' INIT(0);
CODE = MY_COMM.RETURN_CODE;
PUT SKIP LIST('MQ FAILED DOING '||TEXT||CODE);
BY_PASS_CLOSE = '0'B;
IF TEXT = 'CONNECT' | TEXT = 'OPEN ' THEN BY_PASS_CLOSE = '1'B;
PUT SKIP
DATA(MY_COMM);
SIGNAL ERROR;
END PANIC;
END FAXMQ;
This program reads queues written by the program above. The only restriction is it supports text lines of up to 128 bytes. The PANIC procedure is better in this program than in the FAXMQ. This logic should be considered in an enhancement to FAXMQ.
BROWSE - ZXZ
Z.LBN.CHGMAN.AQUA.#007603.BAT(FAXREAD)
*PROCESS MACRO,NOINSOURCE;
FAXREAD: PROC(PARM) OPTIONS(MAIN);
DCL SYSPRINT FILE OUTPUT STREAM;
DCL (II,JJ)
FIXED BIN(15) INIT(0);
It takes a village to keep a CICS region running. Actually, it's the other way around. CICS is the village and CICS transactions are the villagers. The transactions share resources in CICS, and for it to work, every transaction must abide by the rules.
The golden rule is to only read and write your own storage. When programs break the golden rule, two things can happen:
· CICS catches the error and terminates the program.
· It may cause another program to terminate. Sometimes both conditions and more occur. The more is causing the CICS region to terminate.
There is a simple rule that good villagers follow. Avoid instructions where the address or length of the target data field is calculated.
· For variable addresses or data lengths, use the PL/I built-in functions.
· Hard-coding lengths, or depending on lengths that are embedded in the data, leads to errors.
· Never use a value of other than EIBCALEN to determine the length of the COMMAREA passed to a program. Make sure the EIBCALEN is greater than 0 before trying to use the COMMAREA.
· Always check the upper bound of an array indexed by a variable.
· Always check that the starting location and length of a SUBSTR are within the string. SUBSTR(WIPEOUT,I,J) = LOW(1000) makes the compiler happy but may not execute correctly.
· Use CHAR VARYING fields with care.
· Avoid conditional lengths on REPEAT, LOW, and HIGH functions.
· Watch out for POINTER variables. They are absolute addresses. Trust but verify is the operative expression.
Do not let the length of your CICS commands exceed 24 KB, if possible. Watch out for COMMAREAS that are passed across platforms. All the wonderful software helping along the way has the potential to tack control information onto your area. When the total of your data plus the system's added storage exceeds 32KB, the process fails.
Check control blocks passed as a COMMAREA or picked up by a RETRIEVE command for BINARY fields. If the BINARY fields are not at the beginning, there may be data alignment problems. Unless you force structured data-element alignment, or code UNALIGNED in all the programs that use the structure, the compiler has the opportunity to introduce slack bytes. An opportunity it will only take advantage of when it can cause the most trouble.
Be careful with map fields. There is one area of storage for each map with two structures, as shown below. Use the input field names when establishing addressing. ADDR(SYSTML) is correct, not ADDR(DFHMS4). If another field is added before SYSTMI, DFHMS4 will not be the label of the correct field. Make sure any structures that are redefined over the map definitions are UNALIGNED.
/*BEGIN %INCLUDE MM1(ATMTS0M )
input definition output definition
DCL 1 ATMT0MI AUTOMATIC UNALIGNED,
DCL 1 ATMT0MO BASED(ADDR(ATMT0MI)) UNALIGNED,
2 DFHMS1 CHARACTER (12), 2 DFHMS2 CHARACTER (12),
2 DATENL FIXED BINARY
(15,0), 2 DFHMS3 FIXED BINARY (15,0),
2 DATENF CHARACTER (1), 2 DATENA CHARACTER (1),
2 DATENI CHARACTER (8), 2 DATENO CHARACTER (8),
2 SYSTML FIXED BINARY
(15,0), 2 DFHMS4 FIXED BINARY (15,0),
2 SYSTMF CHARACTER (1), 2 SYSTMA CHARACTER (1),
2 SYSTMI CHARACTER (6), 2 SYSTMO CHARACTER (6),
2 TITLE1L FIXED BINARY
(15,0), 2 DFHMS5 FIXED BINARY (15,0),
2 TITLE1F CHARACTER (1), 2 TITLE1A CHARACTER (1),
2 TITLE1I CHARACTER (30), 2 TITLE1O CHARACTER (30),
Need more storage in a program? It's cheaper above the line, and avoids learning all the rules of PL/I storage management under CICS. Note with the latest PL/I compiler in CICS, storage for ALLOCATE variables will be above the line. Therefore using the PL/I ALLOCATE and CICS statements produce the same result with one very important exception. PL/I allocated storage remains for the life of the program unless freed. CICS GETMAIN storage remains for the life of the task unless freed. Define the largest PL/I structures and arrays as BASED on a POINTER variable, which is initialized using:
GETMAIN SET (pointer) FLENGTH(length)
Use FLENGTH instead of LENGTH. There are two other considerations when buying this real estate:
1. Give it back when done, using a FREEMAIN in the same program.
2. Provide logic to deal with the fact that it may not be available. Either wait or terminate. This might seem like a programming pain.
Most programs will not need this storage-management technique, but it's good to know. This is also a good place to consider how to be a good neighbor in the CICS village. Programs that have a great deal of processing without issuing CICS commands should consider the CICS SUSPEND command. A DO loop dividing every element of ERIN by the element with the maximum value within ERIN would be an extreme example of where SUSPEND is needed.
DCL APOINT_ABOVE
POINTER,
ERIN(999,999) FLOAT BASED(APOINT_ABOVE),
CSTG BUILTIN;
EXEC CICS GETMAIN SET(APOINT_ABOVE) FLENGTH(CSTG(ERIN));
EXEC CICS FREEMAIN
DATAPOINTER(APOINT_ABOVE);
A quick paraphrase of the IBM manuals follows. Refer to the PL/I Optimizing Compiler Programmer's Guide for details.
NEVER EVER…
· Use the multitasking built-in functions: COMPLETION, PRIORITY, and STATUS.
· Use the multitasking options: EVENT, PRIORITY, and TASK.
· Use PL/I Sort/Merge.
· Use static storage (except for read-only data - and don't even do that!).
· Use the PL/I 48-character set option in EXEC CICS statements.
AVOID the following PL/I statements:
READ LOCATE WRITE DELETE GET UNLOCK PUT STOP OPEN
HALT CLOSE EXIT DISPLAY FETCH DELAY RELEASE REWRITE
CLOSE,
PUT, and OPEN for SYSPRINT will work, but
use PUT infrequently. Do not use PUT DATA or the OPEN and
CLOSE statements.
Also avoid, or at least be careful with, PL/I storage-management instructions such as ALLOCATE.
Use EXEC CICS commands for the storage
and
retrieval of data, and for communication with terminals. If you declare a variable with the STATIC
and EXTERNAL attributes, include the INITIAL attribute. If you do not, such a declaration
generates
a common CSECT that cannot be handled by CICS.
Don't define variables or structures with
variable names that begin with DFH.
Care must be taken with the LIKE keyword to avoid implicitly
generating
such variable names.
All PROC statements must be in uppercase,
with the exception of the PROC name, which may be in lowercase. The suboptions of the XOPTS option of the
*PROCESS statement must be in uppercase.
If a CICS command uses the SUBSTR
built-in
function in defining a data value, it must include a LENGTH option to
specify
the data length. If it does not, the
translator generates a PL/I call including an invocation of the CSTG
built-in
function in the form:
CSTG(SUBSTR(..,.. ,..)).
The compiler rejects this.
The primary reason for terminating a program with a dump is because it didn't end. Any program smart enough to end should be smart enough to report what went wrong. Therefore, much of the time spent in error analysis will be looking for external causes.
Question 1 - what changed? Other questions to ask are:
· What could cause a deadly embrace? A long wait? Faulty queue-handling?
· What did the operator do?
· Is the syncpoint and rollback logic correct?
|
Keep telling yourself that solving tough problems is the fun part of programming. |
OK… everything else failed and it's time to read a dump. Keep in mind that being known as the DUMP KING of application programming may not be all that helpful for career planning. The CICS staff will, when necessary, make region dumps available through TSO on the processor where the error occurred. Their first interest in looking at a dump is to determine the felon and the victims. If there are programs causing storage-protection violations in the region, other programs may abend. In fact, they may abend well after the damage was done. Remember the earlier village analogy. When looking at a dump, focus on two areas:
· First, find the routine with the error to learn what the program was trying to accomplish, and what resources it was using at the time.
· Second, find the active data. PL/I and CICS rarely are the cause of a problem. Look elsewhere first, so follow the application data trail. Finding this data is generally pretty easy and, unless you are the DUMP KING, you may not know the details of CICS control blocks anyway. Remember to think about what has recently changed in either the program or the application files. You have the first lead to follow.
------------------------ ZXZ COMPUWARE PRODUCT
MENU ---------------------
OPTION ===> 4
1. RADAR -
RADAR
for CICS Version 2.1.2 / 3.3
2. ABEND-AID CICS -
ABEND-AID for CICS Version 2.1.2 / 3.3
3. XPEDITER/TSO -
Program Debugger
4.
ABEND-AID/FX -
ABEND-AID/FX
for CICS/ESA
Place the cursor on the region to work with, then hit <ENTER>:
CICS Abend-AID/FX ------ CICS Abend-AID/FX Summary ------ Row 00037
of
00055
Tran --------------- Region Entries
----------------
Region Descriptions Total
Total Abend Cancel Snap SVD Other-CICS Non-CICS
TU302X 3 0 0 0
0 0 0 0
TU308 1
0 0 0 0 0
0 0
TU311 3
0 0 0 0 0
0 0
Place the cursor on the entry to work with, then hit <ENTER>.
CICS Abend-AID/FX ----- CICS
Abend-AID/FX Directory ----- Row 00001 of 00016
M Menu L Lock H Dup
History R Recall T Terminate Analysis
S Diag U Unlock I
Information E Migrate C Change Priority
D Delete G Messages A
Analyze P Print
Entry Job Name Code Tran
Date Time Program Offset Dups
Status
****** ******** ****** **** ******** ***** ******** ****** ****
*********
036126 TU321 ATNI CSM3 04/21/99 07:47 DFHMIRS 000000
0 COMPLETE
036062 TU321 ZDB1 PSEP 04/19/99 10:29 CEECCICS 001284 0 COMPLETE
036061 TU321 ZDB1 PSAU 04/19/99 10:29 CEECCICS 001284 0 COMPLETE
Type a line command, then hit <Enter> to process it
At this point, all the facilities to look at a specific dump are available. The best way to get a working knowledge of how to navigate these options is to make a trial run using a test region. Once inside an option, navigation is done by placing the cursor on the option and hitting <ENTER>. It also helps to have a CICS manual that explains things like PPT and EIB in detail.
EIB Fields and Values provides a quick EIB field-definition guide. It provides the more common fields only, and does not include field values definitions.
Abend-AID is easy to use and the abbreviations generally have text with them. The TSO QW command can be used inside of Abend-AID to get explanations for system-error messages and codes.
CICS Abend-AID/FX ----------- Primary
Options -----------------
MSDSD0539I Dump 36,710 (C9 ZXZ
A)
successfully selected
1
DIAG Diagnostic
Summary 6
CB Control
Blocks/Storage
2 PROG Program Information
7 *FILE File Request Summary
3
TRACE CICS Trace 8 *DB2 DB2
Information
4
TERM Terminal Detail 9
*L3270 Last 3270 Screen
5
TASK Task Detail
D
DIRECTRY FX Directory
R SRCDIR Source Directory
S
SUMMARY FX Summary U USER User Control
Facility
X
EXIT Exit
Entry=036710(C9 ZXZ A) Code=DDDD Help=PF01
AssistMenu=PF24
Use AADF in the correct region and find the error. SM0102 is a storage violation. CICS detects storage violations in two ways. A duplicate or initial storage accounting area element has been corrupted. Or the leading or trailing storage-check zone of a user-task storage element is corrupt, as in this example. The program does a GETMAIN for storage and then misuses it. Select the name, SM0102, and hit <ENTER>. Only partial screens are shown to keep this short. On the next screen:
· Select Option 2 to find the transactions.
· Use < PF2> to find the active task.
· Press < PF3> to return to the main menu.
· Use Option 1, DIAG, from the main menu.
CICS Abend-AID/FX ----- CICS
Abend-AID/FX Directory ----- Row 00001 of 00033
FDBRC2100I User AQUACODE
successfully
logged on
M Menu L Lock H Dup
History R Recall
T
Terminate Analysis
S Diag U Unlock I
Information E Migrate C Change Priority
D Delete G Messages A
Analyze P Print
Entry Job Name Code Tran
Date Time Program Offset Dups
Status
****** ******** ****** **** ******** ***** ******** ****** ****
*********
010566 CI351 SM0102 10/13/99 08:30 COMPLETE
010482 CI351 AFCY
IS74 10/12/99 09:09 ISCP26
00156E 1 COMPLETE
010462 CI351 RK1X RK1X 10/11/99 14:08 CEECCICS 00903C YES COMPLETE
CICS
Abend-AID/FX -----------
Primary Options ------------------------------
OPTION ===> 2
MSDSD0539I Dump 10,566 (CI351)
successfully selected
1
DIAG Diagnostic
Summary 5
CB Control
Blocks/Storage
2
TASKS Task/Wait
Analysis 6
MVSINFO MVS Information
CICS Abend-AID/FX ----------
Task/Wait
Analysis ----------------------------
OPTION ===> 2
1 TASKSUMM Task Summary
2 TASKLIST Task List/Wait Analysis
CICS Abend-AID/FX ---------- Task/Wait Analysis --------- Row 00001
of
00022
S Task Detail L Program Levels C Storage Chain
E
EIB Detail
T Trace Table M Monitoring Detail W Wait Analysis
DS XM
DTA Task Tran
Terminal
Status TCA Status KETASK TXN
Error
******* ******* **** **** ***
******* *** ********
*******
***
DTA0029 0062900 CPMI -AJM
RUN TCA0029 ACT KETA0029 TXN0029 YES
DTA0024 0062878 GXMN SUS TCA0024 ACT
KETA0024
TXN0024 YES
For details, place the request letter in front of the transaction to view (DTA column). L gives program names:
CICS Abend-AID/FX ----------- Primary Options
------------------------------
OPTION ===> 1
MSDSD0539I Dump 10,566
(CI351)
successfully selected
1
DIAG Diagnostic
Summary 5
CB Control
Blocks/Storage
2
TASKS Task/Wait
Analysis 6
MVSINFO MVS Information
Browse through the diagnostic information with
<PF8> and make sure it's a storage violation. The format of a storage element is a
leading
storage-check zone value, followed by user data, followed by the trailing
storage-check zone. The program can
only read and write the user data area, and the zone values should be
identical. Write down the highlighted fields. You'll
use
them when looking at dump data. When
you're through, use <
PF3> to get back to the options menu.
CICS Abend-AID/FX ----------
Diagnostic
Summary --------- Row 00001 of 00037
Date... 10/13/99 Time... 08:30:25
ASID... 00A0 Dump Code... SM0102
Title.. CICS DUMP: SYSTEM=CI351
CODE=SM0102 I Category.... STG VIOL
To display the Diagnostic Summary
in
abbreviated format select ABBREV
Description
This dump ( code SM0102 ) was taken
because CICS detected a storage
violation.
The CICS message associated is:
DFHSM0102 CI351 A storage violation (code
X'030B') has been detected by
module
DFHSMGF .
The short symptom string is:
PIDS/565501800 LVLS/410 MS/DFHSM0102
RIDS/DFHSMGF PTFS/UQ05133
PRCS/0000030B
Analysis
A storage violation occurred. CICS detected that the storage at
address
12306940 has an invalid storage zone. The leading storage zone is
The use of <PF8> will show the following information (after the standard header lines):
E4F0F0F6F2F9F0F0 and the
trailing
storage zone is 123042CC00001000.
Addressability and matching
information are available for the area.
The current task at the time the
dump
was taken was 62900.
The CICS trace table has 10
exception
entries, and 1 is related to task
62900.
The
exception trace entry for task 62900 gives the following
information:
62900 1 SM 030B SMGF *EXC* Storage_check_failed_on_FREEMAIN_request
FREEMAIN,12306948,LE_RUWA,TASK31
Now get to storage to see what happened. Start at the address provided by CICS -
12306948. Then verify
that
the CICS key, E4F0F0F6F2F9F0F0, is
there. The block of storage you are
viewing may be large, which calls for some cleverness in figuring out where
to
start.
There are a few ways to update storage outside of the program's data areas that the compiler will not catch. It has to execute an instruction where the target address or data-move length is calculated at execution time. The corrupt trailing zone and failed FREEMAIN are indicators of an allocation problem. Look for ALLOCATE statements or procedure DCLs, then find the statements that operate on these data areas.
There are three easy ways to do this in the program:
1. Exceed the index limits of an array. The Do I = 1 TO J trick; DO WHILE(STOP=GO) I=I+1; ARRAY(I)= 0; END;
2. Misuse built-in functions that return a string of data where the length is determined in the built-in function:
SUBSTR(INBOUNDS,1,TOOBIG) = SUBSTR(INDATA(J,TOOBIG)
INBOUNDS is allocated storage. If INBOUNDS is simply defined storage within the program, you have an equal chance of generating some other error. The storage protect violation frequently occurs for allocated storage when the storage is freed by CICS or PL/I housekeeping.
3. Maintain a POINTER variable that points to freed storage. Having the pointer in the main data area and the allocated area in a procedure will do this. This example is an actual production dump, where the dump was used first to identify the programs, then used again to verify program logic errors found using the above analysis technique.
Use this knowledge to scan the storage area. The storage area has the two control
fields
explained above. If the beginning is
destroyed, the damage is at the top.
If
not, figure out how large the possible allocations are and look near the end
of
that length. This is the time to
bring
out the hex calculator. Now go
through
the dump. It's difficult to destroy
the
leading control unless negative indexes or OFFSET values were used.
CICS Abend-AID/FX ----------- Primary Options
------------------------------
OPTION ===> 5
1
DIAG Diagnostic
Summary 5
CB Control
Blocks/Storage
CICS Abend-AID/FX -------- Control Blocks/Storage ------- Row
00001 of 00041
MEM Display Memory at Address ===> 12306940
PCLP Current Paperclip Table
SACLIP Saved Paperclip
Table
At this point, verify the leading indicator and proceed to the approximate address of the crime scene. Try to verify which allocation or data movement took place, by looking at the data. The task number, 62900, is part of both storage-zone keys if they are intact.
CICS Abend-AID/FX ------------
Memory
Display ------------------------------
Clip Prev Next Lock Start Addr: 12306940
Comment:
Address Offset Word 1 Word 2
Word 3 Word 4 Storage
12306940 +00000000 E4F0F0F6
F2F9F0F0
00000000 00000000 *U0062900........*
12306950 +00000010 00000000 00000000 00000000 00000000 *................*
EIB fields can be used to add a great deal of information to error messages. Don't just copy what is in some other program. Remember that the programmer you copied from will not get the dreaded phone call. For error messages, try to take as much information as possible from the EIB variables. These fields provide CICS's view of the crime scene. Remember to convert the BINARY values to PIC before inserting them into a CHAR string. Also, some of the fields shown as character are really hex values that should be translated for display. As an extension to this information, use the CICS ASSIGN command. This will return an incredible amount of information about your task, for normal execution or diagnostic purposes.
For
greater detail, go to the IBM CICS Application Programmer Interface manual
or
to a good book on CICS programming.
|
EIB Field |
Description |
|
EIBAID CHAR(1) |
Attention identifier (AID) from the last terminal control or BMS input operation. |
|
EIBCALEN FIXED BIN(15) |
Length of the communications area passed to the program, using the COMMAREA and LENGTH options. If no communications area is passed, this field contains zeros. This should be equal to, or less than, the receiving program's field definitions that define the area. |
|
EIBCPOSN FIXED BIN(15) |
Cursor address (position) of the last terminal control or BMS input operation. |
|
EIBDATE FIXED DEC(7,0) |
Date the task is started or updated by ASKTIME, formatted as 0CYYDDD, where C shows the century with a value of 1 for the 2000s. For 1 January 2000, the EIBDATE value is 0100001. |
|
EIBDS CHAR(8) |
Symbolic identifier of the last data set referenced in a file control request. |
|
EIBFN CHAR(2) |
Code that identifies the last CICS command issued by the task. This is a hex value that must be translated in order to print or display. X'0208' is the ASSIGN command. |
|
EIBRCODE
CHAR(6) |
CICS response code returned after the last CICS command has completed. |
|
EIBREQID
CHAR(8) |
Request identifier assigned to an interval control command by CICS. It is not used when a request identifier is specified in the application program. |
|
EIBRESP FIXED
BIN(31) |
Number corresponding to the RESP condition that occurred. |
|
EIBRESP2
FIXED
BIN(31) |
More detailed information to explain why the RESP condition occurred. |
|
EIBRLDBK
CHAR(1) |
Rollback indicator. |
|
EIBRSRCE
CHAR(8) |
Symbolic identifier of the resource being accessed by the latest executed command. |
|
EIBTASKN
FIXED
DEC(7,0) |
CICS task number. |
|
EIBTIME FIXED
DEC(7,0) |
Time the task started or was updated by ASKTIME, formatted as 0HHMMSS. |
|
EIBTRMID
CHAR(4) |
Symbolic terminal identifier. |
|
EIBTRNID
CHAR(4)
|
Symbolic transaction identifier of the task. |
A RESP condition value is returned in a FIXED BIN(31) field by RESP(YOUR_FIELD). Remember to write the test as IF YOUR_FIELD = DFHRESP(a value from below). Usually just test for NORMAL and treat everything else as an error. The errors here include new Transaction Server values. Do not test the numeric value. Use the text name as above.
00 NORMAL
01 ERROR
02 RDATT
03 WRBRK
04 EOF
05
EODS 06 EOC
07 INBFMH
08 ENDINPT 09 NONVAL
10 NOSTART
11 TERMIDERR
12 FILENOTFOUND 13 NOTFND 14
DUPREC 15 DUPKEY
16 INVREQ 17 IOERR
18 NOSPACE
19 NOTOPEN
20 ENDFILE 21 ILLOGIC
22 LENGERR
23 QZERO
24 SIGNAL 25 QBUSY
26 ITEMERR
27 PGMIDERR
28 TRANSIDERR 29 ENDDATA 31
EXPIRED 32 RETPAGE
33 RTEFAIL 34 RTESOME
35 TSIOERR
36 MAPFAIL
37 INVERRTERM 38 INVMPSZ 39 IGREQID 40 OVERFLOW
41 INVLDC 42 NOSTG
43 JIDERR
44 QIDERR
45 NOJBUFSP 46 DSSTAT
47 SELNERR
48 FUNCERR
49 UNEXPIN 50 NOPASSBKRD
51 NOPASSBKWR
52 -
53 SYSIDERR 54 ISCINVREQ
55 ENQBUSY
56 ENVDEFERR
57 IGREQCD 58 SESSIONERR
59 SYSBUSY
60 SESSBUSY
61 NOTALLOC 62 CBIDERR
63 INVEXITREQ
64 INVPARTNSET
65 INVPARTN 66 PARTNFAIL
67 -
68 -
69 USERIDERR 70 NOTAUTH
71 -
72 SUPPRESSED
73 -
74
- 75 -
76 -
77 -
78
- 79 -
80 NOSPOOL
81 TERMERR 82 ROLLEDBACK
83 -
84 DISABLED
85 ALLOCERR 86 STRELERR
87 OPENERR
88 SPOLBUSY
89 SPOLERR 90 NODEIDERR
91 TASKIDERR
92 TCIDERR
93 DSNNOTFOUND 94 LOADING 95
MODELIDERR 96 OUTDESCRERR
97 PARTNERIDERR 98 PROFILEIDERR 99
NETNAMEIDERR 100 LOCKED
101 RECORDBUSY
In case you want to make sure all the CICS error information is coordinated, or to get an idea of the RESP that corresponds to the abend code, use this table. For the commands shown below, the left four bytes of EIBRCODE equals the RESP value in hexadecimal. The remaining two bytes are X'00'.
Condition RESP
EIBRCODE Abend Condition
RESP EIBRCODE Abend
Value(Byte 3)
code Value(Byte
3) code
DSNNOTFOUND 93 5D AEX1
DUPREC 14 0E AEIN
END 83 53 AEX
FILENOTFOUND 12 0C AEIL
ILLOGIC 21 15 AEI
INVREQ 16 10 AEIP
IOERR 17 11 AEI JIDERR 43 2B AEYG
LENGERR 22 16 AEI
MODELIDERR 95 5F AEX3
NOSPACE 18 12 AEI NOSTG 42 2A -
NOTAUTH 70 46 AEY
NOTFND 13 0D AEIM
PARTNERIDERR 97 61 AEX
PGMIDERR 27
1B AEI0
PROFILEIDERR 98 62 AEX
QIDERR 44 2C AEYH
SYSBUSY 59 3B -
SYSIDERR 53
35 AEYQ
TASKIDERR 91 5B AEX
TCIDERR 92 5C AEX0
TERMIDERR 11 0B AEI
TRANSIDERR 28 1C AEI1
USERIDERR 69 45 AEY
VOLIDERR 71
47 AEXV
INVEXITREQ 63 80
AEY NOTAUTH 70 46 AEY7
The program below is pretty simple, but effective in demonstrating a PL/I error. By the end of this section, you should be able to determine what is wrong.
PGZ3000: PROC OPTIONS(MAIN);
DCL (I,J,ZERO) FIXED BIN(15)
INIT(0);
ON ERROR BEGIN; ON ERROR SYSTEM; END;
PUT SKIP LIST ('PGZ3 START');
I = 1;
ZERO=0000;
J = I/ZERO;
PUT SKIP LIST ('PGZ3 END RETURN');
EXEC CICS RETURN;
END PGZ3000;
.
.
pgz3
.
.
DFHAC2206 09:14:01 CICS Transaction PGZ3 has failed with abend ASRA. Resource back out was successful.
Remember that PL/I communicates through the CESE queue.
LOGGED QUEUE
1...5....0....5....0....5....0....5....0....5....0....5...
Q region
tranid
990709 09:13:52 CESE SASS
5C93PGZ3 19990709091352
IBM0301S ONCODE=320 The ZERODIVIDE
condition was raised.
990709 09:13:52 CESE SASS 5C93PGZ3
19990709091352 From compile unit
PGZ3000 at entry point PGZ3000 at statement 16 at compile unit offset
+00000104
990709 09:14:01 CESE SASS 15C93PGZ3 19990709091401 PGZ3 START
990709 09:14:01 CSMT SASS DFHAC2236 07/09/99 09:14:01 SASS Transaction PGZ3
abend ASRA in program PGZ3000 term 5C93 backout successful.
Look at the region's CICS job. You
may not be able to do this for the production regions.
SDSF STATUS DISPLAY ALL CLASSES LINE 1-1 (1)
NP JOBNAME TYPE
JNUM PRTY QUEUE ASYS C MC
DEST STAT TOT-LINES ST
C9 ZXZ S JOB 6592 12 EXECUTION YSYS 7 I LOCAL 489
7
---------------------------------------------------------------------
---
SDSF JOB DATA SET DISPLAY - JOB C9 ZXZ S (JOB06592) LINE
1-12
(12)
NP
DDNAME STEPNAME PROCSTEP
DSID
OWNER C DEST REC-CNT PAGE
s
JESMSGLG JES2 2 ZXZ 9ATS I 130
JESJCL JES2 3 ZXZ
9ATS I 478
JESYSMSG JES2 4 ZXZ 9ATS I 197
DFHCXRF CICS CICS 102
ZXZ 9ATS I 35
Remember to use QW to find out what 0C9 and AKEA really mean.
SDSF OUTPUT DISPLAY C9 ZXZ S
JOB06592 DSID 2 LINE 185 COLUMNS 01- 80
09.13.49 JOB06592 +DFHSR0001 SASS An abend (code 0C9/AKEA) has occurred at offset
X'000002A2' in program PGZ3000 .
09.13.49 JOB06592 +DFHME0116 SASS
(Module:DFHMEME)
CICS symptom string for message DFHSR0001
PIDS/565501800
LVLS/410 MS/DFHSR0001 RIDS/DFHSRP PTFS/UN949
AB/S00C9 AB/UAKEA RIDS/PGZ3000
ADRS/000002A2
09.13.49 JOB06592 +DFHDU0201 SASS ABOUT TO TAKE SDUMP.
DUMPCODE: SR0001 ,
09.13.52 JOB06592 IEA794I SVC DUMP HAS CAPTURED:
09.13.52 JOB06592 +DFHDU0202 SASS SDUMPX COMPLETE.
SDUMPX
RETURN CODE X'00
SDSF JOB DATA SET DISPLAY - JOB C9 ZXZ S (JOB06592) DATA
SET
DISPLAYED
NP DDNAME STEPNAME
PROCSTEP DSID OWNER C DEST REC-CNT PAGE
JESMSGLG JES2 2 ZXZ 9ATS I 130
JESJCL JES2
3 ZXZ 9ATS I 478
s JESYSMSG JES2 4 ZXZ 9ATS I 197
SDSF OUTPUT DISPLAY C9 ZXZ S
JOB06592 DSID 4 LINE 243 COLUMNS 02- 81
DFHSR0001 SASS An abend (code
0C9/AKEA) has occurred at offset X'000002A2' in program PGZ3000 .
DFHME0116 SASS
(Module:DFHMEME) CICS symptom string for message DFHSR0001 is
PIDS/565501800 LVLS/410 MS/DFHSR0001 RIDS/DFHSRP PTFS/UN94911
AB/S00C9 AB/UAKEA RIDS/PGZ3000 ADRS/000002A2
IEF237I CWSS ALLOCATED TO HC873C58
IEF285I SYS99190.T091419.RA000.C9
ZXZ
S.R0443558 SUBSYSTEM
Need more storage in a program? It's cheaper above the line, and avoids learning all the rules of PL/I storage management under CICS. Note with the latest PL/I compiler in CICS, storage for ALLOCATE variables will be above the line. Therefore using the PL/I ALLOCATE and CICS statements produce the same result with one very important exception. PL/I allocated storage remains for the life of the program unless freed. CICS GETMAIN storage remains for the life of the task unless freed. Define the largest PL/I structures and arrays as BASED on a POINTER variable, which is initialized using:
GETMAIN SET (pointer) FLENGTH(length)
Use FLENGTH instead of LENGTH. There are two other considerations when buying this real estate:
1. Give it back when done, using a FREEMAIN in the same program.
2. Provide logic to deal with the fact that it may not be available. Either wait or terminate. This might seem like a programming pain.
Most programs will not need this storage-management technique, but it's good to know. This is also a good place to consider how to be a good neighbor in the CICS village. Programs that have a great deal of processing without issuing CICS commands should consider the CICS SUSPEND command. A DO loop dividing every element of ERIN by the element with the maximum value within ERIN would be an extreme example of where SUSPEND is needed.
DCL APOINT_ABOVE
POINTER,
ERIN(999,999) FLOAT BASED(APOINT_ABOVE),
CSTG BUILTIN;
EXEC CICS GETMAIN SET(APOINT_ABOVE) FLENGTH(CSTG(ERIN));
EXEC CICS FREEMAIN
DATAPOINTER(APOINT_ABOVE);
A quick paraphrase of the IBM manuals follows. Refer to the PL/I Optimizing Compiler Programmer's Guide for details.