Testing for Multithreading

I often write little CL driver programs for my Java code. This is an easy way for my RPG programs to use my Java utilities. However, if a job environment doesn’t allow multithreading, the Run Java (RUNJVA) command in the CL program fails.

I couldn’t find an easy way to determine whether or not a CL program is running in a multithreaded environment. At least, the Retrieve Job Attributes (RTVJOBA) command doesn’t have this parameter in V4R3. Still, I knew that, if a CL program could determine that it was not running in a multithreaded environment, it could take some corrective action. For example, before running a Java program, it might submit itself as a batch job with ALWMTTHD(*YES) specified. For this reason, I wrote the ISALWMTTHD program, shown in Figure 1.

ISALWMTTHD has two parameters, Return code and Error code. If the job is multithreaded, ISALWMTTHD places a 1 in the return code; if it is not, it places a zero. If all proceeds without error, the error code is blanked out. Otherwise, ISALWMTTHD places the message ID of the error message it receives.

— Alex Garrison This email address is being protected from spambots. You need JavaScript enabled to view it.

/*==================================================================*/

/* ISALWMTTHD */
/* Check to see if this job allows multiple threads. */
/* returns ‘0’ if multithreaded not allowed. */
/* ‘1’ if multithreaded allowed. */
/* errcd is the CPFxxxx error if any. */
/*==================================================================*/

/* To compile: */
/* */

/* CRTBNDCL PGM(XXX/ISALWMTTHD) SRCFILE(XXX/QCLSRC) + */
/* DFTACTGRP(*NO) ACTGRP(*CALLER) */
/* */

/*==================================================================*/

pgm parm(&rtncd &cpferr)

dcl var(&rtncd) type(*char) len(1)

dcl var(&cpferr) type(*char) len(7)

/* vars for qwcrtvca api */

dcl var(&rcvvar) type(*char) len(21)

dcl var(&rcvlenbin) type(*char) len(4)

dcl var(&rcvlen) type(*dec) len(3 0) value(21)

dcl var(&fmtnam) type(*char) len(8) value(‘RTVC0100’)

dcl var(&numattrbin) type(*char) len(4)

dcl var(&numattr) type(*dec) len(3 0) value(1)

dcl var(&attrbin) type(*char) len(4)

dcl var(&attr) type(*dec) len(4 0) value(0102)

/* vars for rtvc0100 format */

dcl var(&rnattrbin) type(*char) len(4)

dcl var(&rnattr) type(*dec) len(3 0)

dcl var(&rlattrbin) type(*char) len(4)

dcl var(&rlattr) type(*dec) len(3 0)

dcl var(&rkeybin) type(*char) len(4)

dcl var(&rkey) type(*dec) len(4 0)

dcl var(&rdattype) type(*char) len(1)

dcl var(&rdatlenbin) type(*char) len(4)

dcl var(&rdatlen) type(*dec) len(4 0)

dcl var(&dat) type(*char) len(1)

/* vars for errorcode */

dcl var(&errcd) type(*char) len(23)

dcl var(&bytprovbin) type(*char) len(4)

dcl var(&bytprov) type(*dec) len(2 0) value(15)

/* convert dec values to 4 byte binary and store in temp char var*/

chgvar var(%bin(&rcvlenbin)) value(&rcvlen)

chgvar var(%bin(&numattrbin)) value(&numattr)

chgvar var(%bin(&attrbin)) value(&attr)

chgvar var(%bin(&bytprovbin)) value(&bytprov)

chgvar var(&errcd) value(&bytprovbin)

chgvar var(&rtncd ) value(‘0’) /* assume not multithreaded */

call qwcrtvca parm(&rcvvar &rcvlenbin &fmtnam &numattrbin +

&attrbin &errcd)

chgvar var(&cpferr) value(%sst(&errcd 9 7))

if cond(&cpferr *eq ‘ ‘) then(do)

/*no error. unpack msg */

chgvar var(&rnattrbin) value(%sst(&rcvvar 1 4))

chgvar var(&rnattr) value(%bin(&rnattrbin))

chgvar var(&rlattrbin) value(%sst(&rcvvar 5 4))

chgvar var(&rlattr) value(%bin(&rlattrbin))

chgvar var(&rkeybin) value(%sst(&rcvvar 9 4))

chgvar var(&rkey) value(%bin(&rkeybin))

chgvar var(&rdattype) value(%sst(&rcvvar 13 1))

chgvar var(&rdatlenbin) value(%sst(&rcvvar 17 4))

chgvar var(&rdatlen) value(%bin(&rdatlenbin))

chgvar var(&dat) value(%sst(&rcvvar 21 1))

if cond((&rnattr *eq 1) *and (&rkey *eq &attr) *and +

(&rdatlen *eq 1)) then(do)

chgvar var(&rtncd) value(&dat)

enddo

enddo

endpgm

Figure 1: Any job that needs to determine whether or not multithreading is allowed can call ISALWMTTHD.

Which JDK Do I Use?

V4R5 now ships with four different, optionally installable versions of AS/400
Development for Java: JDK 1.1.6, JDK 1.1.7, JDK 1.1.8, and JDK 1.2. (JDK 1.3 is now available as a PTF.) With all those installed, how do you qualify which one is to be used? I had to tackle that problem myself recently because I use several open source Java products that require either JDK 1.2 or JDK 1.3.

The easiest solution is to qualify the JDK in the Java command with the java.version option: However, you sometimes don’t have access to the Java command (as with IBM’s SQLJ utilities). Besides, adding that option can become tiring if you want a specific JDK to be your default.

You can do just that by adding the string java.version=1.2 to a text file called System-Default.properties. This file can exist in one of two places in the AS/400 Integrated File System (AS/400 IFS): your user home directory or the Java home directory. Your user home directory is qualified in your user profile, so use the Display User Profile (DSPUSRPRF) command to see what yours is set to. (I’ll tell you that it defaults to a
directory of your profile name underneath the /home directory.) The Java home directory is
/QIBM/UserData/Java400/.

java -Djava.version=1.2 MyClass

The easiest way to modify (or create, if it doesn’t already exist) the SystemDefault.properties file in your AS/400 IFS is to use the Edit File (EDTF) command: To find the setting of the JDK, Java looks first to the Java command options, then to the user home’s SystemDefault.properties file, then to the Java home’s SystemDefault.properties file, and finally to an environment variable.

Don Denoncourt Senior Technical Editor
Midrange Computing

Checking for the Existence of an IFS Stream File

Q: Do you know the best way to check for the existence of an AS/400 Integrated File System (AS/400 IFS) stream file? I’m not asking to check authority or such as can be done with the Check Object (CHKOBJ) or Check Document Library Object (CHKDLO) command, although that would be a nice utility.

I’ve decided to settle on CHKIN OBJ(‘/path/streamfile.name’) and monitor for CPFA0A9 (“Object not found”). Do you have a better idea? I don’t think that the Check In Object (CHKIN) command modifies the object in any way. I tested it, and it didn’t change any attributes displayed with the Work with Link (WRKLNK) option (option 8).

— Ken Rokos

A: Figure 2 illustrates a CL solution that requires no RPG wrappers. It uses the C stat( ) function.

— James Swan Baycorp Holdings Ltd.

A: The code in Figure 3 performs the same function as James’ CL program, but it does so as an RPG IV service program I call CheckExist.

— Jerry Hensley

Peerless Chain

A: Over the years, I have relied extensively on CHKOBJ to see whether or not a file existed. I used CHKOBJ to ensure that the necessary files and authority were in place to minimize the cleanup and recovery required whenever a complex job stream failed. Recently, however, I began supporting purchased applications on the AS/400 that use AS/400 IFS files extensively. These purchased applications are ported from UNIX to run on the AS/400 and do not use native AS/400 messaging techniques to indicate when an error has occurred.

This lack of standard message handling made it more difficult to integrate these programs into my company’s own systems and job streams. To simplify their integration, I created a Check IFS Object (CHKIFSOBJ) command, which mimics the AS/400’s native CHKOBJ. This simple command uses the access() UNIX API to check whether or not a file exists and, optionally, to check authority to the file.

In general, the UNIX APIs are easier to use than regular AS/400 IFS APIs. The access() API takes a file path and an integer value representing the authority to check. If the
file is not found or the user does not have authority to the file, the API returns a -1. If the file exists and the user’s authority is sufficient, it returns a zero.

You can download the source code for CHKIFSOBJ at www.midrangecomputing.com/mc.

EDTF ‘/home/Denoncourt/ SystemDefault.properties’

Then, add the entry:

java.version=1.3

— David Morris

pgm

dcl var(&PATH) type(*CHAR) len(256) +

value(‘/mydir/myfile’)

dcl var(&BUFFER) type(*CHAR) len(256)

dcl var(&RV) type(*CHAR) len(2)

dcl var(&NULL) type(*CHAR) len(1) value(X’00’)

/* stat() requires null terminated strings */

chgVar var(&PATH) value(&PATH *tcat &NULL)

chgVar var(&BUFFER) value(&BUFFER *tcat &NULL)

/* Check if IFS file exists */

callPrc prc(STAT) parm(&PATH &BUFFER) +

rtnVal(%binary(&RV))

if cond(%binary(&RV) *EQ -1) then(do)

/* IFS file (or directory) not found */

enddo

endpgm

*===============================================================

* To compile:

*

* CRTRPGMOD MODULE(XXX/CHECKEXIST) SRCFILE(XXX/QRPGLESRC)

* CRTSRVPGM SRVPGM(XXX/CHECKEXIST) EXPORT(*ALL)

*

*===============================================================

H NOMAIN

H BNDDIR(‘QC2LE’)

D CheckExist PR 1n

D p_FilePath 256 const

* Unix Type Error Number/Message pointers, fields and ProtoTypes

D Ptr_ErrorNum S * inz

D Ptr_ErrorMsg S * inz

D Error_Number S 10I 0 based(Ptr_ErrorNum)

D Error_Msg S 256A based(Ptr_ErrorMsg)

D GetErrorNum PR * extproc(‘__errno’)

D GetErrorMsg PR * extproc(‘strerror’)

D p_ErrorNumber 10i 0 value

*——————————————————————————————————-* CheckExist - Check for the Existence of the Stream File returns:

* True (‘1’/*ON ) if file exist

* False (‘0’/*OFF) if file does not exist

*——————————————————————————————————-P CheckExist B export

D CheckExist PI 1n

D p_FilePath 256 const

* Definitions for Procedure Defined Work Fields and Pointers

D File_Exist S 1n

D w_FilePath S 256

D w_Buffer S 1

D w_ReturnCode S 10i 0

D Ptr_FilePath S * inz(%addr(w_FilePath))

D Ptr_Buffer S * inz(%addr(w_Buffer))

* Unix Type Procedure Prototype

D Statistics PR 10i 0 extproc(‘stat’)

D p_PtrPath * value

D p_Buffer * value

Figure 2: Here’s an easy way for a CL program to check the existence of an AS/400 IFS file.

C eval w_FilePath = %trim(p_FilePath) + x’00’

C eval w_ReturnCode = Statistics(Ptr_FilePath :

C Ptr_Buffer )

* It is assumed, if the return code is less than zero, the file does

* not exist. Other errors may cause this condition and may be

* determined by examining Error_Number and Error_Msg

C If w_ReturnCode < *ZERO

C eval Ptr_ErrorNum = GetErrorNum

C eval Ptr_ErrorMsg = GetErrorMsg(Error_Number)

C eval File_Exist = *OFF

C else

C eval File_Exist = *ON

C endIf

C return File_Exist

P E

Figure 3: The CheckExist service program is just the thing for verifying the existence of AS/400 IFS files in ILE applications.

Also Read

The Power of Writing Code in a Low-Code Solution

TechTip: Let’s Have a Date, Part 2

Going off the Rails