|
Date: Mon, 12 May 2008 12:20:56 -0700> From: paulgjackson@xxxxxxxxx> To: mi400@xxxxxxxxxxxx> Subject: [MI400] MI program unable to locate job - need assistance> > 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.>_________________________________________________________________
As an Amazon Associate we earn from qualifying purchases.
This mailing list archive is Copyright 1997-2024 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].
Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.
midrange.com
