Inside COBOL
by
Shawn M. Gordon
President SMGA

One of the things that many people complain about COBOL is it’s inability to work directly with bits. There are various intrinsic call’s that return an integer whose different bits indicate values being on or off. A good example of this is the WHO intrinsic, it returns two pieces of information that can be very critical to find out, but they are both in integer bit mask’s, they are ‘MODE’ indicating if you are a job or session, and the capability list.

For me, I like to know if I have PM cap so I can call GETPRIVMODE for
various functions. Years ago I wrote a program that would go through
a series of calculations to figure out which bits were on and which
were off. Of course as we all live and learn, ane eventually I found a
better and easier way to deal with it. There is an intrinsic called
BITMAPCNV that will perform a couple of different functions. One of
these functions will convert an integer bit mask into a byte array,
the other function is to take a byte array and convert it into an
integer bit mask. The only problem with this intrinsic is that it is
documented in the V/PLUS manual and not in the INTRINSICS manual.
Apparently the authors felt that we would only care about doing
this in the context of VIEW.

What I will do first this month is show you a short program that will
call the WHO intrinsic and then convert the capability list into
a byte array that we can make use of. Notice that the capability
mask is returned in two double integers so we have to call BITMAPCNV
twice, once for each half of the array.

 WORKING-STORAGE SECTION.

  01 CAPS.
     03 CFULL             PIC S9(9)     COMP VALUE 0.
     03 CREDEF          REDEFINES CFULL.
        05 CWORD1         PIC S9(4)     COMP.
        05 CWORD2         PIC S9(4)     COMP.

  01 NUMBYTES             PIC S9(4)     COMP VALUE 16.
  01 BYTEFUNC             PIC S9(4)     COMP VALUE 1.
  01 BYTERR               PIC S9(4)     COMP VALUE 0.

  01 CAP1.
     03 SMCAP             PIC X.
     03 AMCAP             PIC X.
     03 ALCAP             PIC X.
     03 GLCAP             PIC X.
     03 DICAP             PIC X.
     03 OPCAP             PIC X.
     03 CVCAP             PIC X.
     03 UVCAP             PIC X.
     03 LGCAP             PIC X.
     03                   PIC X(02)     VALUE SPACES.
     03 NACAP             PIC X.
     03 NMCAP             PIC X.
     03 CSCAP             PIC X.
     03 NDCAP             PIC X.
     03 SFCAP             PIC X.

  01 CAP2. 
     03                   PIC X(07)     VALUE SPACES.
     03 BACAP             PIC X.
     03 IACAP             PIC X.
     03 PMCAP             PIC X.
     03                   PIC X(02)     VALUE SPACES.
     03 MRCAP             PIC X.
     03                   PIC X         VALUE SPACES.
     03 DSCAP             PIC X.
     03 PHCAP             PIC X.

 PROCEDURE DIVISION.

      CALL INTRINSIC "WHO" USING \\, CFULL.
      CALL "BITMAPCNV" USING CWORD1, @CAP1, NUMBYTES,
                             BYTEFUNC, BYTERR.
      IF BYTERR <> 0
         DISPLAY 'Failure in BITMAPCNV for CAP1 ' BYTERR.

      CALL "BITMAPCNV" USING CWORD2, @CAP2, NUMBYTES,
                             BYTEFUNC, BYTERR.
      IF BYTERR <> 0
         DISPLAY 'Failure in BITMAPCNV for CAP2 ' BYTERR.

      DISPLAY 'Byte Array for cap word 1: ' CAP1.
      DISPLAY 'Byte Array for cap word 2: ' CAP2.
      STOP RUN.

Now each of these fields will have a ‘1’ in it if it is on, and a ‘0’ if it is off. Note that my layout for the capabilities list is correct, some versions of the Intrinsics manual have a typo that has some of the capabilities mixed up. Also note that they layout of the second word of the capability list is identical as that found inside an executable program to describe it’s own capabilities. In a later column I may show you some of what is in an executable program, and how to access and make use of it.

Also note that we don’t use the word INTRINSIC when making this call. Since it is part of the V/PLUS library it adheres to the same rules.

The use of the @ sign in front of CAP1 and CAP2 means that a pointer to the byte array will be passed, and not the byte array itself. This kind of thing is very common in C (not the @ sign, but passing pointers to byte arrays to functions instead of the byte array itself which is usually much larger than a pointer). You don’t really need to understand what it is as long as you make sure that you use it.

Here is another little tidbit for you. Did you know you can use a variable name in your SELECT..ASSIGN clause for run time resolution of the file? This means you don’t have to issue programmatic file equations or use FOPEN because you will be having variable files to work with. Here is how it works.

FILE-CONTROL.
     SELECT PROCFILE  ASSIGN TO "DUMMY" USING PROC-FILE.
DATA DIVISION.
FILE SECTION.

FD PROCFILE
01 PROCFILE-RECORD     PIC X(80).

WORKING-STORAGE SECTION.

01 PROC-FILE           PIC X(26).

PROCEDURE DIVSION.
A1000-INIT.
     DISPLAY 'Enter file to process ' NO ADVANCING.
     ACCEPT PROC-FILE FREE.
     OPEN  INPUT  PROCFILE.

Now you can go on your merry way and read the file. The file name in the ASSIGN section is ignored when USING is specified, but you have to put something there.

That’s it for this month, who knows what’s in store for next month.