Last active
December 16, 2021 21:29
-
-
Save greghelton/7493168 to your computer and use it in GitHub Desktop.
This code shows Throw and Catch in RPG based on my 2005 article in the iSeries News magazine. <br/><br/> RPG's MONITOR & ON-ERROR clause were great additions to the RPG language. They capture program exceptions so a program's error handling can be grouped in an ON-ERROR clause thus allowing error handling logic to be separated from business logi…
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| h nomain option(*srcstmt:*nodebugio) | |
| d throw pr extproc('throw') | |
| d messageID 7 CONST | |
| d messageData 200 CONST VARYING options(*nopass) | |
| d messageFile 10 CONST options(*nopass) | |
| P throw b EXPORT | |
| d pi | |
| d messageID 7 const | |
| d messageData 200 const varying options(*nopass) | |
| d messageFile 10 const options(*nopass) | |
| *------------------------------------------------------------- | |
| D errorDS ds 16 | |
| D BytesProv 10i 0 inz(%size(ErrorDS)) | |
| D BytesAvail 10i 0 | |
| D ExceptionID 7 | |
| *------------------------------------------------------------- | |
| D sndPgmMsg pr extPgm( 'QMHSNDPM' ) | |
| D msgId 7 const | |
| D qualMsgF 20 const | |
| D msgData 80 const options( *varSize ) | |
| D msgDataLen 10i 0 const | |
| D msgType 10 const | |
| D toCSE 9999 const options( *varSize ) | |
| D toCSECtr 10i 0 const | |
| D msgKey 4 | |
| D ErrorInfo like(ErrorDS) | |
| *------------------------------------------------------------- | |
| D msgData s 100 varying | |
| D msgFile s 20 | |
| D msgKey s 4 | |
| /free | |
| if %parms() < 2 ; | |
| msgData = *BLANKS; | |
| else; | |
| msgdata = messageData; | |
| endIf; | |
| if %parms() < 3 ; | |
| msgFile = 'QCPFMSG ' + '*LIBL '; | |
| else; | |
| msgfile = messageFile + '*LIBL '; | |
| endIf; | |
| sndPgmMsg( messageID | |
| : msgFile | |
| : msgData | |
| : %len( %trim( msgData ) ) | |
| : '*ESCAPE' | |
| : '*' | |
| : 1 | |
| : msgKey | |
| : errorDS ); | |
| /end-free | |
| P e |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| h nomain option(*srcstmt:*nodebugio) | |
| d catch pr 8000 extproc('catch') varying | |
| P catch b EXPORT | |
| D pi 8000 varying | |
| *-------------------------------------------------------- | |
| D RcvMsg PR ExtPgm( 'QMHRCVPM' ) | |
| D MsgInf 32767A Options(*varsize) | |
| D MsgInfLen 10I 0 Const | |
| D FmtName 8 Const | |
| D ClStkEntry 10 Const | |
| D ClStkCounter 10I 0 Const | |
| D MsgType 10 Const | |
| D MsgKey 4 Const | |
| D WaitTime 10I 0 Const | |
| D MsgAction 10 Const | |
| D ApiErrDs 8000 options(*varsize) | |
| *-------------------------------------------------------- | |
| D RCVM0200 DS qualified | |
| D BytesRtn 10I 0 | |
| D BytesAvail 10I 0 | |
| D MsgSev 10I 0 | |
| D MsgID 7A | |
| D MsgType 2A | |
| D MsgKey 4A | |
| D msg_file 10A | |
| D msg_lib_spec 10A | |
| D msg_lib_used 10A | |
| D job 10A | |
| D profile 10A | |
| D number 6A | |
| D sendPgmName 12A | |
| D sendPgmInstr 4A | |
| D time_stamp 13A | |
| D rcv_pgm 10A | |
| D rcv_pgm_line 4A | |
| D send_type 1A | |
| D rcv_type 1A | |
| D reserved 1A | |
| D CCSID_text 10I 0 | |
| D CCSID_data 10I 0 | |
| D alert_opt 9A | |
| D CCSID_msg 10I 0 | |
| D CCSID_repl 10I 0 | |
| D replace_len1 10I 0 | |
| D replace_len2 10I 0 | |
| D MsgDtaLen 10I 0 | |
| D MsgDtaAvail 10I 0 | |
| D MsgHelpRtn 10I 0 | |
| D MsgHelpAvl 10I 0 | |
| D MsgDta 500A | |
| D ErrorCode ds qualified | |
| D BytesProv 10I 0 inz(0) | |
| D BytesAvail 10I 0 inz(0) | |
| d MSGKEY s 4 | |
| /free | |
| RcvMsg( RCVM0200 | |
| : %size(RCVM0200) | |
| : 'RCVM0200' | |
| : '*' | |
| : 1 | |
| : '*ANY' | |
| : MsgKey | |
| : 0 | |
| : '*REMOVE' | |
| : ErrorCode ); | |
| return %subst(RCVM0200.msgdta : | |
| (1 + RCVM0200.replace_len1) : | |
| RCVM0200.MsgDtaLen); | |
| /end-free | |
| P e |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| h option(*srcstmt:*nodebugio) | |
| h bnddir('TANDC') | |
| d getAccountBalance... | |
| d pr 7 2 | |
| d 5 0 CONST | |
| d throw pr extproc('throw') | |
| d messageID 7 CONST | |
| d messageData 200 CONST VARYING options(*nopass | |
| d messageFile 10 CONST options(*nopass) | |
| d catch pr 8000 extproc('catch') varying | |
| d ACCT# S 3P 0 inz(-1) | |
| d balance S 7P 2 | |
| d errorMsg S 8000 | |
| /free | |
| MONITOR; | |
| DOW 1 = 1; | |
| balance = getAccountBalance(ACCT#); | |
| dsply 'HELLO'; | |
| ENDDO; | |
| ON-ERROR; | |
| errorMsg = catch(); | |
| ENDMON; | |
| *inlr = *on; | |
| /end-free | |
| P getAccountBalance... | |
| P b EXPORT | |
| d pi like(balance) | |
| d account 5 0 CONST | |
| d acctBalance s inz like(balance) | |
| /free | |
| select; | |
| when account <= 0; | |
| throw('CPF9897': 'Invalid account passed.'); | |
| other; | |
| acctBalance = 0.00; | |
| endsl; | |
| return acctBalance; | |
| /end-free | |
| p e |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Compile and link commands | |
| chgcurlib YOURLIB | |
| addlible YOURLIB *first | |
| crtrpgmod tacthrow | |
| crtrpgmod taccatch | |
| crtrpgmod tactest | |
| crtbnddir tandc | |
| addbnddire taccatch | |
| addbnddire tacthrow | |
| crtpgm tactest | |
| Debug | |
| strdbg tactest | |
| call tactest |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment