• Subject: Re: Call Stack API.
  • From: "Brad Felber" <poprpg@xxxxxxxxxxxx>
  • Date: Fri, 29 Oct 1999 11:26:30 -0500

----- Original Message -----

> In one of my RPG programs I need to get all the parent programs during Run
> Time. Is there any API which I can use to get Call stack into my program.
>
> Any help is really appreciated.
>

I know you asked for an API.  I have this CL program that I use to make sure
someone runs a program before anything else.  (so they change their library
list before executing a program) the way I do that is see if the 3rd program
back in the command stack is the right program.  The idea was originally
from some Magazine like MC, what it does is send a message to the *PRV
program, then it retirves it,  and sends a message to the *PRV of that
program.  and so on.

PGM

             DCL        VAR(&PGM) TYPE(*CHAR) LEN(10)
             DCL        VAR(&RTNPGM) TYPE(*CHAR) LEN(80)
             DCL        VAR(&COUNT) TYPE(*DEC) LEN(2 0) VALUE(2)

/* FIRST MESSAGE */

             SNDPGMMSG  MSG(*)
             RCVMSG     PGMQ(*PRV) SENDER(&RTNPGM)
             CHGVAR     VAR(&PGM) VALUE(%SST(&RTNPGM 56 10))
             IF         COND(&PGM *EQ 'QOFIPGM') THEN(GOTO +
                          CMDLBL(NOGOOD))

/* 2ND THROUGH 3RD MESSAGE */
LOOP:

             SNDPGMMSG  MSG(*) TOPGMQ(*PRV (&PGM))
             RCVMSG     PGMQ(*PRV (&PGM)) SENDER(&RTNPGM)
             CHGVAR     VAR(&PGM) VALUE(%SST(&RTNPGM 56 10))
             CHGVAR     VAR(&COUNT) VALUE(&COUNT + 1)
             IF         COND(&COUNT *LE 3) THEN(GOTO CMDLBL(LOOP))

/* IF THE 3RD PROGRAM BACK ISN'T QCMD THEN THIS ISN'T AN INITIAL PGM */

             IF         COND(&PGM *NE 'QCMD') THEN(GOTO CMDLBL(NOGOOD))
             CHGCURLIB  CURLIB(FRNMODBETA)
             SNDPGMMSG  MSG('Beta testing environment entered. +
                          Continue to log on normally')
             RCLRSC
             GOTO       CMDLBL(END)

NOGOOD:
             SNDPGMMSG  MSG('You must run this before anything else')
END:
ENDPGM

Brad Felber
bradf@csepromo.com
CSE, Inc.
new (262)786-8400 ext 3069
old (414)786-8400 ext 3069


+---
| This is the Midrange System Mailing List!
| To submit a new message, send your mail to MIDRANGE-L@midrange.com.
| To subscribe to this list send email to MIDRANGE-L-SUB@midrange.com.
| To unsubscribe from this list send email to MIDRANGE-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...

Replies:

Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2022 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.