Add Message Commands
This commit is contained in:
SJLennon
parent
661c5091fc
commit
3a9593c8ab
46
APIs/CLERRHANDL.CLLE
Normal file
46
APIs/CLERRHANDL.CLLE
Normal file
@ -0,0 +1,46 @@
|
||||
pgm
|
||||
|
||||
dcl &Abending *lgl
|
||||
dcl &JobName *char 10
|
||||
dcl &JobUser *char 10
|
||||
dcl &JobNbr *char 6
|
||||
dcl &MsgKey *char 4
|
||||
dcl &PgmName *char 10
|
||||
dcl &Sender *char 80
|
||||
|
||||
monmsg cpf0000 exec(goto abend)
|
||||
|
||||
/* Determine the name of this program. */
|
||||
|
||||
sndpgmmsg msg('Dummy message') topgmq(*same) +
|
||||
msgtype(*info) keyvar(&msgkey)
|
||||
rcvmsg pgmq(*same) msgtype(*info) msgkey(&MsgKey) +
|
||||
rmv(*yes) sender(&Sender)
|
||||
chgvar var(&PgmName) value(%sst(&Sender 27 10))
|
||||
|
||||
rtvjoba job(&JobName) user(&JobUser) nbr(&JobNbr)
|
||||
|
||||
/* regular processing goes here */
|
||||
|
||||
cpyf fromfile(qcustcdt) tofile(qtemp/br549)
|
||||
return
|
||||
|
||||
/* ===========================================================*/
|
||||
/* * Routine to handle unexpected errors */
|
||||
Abend:
|
||||
/* Don't let this program go into a loop here. */
|
||||
if &Abending then(do)
|
||||
sndpgmmsg msgid(cpf9898) msgf(qcpfmsg) msgtype(*escape) +
|
||||
msgdta('Program' *bcat &PgmName *bcat +
|
||||
'ended abnormally at label Abend')
|
||||
monmsg cpf0000
|
||||
return
|
||||
enddo
|
||||
chgvar &Abending '1'
|
||||
|
||||
/* Resend diagnostic & escape messages to the caller */
|
||||
/* caller as diagnostic messages. */
|
||||
movpgmmsg msgtype(*diag)
|
||||
rsnescmsg
|
||||
|
||||
endpgm
|
||||
32
APIs/MOVPGMMSG.CMD
Normal file
32
APIs/MOVPGMMSG.CMD
Normal file
@ -0,0 +1,32 @@
|
||||
/* Command ...... : MOVPGMMSG - Move Program Messages */
|
||||
/* CPP .......... : QMHMOVPM */
|
||||
/* Author ....... : Brian Rusch */
|
||||
/* */
|
||||
/* This is a command interface over IBM's API. */
|
||||
/* */
|
||||
/* Published in Four Hundred Guru on May 2, 2012 */
|
||||
/* No warranties expressed or implied. Use at your own risk. */
|
||||
/* */
|
||||
/* Compile with ALLOW(*BPGM *IPGM *BMOD *IMOD) */
|
||||
/* CRTCMD CMD(MOVPGMMSG) PGM(QMHMOVPM) SRCFILE(yourlib/srcfile) */
|
||||
/* ALLOW(*BPGM *IPGM *BMOD *IMOD) */
|
||||
|
||||
|
||||
CMD PROMPT('Move Program Messages')
|
||||
|
||||
PARM KWD(MSGKEY) TYPE(*CHAR) LEN(4) CONSTANT(' ')
|
||||
|
||||
PARM KWD(MSGTYPE) TYPE(*CHAR) LEN(10) RSTD(*YES) +
|
||||
DFT(*DIAG) VALUES(*COMP *DIAG *ESCAPE +
|
||||
*INFO) PROMPT('Message type')
|
||||
|
||||
PARM KWD(NBRTYPS) TYPE(*INT4) CONSTANT(1)
|
||||
|
||||
PARM KWD(TOPGMQ) TYPE(*CHAR) LEN(10) RSTD(*YES) +
|
||||
DFT(*PGMBDY) VALUES(* *CTLBDY *PGMBDY) +
|
||||
PROMPT('Call stack entry')
|
||||
|
||||
PARM KWD(UPSTKCNT) TYPE(*INT4) CONSTANT(1)
|
||||
|
||||
PARM KWD(ERRCOD) TYPE(*CHAR) LEN(8) +
|
||||
CONSTANT(X'0000000800000000')
|
||||
@ -73,3 +73,19 @@ Notes:
|
||||
|
||||
1. The code was originally fixed format but I converted it to **FREE (using [Craig Rutledge's JCRCMDS](https://www.jcrcmds.com/)). If needed for general use it should probably be a service program. I'm not sure service programs were a thing in 1997, but if they were I was not familar with them then.
|
||||
2. On more current OS releases you can get similar information in SQL with the [GET_JOB_INFO table function](https://www.ibm.com/docs/en/i/7.4?topic=services-get-job-info-table-function).
|
||||
|
||||
## Messages: QMHMOVPM (Move Program Messages) & QMHRSNEM (Resend Escape Message)
|
||||
|
||||
These commands makes handling CL program exceptions easy and concise. Source is an [article in IT Jungle](https://www.itjungle.com/2012/05/02/fhg050212-story01/) back in 2012. My thanks to Ted Holt and Brian Rusch.
|
||||
|
||||
### MOVPGMMSG - Move Program Messages Command
|
||||
|
||||
This is a command that calls the IBM QMHMOVPM (Move Program Messages) API. You'd use it to pass diagnostic messages up to the calling program.
|
||||
|
||||
### RSNESCMSG - Resend Escape Message Command
|
||||
|
||||
This is a command that calls the IBM QMHRSNEM (Resend Escape Message) API to send the current escape message to the caling program. This also ends the current program.
|
||||
|
||||
### CLERRHANDL - Ted Holt's CL Error Handler Template
|
||||
|
||||
This is execuatble code from Ted Holt that demonstrates handling exceptions in CL, using these two commands. Call it from a command line, it will fail and you will see the diagnostic message "From-file QCUSTCDT in *LIBL not found."
|
||||
|
||||
35
APIs/RSNESCMSG.CMD
Normal file
35
APIs/RSNESCMSG.CMD
Normal file
@ -0,0 +1,35 @@
|
||||
/* Command ...... : RSNESCMSG - Resend Escape Message */
|
||||
/* CPP .......... : QMHRSNEM */
|
||||
/* Author ....... : Brian Rusch */
|
||||
/* */
|
||||
/* This is a command interface over IBM's API. */
|
||||
/* */
|
||||
/* Published in Four Hundred Guru on May 2, 2012 */
|
||||
/* No warranties expressed or implied. Use at your own risk. */
|
||||
/* */
|
||||
/* Compile with ALLOW(*BPGM *IPGM *BMOD *IMOD) */
|
||||
|
||||
/* CRTCMD CMD(RSNESCMSG) PGM(QMHRSNEM) SRCFILE(yourlib/srcfile) */
|
||||
/* ALLOW(*BPGM *IPGM *BMOD *IMOD) */
|
||||
|
||||
CMD PROMPT('Resend Escape Message')
|
||||
|
||||
PARM KWD(MSGKEY) TYPE(*CHAR) LEN(4) CONSTANT(' ')
|
||||
|
||||
PARM KWD(ERRCOD) TYPE(*CHAR) LEN(8) +
|
||||
CONSTANT(X'0000000800000000')
|
||||
|
||||
/* Null pointer, to call stack counter (1), pointer qualifier (*PGMBDY) */
|
||||
PARM KWD(TOSTKE) TYPE(*CHAR) LEN(30) +
|
||||
CONSTANT(X'00000000000000000000000000000000+
|
||||
000000015CD7C7D4C2C4E8404040')
|
||||
|
||||
PARM KWD(TOSTKELEN) TYPE(*INT4) CONSTANT(30)
|
||||
|
||||
PARM KWD(TOSTKEFMT) TYPE(*CHAR) LEN(8) +
|
||||
CONSTANT(RSNM0200)
|
||||
|
||||
PARM KWD(FRSTKEADDR) TYPE(*CHAR) LEN(16) +
|
||||
CONSTANT('*')
|
||||
|
||||
PARM KWD(FRSTKCNT) TYPE(*INT4) CONSTANT(0)
|
||||
Loading…
x
Reference in New Issue
Block a user