Hi, Paul:

The code you show relies on knowledge of i5/OS "internals" that can change from release to release.

It appears that you want to copy the contents of the *LDA of the target job into a space pointed to by the .#RETSPC parameter; is that correct?

The QWCJBITP API is available in V5R4 and above. Search the MI400 list for "QWCJBITP" and you will find several discussions of how it may be used for similar purposes.

Regards,

Mark S. Waterbury

> Paul Jackson wrote:
Hello folks,

I have an MI program that for some reason is unable to locate jobs on
a system and returns with code 9. This same program works fine on
other systems. Just wondering if there's anything I am missing in the
code itself. Has the maximum number of WCB tables increased beyond
30?

Thanks!

All systems at V5R4 and sec level 40, program is System State:

ENTRY RTVJOBLDA(ENTPARM) EXT;
/* Declare a pointer to the job name */
DCL SPCPTR .#JOBNAM PARM;
/* Declare a pointer to the job user */
DCL SPCPTR .#JOBUSR PARM;
/* Declare a pointer to the job number */
DCL SPCPTR .#JOBNBR PARM;
/* Declare a pointer to the job data area required (*LDA etc) */
DCL SPCPTR .#JOBARA PARM;
/* Declare a pointer to the passed LDA space. */
DCL SPCPTR .#RETSPC PARM;
/* Declare a pointer to the returned code. */
DCL SPCPTR .#RETCDE PARM;
/* Parameter list. */
DCL OL ENTPARM(.#JOBNAM, .#JOBUSR, .#JOBNBR, .#JOBARA,
.#RETSPC, .#RETCDE) EXT PARM MIN(0);
/* Job name */
DCL DD #JOBNAME CHAR(10) BAS(.#JOBNAM);
/* Job user name */
DCL DD #JOBUSER CHAR(10) BAS(.#JOBUSR);
/* Job number */
DCL DD #JOBNBR CHAR(6) BAS(.#JOBNBR);
/* Job data area */
DCL DD #JOBARA CHAR(4) BAS(.#JOBARA);

/* Returned LDA value */

DCL DD #RETSPC CHAR(2000) BAS(.#RETSPC);

/* Returned code */

DCL DD #RETCDE PKD(1) BAS(.#RETCDE);

/* Current Job PCO space */

DCL DD OWN-PCO CHAR(512) BASPCO;

/*------------------------------------------*/
/* Pointer in PCO to Master Table (QWCBT00) */
/*------------------------------------------*/
DCL SYSPTR @WCBT00 DEF(OWN-PCO) POS(433); /* Offset X'1B0' */


DCL SPCPTR .WCB-ROOT;
DCL DD WCB-ROOT CHAR(2048) BAS(.WCB-ROOT);
DCL SYSPTR .WCB-TABLES(30) DEF(WCB-ROOT) POS(577);

/* Work variables */

DCL DD THE-TABLE BIN(4);
DCL DD THE-OFFSET BIN(4);

/* Size of the Work Control Block table(s) */

DCL SPCPTR .WCBSPC;
DCL DD WCBTBL-SPACE CHAR(256) BAS(.WCBSPC);
DCL DD WCBTBL-SIZE BIN(4) DEF(WCBTBL-SPACE) POS(21);

/* Work Control Table entry structure */

DCL SPCPTR .WCB-ENTRY;
DCL DD WCB-ENTRY CHAR(1024) BAS(.WCB-ENTRY);
DCL DD WCB-JOBNAM CHAR(10) DEF(WCB-ENTRY) POS( 1);
DCL DD WCB-JOBUSR CHAR(10) DEF(WCB-ENTRY) POS( 11);
DCL DD WCB-JOBNBR CHAR( 6) DEF(WCB-ENTRY) POS( 21);
DCL SYSPTR .JOBPCS DEF(WCB-ENTRY) POS( 33);
DCL SYSPTR .JOBLDA DEF(WCB-ENTRY) POS(113);


/* GDA has a space and actual data space */

DCL SPCPTR .ARAPTR;
DCL DD ARASPACE CHAR(2048) BAS(.ARAPTR);
DCL DD ARAOFF BIN(2) DEF(ARASPACE) POS(3);

/* Space pointer to a PCS space. */

DCL SPCPTR .PCSPTR;
DCL DD PCSSPC CHAR(4096) BAS(.PCSPTR);

/* Pointer from the PCSSPC to the jobs GDA. */

DCL SYSPTR .JOBGDA DEF(PCSSPC) POS(209); /* H'D1' */
DCL SYSPTR .JOBPDA DEF(PCSSPC) POS(353); /* H'161' */


/*------------------------------------------*/
/* Executable instructions */
/*------------------------------------------*/

GET-WCB-ROOT:
SETSPPFP .WCB-ROOT, @WCBT00; /* Point WCB-ROOT structure at
address of Master Table. */
CPYNV THE-TABLE, 0;

NEXT-WCB-TABLE:
/* If searched maximum table entries, then job not found */
CMPNV(B) THE-TABLE, 30/EQ(.BP00003);

ADDN(S) THE-TABLE, 1;

/* If pointer null (end of index reached), then skip to */
/* "No job found" handling. */
CMPPTRT(B) .WCB-TABLES(THE-TABLE), * /EQ(.BP00003);

/* Find the size of the table from table header */

SETSPPFP .WCBSPC, .WCB-TABLES(THE-TABLE);

/* Search table entries for matching job */

PREPARE-TO-SEARCH-WCB-TABLE:
/* Init pointer to start of table */
SETSPPFP .WCB-ENTRY, .WCBSPC;

/* Add the offset to start of job entries then skip two statements */

CPYNV(B) THE-OFFSET, H'0300'/POS(=+2); /* first entry */

NEXT-WCTBL-ENTRY:
ADDN(S) THE-OFFSET, H'0400'; : /* size of entry */
CMPNV(B) THE-OFFSET, WCBTBL-SIZE/NLO(NEXT-WCB-TABLE);

SETSPPO .WCB-ENTRY, THE-OFFSET;
CHECK-WCBTBL-ENTRY:
/* Now test for a job match */
CMPBLA(B) #JOBNAME, WCB-JOBNAM/NEQ(NEXT-WCTBL-ENTRY);
CMPBLA(B) #JOBUSER, WCB-JOBUSR/NEQ(NEXT-WCTBL-ENTRY);
CMPBLA(B) #JOBNBR , WCB-JOBNBR/NEQ(NEXT-WCTBL-ENTRY);
/* everything matches - WE HAVE THE JOB!! */
B .GOTJOB;

.GOTJOB:
BRK 'BREAK002';
CMPBLA(B) #JOBARA,C'*LDA'/NEQ(.NOTLDA0);

/* Make sure we have an LDA. Should be a system pointer. */

CMPPTRT(B) .JOBLDA,X'01'/NEQ(.BP00004);

/* Set to LDA space... */

SETSPPFP .ARAPTR, .JOBLDA;
BRK 'BREAK008';
ADDSPP .ARAPTR, .ARAPTR, 96; /* H'60' */

/* Pass it back. */

CPYBLAP #RETSPC,ARASPACE(1:1024),C' ';
CPYNV #RETCDE,0;
B .BP00002;
.NOTLDA0:

/* If job is no longer active... */

CMPPTRT(B) .JOBPCS,X'01'/NEQ(.BP00005);
SETSPPFP .PCSPTR, .JOBPCS;
BRK 'BREAK003';
CMPBLA(B) #JOBARA,C'*GDA'/NEQ(.NOTGDA0);

/* Make sure we have an GDA. Should be a system pointer. */

CMPPTRT(B) .JOBGDA,X'01'/NEQ(.BP00004);

/* Set to GDA space... */

SETSPPFP .ARAPTR, .JOBGDA;
BRK 'BREAK004';

/* Pass it back. */

ADDSPP .ARAPTR, .ARAPTR, ARAOFF;
ADDSPP .ARAPTR, .ARAPTR, 3;
BRK 'BREAK005';
CPYBLAP #RETSPC,ARASPACE(1:512),C' ';
B .NOTGDA1;
.NOTGDA0:;
CMPPTRT(B) .JOBPDA,X'01'/NEQ(.BP00004);

/* Set to PDA space... */

SETSPPFP .ARAPTR, .JOBPDA;
BRK 'BREAK006';
ADDSPP .ARAPTR, .ARAPTR, ARAOFF;
ADDSPP .ARAPTR, .ARAPTR, 3;
BRK 'BREAK007';
CPYBLAP #RETSPC, ARASPACE(1:2000),C' ';
.NOTGDA1:;
CPYNV #RETCDE,0;
.BP00002:;
DEACTPG * ;
RTX *;

/* Branch here if job not found */

.BP00003:;
CPYNV #RETCDE,9;
B .BP00002;

/* Branch here if no LDA */

.BP00004:;
CPYNV #RETCDE,8;
B .BP00002;

/* Branch here if job not active */

.BP00005:;
CPYNV #RETCDE,7;
B .BP00002;
PEND;
_______________________________________________
This is the MI Programming on the AS400 / iSeries (MI400) mailing list
To post a message email: MI400@xxxxxxxxxxxx
To subscribe, unsubscribe, or change list options,
visit: http://lists.midrange.com/mailman/listinfo/mi400
or email: MI400-request@xxxxxxxxxxxx
Before posting, please take a moment to review the archives
at http://archive.midrange.com/mi400.



This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2020 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].