Inside COBOL #50 (User Tips)
by
Shawn Gordon
President
The Kompany

There has recently been some good dialog on the HP3000 list server about different things concerning COBOL. First there was a discussion on using the PAUSE intrinsic in COBOL. The funky thing about the PAUSE intrinsic is that it requires a REAL number value as it’s parameter, the problem with this is that you cannot make use of a REAL in COBOL. So what I did originally based on a COBOL tip sheet I read around 10 years ago, was using these strange octal values that would somehow be translated to the correct time, for example.

  01 10-SEC-PAUSE.
     05                   PIC S9(4)     COMP VALUE %40320.
     05                   PIC S9(4)     COMP VALUE 0.
  01 PAUSE1  REDEFINES 10-SEC-PAUSE PIC S9(9) COMP.

         CALL INTRINSIC "PAUSE" USING PAUSE1

Then I found out about a library function called EXTIN’ (note the single quote at the end), there is a whole series of these for converting between types, but I only ever used it to get pause times for the PAUSE intrinsic. Basically you pass the routine the number of seconds you want, and it returns the REAL value that you can then pass to PAUSE, as in;


  01 PAUSE-INFO.
     03 L3                    PIC S9     COMP VALUE 3.
     03 EX-ERR                PIC S9     COMP.
     03 SEC-ASCII             PIC 9(03)  VALUE ZEROES.
     03 SEC-REAL              PIC S9(5)  COMP SYNC.

      CALL "EXTIN'" USING @SEC-ASCII, L3, \0\, \1\, \0\, \0\,
                          SEC-REAL, EX-ERR.

      CALL INTRINSIC "PAUSE" USING SEC-REAL.

Our first tip comes from John Zoltak, and it’s a new way to pause, that is really a bastardization of another intrinsic that I had never seen or used till now. This is the HPSELECT intrinsic, and it is actually designed to wait on socket connections, but if you don’t specify any sockets, then it will just pause. You are actually passing a 64 bit integer that specifies the seconds in the first 32 bits, and the milliseconds in the next 32 bits, so you can actually achieve an even greater level of granularity. Here is the syntax;

01 RETURN-STATUS       PIC S9(9) COMP. 
01 TIME-VALUES.
   05 TIME-IN-SECONDS  PIC S9(9) COMP. 
   05 TIME-IN-MSECS    PIC S9(9) COMP. <:f>

     MOVE 5 TO TIME-IN-SECONDS. 
     MOVE 0 TO TIME-IN-MSECS. 

CALL INTRINSIC "HPSELECT" USING \0\, \\, \\,\\,
                               TIME-VALUES, RETURN-STATUS.

My next item was sparked by a posting from Ray Potts at Bi-Tech, where he had posted some performance numbers comparing using the MOVE FUNCTION CURRENT-DATE to just MOVE CURRENT-DATE. The time difference on 10,000 iterations was staggering, however not entirely fair. If you use MOVE CURRENT-DATE you will end up with a field that is in MM/DD/YY format, whereas MOVE FUNCTION CURRENT-DATE will return a century date as well as time down to the hundredths of a second and offset from GMT.

I built my own test to run through 100,000 iterations because I had a fast box that was not being used, and I wanted to see the larger impact. I did two variations of three different tests. The first time through I compare the MOVE FUNCTION to MOVE, and to calling the CALENDAR, and FMTCALENDAR intrinsics (because that will give us century. Here are the numbers

CPU            WALL       TIMES              TYPE
.812             .814     100,000            CURRENT-DATE
17.89          16.73      100,000            MOVE FUNCTION CURRENT-DATE
2.134          2.138      100,000            INTRINSICS

Now to make it a little more fair I included logic to reformat CURRENT-DATE into YYMMDD format (which is redundant because you can say ACCEPT VAR FROM DATE and get the same result), but this doesn’t give you century. The only option that quickly gives you century liked MOVE FUNCTION CURRENT-DATE is to use a combination of CALENDAR, FMTCALENDAR and ACCEPT FROM DATE, and then move the two fields to a single field that will contain CCYYMMDD So that is what is in our INTRINSICS category.


CPU            WALL       TIMES                  TYPE
.828           .830       100,000                CURRENT-DATE
16.56        16.93        100,000                MOVE FUNCTION CURRENT-DATE
2.148         2.152       100,000                INTRINSICS

So what we can determine is that going through the three calls, CALENDAR, FMTCALENDAR and ACCEPT FROM DATE takes almost 3 times longer than just a move of CURRENT-DATE, it is still 8 times faster than using MOVE FUNCTION CURRENT-DATE, and has the advantage of also giving you the century.

Doing a little stack tracing I was able to determine that MOVE FUNCTION CURRENT-DATE actually calls an intrinsic called HPGMTSECS, and also makes an access to the COBOL library function COB_TZ_DATE in XL.PUB.SYS. It actually makes LESS calls than the other processes we tried, but it appears to just be very inefficient.

That wraps it up for this month, keep those ideas flowing, and questions coming.