Inside COBOL #14
by
Shawn M. Gordon
President S.M.Gordon & Associates
Last month I claimed I was out of ideas, but in going through my handy bag of programming tricks, I found some stuff that I make extensive use of, so I thought you may as well. Some of these tricks have come from the very knowledgeable Walter Manise of CHEOPS Technology, who does the Q&A column for Interact. Actually, I always make sure to read Walter because you folks write in with some good questions, and the answers are very instructive. So you may see a little redundancy here if you are also an avid Q&A reader.
Have you ever used a program that saved and restored your function keys? Have you ever wondered how to do it? Well if you have, then you are in for a treat this month, I am going to show you a blow by blow of how to do it. Below is a complete listing for a callable routine to save and restore function keys. The first time it is called it will save the function keys, the next time it is called it knows that it has function key data, and will restore it. Go ahead
and look it over, then let’s go over some of what is happening.
$CONTROL USLINIT,BOUNDS,SUBPROGRAM
IDENTIFICATION DIVISION.
PROGRAM-ID. FKSAVE.
AUTHOR. SHAWN M. GORDON
INSTALLATION. S.M.GORDON & ASSOCIATES.
DATE-WRITTEN. TUE, MAY 8, 1990.
DATE-COMPILED.
ENVIRONMENT DIVISION.
CONFIGURATION SECTION.
SOURCE-COMPUTER. HP-3000.
OBJECT-COMPUTER. HP-3000.
SPECIAL-NAMES.
CONDITION-CODE IS CC.
DATA DIVISION.
WORKING-STORAGE SECTION.
*
01 STDIN PIC S9(4) COMP VALUE 0.
01 ERR PIC S9(4) COMP VALUE 0.
01 BUFF PIC X(1024) VALUE SPACES.
*
PROCEDURE DIVISION.
A1000-INIT.
* open terminal as STDIN and BINARY.
CALL INTRINSIC "FOPEN" USING \\, %2057, 0, -1024
GIVING STDIN.
IF CC <> 0
MOVE 1 TO ERR
GO TO E1000-STATUS.
*
* If this is called again then restore the function keys
*
IF BUFF <> SPACES
CALL INTRINSIC 'PRINT' USING BUFF, -1024, %320
DISPLAY %33 'U' %33 'J' %33 '&jB' NO ADVANCING
CALL INTRINSIC 'FCLOSE' USING STDIN, 0, 0
GOBACK.
*
* Allocate terminal
*
CALL INTRINSIC 'FCONTROL' USING STDIN, 37, ERR.
IF CC <> 0
MOVE 2 TO ERR
GO TO E1000-STATUS.
*
* Echo off
*
CALL INTRINSIC 'FCONTROL' USING STDIN, 13, ERR.
IF CC <> 0
MOVE 3 TO ERR
GO TO E1000-STATUS.
*
* Complete I/O
*
CALL INTRINSIC 'FCONTROL' USING STDIN, 2, ERR.
IF CC <> 0
MOVE 4 TO ERR
GO TO E1000-STATUS.
*
* Set INH Hand shake and Block Mode and set Page/Line to Page.
*
DISPLAY %33 '&s1G' %33 '&k1B' %33 '&s1D' %33 'j' %33 'H'
%33 'd' NO ADVANCING.
*
* Enable user block mode transfers
*
CALL INTRINSIC 'FCONTROL' USING STDIN, 29, ERR.
IF CC <> 0
MOVE 5 TO ERR
GO TO E1000-STATUS.
*
* Set terminal to un-edited mode and change read trigger to 'RS'
*
MOVE %36 TO ERR.
CALL INTRINSIC 'FCONTROL' USING STDIN, 41, ERR.
IF CC <> 0
MOVE 6 TO ERR
GO TO E1000-STATUS.
*
* Set 1-second timeout for read
*
MOVE 1 TO ERR
CALL INTRINSIC 'FCONTROL' USING STDIN, 4, ERR.
IF CC <> 0
MOVE 7 TO ERR
GO TO E1000-STATUS.
*
* Issue FREAD
*
CALL INTRINSIC 'FREAD' USING STDIN, BUFF, 1.
*
* Send CR/LF to start transfer
CALL INTRINSIC 'PRINT' USING BUFF, 0, 0.
*
* Bring in the fkey buffer
*
CALL INTRINSIC 'FREAD' USING STDIN, BUFF, -1024
IF CC <> 0
MOVE 8 TO ERR
GO TO E1000-STATUS.
*
* Echo on
*
CALL INTRINSIC 'FCONTROL' USING STDIN, 12, ERR.
IF CC <> 0
MOVE 9 TO ERR
GO TO E1000-STATUS.
*
* Reset all the stuff we turned on earlier.
*
DISPLAY %33 'k' %33 "F" %33 "&s1D" %33 "&k0B" %33 "&s0G"
%33 "m" %33 "J" NO ADVANCING.
*
CALL INTRINSIC 'FCLOSE' USING STDIN, 0, 0.
GOBACK.
A1000-EXIT. EXIT.
*
E1000-STATUS.
DISPLAY %33 'k' %33 "F" %33 "&s1D" %33 "&k0B" %33 "&s0G"
%33 "m" %33 "J" NO ADVANCING.
CALL INTRINSIC 'FCLOSE' USING STDIN, 0, 0.
DISPLAY "Problem " ERR " saving function keys".
GOBACK.
One of the first things you should have noticed, is that the control line specifies SUBPROGRAM. This keeps the program for reinitializing the variables every time it is called. That is how the program knows to restore the function keys on subsequent calls. One thing to keep in mind with this method, is that this subprogram is going to require global storage. That means you can’t put it in an SL or XL, you will have to link it into your main program. This may not be the most elegant way to do this, but it is the fastest. You could also write the function keys to a temporary file if you wanted.
The program is self documentating, but there are a couple of things worth noting. When you save the function keys, the only way to do it is to actually display the function key programming screen and do a block read of it. That is why you always see that screen come up when you save the function keys. To be totally honest, I am not sure why you have to perform some of these steps, since this worked it never seemed worth the time digging out what exactly each step got you. Whoever thought of this originally, really understood the HP terminal and what it could do.
This next one is fairly recent piece of information from the Q&A column, but it was timely for me. It has to do with generating random numbers in COBOL. The ’89 COBOL addendum adds the RANDOM function to the language, but if you don’t have or don’t use the ’89 addendum then there is still a way to do it using the Compiler Library functions RAND1 (to generate the seed), and RAND (which generates pseudo-random numbers). Until I saw this trick I would usually use the CLOCK intrinsic, or the time to get a sort of random number, but I was running into to many collisions. So here is a small program that will generate random numbers for you.
$CONTROL USLINIT,BOUNDS
IDENTIFICATION DIVISION.
PROGRAM-ID. RANDOM.
AUTHOR. SHAWN GORDON.
DATE-WRITTEN. THU, NOV 10, 1994.
DATE-COMPILED.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
77 RAND PIC S9(9) COMP VALUE 0.
77 SEED PIC S9(9) COMP VALUE 0.
PROCEDURE DIVISION.
A1000-INIT.
CALL INTRINSIC 'RAND1' GIVING SEED.
PERFORM 10 TIMES
CALL INTRINSIC 'RAND' USING SEED GIVING RAND
DISPLAY 'RANDOM value is: ' RAND
END-PERFORM.
STOP RUN.
:RUN RANDOM
RANDOM value is: +060448496
RANDOM value is: +065213493
RANDOM value is: +048424960
RANDOM value is: +045054471
RANDOM value is: +025850186
RANDOM value is: +062813325
RANDOM value is: +052874411
RANDOM value is: +061847241
RANDOM value is: +059910710
RANDOM value is: +050117509
As you can see, we first get a ‘seed’ value to pass to the RAND function. We then go through the loop 10 times, just to see what the output is going to look like.
Next month we will cover building a comprehensive virtual reality system on any HP 3000 using conventional COBOL and a serial link to a Sega game machine.