Inside COBOL #12
by
Shawn M. Gordon
President S.M.Gordon & Associates

Well I found out something new the other day, and maybe you will think
I am dumb for not having noticed before, but what the heck. Some of
you may remember last year when I showed you how to use a variable name in the SELECT..ASSIGN clause so you could resolve file names at run time. Well, I just found out you can do the same thing in a ‘CALL’
statement. I always thought if you wanted to dynamically load a
procedure you had to use a bunch of weird intrinsics, but apparantly
this isn’t the case. Following is an example of how easy it is to do this dynamically.

01 PROC-NAME         PIC X(26)  VALUE SPACES.

DISPLAY 'What procedure do you want to load?'.
ACCEPT PROC-NAME FREE.
CALL PROC-NAME.
STOP RUN.

It’s that simple. Now I don’t know if you have a need for this type of
thing, but it would be worthwhile to keep it in mind.

Now last month I showed you how to use the HP COBOL psuedo-intrinsics
“.LEN.” and “.LOC.”. The “.LOC.” psuedo-intrinsic is necessary for
certain uses of the CREATEPROCESS intrinsic. I want to build on what
we talked about last month, but I am going to give you a very specific example.

About 6 years ago I wrote a paper on how to use MPEX from VESOFT to
make programs and jobs more foolproof. For the programs, we would check to see if a file had filled up, then do a CREATEPROCESS on MPEX to do an ALTFILE of the file, then re-open the file and keep writing to it. Now this is a one shot command to MPEX that will finish and then return to the program. What if you want to be in a command driven program and be able to issue MPEX command from your program? It is highly inneficient to do a new CREATEPROCESS for each and every command.

MPEX also makes use of the ‘SENDMAIL’ intrinsic for this type of
communication. So now we have to be able to create MPEX as a son
process, keep it alive after we come back to the father process, and then pass commands to MPEX that it will execute. So strap on your seat belts, here we go.

  01 MPEX-STUFF.
     03 MPEX-PIN               PIC S9(4)  COMP VALUE 0.
     03 MPEX-BUFF              PIC X(70)  VALUE SPACES.
     03 MPEX-FILE              PIC X(26)  VALUE "MPEX.PUB.VESOFT".
     03 MSG-LEN                PIC S9(4)  COMP VALUE 35.
     03 MAIL-STAT              PIC S9(4)  COMP VALUE 0.
 $IF X0=OFF
     03 MS-I.
        05                     PIC S9(4)  COMP VALUE 0.
     03 MS-IN.
        05                     PIC S9(4)  COMP VALUE 0.
     03 MPEX-ERRORS            PIC S9(4)  COMP VALUE 0.
 $IF X0=ON
     03 MS-I.
        05                     PIC S9(9)  COMP VALUE 0.
     03 MS-IN.
        05                     PIC S9(9)  COMP VALUE 0.
     03 MPEX-ERRORS            PIC S9(9)  COMP VALUE 0.
 $IF
  01 COM-IMAGE.
     03 COMMAND-IMAGE          PIC X(60)  VALUE SPACES.
     03                        PIC X      VALUE %15.
  01 COMMAND-ERROR             PIC S9(4)  COMP VALUE 0.
 *
  PROCEDURE DIVISION.
  A0000-DEFINE-MACROS.
 *
 $DEFINE %COMIMAGE=
         MOVE !1
                 TO COMMAND-IMAGE
         CALL INTRINSIC 'COMMAND' USING COM-IMAGE,
                                        COMMAND-ERROR,
                                        ERR-PARM
         IF COMMAND-ERROR = 975
            DISPLAY "UNKNOWN COMMAND NAME"
         END-IF#
 *
 $DEFINE %UPSHIFT=
         INSPECT !1 CONVERTING
         "abcdefghijklmnopqrstuvwxyz" TO
         "ABCDEFGHIJKLMNOPQRSTUVWXYZ"#
 *
  A1100-PROMPT.
      MOVE SPACES                  TO READ-BUFF.
      ACCEPT READ-BUFF FREE.
      %UPSHIFT(READ-BUFF#).
 
      IF READ-BUFF(1:1) = ":"
         %COMIMAGE(READ-BUFF(2:76)#)
         GO TO A1100-PROMPT.
 
      IF READ-BUFF(1:1) = "%"
         MOVE READ-BUFF(2:76)      TO MPEX-BUFF
         PERFORM G2000-MPEX      THRU G2000-EXIT
         GO TO A1100-PROMPT.
 *
  G2000-MPEX.
      IF MPEX-PIN = 0
         CALL INTRINSIC "CREATEPROCESS" USING MPEX-ERRORS,
                                              MPEX-PIN,
                                              MPEX-FILE,
                                              MS-I, MS-IN
         IF MPEX-ERRORS <> 0
            DISPLAY "Failure in CREATEPROCESS: " MPEX-ERRORS
            GO TO G2000-EXIT.
      CALL INTRINSIC 'SENDMAIL' USING MPEX-PIN, MSG-LEN,
                                      MPEX-BUFF, 0
                               GIVING MAIL-STAT.
      IF CC <> 0
         DISPLAY "Failure in SENDMAIL: " MAIL-STAT
         GO TO G2000-EXIT.
      CALL INTRINSIC 'ACTIVATE' USING MPEX-PIN, 3
      IF CC <> 0
         DISPLAY "Failure in ACTIVATE".
  G2000-EXIT.  EXIT.
 *

One of the first things you will notice in the Working-Storage section is that I use compilier switches to determine if this is Native Mode or Compatibility Mode. Some of the variable lengths in the CREATEPROCESS intrinsic change between the two platforms. This is a quick way to keep from having to make major changes in your code when switching from one platform to the other.

The next thing you should notice is that I am allowing both MPE commands and MPEX commands to be executed. If a command is prefaced with a colon ‘:’ then I give it to the COMMAND intrinsic. If it is prefaced with a percent sign ‘%’, then I pass it to MPEX.

In the G2000-MPEX paragraph, I first check the PIN number for MPEX to see if it is zero. If it is, then we need to create MPEX as a child process, pass it the command through the SENDMAIL intrinsic (We could pass it as an INFO string through CREATEPROCESS, but that wouldn’t let us just keep passing commands to it). We then need to ‘ACTIVATE’ MPEX. Once we activate MPEX it will execute the command we passed it in SENDMAIL and then return control back to the parent process. It essentially goes to sleep until it gets another command through the SENDMAIL intrinsic.

That’s really all there is to it. There aren’t a lot of steps, but you need to know what those steps are, and hopefully I have laid them out for you here. Sometime you should just try going through the intrinsics manual looking for interesting things to use, that is how
I learned them originally.