Techniques for working your way out of the System/36 Environment

In this installment of Going Native, we will study coding Procedures on the S/36, involving the use of procedure control expressions, substitution expressions, and various OCL statements that cannot be grouped into meaningful categories.

Do You Care to Comment?

S/36 procedures treat as a comment any statement that begins with an asterisk (*). Being comments, you can type anything you want; the OCL interpreter will ignore it. In the native environment, CL programs also allow for comments, but they must be enclosed between /* and */. Anything appearing within these two composite symbols is treated as a comment; likewise, the CL compiler will ignore it.

To illustrate, a statement like

* Delete work files

should be written as follows in CL:

/* Delete work files */

A marked advantage of CL is that comments can continue on the following lines provided that the last character is a plus sign (+). Consequently, you can have a long comment like this:

 /* Delete all work files + created by this job */ 

Substituting Parameters

A nifty feature of OCL is its ability to code substitution expressions that are evaluated at run time and executed differently, depending on the value analyzed. For instance, just about everybody has used the ?USER? and ?WS? expressions at some length. When the OCL interpreter comes across ?WS?, the four characters ?, W, S, ?, are replaced by the two-character name of the workstation running the procedure; then the statement is executed.

CL lacks this flexibility because it is a compiled language, but it more than makes up for it by supporting variables. All CL variables begin with the ampersand (&), followed by a maximum of 10 characters.

One of the most widely used substitution expressions is ?n?, where "n" can be any number from 1 to 64. This expression replaces ?n? with the value of the nth positional parameter. A CL program references the parameters passed to it by their variable names, not by their position number. For this reason, there can be no exact equivalent to the ?n?, ?n'value'?, ?nT'value'? (and other) substitution expressions. You simply use the variable name. See 1.

One of the most widely used substitution expressions is ?n?, where "n" can be any number from 1 to 64. This expression replaces ?n? with the value of the nth positional parameter. A CL program references the parameters passed to it by their variable names, not by their position number. For this reason, there can be no exact equivalent to the ?n?, ?n'value'?, ?nT'value'? (and other) substitution expressions. You simply use the variable name. See Figure 1.

Notice how ?1? has become &FILE. If procedure DELFILE received more than one parameter, the CL program probably would have to receive more as well. The other parameters would simply have a different variable name and would be treated the same way.

CL also lacks the concept of "default value" for a parameter. The best you can do is test the variable for blanks (or zeros) and, if true, change the value of the variable. 2 shows how to convert ?1'MYLIB'? to native, assuming that the first parameter is a library name.

CL also lacks the concept of "default value" for a parameter. The best you can do is test the variable for blanks (or zeros) and, if true, change the value of the variable. Figure 2 shows how to convert ?1'MYLIB'? to native, assuming that the first parameter is a library name.

This code should be used whether the parameter is given a default value (?n'value'?), a temporary value (?nT'value'?), or a forced value (?nF'value'?). Just remember that in CL the change will be permanent.

Missing and Required Parameters

Generally, both procedures and CL programs are intended to run from beginning to end without stopping anywhere in between. There are occasions, though, when a job needs information from the user before it can continue. Procedures take care of this by using the required/missing Parameter substitution expressions: ?R?, ?nR?, ?R'mic'?, ?nR'mic'?.

Avoid these stop-in-the-middle tricks whenever possible. Generally speaking, a procedure or CL program should be able to run to completion if it has been well-designed. If you must stop a CL program in the middle to ask for information, you can use the SNDUSRMSG command as a viable replacement. 3 shows an example of an S/36 procedure and a CL program performing the same function.

Avoid these stop-in-the-middle tricks whenever possible. Generally speaking, a procedure or CL program should be able to run to completion if it has been well-designed. If you must stop a CL program in the middle to ask for information, you can use the SNDUSRMSG command as a viable replacement. Figure 3 shows an example of an S/36 procedure and a CL program performing the same function.

If you use MICs on the S/36E, you can still use them in native. Instead of using the MSG parameter on both the SNDPGMMSG and SNDUSRMSG commands, use the MSGID and MSGF parameters to identify the message ID ("MIC") and message file in their correct locations. Notice that because the message file is indicated along with the message ID, you don't have to concern yourself with finding an equivalent for the // MEMBER statement.

Other Substitution Expressions

OCL offers more substitution expressions. Some have equivalents, others don't. First, let's have a look at those that have no equivalent in native:

 ?Cn? and ?C'value'? (length of parameter or of a value). ?F'S,name'? and ?F'A,name'? + (size of a file). ?MENU? (current menu). ?PROC? (first level procedure). ?SYSLIST? (system list device). 

Now let's consider the substitution expressions that do have equivalents.

?CD? (Return code). There is no direct equivalent, but CL has operations that perform equivalent functions. ?CD? is used in OCL to determine what key was pressed from a PROMPTed screen format. CL determines what key was pressed from a display file with indicators which translate as logical variables (type *LGL) in CL. ?CD? is also used to retrieve the completion status of the previous job step. CL can do this with the MONMSG command; if the previous command ended abnormally, an escape message is issued which can be monitored by MONMSG and acted upon.

?CLIB? and ?SLIB? (Current and Session library). There is no such thing as a "session" library in native -- only current library, and even the concept of current library is different. The native environment uses the library list to locate objects; if you define one library as being the "current" library, you can retrieve its name with RTVJOBA CURLIB(&CURLIB). When this command is executed, variable &CURLIB will contain the name of the current library. &CURLIB must be declared as a 10-byte character field.

?DATE? and ?TIME? (System date and time). You can retrieve the system date and time from system values QDATE and QTIME; you must use the RTVSYSVAL command, which will pass the system value to a CL variable. For instance, to retrieve the system date, execute RTVSYSVAL SYSVAL (QDATE) RTNVAR(&SYSDATE), where &SYSDATE has been declared as a 6-byte character variable. As a matter of fact, you can also retrieve parts of the system date or system time by retrieving other system values: QHOUR (system hour), QMINUTE, QSECOND, QDAY (system day of the month), QMONTH, QYEAR.

?L'position,length'? (Local data area). The LDA is alive and well in the native environment; it is a data area called *LDA (asterisk and all). To retrieve a portion of the LDA, run the RTVDTAARA command indicating *LDA as the name of the data area; a starting position; a length; and the name of a CL variable where you put the contents of the LDA. For example, RTVDTAARA DTAARA(*LDA (35 12)) RTNVAR(&OPTION) will pass 12 bytes of the LDA, beginning at position 35, to variable &OPTION.

?Mmic? and ?M'mic,position ,length'? (Message member). With the RTVMSG command, you can retrieve the first-level or second-level text for a message (along with other useful information). If you need a portion of the message text (as ?M'mic, position,length'? would do), use RTVMSG to retrieve the entire text to a CL variable, then use %SST (substring function) to extract the portion you need.

?PRINTER? (Session Printer). Run RTVJOBA PRTDEV(&PRT). Variable &PRT (10-byte character) will contain the name of the printer device assigned to your job.

?USER? (Operator's User ID). Run RTVJOBA USER(&USER). Variable &USER (10-byte character) will have the name of the operator's user ID.

?VOLID? and ?VOLID'location'? (Diskette or tape volume ID). This function is not supported directly -- there is no direct way a CL program can retrieve the volume ID of a mounted diskette or tape. However, in most cases ?VOLID? is not used to find that out, but to override the requirement of certain procedures like INIT, which must have a volume ID. In these cases, the programmer usually runs the INIT procedure using ?VOLID? as the volume ID parameter. This satisfies the requirement of the INIT procedure, and the diskette will then be processed correctly. On the AS/400 this is not needed. All commands that operate on diskettes or tapes can have special value *MOUNTED in the volume ID parameter; this means, literally, "the volume ID of whatever diskette/tape is currently mounted."

?WS? (Display station ID). Run RTVJOBA JOB(&DSPNAME). Variable &DSPNAME (10-byte character) will have the name of the display station.

IF Conditional Expressions

OCL can perform many tests, but unfortunately has no way of grouping the statements to be executed when the test is evaluated; for example, RPG's IFxx operation will execute all the statements following it whenever the test is positive, until an ELSE or an END is reached. CL does have this capability; you simply run the DO command to indicate the beginning of the group of statements, followed by an ENDDO command.

Also, OCL has no way of coding logical expressions when several tests are made and are combined with AND, OR, or NOT. When comparing two values, you can only compare for equal or greater than. CL, again, overcomes these limitations very easily.

IF ACTIVE-procname. Despite its shortcomings, OCL can test to see if a procedure is running anywhere in the system. CL cannot test to determine whether a program is running. One solution to this problem is to create a data area having the same name as the program you wish to test. The program allocates the data area for exclusive use at the beginning and deallocates it at the end. Any other program can thus check if the first program is running by attempting to use the data area; if it can't be used, it can only be because the first program is still running.

IF BLOCKS-size. Because the AS/400 uses single-level storage, it doesn't really care whether there is any amount of contiguous space on disk -- it's irrelevant.

IF CONSOLE. The AS/400 comes very near to being a "console-less" system. Any display station can do anything provided that the user who signs on has sufficient authority; even the "console messages" can be read from any display station. However, there is a display station known to the system as the "console." If you wish to ensure that a CL program is run from the system console, you can use the code shown in 4.

IF CONSOLE. The AS/400 comes very near to being a "console-less" system. Any display station can do anything provided that the user who signs on has sufficient authority; even the "console messages" can be read from any display station. However, there is a display station known to the system as the "console." If you wish to ensure that a CL program is run from the system console, you can use the code shown in Figure 4.

IF DATAF1-name. Because files reside in libraries, you must know the name of the library in which to look, or use the library list. In either case, you must run the CHKOBJ command, as illustrated in 5.

IF DATAF1-name. Because files reside in libraries, you must know the name of the library in which to look, or use the library list. In either case, you must run the CHKOBJ command, as illustrated in Figure 5.

IF DATAI1-name and IF DATAT-name. You can use the CHKDKT or CHKTAP command instead, or simply attempt to use the file directly, making sure to monitor messages with the MONMSG command.

IF DSPLY. I haven't found any function in CL that performs this test, but then again it's one of those things you hardly ever use in OCL. Besides, AS/400 display files can take care of this duality.

IF EVOKED. Run the RTVJOBA command. If the subtype is 'E', the job running is evoked. You can see this in 6.

IF EVOKED. Run the RTVJOBA command. If the subtype is 'E', the job running is evoked. You can see this in Figure 6.

IF INQUIRY. There's no such thing as "inquiry mode" on the AS/400; consequently, testing for this condition is meaningless.

IF JOBQ. Run the RTVJOBA command. If the type is '0' (zero), the job is running from the job queue. See 7.

IF JOBQ. Run the RTVJOBA command. If the type is '0' (zero), the job is running from the job queue. See Figure 7.

IF LOAD, IF PROC, IF SOURCE and IF SUBR. These conditional expressions check the existence of a particular library member. Because S/36 load and subroutine members become objects in an AS/400 library, and S/36 procedure and source members become members in a source physical file, checking is different. Check 8.

IF LOAD, IF PROC, IF SOURCE and IF SUBR. These conditional expressions check the existence of a particular library member. Because S/36 load and subroutine members become objects in an AS/400 library, and S/36 procedure and source members become members in a source physical file, checking is different. Check Figure 8.

IF SECURITY-ACTIVE. Because this conditional expression checks whether password security is active, you can emulate it by checking system value QSECURITY. If it has a value of '20' or higher, "Password security" is active:

IF SECURITY-level. This expression checks the security classification of the user (level can be M, S, O, C or D). Because the AS/400 has a built-in security system that is much more comprehensive than that of the S/36, this conditional expression is rarely needed. It's a good thing, too, because there's no equivalent. If you must use it in your CL programs, you can use the CHKSPCAUT command shown in Figures 9a and 9b.

For instance, if you had a procedure that checked if the user was a system operator before continuing, you could include the CHKSPCAUT command in your equivalent CL program, checking for special authority *JOBCTL (job control). This allows you to control who can run the program without having to maintain specific authorities for each user.

IF SWITCH. User switches can be tested with the %SWITCH function or the RTVJOBA command. For example, to test whether switch 3 is ON, you can use the code shown in 10.

IF SWITCH. User switches can be tested with the %SWITCH function or the RTVJOBA command. For example, to test whether switch 3 is ON, you can use the code shown in Figure 10.

IF string1=string2, IF string1> string2. These tests are the easiest of the lot. You simply compare two values (they can be two variables, a variable and a constant, or two constants) with the IF command and a comparison operator. In CL, the comparison operator can be *EQ, *NE, *LT, *LE, *NL, *GT, *GE, *NG; they stand for equal, not equal, less than, less than or equal to, not less than, greater than, greater than or equal to, and not greater to. Alternatively, you can use symbols instead of the *xx codes (=, =, <, <=, <, >, >=, >). In the example that follows, variable &OPTION is checked for equality to constant '*PRT':

IF COND + (&OPTION *EQ '*PRT') THEN(...)

IF VOLID. This condition expression is used to compare the volume ID of a diskette or tape against something else, such as "if the volume ID of the current diskette is not MC, abort the job." This verification can be done in native with the CHKDKT and CHKTAP commands. Basically speaking, you indicate the name of the diskette or tape device and the volume ID you expect it to have. If a different volume ID is found (or if no diskette/tape is mounted!), an escape message is issued, which you can trap with the MONMSG command immediately following. This technique is illustrated in 11.

IF VOLID. This condition expression is used to compare the volume ID of a diskette or tape against something else, such as "if the volume ID of the current diskette is not MC, abort the job." This verification can be done in native with the CHKDKT and CHKTAP commands. Basically speaking, you indicate the name of the diskette or tape device and the volume ID you expect it to have. If a different volume ID is found (or if no diskette/tape is mounted!), an escape message is issued, which you can trap with the MONMSG command immediately following. This technique is illustrated in Figure 11.

For tape devices, the messages are CPF6760 and CPF6720, respectively.

Special Control Statements

The RESET statement is the approximate equivalent to the TFRCTL command. You'll remember that RESET starts execution of a procedure but, unlike INCLUDE, control never returns to the original procedure. TFRCTL works like that, but has some restrictions that won't allow you to use it every time RESET is used. For instance, you cannot use TFRCTL to pass a parameter to the second program unless that parameter was received by the first program. Another restriction is that if program A runs TFRCTL to program B, when program B ends control will be passed to the program that called program A -- not to the keyboard, as RESET would have done.

The CANCEL statement is not supported in CL. In OCL, CANCEL ends the execution of the procedure and returns control to the keyboard even if issued in nested procedures (that is, one procedure may have started another procedure; if the second procedure finds a CANCEL statement, it doesn't return to the first procedure -- it aborts all levels). CL cannot do that.

EVALUATE is used in OCL to assign values to the positional parameters or to ?CD?. The equivalent is CHGVAR, which changes the value of a variable. CHGVAR is considerably more powerful than EVALUATE, however, since it can include complicated expressions and the %SST and %SWITCH functions.

Spaghetti coders will rejoice when they learn that GOTO and TAG are supported in CL. CL uses GOTO in exactly the same way. TAGs are merely names followed by a colon (:), usually written on the left margin, like this:

AGAIN: SNDRCVF ... GOTO CMDLBL(AGAIN)

Finally, we draw an exact parallel between OCL and CL. You won't have any trouble remembering this one: the RETURN statement, in OCL, becomes the RETURN command in CL. Seems natural, going native.

Going Native: AS/400 Equivalents to S/36 OCL

Figure 1 Equivalence for ?n?

 Figure 1: Equivalence for ?n? // DELETE ?1?,F1,ERASE // PAUSE 'File ?1? deleted.' DELFILE: PGM PARM(&FILE) DCL VAR(&FILE) TYPE(*CHAR) LEN(10) DLTF FILE(&FILE) SNDPGMMSG MSG('File' *BCAT &FILE *BCAT 'deleted.') + MSGTYPE(*COMP) ENDPGM 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 10 Equivalence for IF SWITCH
 
 Figure 10: Equivalence for IF SWITCH IF COND(%SWITCH(XX1XXXXX)) THEN(...) ...or... RTVJOBA SWS(&SWITCHES) IF COND(%SST(&SWITCHES 3 1) *EQ '1') THEN(...) 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 11 Equivalence for IF VOLID
 
 Figure 11: Equivalence for IF VOLID CHKDKT VOL('MC') MONMSG MSGID(CPF6165) EXEC(DO) /* Code needed if diskette drive is not ready */ ENDDO MONMSG MSGID(CPF6162) EXEC(DO) /* Code needed if volume ID is not matched */ ENDDO 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 2 Equivalence for ?1'MYLIB'?
 
 Figure 2: Equivalence for ?1'MYLIB'? IF COND(&LIB *EQ ' ') THEN(DO) CHGVAR VAR(&LIB) VALUE('MYLIB') ENDDO ...or... IF COND(&LIB *EQ ' ') THEN(CHGVAR + VAR(&LIB) VALUE('MYLIB')) 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 3 Equivalence for ?R?
 
 Figure 3: Equivalence for ?R? // * 'Insert next diskette' // * 'C=Cancel, G=Go' // IF ?R?=C RETURN SNDPGMMSG MSG('Insert next diskette') MSGTYPE(*DIAG) SNDUSRMSG MSG('C=Cancel, G=Go') VALUES(C G) DFT(G) MSGTYPE(*INQ) + MSGRPY(&REPLY) IF COND(&REPLY *EQ 'C') THEN(RETURN) 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 4 Equivalence for IF CONSOLE
 
 Figure 4: Equivalence for IF CONSOLE RTVJOBA JOB(&DSPNAM) RTVSYSVAL SYSVAL(QCONSOLE) RTNVAR(&SYSCNS) IF COND(&DSPNAM *EQ &SYSCNS) THEN(DO) /* The display is the system console */ ENDDO 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 5 Equivalence for IF DATAF1
 
 Figure 5: Equivalence for IF DATAF1 CHKOBJ OBJ(library/file) OBJTYPE(*FILE) MONMSG MSGID(CPF9801) EXEC(DO) /* What to do if the file doesn't exist */ ENDDO 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 6 Equivalence for IF EVOKED
 
 Figure 6: Equivalence for IF EVOKED RTVJOBA SUBTYPE(&EVOKED) IF COND(&EVOKED *EQ 'E') THEN(DO) /* What to do if the job is evoked */ ENDDO 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 7 Equivalence for IF JOBQ
 
 Figure 7: Equivalence for IF JOBQ RTVJOBA TYPE(&JOBQ) IF COND(&JOBQ *EQ '0') THEN(DO) /* What to do if the job is running from the job queue */ ENDDO 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 8 Equivalence for IF LOAD and IF SOURCE
 
 Figure 8: Equivalence for IF LOAD and IF SOURCE CHKOBJ OBJ(lib/PGM1) OBJTYPE(*PGM) MONMSG MSGID(CPF9801) EXEC(DO) /* What to do if program PGM1 can't be found */ ENDDO CHKOBJ OBJ(lib/QRPGSRC) OBJTYPE(*FILE) MBR(MBR1) MONMSG MSGID(CPF9815) EXEC(DO) /* What to do if RPG source member MBR1 can't be found */ ENDDO 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 9A Command CHKSPCAUT
 
 CHKSPCAUT: CMD PROMPT('Check Special Authority') PARM KWD(USRPRF) TYPE(*SNAME) LEN(10) + DFT(*CURRENT) SPCVAL((*CURRENT)) + PROMPT('User Profile') PARM KWD(SPCAUT) TYPE(*CHAR) LEN(8) RSTD(*YES) + DFT(*ALLOBJ) VALUES(*ALLOBJ *SAVSYS + *JOBCTL *SECADM *SERVICE *SPLCTL) + PROMPT('Special authority') PARM KWD(RTNCDE) TYPE(*LGL) RTNVAL(*YES) + CHOICE('''1'' or ''0''') PROMPT('Return + code (*LGL)') 
 
 Going Native: AS/400 Equivalents to S/36 OCL
 
 Figure 9B CL program SPC001CL
 
 SPC001CL: PGM PARM(&USRPRF &SPCAUT &RTNCDE) DCL VAR(&PATLEN) TYPE(*DEC) LEN(3 0) VALUE(8) DCL VAR(&RESULT) TYPE(*DEC) LEN(3 0) DCL VAR(&RTNCDE) TYPE(*LGL) DCL VAR(&SPCAUT) TYPE(*CHAR) LEN(8) DCL VAR(&STRLEN) TYPE(*DEC) LEN(3 0) VALUE(100) DCL VAR(&STRPOS) TYPE(*DEC) LEN(3 0) VALUE(1) DCL VAR(&TRANSLATE) TYPE(*LGL) VALUE('1') DCL VAR(&TRIM) TYPE(*LGL) VALUE('1') DCL VAR(&USRPRF) TYPE(*CHAR) LEN(10) DCL VAR(&USRSPCAUT) TYPE(*CHAR) LEN(100) DCL VAR(&WILD) TYPE(*CHAR) LEN(1) VALUE(' ') /* Get all special authorities for user */ RTVUSRPRF USRPRF(&USRPRF) SPCAUT(&USRSPCAUT) /* Scan for special authority */ CALL PGM(QCLSCAN) PARM(&USRSPCAUT &STRLEN &STRPOS + &SPCAUT &PATLEN &TRANSLATE &TRIM &WILD + &RESULT) IF COND(&RESULT *GT 0) THEN(CHGVAR VAR(&RTNCDE) + VALUE('1')) ELSE CMD(CHGVAR VAR(&RTNCDE) VALUE('0')) ENDPGM