#IBMi Control Language, Templates and Subroutines

IBM i

Oct 17

Control Language (*CLP) is a wonderful little tool in every IBM i Programmer’s toolkit. Sadly it’s frequently derided, frowned upon and ridiculed by RPG chaps and chappettes. OK, so CL isnt a full suite business language, but reminds me of learning BBC BASIC back in my school days. I secretly wish I could write everything in CL. It’s simple, and really quite cool.

A fresher IBM programmer was asking me about CL this morning, so I put together this little template for the bare bones of a CL procedure. Of course, there are lots of different ways to structure any piece of code but this is a good starting point.

The basic premise is

  • Barebones CL program with a global capture routine to capture and display errors that we dont explicitly monitor for
  • Some basic variable declarations and copyright options
  • Written in ILE Control Language (CLLE)

So, grab it. Hack it. Have your wicked way with it.

Example ILE CLP program template

/* ------------------------------------------------------------ */
/* TEMPLATE - automate the HOTFIX distribution and installation */
/* ------------------------------------------------------------ */
/* Program.......... TEMPLATE                                   */
/* Author........... nick@nicklitten.com                        */
/* Calling Program.. *NONE                                      */
/* Calling Command.. *NONE                                      */
/* Function......... This is a template for a simple CL program */
/*                    - edit & use as you please                */
/* User Profile..... *USER                                      */
/* Object Owner..... QPGMR                                      */
/* Compiler Options. This is a CLLE *MODULE bound into *PGM     */
/* Module: CRTCLMOD MODULE('library'/TEMPLATE)                  */
/*         SRCFILE('library'/QCLLESRC)                          */
/*         SRCMBR(TEMPLATE)                                     */
/*         OPTIMIZE(*NONE)                                      */
/*         DBGVIEW(*SOURCE)                                     */
/* ILEPGM: CRTPGM PGM('library'/TEMPLATE) MODULE(TEMPLATE*)     */
/* -------------------------------------------------------------*/
/* Modification History:                                        */
/* Author Date       Description                                */
/* NJL01  10/17/2017 Created                                    */
/* ------------------------------------------------------------ */
PGM

RPG Code Snippet IBMi Control LanguageDCLPRCOPT LOG(*NO) DFTACTGRP(*NO) ACTGRP(*CALLER)
DCL VAR(&PGMNAME) TYPE(*CHAR) LEN(10)
DCL VAR(&CRASHED) TYPE(*LGL) VALUE('0')
DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(256)
DCL VAR(&MSGFIL) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
DCL VAR(&MSGKEY) TYPE(*CHAR) LEN(4)
DCL VAR(&RTNTYPE) TYPE(*CHAR) LEN(2)
DCL VAR(&SENDER) TYPE(*CHAR) LEN(80)

/* NOTE: the COPYRIGHT statement will display when you do a DSPPGM but we */
/* can go an extra step and include it with a variable so that it */
/* displays in DUMP outputs (not that my code ever dumps of course ;) */
COPYRIGHT TEXT('TEMPLATE Ver:001 Simple CL template.  Add any comments you like here')

DCL VAR(&COPYRIGHT) TYPE(*CHAR) LEN(256) +
 VALUE('YOUR COMPANY © 2017 | IBM i V7.1 https://www.nicklitten.com')

DCL VAR(&COPYRIGHTP) TYPE(*PTR) STG(*DEFINED) DEFVAR(&COPYRIGHT) /* &VARIABLES are not +
 shown in DUMPS unless theyre used but we can *fool* IBM i into using it - how +
 about something like a little pointer? */

MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(CRASH)) /* Global monitor for any error messages */

CALLSUBR SUBR(INZSR) /* a little initialization subroutine to do pre-run gubbins */

/* begin regular program logic here */
/* or, if you prefer, put that logic in the MAINLINE subroutine something */
/* like this: CALLSUBR SUBR(MAINLINE) */


CHKOBJ OBJ(QTEMP/SANTACLAUS) OBJTYPE(*PGM) /* Here is an example command that will deliberately crash the program so you can see the error message in use. Obviously you should replace this with the actual logic you are writing... */



SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) +
 MSGDTA('Program' *BCAT &PGMNAME *TCAT 'completed normally') MSGTYPE(*COMP)
END: RETURN
CRASH: CALLSUBR SUBR(CRASH)

/* ---------------------------------------------------------------------------------------------- */
/* SUBROUTINE SECTION */
/* ---------------------------------------------------------------------------------------------- */
/* Initialization Routine - could contains anything but lets use it to get the pgm name */
/* ---------------------------------------------------------------------------------------------- */
SUBR SUBR(INZSR)
  SNDPGMMSG MSG('What is this program name?') TOPGMQ(*SAME) MSGTYPE(*INFO) KEYVAR(&MSGKEY)
  RCVMSG PGMQ(*SAME) MSGTYPE(*INFO) WAIT(0) RMV(*YES) SENDER(&SENDER) SENDERFMT(*SHORT)
  CHGVAR VAR(&PGMNAME) VALUE(%SST(&SENDER 56 10))
ENDSUBR

/* ---------------------------------------------------------------------------------------------- */
/* MAINLINE - If you prefer you could use this for your mainline */
/* ---------------------------------------------------------------------------------------------- */
SUBR SUBR(MAINLINE)
ENDSUBR

/* ---------------------------------------------------------------------------------------------- */
/* CRASH : Routine to handle unexpected errors */
/* ---------------------------------------------------------------------------------------------- */
SUBR SUBR(CRASH)
  IF COND(&CRASHED) THEN(RETURN)
  CHGVAR VAR(&CRASHED) VALUE('1')

/* This subroutine will read back through this programs joblog */
/* and pump out messages to your joblog based on the status */
/* codes returned from RCVMSG. RTNTYPE values include: */
/* - 01 Completion */
/* - 02 Diagnostic */
/* - 04 Information */
/* - 05 Inquiry */
/* - 06 Copy */
/* - 08 Request */
/* - 10 Request with prompting */
/* - 14 Notify (exception already handled at time of RCVMSG) */
/* - 15 Escape (exception already handled at time of RCVMSG) */
/* - 16 Notify (exception not handled at time of RCVMSG) */
/* - 17 Escape (exception not handled at time of RCVMSG) */
/* - 21 Reply, not checked for validity */
/* - 22 Reply, already checked for validity */
/* - 23 Reply, message default used */
/* - 24 Reply, system default used */
/* - 25 Reply, from System Reply List */
/* - 26 Reply, from exit program */
   RCVMSG MSGTYPE(*LAST) MSGDTA(&MSGDTA) MSGID(&MSGID) RTNTYPE(&RTNTYPE) MSGF(&MSGFIL) +
     SNDMSGFLIB(&MSGFLIB)
   IF COND(&RTNTYPE *EQ '15' *OR &RTNTYPE *EQ '17') THEN(DO) /* *escape */
     SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFIL) MSGDTA(&MSGDTA) MSGTYPE(*DIAG)
   ENDDO
   SNDPGMMSG MSGID(CPF9898) MSGF(QCPFMSG) MSGDTA('* Program' *BCAT &PGMNAME *BCAT 'ended abnormally') MSGTYPE(*ESCAPE)
ENDSUBR
ENDPGM: ENDPGM
Follow

About the Author

IBM i Software Developer, Digital Dad, AS400 Anarchist, RPG Modernizer, Alpha Nerd and Passionate Eater of Cheese and Biscuits. Nick Litten Dot Com is a mixture of blog posts that can be sometimes serious, frequently playful and probably down-right pointless all in the space of a day. Enjoy your stay, feel free to comment and in the words of the most interesting man in the world: Stay thirsty my friend.