Greetings again,
I'm having a hard time getting this exit to work. My assembler skills
are pretty much non-existent. I'm trying convert an old JES2 EXIT2 to
work
as as an EXIT52. Following the manuals, IBM's sample exit and the old
exit,
I put this together. I yanked all the doc so it would post without being
too
terribly long. It abends S0C4 whenever it is executed. I don't see where
it's
wandering off, but that's no surprise. If anyone can spare some time to
help,
I'd appreciate it.... again.
I originally had the load of register 5 wrong, so it errored off. It
was
working up until the point where it formatted and inserted a jobcard
though.
I'm guessing there's something wrong with the address in R5. More likely
the
way I'm using it. The manuals say X052JXWR is supposed to point to an
area to
be used to format an inserted card. I also backed it off to look like
the old
exit and set R5 to the address starting at byte 8 of R1, but that S0C4's
too.
Thanks again,
HASX52A TITLE 'USER EXIT 52 MODULE -- PROLOG (MODULE COMMENT BLOCK)'
TITLE 'USER EXIT 52 MODULE -- PROLOG ($HASPGBL)'
COPY $HASPGBL COPY HASP GLOBALS
TITLE 'USER EXIT 52 MODULE -- PROLOG ($MODULE)'
HASX52A $MODULE ENVIRON=(USER,ANY), C
RMODE=ANY, C
IBMJES2=SAMPLE, C
TITLE='USER EXIT 52 MODULE', C
$BUFFER, GENERATE HASP BUFFER DSECT C
$CADDR, GENERATE HASP CADDR DSECT C
$HASPEQU, GENERATE HASP EQU DSECT C
$HCCT, Generate HASP HCCT DSECT C
$HCT, GENERATE HASP HCT DSECT C
$JCT, GENERATE HASP JCT DSECT C
$JRW, Generate HASP JRW DSECT C
$MIT, GENERATE HASP MIT DSECT C
$MITETBL, Generate HASP MTE dsect C
$PADDR, GENERATE HASP PADDR DSECT C
$PARMLST, GENERATE HASP PADDR DSECT C
$PCE, GENERATE HASP PCE DSECT C
$PSV, GENERATE HASP PSV DSECT C
$USERCBS, GENERATE HASP USERCBDS DSECT C
$XECB, GENERATE HASP XECB DSECT C
$XIT, Generate HASP XIT DSECT C
$XPL Generate HASP XPL DSECT
TITLE 'USER EXIT 52 MODULE -- JOB STATEMENT SCAN'
USING JRW,R7 JRW addressability
USING XPL,R8 XPL addressability
SPACE 1
EXIT52 $ENTRY BASE=R12,SAVE=YES Provide exit routine entry point
LR R12,R15 Load base Register
USING JCT,R10 Provide JCT addressability
TM X052COND,X052SEC Second time thru for this card ?
BNZ USERFND Yes, get out
TM JCTJOBFL,JCTBATCH Is this a batch JOB?
BZ USERFND No, get out
L R2,0(R1) Put the address of the current JOB
* statement in Register 2
CLC COMMENT,0(R2) Is this a comment card ??
BE X2RC00 Yes, skip this card
LA R2,3(,R2) Start scan on card column 4
LA R3,68 Set scan limit to stop after col 72
L R4,4(R1) Put the address of the exit flag
* byte(RDWFLAGX) in Register 4
L R5,X052JXWR Put the address of the X052JXWR
* field in Register 5
XC 0(1,R5),0(R5) Clear first byte to use as a flag
CHK4USER DS 0H
CLI 0(R2),C' ' Is this a blank ?
BNE CHKEQUAL No, continue with other tests
* Yes, why is there a blank here ??
TM 0(R5),OPNQUOTE+OPNPAREN Are we within quotes or
* parens?
BNZ CHK4U01 Yes, Blank within quotes or parens
* is OK. Ignore it and continue scan
* at next character
* Else
TM 0(R5),POSPARM Has a positional parm been found ??
BNZ ADDCARD Yes, then we have found the end
* Else
B CHK4U01 Continue scan at next character
CHKEQUAL DS 0H
CLI 0(R2),C'=' Is this part of a positional parm ??
BNE CONTINUE No, continue with other tests
TM 0(R5),OPNQUOTE+OPNPAREN Are we within quotes or
* parens ??
BNZ CHK4U01 Yes, ignore the "=" sign and
* continue scan at next character
OI 0(R5),POSPARM Else the "=" sign is part of a
* positional parm - set the flag
CONTINUE DS 0H
CLI 0(R2),C'''' Is this a quote ??
BE CHKQUOTE Yes
CLI 0(R2),C'(' Is this a left paren ??
BE LPAREN Yes
CLI 0(R2),C')' Is this a right paren ??
BE RPAREN Yes
CLC USERCHK,0(R2) Is this the "USER=" parameter ??
BE USERFND Yes
CLC 0(2,R2),=C', ' Is this the end of the jobcard with
* more to come ??
BNE CHK4U01 No, Continue scan at next character
TM 0(R5),OPNQUOTE+OPNPAREN Are we within quotes or
* parens ??
BZ X2RC00 No, we are done with this jobcard.
* Move on to the next jobcard.
CHK4U01 DS 0H
LA R2,1(,R2) Increment to the next character in
* the jobcard.
BCT R3,CHK4USER If column number is less than 68
* stored in register 3, continue scan
* for "USER=" parameter
ADDCARD DS 0H
MVC 0(2,R2),=C', ' Add a comma and space to the end
* of the last jobcard
OI X052RESP,X052XSNC Set flag for added statement
MVI 0(R5),C' ' Clear the flag byte
MVC 1(79,R5),0(R5) Clear the other 79 bytes of the
* JCT work area
MVC 0(8,R5),USRCARD Move skeleton "USER=" statement
USE5JOB MVC 8(5,R5),JCTJNAME String first five characters
* of the JOB name after the USER=
* parameter
B USERFND Exit and don't come back
CHKQUOTE DS 0H
TM 0(R5),OPNQUOTE Is this ending quote ??
BZ CHKQU01 No, move on to next test
NI 0(R5),X'FF'-OPNQUOTE Yes, reset the beginning
* quote flag. No longer within
* quoted field.
B CHK4U01 Continue scan at next character
CHKQU01 DS 0H
OI 0(R5),OPNQUOTE Set open quote flag
B CHK4U01 Continue scan at next character
RPAREN DS 0H
NI 0(R5),X'FF'-OPNPAREN Reset open paren flag.
* No longer within parens.
B CHK4U01 Continue scan at next character
LPAREN DS 0H
OI 0(R5),OPNPAREN Set open paren flag
B CHK4U01 Continue scan at next character
USERFND DS 0H We found the "USER=" parameter
B X2RC00 Branch to common return routine
TITLE 'USER EXIT 2 MODULE -- COMMON RETURN ROUTINE'
SPACE 2
X2RC00 DS 0H RC=0 RETURN
XR R2,R2 Set RC=0
B X2RTN Branch to common return
SPACE 2
X2RC04 DS 0H RC=4 RETURN
LA R2,4 Set RC=4
B X2RTN Branch to common return
SPACE 2
X2RC08 DS 0H RC=8 RETURN
LA R2,8 Set RC=8
B X2RTN Branch to common return
SPACE 2
X2RC12 DS 0H RC=12 RETURN
LA R2,12 Set RC=12
B X2RTN Branch to common return
SPACE 2
X2RTN DS 0H
SPACE 2
$RETURN RC=(R2) Return to HASPPRPU
DROP R7,R8,R10,R12 Drop JRW, XPL, JCT & Local USINGs
TITLE 'USER EXIT 2 MODULE -- CONSTANTS'
SPACE 1
USERCHK DC CL5'USER=' JCL parameter we are scanning
COMMENT DC CL3'//*' Comment card
USRCARD DC CL8'// USER=' Skeleton statement
OPNQUOTE EQU X'80' Open quotes flag
OPNPAREN EQU X'40' Open parenthesis flag
POSPARM EQU X'10' Positional parameter found flag
DS 0F Alignment
LTORG PLACE LITERALS HERE
TITLE 'USER EXIT 52 MODULE -- EPILOG ($MODEND)'
$MODEND
APARNUM DC CL8'NONE' APAR Number
PTFNUM DC CL8'NONE' PTF Number
END , END OF HASX52A
------------------------------------------------------------------------------
This e-mail transmission may contain information that is proprietary,
privileged and/or confidential and is intended exclusively for the person(s) to
whom it is addressed. Any use, copying, retention or disclosure by any person
other than the intended recipient or the intended recipient's designees is
strictly prohibited. If you are not the intended recipient or their designee,
please notify the sender immediately by return e-mail and delete all copies.
OppenheimerFunds may, at its sole discretion, monitor, review, retain and/or
disclose the content of all email communications.
==============================================================================
----------------------------------------------------------------------
For IBM-MAIN subscribe / signoff / archive access instructions,
send email to [EMAIL PROTECTED] with the message: GET IBM-MAIN INFO
Search the archives at http://bama.ua.edu/archives/ibm-main.html
