I’m a big fan of service programs. From a maintainability point of view, encapsulated procedures are great. And exported procedures, which mean you only need to develop any piece of functionality once, are even better.
However, I now find myself in the position of having to start creating a set of these from scratch (nothing to copy/paste) and, since they can be a bit fiddly, now seems like a good time to document the steps.
In the example that follows, I create a service program with a single procedure, RtvProgram, which returns the name of the program that called the service program. It sounds a bit recursive, I know, but bear with me. Whenever coding a display file (or a report, for that matter) I like to put the program name somewhere on the screen (top left, unless someone tells me otherwise). This means that when someone has a problem, we can very quickly identify what program they are talking about.
Obviously, hard-coding the program name in the display file would be easy. But code gets copied and pasted and, sooner or later, all hard coded values end up being wrong. I have also seen cases of one display file being used by two or more programs, so it is much better to put the program name in a field and retrieve it dynamically. That way, you are always getting the right program.
So on to the service program.
First, you need a copy member to contain the procedure prototype. You could, of course, code the prototype in each program that uses the service program, but that way madness lies.
In my case, I have created the copy member in QRPGLESRC and called it LSS001RP. It looks like this:
* Retrieve Program Name d RtvProgram pr 10a
And then you need to write the service program:
* ---------------------------------------------------------------------- *
* Program : LSS001R *
* Description : Program information service programs *
* ---------------------------------------------------------------------- *
h nomain
* ---------------------------------------------------------------------- *
* Exportable Prototypes *
* ---------------------------------------------------------------------- *
/copy LSCLIB/qrpglesrc,lss001rp
* ---------------------------------------------------------------------- *
* API Prototypes *
* ---------------------------------------------------------------------- *
d RtvCallStack pr extpgm('QWVRCSTK')
d 2000a
d 10i 0
d 8a
d 56a
d 8a
d 15a
* ---------------------------------------------------------------------- *
* RtvProgram: Retrieve the program name *
* ---------------------------------------------------------------------- *
p RtvProgram b export
d RtvProgram pi 10a
d Var ds 2000 qualified
d BytAvl 10i 0
d BytRtn 10i 0
d Entries 10i 0
d Offset 10i 0
d Count 10i 0
d JobID ds qualified
d QName 26a inz('*')
d IntID 16a
d Res3 2a inz(*loval)
d ThreadInd 10i 0 inz(1)
d Thread 8a inz(*loval)
d Entry ds qualified
d Length 10i 0
d Program 10a overlay(Entry: 25)
d Library 10a overlay(Entry: 35)
d VarLength s 10i 0 inz(%size(Var))
d RcvFormat s 8a inz('CSTK0100')
d JobIdFmt s 8a inz('JIDF0100')
d ApiError s 15a
d i s 10i 0
/free
RtvCallStack(Var: VarLength: RcvFormat: JobID: JobIdFmt : ApiError);
for i = 1 to 2;
Entry = %subst(Var: Var.Offset + 1);
Var.Offset += Entry.Length;
endfor;
return Entry.Program;
/end-free
p RtvProgram e
* ---------------------------------------------------------------------- *
I’m not going to go into too much detail here. The service program LSS001R contains one procedure, RtvProgram which uses the QWVRCSTK API to retrieve the current call stack then it reads back two entries: The first entry is the service program and the second entry is the calling program. And this is the program name that it returns.
You now need to create the RPG Module. Note the terminology here — you are not creating a Bound RPG Program (it’s the difference between options 15 and 14 in PDM).
I also need the binding source. In this case, the member is called LSS001S and I have put it in the QSRVSRC source file. It looks like this:
STRPGMEXP PGMLVL(*CURRENT)
EXPORT SYMBOL('RTVPROGRAM')
ENDPGMEXP
Note that the capitalisation is actually important here.
And now I’m ready to create the service program:
CRTSRVPGM SRVPGM(LSCLIB/LSS001R) MODULE(LSCLIB/LSS001R) SRCFILE(LSCLIB/QSRVSRC) SRCMBR(LSS001S)
Since I’m doing this from scratch, I need to create a binder directory:
CRTBNDDIR BNDDIR(LSCLIB/LSBNDDIR) TEXT('General purpose binding directory')
And add the service program to it:
ADDBNDDIRE BNDDIR(LSCLIB/LSBNDDIR) OBJ((LSS001R))
And we’re ready to go. All I have to do now is make a couple of amendments to the main program to take advantage of the service program:
The control spec needs this line:
h bnddir('LSBNDDIR')
Obviously, I need to copy the prototype definition somewhere in the definition specification:
/copy LSCLIB/qrpglesrc,lss001rp
And when the program starts, I need to identify the name of the program:
/free
// Identify the current program
program = RtvProgram();
And that’s it.
One Reply to “Service Programs and Call Stack APIs”