Repairing a female Molex .156 Found on Pinball Games

I recently purchased the pinball game Funhouse, my all time favorite. The machine was refurbished and looks brand new inside and out.

Shortly after receiving it I noticed that coin door functions were working erratically. Most importantly, the buttons used to program the unit are on the back of the coin door were misbehaving.

Researching the Problem

The coin door wiring harness comes into the game and connects to the coin door interface board:

Pulling the connector off the door I could test for continuity, but clearly just looking into the connector some of the pins inside looked different than the others. Turned out they were broken and might or might not make an electrical connection.

Using a tiny screw driver, I was able to press against the metal tab (circled) of the pin to allow it to be extracted:

A good pin should look like this:

Several of them looked more like this, the spring part had snapped off:

Clearly, this connector needed to be rebuilt.

Obtaining the Parts

There are several pinball specialty companies out there that sell these parts. I ended up purchasing parts from Marcos Specialties and Pinball Life. It was from these sites that I learned these are Molex .156 connectors. You can also find these parts (except the key post) from  Mouser, Digikey, and Jameco.

From Pinball Life I purchased:

Tools

Besides the small screw driver and a wire cutter, I needed a crimper plus I went with a fancy wire stripper that allows me to consistently strip insulation at the same length. I don’t want to cut any more wire than absolutely necessary from this old pinball game.

Building the New Cable End

I’m not going to spend time going over how to build the cable ends. You can find a general overview of the procedure here:

How to re-pin Molex connectors

A procedure for crimping the terminals to the wires can be found here:

MOLEX & OPEN BARREL PIN CRIMPING

Some Additional Notes

I wanted to make sure my new cable end was keyed so I could not connect it upside down. I guarantee some day I will try to. That is the function of the polarizing key. I inserted it into the same terminal hole as it was on the hold connector:

With the polarizing key installed, it was then just a matter of extracting the terminal from the old connector, cutting the old terminal off, stripping, crimping the new one on, and inserting the terminal into the PROPER hole in the new connector.

Here is the completed connector. Note that there is one hole without a terminal.

The connector is then connected back onto the coin door interface board and tested. Success!

After completing the project, I decided to see if my old IWISS Dupont pin crimper would work. It does, and it will make both crimps at the same time.

 

Posted in c-electronics, c-retro | Tagged , , , | Leave a comment

GnuCOBOL’s Report Writer Module

I am finally to my goal made at the beginning of this (lousy) year! Use embedded SQL to extract data from a database and the COBOL report writer to produce a printed report. Thus, this is the last planned post for GnuCOBOL.

In 1979 when I started my career, I was a programmer for (what is now) Texas Statue University’s Administrative Data Processing department. Paper reports were big and even bigger at the university where few humans in the Admin dept had access to a terminal.

A year later I went on to a much better paid position (the university could get by with paying less than minimum wage) where I used COBOL on a Hewlett-Packard HP3000 which was my machine of choice for the rest of my professional programming career. UNFORTUNATELY, HP decided not to implement the Report Writer module (the Report Writer was an optional module in the COBOL standard).

I can remember banging my head on the wall because it was extremely boring to have to manage the details of writing a report by hand. As time went by I eventually completely forgot how the Report Writer even works, but I never forgot I would prefer to have it!

To write the test program for this post, I had to relearn the report writer. It really isn’t too difficult to do so. But you do have to learn quite a few things simultaneously to make it work.

Note, I had originally intended to also use SORT INPUT/OUTPUT PROCEDURES to sort the data as done in the prior post. My initial version of the program did that, but there was a lot more code than I wanted for an example. Given one most likely wouldn’t use COBOL SORT when extracting data from a database, I decided to forgo the COBOL SORT.

Resources

The GnuCOBOL manual (3.1) has an entire section (section 9) on how to use the Report Writer. I also found this tutorial quite useful.

COBOL Report Writer Feature

It is written for IBM MVT COBOL, but there are few differences between that and GnuCOBOL.

The GnuCOBOL FAQ also has a section on the report writer, with an example derived from the above tutorial.

Designing The Report

As with the prior example, I want to design a DVD rental history report but now that I’m using the report writer, it will have headings, counts, and footings. A real report.

As I was working on this projects, I thought back to the president of the company I worked at long ago. He designed ALL reports and we programmers implemented them. The reports were the face of our company and he wanted them to look good. Indeed they did, his reports were probably the best I’ve seen. Especially these days when many reports are just an after thought.

When he gave us a report to implement it was on an official IBM Report Layout form like this (found at http://ibm-1401.info/IBM1401_ArchivePics.html)

Totally off topic, but notice the Carriage Control Tape column on the far left. When using old printers like the IBM 1403, you could advance to a particular line by if there was a punch in that tape. Channel 1 of the tape was always top of the form and typically we used used a tape with only that channel punched. But if you need to print a report that was largely empty space, like may be a check or a utility bill, you could very quickly slew to the line you needed by advancing to the appropriate channel. For example:

WRITE PRINT-REC AFTER ADVANCING TO-CHECK-AMT-LINE.

That old 1403 printer could print amazingly fast for something so large. And standing next to it was about like standing next to a gattling gun (or so it seems to me now).

Popping the stack back to my original train of thought: My input data is this data base:

I’ll use this query to extract the data:

select 
    customer.customer_id,
    customer.last_name,
    customer.first_name,
    film.title,
    to_char(rental.return_date,'yyyymmdd') as 
        sorteddate
from customer
inner join rental    on 
    customer.customer_id = rental.customer_id
left  join inventory on 
    rental.inventory_id  = inventory.inventory_id
left  join film      on 
    inventory.film_id    = film.film_id
order by customer.last_name, customer.first_name, 
    sorteddate

and will produce a report that looks like this:

11/12/2020                                               PAGE:  1
---------------------CUSTOMER HISTORY REPORT---------------------

------------NAME------------ CUST                      ---DATE---
-----LAST------ ---FIRST---- -ID- -----DVD TITLE------ -RETURNED-

I will want to report the total DVDs each customer has rented, the total number of DVDs rented, and the total number of customers reported.

A Simpler Report Writer Program First

It took me some time to get my head around the operation of the report writer.It’s not hard, just different. nearly everything is specified in the DATA DIVISION not the PROCEDURE DIVISION.

I started by writing a program that didn’t do report control breaks. Omitting the control footings makes the reporting easier to understand.

The program source can be found at http://www.xyfyx.com/files/reportWriter01.cob

Here is notable parts of the code with comments:

Below is the output file that will contain the report. LINE SEQUENTIAL indicates when each line is written it should be terminated with the appropriate line terminator for the operating system being used.

 ENVIRONMENT DIVISION.
 INPUT-OUTPUT SECTION.
 FILE-CONTROL.
 
     SELECT RF-REPORT-FILE,
         ASSIGN TO               "./reportWriter01.lst",
         ORGANIZATION IS         LINE SEQUENTIAL.
...         
 FD  RF-REPORT-FILE,
     REPORT IS                   RF-REPORT.

These fields are used to format dates:

 WORKING-STORAGE SECTION.

...

 01  DB-REC.
     03  DB-CUSTID               PIC 9(9).
     03  DB-LASTNAME             PIC X(45).
     03  DB-FIRSTNAME            PIC X(45).
     03  DB-FILMTITLE            PIC X(45).
     03  DB-RETURNDATE           PIC 99999999.

...

 01  TF-TEMP-FIELDS.
     03  TF-DATE-IN.
         05  TF-YY               PIC 9999.
         05  TF-MM               PIC 99.
         05  TF-DD               PIC 99.
     03  TF-DATE-OUT             PIC X(10).    
     03  TF-RUNDATE-IN.
         05  TF-RUNDATE-YY       PIC 9999.
         05  TF-RUNDATE-MM       PIC 99.
         05  TF-RUNDATE-DD       PIC 99.
     03  TF-RUNDATE-OUT          PIC X(10).    
         
... 

At the end of the DATA DIVISION is the REPORT SECTION which will describe (usually) everything needed to produce the report.

  • Page Limit: Number of lines per page.
  • Heading: line upon which the first header line is printed.
  • First Detail: line upon which the first detail line is printed.
  • Last detail: line upon which the last detail line of the page can be printed.
REPORT SECTION.

RD  RF-REPORT,
    PAGE LIMIT                  66 LINES,
    HEADING                     1,
    FIRST DETAIL                7,
    LAST DETAIL                 60.

This next section defines the header lines to be printed. The first line is on the absolute position of LINE 1, then each line after is placed on the next physical line (LINE PLUS 1) or 2 lines down (LINE PLUS 2).

Within each line are column definitions. For this report I’m specifying exact column placement. SOURCE indicated this column will contain the specified field using the specified PIC. So the report’s run date starts in column 1, comes from TF-RUNDATE-OUT and will take 20 characters.

The constant “PAGE” is placed at column 58. Note that you do not have to use PIC for values. The next example will show a more concise page definition.

01  PAGE-HEAD-GROUP TYPE PAGE HEADING.
    03  LINE 1.
        05  COLUMN 1            PIC X(20),
                SOURCE TF-RUNDATE-OUT.
        05  COLUMN 58           PIC X(6),
                VALUE "PAGE: ".
        05  COLUMN 64           PIC Z9,
                SOURCE PAGE-COUNTER.
    03  LINE PLUS 1.
        05  COLUMN 1            PIC X(21),
                VALUE ALL "-".
        05  COLUMN 22            PIC X(23),
                VALUE "CUSTOMER HISTORY REPORT".
        05  COLUMN 45           PIC X(21),
                VALUE ALL "-".
    03  LINE PLUS 2.
        05  COLUMN 1            PIC X(28),
                VALUE "------------NAME------------".
        05  COLUMN 30           PIC XXXX,
                VALUE "CUST".
        05  COLUMN 56           PIC X(10),
                VALUE "---DATE---".
    03  LINE PLUS 1.
        05  COLUMN 1            PIC X(15),
                VALUE "-----LAST------".
        05  COLUMN 17           PIC X(12),
                VALUE "---FIRST----".
        05  COLUMN 30           PIC XXXX,
                VALUE "-ID-".
        05  COLUMN 35           PIC X(20),
                VALUE "-----FILM TITLE-----".
        05  COLUMN 56           PIC X(10),
                VALUE "-RETURNED-".

The detail line is laid out in the same manner. Each field is SOURCEd from the database record (except the date).

01  DETAIL-LINE TYPE DETAIL.
    03  LINE PLUS 1.
        05  COLUMN 1            PIC X(15),
                SOURCE DB-LASTNAME.
        05  COLUMN 17           PIC X(12),
                SOURCE DB-FIRSTNAME.
        05  COLUMN 30           PIC ZZZ9,
                SOURCE DB-CUSTID.
        05  COLUMN 35           PIC X(20),
                SOURCE DB-FILMTITLE.
        05  COLUMN 56           PIC X(10),
                SOURCE TF-DATE-OUT.
...

In the procedure division, the RUN DATE is derived from the system date:

    ACCEPT TF-RUNDATE-IN            FROM DATE YYYYMMDD.
    STRING TF-RUNDATE-MM, "/", TF-RUNDATE-DD, "/", 
        TF-RUNDATE-YY               INTO TF-RUNDATE-OUT.
...

After the cursor is setup, we are ready to begin reading records and printing them. DON’T forget to open the report file (I did at first. No error is generated, but I couldn’t find any output).

The INITIATE verb initiates the report.

    OPEN OUTPUT RF-REPORT-FILE.
    INITIATE RF-REPORT.
...

This is the “heart” of printing. Each line is read from the database, and we simply GENERATE-DETAIL line to print the report – it handles all of the details of printing for us.

    PERFORM UNTIL SQLCODE NOT = ZERO,
        ...    
        GENERATE DETAIL-LINE;
        
        EXEC SQL 
            FETCH C1 INTO 
                :DB-CUSTID,
                :DB-LASTNAME,
                :DB-FIRSTNAME,
                :DB-FILMTITLE,
                :DB-RETURNDATE
        END-EXEC;
    END-PERFORM.
...

We’ve read all of the data, so terminate the report, and close it.

    TERMINATE RF-REPORT.    
    CLOSE RF-REPORT-FILE.
...

As you can see ALL of the work of generating the report is setting up the REPORT SECTION. Even without the report writer you still have to define how the output will appear, so there isn’t much extra necessary to use the report writer.

Compile and run:

$export COBCPY=~/Open-COBOL-ESQL-1.2/copy
$export COB_LDFLAGS=-Wl,--no-as-needed
$ocesql reportWriter01.cob reportWriter01.tmp
precompile start: reportWriter01.cob
=======================================================
              LIST OF CALLED DB Library API            
=======================================================
;
;
;
;
;
;
Generate:OCESQLConnect
Generate:OCESQLCursorDeclare
Generate:OCESQLCursorOpen
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorClose
Generate:OCESQLDisconnect
Generate:ROLLBACK
=======================================================
$cobc  -locesql -x reportWriter01.tmp

Excerpts from the output file:

less reportWriter01.lst 

11/11/2020                                               PAGE:  1
---------------------CUSTOMER HISTORY REPORT---------------------

------------NAME------------ CUST                      ---DATE---
-----LAST------ ---FIRST---- -ID- -----FILM TITLE----- -RETURNED-

Abney           Rafael        505 Sagebrush Clueless   05/29/2005
Abney           Rafael        505 Pocus Pulp           06/05/2005
Abney           Rafael        505 Legally Secretary    06/19/2005
Abney           Rafael        505 Nightmare Chill      06/20/2005
Abney           Rafael        505 Trading Pinocchio    06/28/2005
Abney           Rafael        505 Coneheads Smoochy    06/28/2005
Abney           Rafael        505 Wanda Chamber        07/12/2005
Abney           Rafael        505 Madness Attacks      07/14/2005
Abney           Rafael        505 Conquerer Nuts       07/14/2005

...

Adams           Kathleen       36 Go Purple            06/20/2005
Adams           Kathleen       36 Betrayed Rear        07/10/2005
Adams           Kathleen       36 Room Roman           07/11/2005


11/11/2020                                               PAGE:  2
---------------------CUSTOMER HISTORY REPORT---------------------

------------NAME------------ CUST                      ---DATE---
-----LAST------ ---FIRST---- -ID- -----FILM TITLE----- -RETURNED-

Adams           Kathleen       36 Boogie Amelie        07/12/2005
Adams           Kathleen       36 Swarm Gold           07/12/2005
Adams           Kathleen       36 Amadeus Holy         07/16/2005

...

11/11/2020                                               PAGE: 98
---------------------CUSTOMER HISTORY REPORT---------------------

------------NAME------------ CUST                      ---DATE---
-----LAST------ ---FIRST---- -ID- -----FILM TITLE----- -RETURNED-

Young           Cynthia        28 Ice Crossing         08/23/2005
Young           Cynthia        28 Saddle Antitrust     08/24/2005
Young           Cynthia        28 Lebowski Soldiers    08/27/2005
Young           Cynthia        28 Loverboy Attacks     08/27/2005
Young           Cynthia        28 Attacks Hate         08/28/2005
Young           Cynthia        28 Suspects Quills      00/00/0000

The Final Version of the Program

The above report handles the header and detail lines great. Now I want to add in control breaks to report the number of DVDs each customer has rented, and at the end the total number of DVDs rented and the total number of customers reported.

Unfortunately there was no dollar amounts in this data upon which to report. The report writer can handle totaling detail line amounts with almost no more work than the above report by just using the SUM clause.

Instead, I want to count records which will add just a slight bit more complexity.

The source to this program can be found at http://www.xyfyx.com/files/reportWriter02.cob.

Here are notable parts of the code with comments:

 IDENTIFICATION DIVISION.

...

 WORKING-STORAGE SECTION.

I’m going to need CS-1, a constant of ONE used to add each DVD detail printed. I’m also going to need a counter to track the total number of customers reported.

 01  CS-CONSTANTS.
     03  CS-1                    PIC S9(4), COMP     VALUE 1.
 01  CT-COUNTERS.
     03  CT-CUSTS                PIC S9(9), COMP     VALUE ZERO.

...

I made a couple of changes for the database record read. I added DB-CUSTNAME. I need to know if either DB-LASTNAME or DB-FIRSTNAME changes, so I grouped them into DB-CUSTNAME.

I also altered how I handle DB-RETURNDATE. I want to STRING month, day, year together but OCESQL requires that the field containing the date from the database be an elementary item. To more cleanly handle this, I REDEFINE DB-RETURNDATE which allows access to the individual fields.

 01  DB-REC.
     03  DB-CUSTID               PIC 9(9).
     03  DB-CUSTNAME.
         05  DB-LASTNAME         PIC X(45).
         05  DB-FIRSTNAME        PIC X(45).
     03  DB-DVDTITLE             PIC X(45).
     03  DB-RETURNDATE           PIC 99999999.
     03  FILLER REDEFINES        DB-RETURNDATE.
         05  DB-YYYY             PIC 9999.
         05  DB-MM               PIC 99.
         05  DB-DD               PIC 99.
     
...

* ---------------------------------------------------------------
 REPORT SECTION.

In the RD, I now have the controls FINAL and DB-CUSTNAME. Every time DB-CUSTNAME changes a control break occurs. Also at the end of the report (FINAL) a control break occurs.

  RD  RF-REPORT,                  
     CONTROLS ARE                FINAL, DB-CUSTNAME,     
     PAGE LIMIT                  60 LINES,
     HEADING                     1,
     FIRST DETAIL                7,
     LAST DETAIL                 60.
...

I made a slight change to the header. Line 1 now contains a form feed character which will allow it to print on pretty much any modern printer.

    
 01  PAGE-HEAD-GROUP TYPE PAGE HEADING.
     03  LINE 1.                 *> *** FORMFEED
         05  COLUMN 1            VALUE X'0C'.
     03  LINE PLUS 1.
         05  COLUMN 1            PIC X(20),
             SOURCE TF-RUNDATE-OUT.
         05  COLUMN 58           VALUE "PAGE: ".
         05  COLUMN 64           PIC Z9,
             SOURCE PAGE-COUNTER.

In this report, I drop absolute column positions (except COLUMN 1) and use relative (PLUS n). In this next section, each field is adjacent to the next so I use PLUS 1. Typically I would want a space between columns and in the detail line you will see everything set at PLUS 2.

Also note that the PIC clause is now omitted as well. If omitted, the compiler derives the length from the VALUE clause.

     03  LINE PLUS 1.
         05  COLUMN 1            PIC X(21),
             VALUE ALL "-".
         05  COLUMN PLUS 1       VALUE "CUSTOMER HISTORY REPORT".
         05  COLUMN PLUS 1       PIC X(21),
             VALUE ALL "-".
     03  LINE PLUS 2.
         05  COLUMN 1            VALUE "------------".
         05  COLUMN PLUS 1       VALUE "NAME------------".
         05  COLUMN PLUS 2       VALUE "CUST".
         05  COLUMN 56           VALUE "---DATE---".
     03  LINE PLUS 1.
         05  COLUMN 1            VALUE "-----LAST------".
         05  COLUMN PLUS 2       VALUE "---FIRST----".
         05  COLUMN PLUS 2       VALUE "-ID-".
         05  COLUMN PLUS 2       VALUE "-----DVD TITLE------".
         05  COLUMN PLUS 2       VALUE "-RETURNED-".

The DETAIL-LINE is very nearly like the last report. Each column contains the appropriate PIC clause to format the data, a SOURCE clause indicating where to obtain the data, and a relative column position.

Note the use of GROUP INDICATE. This clause causes the associated field to be omitted after the first time it is printed on each page. This makes the report much easier to read and saves some ink as well.

 01  DETAIL-LINE TYPE DETAIL.
     03  LINE PLUS 1.
         05  COLUMN 1            PIC X(15),
             SOURCE DB-LASTNAME,
             GROUP INDICATE.                 *> PRINTS ONLY ONCE
         05  COLUMN PLUS 2       PIC X(12),
             SOURCE DB-FIRSTNAME,
             GROUP INDICATE.
         05  COLUMN PLUS 2       PIC ZZZ9,
             SOURCE DB-CUSTID,
             GROUP INDICATE.
         05  COLUMN PLUS 2       PIC X(20),
             SOURCE DB-DVDTITLE.
         05  COLUMN PLUS 2       PIC X(10),
             SOURCE TF-DATE-OUT.

This is the footing group that will print at the end of each customer. In consists simply of a label and the number of DVDs rented.

The DVD count is obtained by using SUM CS-1. This will add 1 to an internal counter for each detail line printed for the customer. Had the database contained an amount field, say DB-AMOUNT, you could use SUM DB-AMOUNT and get the total amount for all records.

 01  CUST-TOTAL TYPE CONTROL FOOTING DB-CUSTNAME,
     NEXT GROUP IS PLUS 2.
     03  LINE PLUS 1.
         05  COLUMN 35           VALUE "---CUSTOMER RENTALS:".
         05  COLUMN 61           PIC Z,ZZ9,
             SUM CS-1.           *> *** ADDING 1 PER RECORD

Here is the report totals print group (FINAL FOOTING).

The total DVDs rented is obtains in the same manner as above, by SUMming CS-1.

The customer count has to manually be calculated.

 01  FINAL-GROUP TYPE CONTROL FOOTING FINAL.
     03  LINE PLUS 2.
         05  COLUMN 35           VALUE "------TOTAL RENTALS:".
         05  COLUMN 59           PIC ZZZ,ZZ9,
             SUM CS-1.
     03  LINE PLUS 2.
         05  COLUMN 35           VALUE "----TOTAL CUSTOMERS:".
         05  COLUMN 59           PIC ZZZ,ZZ9,
             SOURCE CT-CUSTS.

* ---------------------------------------------------------------
 PROCEDURE DIVISION.

Here is how the customer count is calculated, in the DECLARATIVES.

This bit of code is executed before each CUST-TOTAL report footing (e.g. the end of each customer).

It simply adds 1 to CT-CUSTS to maintain a running count of customers encountered during the report print.

 
 DECLARATIVES.
 
 00 SECTION.
     USE BEFORE REPORTING CUST-TOTAL.
 
 00-CUST-TOTAL.
 
     ADD 1                       TO CT-CUSTS.
 
 END DECLARATIVES.    

...

The report is generated in the same manner (with a slight change in how I used STRING to generate the date).

     OPEN OUTPUT RF-REPORT-FILE.
     INITIATE RF-REPORT.

     PERFORM UNTIL SQLCODE NOT = ZERO,
         STRING DB-MM, "/", DB-DD, "/", DB-YYYY
             INTO                TF-DATE-OUT;
             
         GENERATE DETAIL-LINE;
         
         EXEC SQL 
             FETCH C1 INTO 
                 :DB-CUSTID,
                 :DB-LASTNAME,
                 :DB-FIRSTNAME,
                 :DB-DVDTITLE,
                 :DB-RETURNDATE
         END-EXEC;
     END-PERFORM.

     TERMINATE RF-REPORT.    
     CLOSE RF-REPORT-FILE.

...         

To compile and run the final report:

$export COBCPY=~/Open-COBOL-ESQL-1.2/copy
$export COB_LDFLAGS=-Wl,--no-as-needed
$ocesql reportWriter02.cob reportWriter02.tmp
precompile start: reportWriter02.cob
=======================================================
              LIST OF CALLED DB Library API            
=======================================================
;
;
;
;
;
;
Generate:OCESQLConnect
Generate:OCESQLCursorDeclare
Generate:OCESQLCursorOpen
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorClose
Generate:OCESQLDisconnect
Generate:ROLLBACK
=======================================================
$cobc  -locesql -x reportWriter02.tmp

Excerpts from the output file:

^L
11/12/2020                                               PAGE:  1
---------------------CUSTOMER HISTORY REPORT---------------------

------------NAME------------ CUST                      ---DATE---
-----LAST------ ---FIRST---- -ID- -----DVD TITLE------ -RETURNED-
Abney           Rafael        505 Sagebrush Clueless   05/29/2005
                                  Pocus Pulp           06/05/2005
                                  Legally Secretary    06/19/2005
                                  Nightmare Chill      06/20/2005
                                  Trading Pinocchio    06/28/2005
                                  Coneheads Smoochy    06/28/2005
                                  Wanda Chamber        07/12/2005
                                  Madness Attacks      07/14/2005
                                  Conquerer Nuts       07/14/2005
                                  Double Wrath         07/16/2005
                                  Goodfellas Salute    07/20/2005
                                  Hobbit Alien         08/05/2005
                                  Shock Cabin          08/06/2005
                                  Karate Moon          08/08/2005
                                  Juggler Hardly       08/10/2005
                                  Strictly Scarface    08/20/2005
                                  Blackout Private     08/23/2005
...

                                  Freddy Storm         08/28/2005
                                  Chocolat Harry       08/28/2005
                                  Clash Freddy         08/28/2005
                                  Conversation Downhil 00/00/0000
                                  ---CUSTOMER RENTALS:         21


Adam            Nathaniel     504 Kiss Glory           05/31/2005
                                  Gathering Calendar   06/04/2005
                                  Noon Papi            06/06/2005
                                  Guys Falcon          06/26/2005
                                  Shepherd Midsummer   06/27/2005
                                  Ending Crowds        07/12/2005
                                  Hanging Deep         07/13/2005
                                  Chasing Fight        07/15/2005
                                  Something Duck       07/15/2005
                                  Nemo Campus          07/18/2005
                                  Poseidon Forever     07/30/2005
                                  Divorce Shining      07/30/2005
                                  Jason Trap           08/01/2005
                                  Sleuth Orient        08/02/2005
                                  Tramp Others         08/03/2005
                                  Tights Dawn          08/04/2005
                                  Rocky War            08/07/2005
                                  Amadeus Holy         08/10/2005
                                  Lust Lock            08/21/2005
                                  Wardrobe Phantom     08/22/2005
                                  Menagerie Rushmore   08/24/2005
                                  Analyze Hoosiers     08/24/2005
                                  Dancing Fever        08/25/2005
                                  Boogie Amelie        08/25/2005
                                  Orient Closer        08/28/2005
                                  War Notting          08/28/2005
                                  Freddy Storm         08/30/2005
                                  Strangers Graffiti   08/31/2005
                                  ---CUSTOMER RENTALS:         28


^L
11/12/2020                                               PAGE:  2
---------------------CUSTOMER HISTORY REPORT---------------------

------------NAME------------ CUST                      ---DATE---
-----LAST------ ---FIRST---- -ID- -----DVD TITLE------ -RETURNED-
Adams           Kathleen       36 Orange Grapes        05/28/2005
                                  Alone Trip           06/01/2005
                                  Go Purple            06/20/2005
                                  Betrayed Rear        07/10/2005
                                  Room Roman           07/11/2005
                                  Boogie Amelie        07/12/2005
                                  Swarm Gold           07/12/2005
                                  Amadeus Holy         07/16/2005
                                  Sling Luke           07/30/2005
                                  Pianist Outfield     08/01/2005
                                  Seabiscuit Punk      08/01/2005
                                  Women Dorado         08/02/2005
                                  Wash Heavenly        08/02/2005
                                  Treatment Jekyll     08/03/2005

...

11/12/2020                                               PAGE: 40
---------------------CUSTOMER HISTORY REPORT---------------------

------------NAME------------ CUST                      ---DATE---
-----LAST------ ---FIRST---- -ID- -----DVD TITLE------ -RETURNED-
Young           Cynthia        28 Ship Wonderland      05/31/2005
                                  Star Operation       06/17/2005
                                  Dying Maker          06/18/2005
                                  Banger Pinocchio     06/23/2005
                                  Odds Boogie          06/25/2005
                                  Virginian Pluto      06/26/2005
                                  Wolves Desire        07/09/2005
                                  Kick Savannah        07/10/2005
                                  Deceiver Betrayed    07/12/2005
                                  Dalmations Sweden    07/16/2005
                                  Murder Antitrust     07/16/2005
                                  Papi Necklace        07/18/2005
                                  Spirit Flintstones   07/18/2005
                                  Trading Pinocchio    08/01/2005
                                  Wars Pluto           08/02/2005
                                  Lawless Vision       08/03/2005
                                  Clueless Bucket      08/03/2005
                                  Birch Antitrust      08/05/2005
                                  Easy Gladiator       08/05/2005
                                  License Weekend      08/05/2005
                                  Fiction Christmas    08/08/2005
                                  Candidate Perdition  08/09/2005
                                  Translation Summer   08/19/2005
                                  Minds Truman         08/21/2005
                                  Beverly Outlaw       08/21/2005
                                  Ice Crossing         08/23/2005
                                  Saddle Antitrust     08/24/2005
                                  Lebowski Soldiers    08/27/2005
                                  Loverboy Attacks     08/27/2005
                                  Attacks Hate         08/28/2005
                                  Suspects Quills      00/00/0000
                                  ---CUSTOMER RENTALS:         32

                                  ------TOTAL RENTALS:     16,044

                                  ----TOTAL CUSTOMERS:        599

Being the paranoid programmer I am, all totals were compared with the database and they match!

This concludes my foray into GnuCOBOL!

Posted in c-gnuCOBOL | Tagged , | Leave a comment

COBOL Sort Module in GnuCOBOL

In this post I’m going to modify the code I wrote in My Own Embedded SQL GnuCOBOL Program.

These days, it is almost certainly more efficient to allow the SQL to do the sort for you. When I was writing COBOL in the 80’s, the COBOL sort module was more efficient than any other method to sort large amounts of data for reporting.

I want to go old school and use the COBOL sort module. There are two methods of sorting in COBOL: sorting files (USING/GIVING) or using sort procedure (RELEASE/RETURN).

USING/GIVING is the simple way to sort. Given an input data file, it will create a new sorted data file. You create an SD (like an FD) of the input file describing the data, then you just use the sort verb:

           SORT SORT-FILE 
               ON ASCENDING KEY MY-KEY,
               USING INPUT-FILE,
               GIVING OUTPUT-FILE.

While this is simple syntax, it really isn’t any faster than running any other stand-alone sort facility. The power of COBOL sort is in it’s INPUT/OUTPUT PROCEDUREs.

When using this form of sort, you supply the name of an INPUT and OUTPUT procedure that will be invoked during the sort. For example:

           SORT SORT-FILE 
               ON ASCENDING KEY MY-KEY,
               INPUT PROCEDURE IS IN-PROC,
               OUTPUT PROCEDURE IS OUT-PROC.

When using sort in this manner, the sort is invoked and each time it needs a new record it calls IN-PROC. When it is ready to start outputting records it calls OUT-PROC for each record.

PROCEDURE DIVISION Sections

SORT INPUT/OUTPUT PROCEDURE requires section names rather than paragraph names. In the code I’ve posted so far I’ve not used section names.

Code Walk Through

The source code to my test program can be found at

http://www.xyfyx.com/files/sortedReport.cob

Like the program upon which this one was based, it will read records from the PostgreSQL dvdRental database and create a terminal based report of Rental History.

First, we need to setup a SELECT statement for the sort file which will just be a temp file in the current directory:

       ENVIRONMENT DIVISION.
       INPUT-OUTPUT SECTION.
       FILE-CONTROL.
       
           SELECT SF-SORT-FILE,
               ASSIGN TO               "./SORTFILE.TMP",
               FILE STATUS IS          SF-STATUS.

SF-STATUS is a 2 byte variable that contains the IO status of the last IO verb applied to the file. If it is ’00’, then there was no error.

Next, you describe the format of the sort file. It must contain a field for every field that you will need to print.

       FILE SECTION.
       
       SD  SF-SORT-FILE.
       
       01  SF-SORT-REC.
           03  SF-CUSTID               PIC 9(9).
           03  SF-LASTNAME             PIC X(45).
           03  SF-FIRSTNAME            PIC X(45).
           03  SF-FILMTITLE            PIC X(45).
           03  SF-RETURNDATE           PIC 99999999.

In the MAIN module, we will CONNECT to the database, DECLARE the cursor, and OPEN the cursor just as we did in the original program. Once the cursor is open, then we invoke the sort:

          SORT SF-SORT-FILE
               ON ASCENDING KEY        SF-LASTNAME,
               ON ASCENDING KEY        SF-FIRSTNAME,
               ON ASCENDING KEY        SF-RETURNDATE,
               INPUT PROCEDURE IS      A1000,
               OUTPUT PROCEDURE IS     A2000.

Here we specify the keys to sort on as well as the SECTION names for the INPUT and OUTPUT procedures.

Here is the INPUT PROCEDURE. Retrieve the first record:

       A1000 SECTION.
       A1000-SORT-INPUT.
       
           EXEC SQL 
               FETCH C1 INTO 
                   :DB-CUSTID,
                   :DB-LASTNAME,
                   :DB-FIRSTNAME,
                   :DB-FILMTITLE,
                   :DB-RETURNDATE
           END-EXEC.
           IF SQLCODE <> ZERO,
               PERFORM Z1000-DB-ERROR  THRU Z1099-EXIT;
               STOP RUN.

Move the fields from the database record into the sort record:

           PERFORM UNTIL SQLCODE NOT = ZERO
               INITIALIZE              SF-SORT-REC; 
               MOVE DB-CUSTID          TO SF-CUSTID;
               MOVE DB-LASTNAME        TO SF-LASTNAME;
               MOVE DB-FIRSTNAME       TO SF-FIRSTNAME;
               MOVE DB-FILMTITLE       TO SF-FILMTITLE;
               MOVE DB-RETURNDATE      TO SF-RETURNDATE;

Release the record to the sort procedure:

               RELEASE SF-SORT-REC;

Get the next record:

               EXEC SQL 
                   FETCH C1 INTO 
                       :DB-CUSTID,
                       :DB-LASTNAME,
                       :DB-FIRSTNAME,
                       :DB-FILMTITLE,
                       :DB-RETURNDATE
               END-EXEC;
           END-PERFORM.

Once the INPUT PROCEDURE exits, that is an indication to SORT there are no more records so it performs the SORT and then calls the OUTPUT PROCEDURE.

In the output procedure, RETURN is used to read records back in from the sort to be processed.

       
       A2000 SECTION.
       A2000-SORT-OUTPUT.

           RETURN SF-SORT-FILE,
               AT END,
                   NEXT SENTENCE.
           
           IF SF-STATUS <> ZERO,
               DISPLAY "NO DATA TO REPORT.";
               STOP RUN.
               
           DISPLAY HD-HDR1.
           DISPLAY HD-HDR2.

Move data from the sort record to the detail print record:

       
           PERFORM UNTIL SF-STATUS <> ZERO,
               INITIALIZE              DT-DETAIL1;
               MOVE SF-CUSTID          TO DT-CUSTID;
               MOVE SF-LASTNAME        TO DT-LASTNAME;
               MOVE SF-FIRSTNAME       TO DT-FIRSTNAME;
               MOVE SF-FILMTITLE       TO DT-FILMTITLE;
               MOVE SF-RETURNDATE      TO TF-DATE;
               STRING TF-MM, "/", TF-DD, "/", TF-YY
                   INTO                DT-RETURNDATE;
                  
               DISPLAY DT-DETAIL1;
               
               RETURN SF-SORT-FILE,
                   AT END,
                       NEXT SENTENCE;
                   END-RETURN;    
               END-PERFORM.
       
       A2099-EXIT.
       
           EXIT.

Compile and Run

$export COBCPY=~/Open-COBOL-ESQL-1.2/copy
$export COB_LDFLAGS=-Wl,--no-as-needed
$ocesql sortedReport.cob sortedReport.tmp
$cobc -locesql -x sortedReport.tmp
$./sortedReport
DOING CONNECT
DOING DECLARE CURSOR
DOING OPEN CURSOR
------------------------DVD RENTAL HISTORY-----------------------
-ID- ------------NAME------------ -----FILM TITLE----- -RETURNED-
 505 Abney           Rafael       Conversation Downhil 00/00/0000
 505 Abney           Rafael       Sagebrush Clueless   05/29/2005
 505 Abney           Rafael       Pocus Pulp           06/05/2005
 505 Abney           Rafael       Legally Secretary    06/19/2005
 505 Abney           Rafael       Nightmare Chill      06/20/2005
 505 Abney           Rafael       Trading Pinocchio    06/28/2005
 505 Abney           Rafael       Coneheads Smoochy    06/28/2005
 505 Abney           Rafael       Wanda Chamber        07/12/2005
 505 Abney           Rafael       Conquerer Nuts       07/14/2005
...

Note the very first line of the report, the returned date is 00/00/0000. This video is not returned yet and has a value of NULL which becomes 00/00/0000.

Posted in c-gnuCOBOL | Tagged | Leave a comment

COBOL and $2,020,202.02

Over the years, in fact even in the past year or two I would see on the News some person either getting a bill or a check for some ridiculous amount of money that would be in the form $2020202020… .02.

If you ever see this you know it was (almost certainly) a programming mistake made in COBOL. Most COBOL programmers have made this bonehead mistake and I am no exception.

The problem is caused by the way COBOL programmers typically initialize a record. Given this little program:

       identification division.
       program-id.
           mistake.
       
       data division.
       working-storage section.
      
      * *** Input record, typically maintained on disk/tape somewhere.
       01  dr-datarec.
           03  dr-name                 pic x(20).
           03  dr-amount               pic s9(7)v99, comp-3.

      * *** print record, sent to a line printer.
       01  dt-detail.
           03  dt-name                 pic x(20).
           03  filler                  pic x.
           03  dt-amount               pic z,zzz,zz9.99.            
       
       procedure division.
       
           move spaces                 to dr-datarec.
           move "test"                 to dr-name.
           move 100                    to dr-amount.

           move spaces                 to dt-detail.
           move dr-name                to dt-name.
           move dr-amount              to dt-amount.

           display dt-detail.
       
           stop run.

In this program, dr-datarec is the input record. Normally it would be coming from disk somewhere. For this simple test, I am creating it by hand.

Once the input record is obtained, calculations are done, and the record is then printed using dt-detail.

The problem is in how dr-datarec is created. Note how I move spaces to it to initialize it. This was a common method of initializing a record.

By doing so, all PIC X fields have spaces in them. BUT, all COMP-3 fields are initialized as well, just not to zero. The programmer has to be sure to create valid values for any COMP-3 field. In the test program, this is properly done:

           move spaces                 to dr-datarec.
           move "test"                 to dr-name.
           move 100                    to dr-amount.

dr-amount clearly has 100 in it. When I run the program I get:

./mistake 
test                       100.00

What if a coding mistake is made and dr-amount is not initialized properly?

It still contains ASCII spaces. That would be HEX 20 or binary 0010 0000.

COMP-3 stores digits as 4 bit “nibbles”, so a single space would appear as the digits 20. If you have 9 digits, as dr-amount has, it requires 10 nibbles of storage (9 nibbles for the digits and one for the sign) OR 5 bytes.

The MOVE SPACES to DR-DATAREC would result in 5 spaces being stored in the field or the hex value of 2020202020. This is interpreted as 2,020,202.02 if you attempt to use the uninitialized variable.

If I comment out the initialization of dr-amount, I can force this error:

           move spaces                 to dr-datarec.
           move "test"                 to dr-name.
     *     move 100                    to dr-amount.

Now when I run the program:

./mistake 
test                 2,020,202.02

COBOL 85 introduced the INITIALIZE verb to correct this problem. Rather than moving spaces to the record, you initialize it and it will move spaces to alphanumeric fields and zeros to numeric fields:

      *    move spaces                 to dr-datarec.
           initialize dt-detail.
           move "test"                 to dr-name.
      *    move 100                    to dr-amount.

results in:

./mistake 
test                         0.00

So the next time you see a poor widow charged $2,020,202.02 on their utility bill, you will know exactly how it happened!

Update

The above example assumes an ASCII machine. If run on an EBCDIC-based machine (IBM), SPACE is HEX 40 and you would see $4,040,404.04 instead.

[https://www.reddit.com/r/programming/comments/jo4c59/cobol_and_202020202/]

Posted in c-gnuCOBOL | Tagged | 2 Comments

My Own Embedded SQL GnuCOBOL Program

Having successfully compiled and executed the OCESQL supplied test program, I want to write my own program.

My plan is to read data from the dvdrental database that I installed during the Installing PostgreSQL (for GnuCOBOL) post.

The sample database looks like this:

I would like to create a Rental history report that shows each customer and all of the DVD titles he has rented.

The query to provide the data I want looks like this:

select customer.customer_id, customer.last_name, customer.first_name,
    film.title, rental.return_date
from customer
    inner join rental    on customer.customer_id = rental.customer_id
    left  join inventory on rental.inventory_id  = inventory.inventory_id
    left  join film      on inventory.film_id    = film.film_id
order by customer.last_name, customer.first_name, film.title

Which provides data like this:

Using ocesql’s FETCHTBL.COB as an example I began writing my own program.

Immediately I found some unexpected issues.

First, you CANNOT use free format code. You must use the original COBOL standard where divisions/sections/paragraphs are in area A (columns 8-11) and the rest is in area B (columns 12-72). Ugh! I don’t know how I wrote so much code with a 72 column limit. It’s really annoying now.

Further, if you accidentally go past column 72, it will be the ocesql precompiler that catches it with a rather vague message:

precompile start: dvdRentalReport.cob
=======================================================
              LIST OF CALLED DB Library API            
=======================================================
000049:syntax error
=======================================================
translate error

The precompiler indicates the error is at line 49, but it wasn’t – it was at line 44. So watch for this!

I also found that I would have various problems if I tried to use lowercase characters in the program. This was really inconsistent. Somethings worked, some didn’t. The answer is to just keep everything upper case.

Due to these limitations, the COBOL being written for ocesql definitely looks old school:

           EXEC SQL DECLARE C1 CURSOR FOR
               SELECT 
                   CUSTOMER.CUSTOMER_ID,
                   CUSTOMER.LAST_NAME,
                   CUSTOMER.FIRST_NAME,
                   FILM.TITLE,
                   TO_CHAR(RENTAL.RETURN_DATE,'YYYYMMDD')
               FROM CUSTOMER
               INNER JOIN RENTAL    ON 
                   CUSTOMER.CUSTOMER_ID = RENTAL.CUSTOMER_ID
               LEFT  JOIN INVENTORY ON 
                   RENTAL.INVENTORY_ID  = INVENTORY.INVENTORY_ID
               LEFT  JOIN FILM      ON 
                   INVENTORY.FILM_ID    = FILM.FILM_ID
           END-EXEC.

Code Walk Through

Any variable that will be passed to SQL in the EXEC SQL statement must be defined in a EXEC SQL BEGIN DECLARE SECTION / END DECLARE SECTION block. Further, any variable used must be an elementary item (not a group item).

I declare these as:

       EXEC SQL BEGIN DECLARE SECTION END-EXEC.
       01  DB-CONTROL.
           03  DB-NAME                 PIC X(30),          VALUE SPACES.
           03  DB-USER                 PIC X(30),          VALUE SPACES.
           03  DB-PASS                 PIC X(10),          VALUE SPACES.
       01  DB-RECCOUNT                 PIC 9(9).
       01  DB-REC.
           03  DB-CUSTID               PIC 9(9).
           03  DB-LASTNAME             PIC X(45).
           03  DB-FIRSTNAME            PIC X(45).
           03  DB-FILMTITLE            PIC X(45).
           03  DB-RETURNDATE           PIC 99999999.
       EXEC SQL END DECLARE SECTION END-EXEC.

I used some groups such as DB-CONTROL and DB-REC, but these are NOT passed to SQL.

DB-RETURNDATE is a great example of not using a group. The SQL will return the date as YYYYMMDD, but if I declare DB-RETURNDATE as:

           03  DB-RETURNDATE.
               05  DB-YY              PIC 9999.
               05  DB-MM              PIC 99.
               05  DB-DD              PIC 99.

Then the query would fail. So I resorted to moving DB-RETURN-DATE to TF-DATE which is defined as

       01  TF-TEMP-FIELDS.
           03  TF-DATE.
               05  TF-YY               PIC 9999.
               05  TF-MM               PIC 99.
               05  TF-DD               PIC 99.

I can then STRING the date together into the format I want.

      * *** DEFINE SQL CONTROL AREA

       EXEC SQL INCLUDE SQLCA END-EXEC.

This is the SQL control area which contains various error information.

To start, the database is opened with CONNECT and the credentials need to be set before the call.

           MOVE "dvdrental@chiefdude10"     TO DB-NAME.
           MOVE "postgres"                  TO DB-USER.
           MOVE "mypass"                    TO DB-PASS.
      
           DISPLAY "DOING CONNECT".
           EXEC SQL
               CONNECT :DB-USER IDENTIFIED BY :DB-PASS USING :DB-NAME;
           END-EXEC.
           
           IF SQLCODE <> ZERO,
               PERFORM Z1000-DB-ERROR  THRU Z1099-EXIT;
               STOP RUN.

If an error occurs, the DB error code is called. This should be done after every EXEC SQL.

Next, a cursor is declared using the SQL statement that will retrieve all of the data:

      * *** DECLARE CURSOR
      
           DISPLAY "DOING DECLARE CURSOR".

           EXEC SQL DECLARE C1 CURSOR FOR
               SELECT 
                   CUSTOMER.CUSTOMER_ID,
                   CUSTOMER.LAST_NAME,
                   CUSTOMER.FIRST_NAME,
                   FILM.TITLE,
                   TO_CHAR(RENTAL.RETURN_DATE,'YYYYMMDD')
               FROM CUSTOMER
               INNER JOIN RENTAL    ON 
                   CUSTOMER.CUSTOMER_ID = RENTAL.CUSTOMER_ID
               LEFT  JOIN INVENTORY ON 
                   RENTAL.INVENTORY_ID  = INVENTORY.INVENTORY_ID
               LEFT  JOIN FILM      ON 
                   INVENTORY.FILM_ID    = FILM.FILM_ID
           END-EXEC.
           IF SQLCODE <> ZERO,
               PERFORM Z1000-DB-ERROR  THRU Z1099-EXIT;
               STOP RUN.

This is the same SQL query I mentioned at the top of this post EXCEPT date must be formatted into something COBOL can handle, so I used

TO_CHAR(RENTAL.RETURN_DATE,'YYYYMMDD')

The rest of the program retrieves each record of data and prints it until there is no more. Retrieving is done with SQL EXEC FETCH:

           EXEC SQL 
               FETCH C1 INTO 
                   :DB-CUSTID,
                   :DB-LASTNAME,
                   :DB-FIRSTNAME,
                   :DB-FILMTITLE,
                   :DB-RETURNDATE
           END-EXEC.
           IF SQLCODE <> ZERO,
               PERFORM Z1000-DB-ERROR  THRU Z1099-EXIT;
               STOP RUN.

Each field of the record is retrieved into a COBOL variable. Then that data is formatted into a line to print:

               MOVE SPACES             TO DT-DETAIL1;
               MOVE DB-CUSTID          TO DT-CUSTID;
               MOVE DB-LASTNAME        TO DT-LASTNAME;
               MOVE DB-FIRSTNAME       TO DT-FIRSTNAME;
               MOVE DB-FILMTITLE       TO DT-FILMTITLE;
               
      * *** GROUP ITEMS CANNOT BE USED IN SQL STATEMENTS, SO MOVE 
      * *** DB-RETURNDATE TO TF-RETURNDATE SO IT CAN BE REFORMATTED.
      
               MOVE DB-RETURNDATE      TO TF-DATE;
               STRING TF-MM, "/", TF-DD, "/", TF-YY
                   INTO                DT-RETURNDATE;
                  
               DISPLAY DT-DETAIL1;

The full program can be found at:

http://www.xyfyx.com/files/dvdRentalReport.cob

Compiling the Program

Don’t forget you need to set a couple of environment variables:

    export COBCPY=~/Open-COBOL-ESQL-1.2/copy
    export COB_LDFLAGS=-Wl,--no-as-needed

With those set, now run the precompiler:

ocesql dvdRentalReport.cob dvdRentalReport.tmp
precompile start: dvdRentalReport.cob
=======================================================
              LIST OF CALLED DB Library API            
=======================================================
;
;
;
;
;
;
Generate:OCESQLConnect
Generate:OCESQLCursorDeclare
Generate:OCESQLCursorOpen
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorClose
Generate:OCESQLDisconnect
Generate:ROLLBACK
=======================================================

To compile:

cobc -locesql -x dvdRentalReport.tmp

and then run with:

./dvdRentalReport
DOING CONNECT
DOING DECLARE CURSOR
DOING OPEN CURSOR
------------------------DVD RENTAL HISTORY-----------------------
-ID- ------------NAME------------ -----FILM TITLE----- -RETURNED-
 459 Collazo         Tommy        Freaky Pocus         05/28/2005
 408 Murrell         Manuel       Graduate Lord        06/01/2005
 333 Purdy           Andrew       Love Suicides        06/03/2005
 222 Hansen          Delores      Idols Snatchers      06/02/2005
 549 Christenson     Nelson       Mystic Truman        05/27/2005
 269 Walters         Cassandra    Swarm Gold           05/29/2005
 239 Romero          Minnie       Lawless Vision       05/27/2005
 126 Simpson         Ellen        Matrix Snowman       05/28/2005
 399 Isom            Danny        Hanging Deep         05/31/2005
 142 Burns           April        Whale Bikini         06/02/2005
 261 Byrd            Deanna       Games Bowfinger      05/30/2005
 334 Mcwhorter       Raymond      King Evolution       05/30/2005
 446 Culp            Theodore     Monterey Labyrinth   05/26/2005
 319 Weiner          Ronald       Pelican Comforts     06/03/2005
 316 Curley          Steven       Boogie Amelie        05/26/2005
 575 Oglesby         Isaac        Contact Anonymous    05/27/2005
  19 Martinez        Ruth         Roman Punk           05/31/2005

Voilà! A COBOL report that looks like it is straight out of 1983!

Now that I can retrieve the data, the next step will be to use the COBOL Sort module to sort and the Report Writer to produce the actual report.

Posted in c-gnuCOBOL | Tagged , | 1 Comment

Embedded SQL for GnuCOBOL using ocesql

After 6 months of messing around with gnuCOBOL, I am finally to the point of trying to implement Embedded SQL.

What is Embedded SQL?

In all of the programming I’ve done / seen, SQL is accessed via some type of procedure calls. A query is setup, executed, then the results are extracted. There is a fair amount of extra code besides the actual SQL statement.

For example, in one of my Pascal programs, I setup an SQL command I want to execute:

query.SQL.Text := 'select * from devices where ownerId  = :ownerId and deviceId = :deviceId';

The variables in the where clause of the query, :ownerId and :deviceId, are then assigned values from program variables:

qpbn(query, deviceR.ownerId,  'ownerId');
qpbn(query, deviceR.deviceId, 'deviceId');

Then the query is executed on the server:

query.Open;

and finally I extract from the query result the values my program needs:

qfbn(query, macAddr,        'macAddr');

It works, but wouldn’t it by much nicer if I could just embed the query straight into the Pascal program something like

SQL('select :macdaddr from devices where ownderId = :ownerId and deviceId = :deviceId');

That’s exactly how embedded SQL in COBOL works. You just delimit the SQL command with EXEC SQL … END-EXEC. For example, the above in COBOL would be:

EXEC SQL
    SELECT :MACADDR FROM DEVICES WHERE OWNERID = :OWNERID AND DEVICEID = :DEVICEID
END-EXEC.

I won’t spend time explaining the operation of embedded SQL as mainframe examples can be easily found elsewhere. Instead, I’m going to cover how to implement it for gnuCOBOL.

Caveats

My initial plan was to do this running gnuCOBOL in Windows. There was a lot of wasted time and head banging trying to make whatever test I was trying to do in gnuCOBOL work in Windows. Eventually I would get the problem resolved.

This was not the case for embedded SQL. I am using OCESQL and I could not get it to compile properly in minGW. After wasting several hours on that, I gave up and implemented it in Linux. Honestly, I can’t imagine any scenario I would prefer using COBOL in Windows more than Linux.

I will give a quick summary regarding the Linux installation below.

Early on I installed PostgreSQL onto a Windows system. That is working fine and for this test, I will be using PostgreSQL for Windows.

Installing gnuCOBOL on Linux

I created a Virtualbox VM and installed Linux Mint 19.3 to do this testing.

I wanted to use the COBOLWorx distribution of gnuCOBOL so I can use their debugger if necessary.

The compiler and debugger can be found at:

Packages for the Debian Package Manager (DPKG)

Download both COBOLworx GnuCOBOL 3.1 and COBOLworx GnuCOBOL CBL-GDB Debugging Extensions.

Installing is very easy, just use apt install for each file:

sudo apt install <gnuCOBOL filename>
sudo apt install <debugger filename>

To verify the install, do the following:

cobc -v
cobc (GnuCOBOL) 3.1-dev.0
Built     Oct 09 2020 13:47:45  Packaged  Oct 26 2020 15:31:29 UTC
C version "7.5.0"
loading standard configuration file 'default.conf'
cobc: error: no input files

cobcd
This is the cobc debugging wrapper [Version 4.2]
Use it as you would 'cobc'

no-pie-link.specs Error

This probably won’t be an issue for you, but it was for me so I will document it. After installing gnuCOBOL I did a test compile and got the error

gcc: error: /usr/share/dpkg/no-pie-link.specs

For some reason my PC was missing the file specified above. I found it on another system and created it in the requested directory. The contents of the file are:

+ %{!shared:%{!r:%{!fPIE:%{!pie:-fno-PIE -no-pie}}}}

Install PostgreSQL Client

If you aren’t using PostgreSQL server on the same system as the compiler, you are going to want to install the client:

sudo apt install postgresql-client

Now verify you can get access to the PostgreSQL server using psql:

psql -h <yourhost> -U postgres
Password for user postgres: 
psql (10.14 (Ubuntu 10.14-0ubuntu0.18.04.1), server 12.3)
WARNING: psql major version 10, server major version 12.
Some psql features might not work.
Type "help" for help.

postgres=#

Fix Windows 10 Firewall

When I attempted to access PostgreSQL on my Windows 10 system, the firewall blocked access. I had to go into the firewall, add the PostgreSQL server, and allow access to it:

Create the testdb Database

The sample ocesql programs will make use of a database called testdb. Use psql to set that up now.

To list the existing databases use the psql command \l (that’s a lowercase L):

and then create the database:

Using the \l command again you will see the database:

Use \q to exit psql.

Installing Ocesql

To install ocesql, you will need C++. You can use g++ to verify it is there:

g++ -v
Using built-in specs.
COLLECT_GCC=g++
COLLECT_LTO_WRAPPER=/usr/lib/gcc/x86_64-linux-gnu/7/lto-wrapper
OFFLOAD_TARGET_NAMES=nvptx-none
OFFLOAD_TARGET_DEFAULT=1
Target: x86_64-linux-gnu
Configured with: ../src/configure -v --with-pkgversion='Ubuntu 7.5.0-3ubuntu1~18.04' --with-bugurl=file:///usr/share/doc/gcc-7/README.Bugs --enable-languages=c,ada,c++,go,brig,d,fortran,objc,obj-c++ --prefix=/usr --with-gcc-major-version-only --program-suffix=-7 --program-prefix=x86_64-linux-gnu- --enable-shared --enable-linker-build-id --libexecdir=/usr/lib --without-included-gettext --enable-threads=posix --libdir=/usr/lib --enable-nls --enable-bootstrap --enable-clocale=gnu --enable-libstdcxx-debug --enable-libstdcxx-time=yes --with-default-libstdcxx-abi=new --enable-gnu-unique-object --disable-vtable-verify --enable-libmpx --enable-plugin --enable-default-pie --with-system-zlib --with-target-system-zlib --enable-objc-gc=auto --enable-multiarch --disable-werror --with-arch-32=i686 --with-abi=m64 --with-multilib-list=m32,m64,mx32 --enable-multilib --with-tune=generic --enable-offload-targets=nvptx-none --without-cuda-driver --enable-checking=release --build=x86_64-linux-gnu --host=x86_64-linux-gnu --target=x86_64-linux-gnu
Thread model: posix
gcc version 7.5.0 (Ubuntu 7.5.0-3ubuntu1~18.04) 

If it is not, install it with:

sudo apt install build-essential g++

You are also going to need some postgresql libs:

sudo apt install libpq5 libpq-dev

Source for ocesql can be found at:

https://github.com/opensourcecobol/Open-COBOL-ESQL/releases/tag/v1.2.

Unzip the file into your home directory (~). You should now have the directory ~/Open-COBOL-ESQL-1.2.

To compile ocesql:

cd ~/Open-COBOL-ESQL-1.2
export CPATH=/usr/include/postgresql/
./configure
make

you will now have the file ./ocesql/ocesql. To install into /usr,

sudo make install

and test:

ocesql
Open Cobol ESQL (Ocesql)
Version 1.2.0

April 19, 2019

Tokyo System House Co., Ltd. <opencobol@tsh-world.co.jp>

Usage: ocesql [options] SOURCE [DESTFILE] [LOGFILE]

options
      --inc=include_dir      set INCLUDE FILE directory path.

usage
  -v, --version              show version.
  -h, --help                 show this usage.

Compiling and Running the Sample Programs

ocesql comes with two sample programs, INSERTTBL and FETCHTBL. I wanted to make sure I could get these to work before I tried my own code.

Fixing the Code

The program INSERTTBL is set to populate the database with data containing Japanese characters. Fortunately, the writer includes both versions of text, you just need to uncomment the English code and delete the Japanese code.

becomes

Go thru the rest of this program and you will find various literals that are in both Japanese and English. Convert them to use the English version.

The last thing, in both programs is to fix the database credentials to the appropriate values:

Preparing to Compile INSERTTBL

You need to make the ocesql copy book available to the COBOL compiler:

export COBCPY=/home/<yourName>/Open-COBOL-ESQL-1.2/copy

The following fixes the runtime error

libcob: error: module 'OCESQLConnect' not found'

(see https://stackoverflow.com/questions/26227458/gnucobol-failing-to-find-dynamic-symbols-only-on-recent-ubuntu):

export COB_LDFLAGS=-Wl,--no-as-needed

Precompiling  INSERTTBL

The first step is to run the precompiler ocesql against the source code. This will convert the EXEC SQL … END-EXEC code into actual COBOL code:

ocesql INSERTTBL.cbl INSERTTBL.cob
precompile start: INSERTTBL.cbl
=======================================================
LIST OF CALLED DB Library API
=======================================================
Generate:OCESQLConnect
Generate:OCESQLExec
Generate:OCESQLExec
Generate:OCESQLExec
Generate:OCESQLExec
Generate:OCESQLExecParams
Generate:COMMIT
Generate:OCESQLDisconnect
Generate:ROLLBACK
=======================================================

Here is an example of ocesql converting an INSERT statement into COBOL code:

     *    INSERT ROWS USING LITERAL
           EXEC SQL
               INSERT INTO EMP VALUES (46, 'KAGOSHIMA ROKURO', -320)
           END-EXEC.
           IF  SQLCODE NOT = ZERO PERFORM ERROR-RTN.

becomes

      *    INSERT ROWS USING LITERAL
OCESQL*    EXEC SQL
OCESQL*        INSERT INTO EMP VALUES (46, 'KAGOSHIMA ROKURO', -320)
OCESQL*    END-EXEC.
OCESQL     CALL "OCESQLExec" USING
OCESQL          BY REFERENCE SQLCA
OCESQL          BY REFERENCE SQ0003
OCESQL     END-CALL.
           IF  SQLCODE NOT = ZERO PERFORM ERROR-RTN.

Compiling and Running INSERTTBL

cobc -x -locesql INSERTTBL.cob
./INSERTTBL
*** INSERTTBL STARTED ***
NOTICE: table "emp" does not exist, skipping
*** INSERTTBL FINISHED ***

Reviewing the Results

Using psql, review the new EMP table:

psql -h chiefdude10 -U postgres 
Password for user postgres: 
psql (10.14 (Ubuntu 10.14-0ubuntu0.18.04.1), server 12.3)
WARNING: psql major version 10, server major version 12.
         Some psql features might not work.
Type "help" for help.

postgres=# \c testdb
psql (10.14 (Ubuntu 10.14-0ubuntu0.18.04.1), server 12.3)
WARNING: psql major version 10, server major version 12.
         Some psql features might not work.
You are now connected to database "testdb" as user "postgres".
testdb=# select * from emp;
 emp_no |       emp_name       | emp_salary 
--------+----------------------+------------
     46 | KAGOSHIMA ROKURO     |       -320
     47 | OKINAWA SHICHIRO     |        480
      1 | HOKKAI TARO          |        400
      2 | AOMORI JIRO          |        350
      3 | AKITA SABURO         |        300
      4 | IWATE SHIRO          |       -250
      5 | MIYAGI GORO          |       -200
      6 | FUKUSHIMA RIKURO     |        150
      7 | TOCHIGI SHICHIRO     |       -100
      8 | IBARAKI HACHIRO      |         50
      9 | GUMMA KURO           |       -200
     10 | SAITAMA JURO         |        350
(12 rows)

FETCHTBL

If you have been successful at running INSERTTBL, FETCHTBL is more of the same:

ocesql FETCHTBL.cbl FETCHTBL.cob
precompile start: FETCHTBL.cbl
=======================================================
              LIST OF CALLED DB Library API            
=======================================================
Generate:OCESQLConnect
Generate:OCESQLExecSelectIntoOne
Generate:OCESQLCursorDeclare
Generate:OCESQLCursorOpen
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorFetchOne
Generate:OCESQLCursorClose
Generate:COMMIT
Generate:OCESQLDisconnect
Generate:ROLLBACK
=======================================================

cobc -x -locesql FETCHTBL.cob

./FETCHTBL
*** FETCHTBL STARTED ***
TOTAL RECORD: 0012
---- -------------------- ------
NO   NAME                 SALARY
---- -------------------- ------
0001 HOKKAI TARO             400
0002 AOMORI JIRO             350
0003 AKITA SABURO            300
0004 IWATE SHIRO            -250
0005 MIYAGI GORO            -200
0006 FUKUSHIMA RIKURO        150
0007 TOCHIGI SHICHIRO       -100
0008 IBARAKI HACHIRO          50
0009 GUMMA KURO             -200
0010 SAITAMA JURO            350
0046 KAGOSHIMA ROKURO       -320
0047 OKINAWA SHICHIRO        480
*** FETCHTBL FINISHED ***

Now that I am able to use ocesql on the sample programs, next I will use it to access the dvdRental database that I installed in Installing PostgreSQL (for GnuCOBOL).

Posted in c-gnuCOBOL | Tagged , | Leave a comment

Create Demo Application Using Lazarus for Android

I created this video for myself showing the basic steps for creating a very simple Android program using Lazarus.

I am the intended audience and the intended audience cares about the content not the video quality, so don’t expect it to be pretty. BUT, if you want to see how simple it is to create an Android app in Lazarus, and can’t find another video with much detail (I wasn’t able), then you are welcome to have a look.

Posted in c-lazarus | Tagged , | 5 Comments

COBOLWorx GnuCOBOL and Debugger

The next step in delving back into COBOL is to get a working debugger. While using DISPLAY debug lines was the only debugging I had available when I did this for a living, there should be no reason to have to do that these days!

After going thru the gnuCOBOL FAQ, I found there is a way to make use of the GNU Debugger (gdb). Unfortunately the link to the debugger in the FAQ is dead. After a little digging I found cobcd, the COBOL debugger pre-processor  on the COBOLWorx site.

I spent quite some time getting cobcd to ‘make’. This is because if you want to run it on Windows you must compile using MinGW/MSYS2 and I have been using the older MSYS.

Even after I got it to compile under MSYS2, it failed to work with Arnold Trembley’s version of the gnuCOBOL I’ve been using. After several days of hair pulling, I finally decided to contact COBOLWorx directly. Bob from COBOLWorx responded quickly and confirmed that cobcd doesn’t play well with Anold Trembley’s version of gnuCOBOL.

Download and Install COBOLWorx GnuCOBOL and the Cobc Pre-Processor

If you are using Windows, the easiest way to get the cobcd pre-processor to work is to download the COBOLWorx’s Windows version of the compiler and debugger. In fact, their build of the compiler is so easy to install, I’d recommending using it even if you aren’t planning to use the cobcd debugger.

The download page for the COBOLWorx versions of gnuCOBOL is here.

Instead of messing with MinGW, I just downloaded the self-extracting installer for Windows found at the top of this page.

If, for some reason, the above link fails, the copy I downloaded is here. However, expect this  version to go out of date quickly.

Once you have the self-extracting EXE file downloaded, double-click on it and let it install. The program is a bit slow to install.

I installed the compiler into the default c:\gnucobol directory.

As the install completes you will see this dialog box:

I recommend you say yes and let it add these environment variables. Beats having to mess with the environment when you want to run the compiler.

Now reboot the PC to make sure everything gets setup properly.

Dealing with Microsoft Python

To test the install, type cobcd and you should see:

C:\cobol>cobcd
This is the cobc debugging wrapper [Version 3.17]
Use it as you would 'cobc'
C:\cobol>

If you instead only get a DOS prompt and no version information, chances are the MicroSoft Python is before gnuCOBOL’s python in your path. The following change will correct this problem.

Microsoft decided to put a stub program into your WindowsApps directory that does nothing except invoke the Microsoft Store. This breaks cobcd. Correcting the problem involves putting the gnuCOBOL path ahead of WindowsApps.

If you look at the path for your user, you will find WindowsApps is searched before gnucobol:

Simply move gnucobol above windowsapps:

The Test Program

Before using the debugger, we need a program to compile. Here is a sample program I’ll be using:

       >>source free
identification division.
program-id.
    testgdb.

data division.
working-storage section.

01  dst-rec.
    03  lastname                        pic x(20).
    03  firstname                       pic x(20).
    03  birthdate                       pic 999999.
    03  age                             pic zz9. 
    03  salary                          pic $$$$,$$9.99.

01  kount                               pic s9(4), comp.

01  src-rec.
    03  lastname                        pic x(20),          value "SMITH".
    03  firstname                       pic x(20),          value "JOHN".
    03  birthdate                       pic 999999,         value 800715.
    03  age                             pic s9(4), comp,    value 35.
    03  salary                          pic s9(6)v99, comp-3, value 123456.78.

procedure division.

    move "TEST"                         to lastname of dst-rec.
    move 20                             to age      of dst-rec.
    move 50000                          to salary   of dst-rec.

    perform varying kount from 1 by 1 until kount > 10,
        add 1                           to age of src-rec;
        end-perform.

    move corresponding src-rec          to dst-rec.

    display "dst-rec:".
    display dst-rec.

    stop run.

Setting Up GDB

The first time you attempt to run GDB, you will get a warning:

C:\cobol>gdb -q testgdb.exe
Reading symbols from optfde01.exe...
warning: File "C:\cobol\optfde01-gdb.py" auto-loading has been declined by your `auto-load safe-path' set to "$debugdir:$datadir/auto-load".
To enable execution of this file add
        add-auto-load-safe-path C:\cobol\optfde01-gdb.py
line to your configuration file "C:\Users\me/.gdbinit".
To completely disable this security protection add
        set auto-load safe-path /
line to your configuration file "C:\Users\me/.gdbinit".
For more information about this security protection see the
"Auto-loading safe path" section in the GDB manual.  E.g., run from the shell:
        info "(gdb)Auto-loading safe path"
(gdb)

To fix this, we need to add set auto-load safe-path / to the file .gdbinit.

It easy enough to create c:\users\<username>\.gdbinit with the proper contents:

C:\Users\me>type \users\me\.gdbinit
set auto-load safe-path /

Compiling the Test Program

Here is an example of compiling the program with debugging and running it w/o invoking the debugger:

C:\cobol\gdbDebugging>cobcd -x testgdb.cbl
C:\cobol\gdbDebugging>testgdb.exe
dst-rec:
SMITH               JOHN                800715 45$123,456.78

C:\cobol\gdbDebugging>

Setting the Initial Breakpoint

To invoke the debugger (-q omits printing the header):

C:\cobol\gdbDebugging>gdb -q testgdb.exe
Reading symbols from testgdb.exe...
registering CPrint (Usage is "print  ") [Version 3.17]
registering CWatch (Usage is "cwatch ")
(gdb)

If you start execution of the program, it will run what I assume is part of the run-time library. I’ve found the best way to bypass this code is to manually set a breakpoint on the first executable line.

First use the search command to find the procedure division and then list to see the lines around it:

(gdb) search procedure
25      procedure division.
(gdb) l
20          03  firstname                       pic x(20),          value "JOHN".
21          03  birthdate                       pic 999999,         value 800715.
22          03  age                             pic s9(4), comp,    value 35.
23          03  salary                          pic s9(6)v99, comp-3, value 123456.78.
24
25      procedure division.
26
27          move "TEST"                         to lastname of dst-rec.
28          move 20                             to age      of dst-rec.
29          move 50000                          to salary   of dst-rec.

Line 27 is the first executable line, so set a breakpoint there and use continue to let the program run until it hits the breakpoint:

gdb) break 27
Breakpoint 1 at 0x4016e3: file testgdb.cbl, line 27.
(gdb) run
Starting program: C:\cobol\gdbDebugging\testgdb.exe
[New Thread 5136.0xc98]
[New Thread 5136.0x18a8]
[New Thread 5136.0x16e8]

Thread 1 hit Breakpoint 1, testgdb_ (entry=0) at testgdb.cbl:27
27          move "TEST"                         to lastname of dst-rec.
(gdb)

Use Continue to Execute Until Next Breakpoing

Once the program is executing, you use continue, rather than start, to execute code until the next breakpoint is encountered:

(gdb) break 28
Breakpoint 2 at 0x401713: file testgdb.cbl, line 28.
(gdb) continue
Continuing.

Thread 1 hit Breakpoint 2, testgdb_ (entry=0) at testgdb.cbl:28
28          move 20                             to age      of dst-rec.
(gdb)

Using Step and Next

Step executes the next line and stop, but if a procedure is called, it will stop inside of the called procedure.

Next executes the next line without stopping inside of any called procedures. This is typically what I want to have happen.

After you type either, simply pressing enter will execute the command again (this is true of any command).

(gdb) next
29          move 50000                          to salary   of dst-rec.
(gdb)<cr>
31          perform varying kount from 1 by 1 until kount > 10,
(gdb)

Examining Contents of Variables

Typing p* will display all variables:

(gdb) p*
 1 : 01 dst-rec/testgdb [W-S] : "TEST", ' ' , "000000 20 $50,000.00"
 2 : 03 lastname/dst-rec/testgdb [W-S] : "TEST                "
 3 : 03 firstname/dst-rec/testgdb [W-S] : "                    "
 4 : 03 birthdate/dst-rec/testgdb [W-S] : "000000"
 5 : 03 age/dst-rec/testgdb [W-S] :  20
 6 : 03 salary/dst-rec/testgdb [W-S] :  $50,000.00
 7 : 01 kount/testgdb [W-S] : +0000
 8 : 01 src-rec/testgdb [W-S] : [534d495448", 20 , 4a4f484e", 20 , 3830303731350023012345678c]
 9 : 03 lastname/src-rec/testgdb [W-S] : "SMITH               "
10 : 03 firstname/src-rec/testgdb [W-S] : "JOHN                "
11 : 03 birthdate/src-rec/testgdb [W-S] : "800715"
12 : 03 age/src-rec/testgdb [W-S] : +0035
13 : 03 salary/src-rec/testgdb [W-S] : [012345678c]

To see the value of only kount, type:

(gdb) p kount
01 kount/testgdb [W-S]  :  +0000

I don’t make a practice of using MOVE CORRESPONDING so I don’t normally need to qualify variables with OF, but I wanted to see how they work in the debugger. To see the value of LASTNAME OF SRC-REC:

(gdb) p lastname/src-rec
03 lastname/src-rec/testgdb [W-S]  :  "SMITH               "

Using cwatch to Display Variable When It Changes

Here I ‘watch’ the value of kount change in the PERFORM loop. Every time the value changes, the program pauses execution:

(gdb) l
26
27          move "TEST"                         to lastname of dst-rec.
28          move 20                             to age      of dst-rec.
29          move 50000                          to salary   of dst-rec.
30
31          perform varying kount from 1 by 1 until kount > 10,
32              add 1                           to age of src-rec;
33              end-perform.
34
35          move corresponding src-rec          to dst-rec.
(gdb) break 35
Breakpoint 3 at 0x40189d: file testgdb.cbl, line 35.
(gdb) cwatch kount
Hardware watchpoint 4: *(char(*)[2])(0x406060)

(gdb) continue
Continuing.

Thread 1 hit Hardware watchpoint 4: *(char(*)[2])(0x406060)

Old value = "\000"
New value = "\000\001"
0x630cf909 in ?? () from c:\gnucobol\bin\libcob-4.dll
(gdb)<cr>
Continuing.

Thread 1 hit Hardware watchpoint 4: *(char(*)[2])(0x406060)

Old value = "\000\001"
New value = "\000\002"
0x0040188a in cob_addswp_s16 (val=, p=0x406060 ) at testgdb.cbl:32
32              add 1                           to age of src-rec;
(gdb) info break
Num     Type           Disp Enb Address    What
1       breakpoint     keep y   0x004016e3 in testgdb_ at testgdb.cbl:27
        breakpoint already hit 1 time
2       breakpoint     keep y   0x00401713 in testgdb_ at testgdb.cbl:28
        breakpoint already hit 1 time
3       breakpoint     keep y   0x0040189d in testgdb_ at testgdb.cbl:35
4       hw watchpoint  keep y              *(char(*)[2])(0x406060)
        breakpoint already hit 2 times
(gdb) disable 4
(gdb) continue
Continuing.

Thread 1 hit Breakpoint 3, testgdb_ (entry=0) at testgdb.cbl:35
35          move corresponding src-rec          to dst-rec.
(gdb)

Finally, let the MOVE CORRESPONDING execute and compare records:

gdb) n
37          display "dst-rec:".
(gdb) p *
 1 : 01 dst-rec/testgdb [W-S] : "SMITH               JOHN                800715 45$123,456.78"
 2 : 03 lastname/dst-rec/testgdb [W-S] : "SMITH               "
 3 : 03 firstname/dst-rec/testgdb [W-S] : "JOHN                "
 4 : 03 birthdate/dst-rec/testgdb [W-S] : "800715"
 5 : 03 age/dst-rec/testgdb [W-S] :  45
 6 : 03 salary/dst-rec/testgdb [W-S] : $123,456.78
 7 : 01 kount/testgdb [W-S] : +0011
 8 : 01 src-rec/testgdb [W-S] : [534d495448", 20 , 4a4f484e", 20 , 383030373135002d012345678c]
 9 : 03 lastname/src-rec/testgdb [W-S] : "SMITH               "
10 : 03 firstname/src-rec/testgdb [W-S] : "JOHN                "
11 : 03 birthdate/src-rec/testgdb [W-S] : "800715"
12 : 03 age/src-rec/testgdb [W-S] : +0045
13 : 03 salary/src-rec/testgdb [W-S] : [012345678c]
(gdb) c
Continuing.
dst-rec:
SMITH JOHN 800715 45$123,456.78
[Thread 8156.0x11d8 exited with code 0]
[Thread 8156.0xf14 exited with code 0]
[Thread 8156.0x96c exited with code 0]
[Inferior 1 (process 8156) exited normally]
(gdb)

There you go, gdb for gnuCOBOL. Pretty slick!

Posted in c-gnuCOBOL | Tagged , | Leave a comment

Debugging GnuCOBOL Using WITH DEBUGGING MODE

Prior to COBOL85, COBOL had its own debug module accessed in the DECLARATIVES. This was removed in the 1985 standard. It appears gnuCOBOL still supports the older debugging, but given gdb can be used (next blog post), I won’t go down that route.

Instead, I will examine the debugging that COBOL85 does still natively support.

Debugging Lines

When debugging is enabled, lines with a D in column 7 (fixed format) or start with >>D (free format) are compiled. If not enabled, they are not compiled.

>>D display "debugging line hit".

OR

      D    display "debugging line hit".

Normally one indicates these lines should be compiled using by specifying WITH DEBUGGING MODE in the SOURCE-COMPUTER paragraph:

source-computer. 
    x86                                 with debugging mode.

However, you can leave this clause off, and use the -fdebugging-line switch when invoking the compiler.

Here is code and a sample run using debugging statements:

C:\cobol\oldDebugging>cobc -t- -fdebugging-line -xj sw0debug.cbl
GnuCOBOL 3.1-rc1.0      sw0debug.cbl         Mon Aug 31 15:31:40 2020  Page 0001

LINE    PG/LN  A...B............................................................

000001         >>source free
000002  identification division.
000003  program-id.
000004      test.
000005
000006  environment division.
000007  configuration section.
000008  source-computer.
000009      x86.
000010
000011  procedure division.
000012
000013  >>D display "debugging line hit".
000014      display "non debugging line hit".
000015
000016      stop run.


0 warnings in compilation group
0 errors in compilation group
debugging line hit
non debugging line hit

Using SW0 to Control Debugging

When I was writing COBOL on the HP3000, I almost always wanted my debugging lines compiled. If there was a problem, I didn’t want to have to recompile code. This was probably because minicomputers were so slow and compilers took so many resources, each programmer might be lucky to get in 3 compiles a day. I often worked nights just so I wouldn’t have to fight as much for compile time!

I needed a simple mechanism to enable/disable debugging at run time rather than compile time. There were several ways to do this on the HP3000 and I did it using the switch register with SPECIAL-NAMES of SW0 and I see gnuCOBOL supports a switch register as well.

The first HP3000 I programmed (Series III) had an actual 16 bit switch register on the front panel that primarily was used to enter a start address to boot the system. However, it could also be read programmatically by COBOL.

The switch register went away on later models, but there needed to be a way to continue to support programs that made use of that register. On the HP3000, this was done by passing the value of the 16 bit switch register, in decimal, to the program in the PARM keyword such as:

:RUN MYPROG;PARM=1

This would set bit 0 of the switch register to 1 rather than 0. (PARM=2 would have set switch register bit 1 to 1). Thus, when I ran a COBOL program on the HP3000 with PARM=1, it would display debugging so I would not have to recompile.

Here is the modified program that uses the SWITCH-0 register in special names to create the condition-name called fl-debug which is tested to determine is debugging output should be displayed. Since SWITCH-0 has not yet been set fl-debug will return false and the debugging will not be displayed:

C:\cobol\oldDebugging>cobc -t- -xj sw0debug.cbl
GnuCOBOL 3.1-rc1.0      sw0debug.cbl         Mon Aug 31 16:09:01 2020  Page 0001

LINE    PG/LN  A...B............................................................

000001         >>source free
000002  identification division.
000003  program-id.
000004      test.
000005
000006  environment division.
000007  configuration section.
000008  source-computer.
000009      x86                                 with debugging mode.
000010  special-names.
000011      SWITCH-0                            is fl-debug-flag,
000012          on status                       is fl-debug.
000013
000014  procedure division.
000015
000016  >>D if fl-debug,
000017  >>D     display "debugging line hit".
000018
000019      display "non debugging line hit".
000020
000021      stop run.


0 warnings in compilation group
0 errors in compilation group
non debugging line hit

For gnuCOBOL, the SWITCH-0 register is set to 1 by setting an environment variable:

C:\cobol\oldDebugging>set COB_SWITCH_0=on

C:\cobol\oldDebugging>sw0debug.exe
debugging line hit
non debugging line hit

Setting COB_SWITCH_0 to off will disable the debugging.

Next time I’ll discuss using gdb with gnuCOBOL. Compared to using a modern debugger like gdb, having only DISPLAY is pretty primitive, but can still work. I still have to debug MCU code just using printf or even worse, just flashing a LED.

Posted in c-gnuCOBOL | Tagged | Leave a comment

Calling Pascal procedures to Manipulate the GnuCOBOL String Data Structure

Last episode saw the definition of a string data structure for COBOL. This episode will show how to write Pascal Code to manipulate the string data structure (cst-string).

Using these examples, it would be easy enough to implement any needed string processing procedure.

I have created 3 Pascal procedures: cstset, cstdeb, and cstrightj.

cstset is used to initialize cst-string by moving text from a buffer into cst-string and setting the cst-len appropriately. It replaces the COBOL-only code I did in the prior post.

cstdeb (deblank) will remove leading and trailing spaces from cst-string.

cstrightj (right justify) will right justify the text in cst-string using the specified field width.

To make using these procedures easier, there is a copy book (.cpy file) for each call: cfCstSet, cfCstDeb, and cfCstRightJ.

Rather than describe all of the parts, the following file contains a listing of the Pascal program, commands to compile and execute the Pascal and COBOL code with the resulting run’s output, and finally the compiler’s listing of the COBOL code.

All Listings

 

Posted in c-gnuCOBOL | Tagged , | Leave a comment