CBL_WRITE_FILE does nothing

The following program doesn't seem to do anything. It compiles and runs, and in the debugger the IF conditions indicating an error are never TRUE. It just runs to completion, displays blanks, and writes no file. What am I missing? (ACUCOBOL version is 32-bit ACU 9.2.1 for Windows.)

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  IOTEST.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FILE-STATUS-GROUP.
           03  FILE-STATUS    PIC XX    COMP-X.
           03  REDEFINES FILE-STATUS.
               05  FS-BYTE-1  PIC X.
               05  FS-BYTE-2  PIC X     COMP-X.

       01  FILENAME     PIC X(32)  VALUE "test.txt".

       01  ACCESS-MODE  PIC X     COMP-X  VALUE 3.
       01  DENY-MODE    PIC X     COMP-X  VALUE 0.
       01  FILE-HANDLE  PIC X(4)  COMP-X  VALUE 0.

       01  OFFSET       PIC X(8)  COMP-X  VALUE 0.
       01  WRITE-COUNT  PIC X(4)  COMP-X  VALUE 32.
       01  READ-COUNT   PIC X(4)  COMP-X  VALUE 32.
       01  GREETING     PIC X(32)         VALUE "HELLO".
       01  REPLY        PIC X(32)         VALUE SPACE.

       PROCEDURE DIVISION.
           CALL "CBL_OPEN_FILE"
               USING FILENAME, ACCESS-MODE, DENY-MODE, 1, FILE-HANDLE
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_WRITE_FILE"
               USING FILE-HANDLE, OFFSET, WRITE-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_READ_FILE"
               USING FILE-HANDLE, OFFSET, READ-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           DISPLAY "Reply: " REPLY

           CALL "CBL_CLOSE_FILE"
             USING FILE-HANDLE
             RETURNING RETURN-CODE
           END-CALL

           GOBACK.

#CBL_WRITE_FILE

Page 1 / 1

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  IOTEST.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FILE-STATUS-GROUP.
           03  FILE-STATUS    PIC XX    COMP-X.
           03  REDEFINES FILE-STATUS.
               05  FS-BYTE-1  PIC X.
               05  FS-BYTE-2  PIC X     COMP-X.

       01  FILENAME     PIC X(32)  VALUE "test.txt".

       01  ACCESS-MODE  PIC X     COMP-X  VALUE 3.
       01  DENY-MODE    PIC X     COMP-X  VALUE 0.
       01  FILE-HANDLE  PIC X(4)  COMP-X  VALUE 0.

       01  OFFSET       PIC X(8)  COMP-X  VALUE 0.
       01  WRITE-COUNT  PIC X(4)  COMP-X  VALUE 32.
       01  READ-COUNT   PIC X(4)  COMP-X  VALUE 32.
       01  GREETING     PIC X(32)         VALUE "HELLO".
       01  REPLY        PIC X(32)         VALUE SPACE.

       PROCEDURE DIVISION.
           CALL "CBL_OPEN_FILE"
               USING FILENAME, ACCESS-MODE, DENY-MODE, 1, FILE-HANDLE
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_WRITE_FILE"
               USING FILE-HANDLE, OFFSET, WRITE-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_READ_FILE"
               USING FILE-HANDLE, OFFSET, READ-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           DISPLAY "Reply: " REPLY

           CALL "CBL_CLOSE_FILE"
             USING FILE-HANDLE
             RETURNING RETURN-CODE
           END-CALL

           GOBACK.

#CBL_WRITE_FILE

First, you shouldn't use the RETURNING RETURN-CODE phrase on any CALL statement. You should instead do one of the following:

Omit the RETURNING clause entirely, in which case the RETURN-CODE special register will get populated
Use RETURNING with a variable you define yourself in Working-Storage

The reasons for this, as I recall, are somewhat obscure and may only apply to ACUCOBOL, but by using RETURNING RETURN-CODE, the value of RETURN-CODE gets reset to whatever value it held prior to the CALL.

Secondly, the fourth parameter to CBL_OPEN_FILE should be a PIC X COMP-X field set to 0.

Having made these changes, when I compile and run your program, I get a file status of 14622 after the call to CBL_OPEN_FILE. Decoded by bytes, this gives "9", 30, and looking up 30 in the ANSI-74 file status table, it means "Permanent error. This is any error not otherwise described."

I don't have any explanation why this doesn't work.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  IOTEST.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FILE-STATUS-GROUP.
           03  FILE-STATUS    PIC XX    COMP-X.
           03  REDEFINES FILE-STATUS.
               05  FS-BYTE-1  PIC X.
               05  FS-BYTE-2  PIC X     COMP-X.

       01  FILENAME     PIC X(32)  VALUE "test.txt".

       01  ACCESS-MODE  PIC X     COMP-X  VALUE 3.
       01  DENY-MODE    PIC X     COMP-X  VALUE 0.
       01  FILE-HANDLE  PIC X(4)  COMP-X  VALUE 0.

       01  OFFSET       PIC X(8)  COMP-X  VALUE 0.
       01  WRITE-COUNT  PIC X(4)  COMP-X  VALUE 32.
       01  READ-COUNT   PIC X(4)  COMP-X  VALUE 32.
       01  GREETING     PIC X(32)         VALUE "HELLO".
       01  REPLY        PIC X(32)         VALUE SPACE.

       PROCEDURE DIVISION.
           CALL "CBL_OPEN_FILE"
               USING FILENAME, ACCESS-MODE, DENY-MODE, 1, FILE-HANDLE
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_WRITE_FILE"
               USING FILE-HANDLE, OFFSET, WRITE-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_READ_FILE"
               USING FILE-HANDLE, OFFSET, READ-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           DISPLAY "Reply: " REPLY

           CALL "CBL_CLOSE_FILE"
             USING FILE-HANDLE
             RETURNING RETURN-CODE
           END-CALL

           GOBACK.

#CBL_WRITE_FILE

I used:

01 my-val pic 99.

01 fourth-value pic x comp-x value 0.

PROCEDURE DIVISION.

CALL "CBL_OPEN_FILE"

USING FILENAME,

ACCESS-MODE,

DENY-MODE,

fourth-value,

FILE-HANDLE

RETURNING my-val

END-CALL

compiled and executed with 9.2.1 and I get a return-code of 0 (zero).

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  IOTEST.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FILE-STATUS-GROUP.
           03  FILE-STATUS    PIC XX    COMP-X.
           03  REDEFINES FILE-STATUS.
               05  FS-BYTE-1  PIC X.
               05  FS-BYTE-2  PIC X     COMP-X.

       01  FILENAME     PIC X(32)  VALUE "test.txt".

       01  ACCESS-MODE  PIC X     COMP-X  VALUE 3.
       01  DENY-MODE    PIC X     COMP-X  VALUE 0.
       01  FILE-HANDLE  PIC X(4)  COMP-X  VALUE 0.

       01  OFFSET       PIC X(8)  COMP-X  VALUE 0.
       01  WRITE-COUNT  PIC X(4)  COMP-X  VALUE 32.
       01  READ-COUNT   PIC X(4)  COMP-X  VALUE 32.
       01  GREETING     PIC X(32)         VALUE "HELLO".
       01  REPLY        PIC X(32)         VALUE SPACE.

       PROCEDURE DIVISION.
           CALL "CBL_OPEN_FILE"
               USING FILENAME, ACCESS-MODE, DENY-MODE, 1, FILE-HANDLE
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_WRITE_FILE"
               USING FILE-HANDLE, OFFSET, WRITE-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_READ_FILE"
               USING FILE-HANDLE, OFFSET, READ-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           DISPLAY "Reply: " REPLY

           CALL "CBL_CLOSE_FILE"
             USING FILE-HANDLE
             RETURNING RETURN-CODE
           END-CALL

           GOBACK.

#CBL_WRITE_FILE

Awesome. Thank you both for the rapid and helpful replies. I'll try these changes and will report back.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  IOTEST.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FILE-STATUS-GROUP.
           03  FILE-STATUS    PIC XX    COMP-X.
           03  REDEFINES FILE-STATUS.
               05  FS-BYTE-1  PIC X.
               05  FS-BYTE-2  PIC X     COMP-X.

       01  FILENAME     PIC X(32)  VALUE "test.txt".

       01  ACCESS-MODE  PIC X     COMP-X  VALUE 3.
       01  DENY-MODE    PIC X     COMP-X  VALUE 0.
       01  FILE-HANDLE  PIC X(4)  COMP-X  VALUE 0.

       01  OFFSET       PIC X(8)  COMP-X  VALUE 0.
       01  WRITE-COUNT  PIC X(4)  COMP-X  VALUE 32.
       01  READ-COUNT   PIC X(4)  COMP-X  VALUE 32.
       01  GREETING     PIC X(32)         VALUE "HELLO".
       01  REPLY        PIC X(32)         VALUE SPACE.

       PROCEDURE DIVISION.
           CALL "CBL_OPEN_FILE"
               USING FILENAME, ACCESS-MODE, DENY-MODE, 1, FILE-HANDLE
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_WRITE_FILE"
               USING FILE-HANDLE, OFFSET, WRITE-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_READ_FILE"
               USING FILE-HANDLE, OFFSET, READ-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           DISPLAY "Reply: " REPLY

           CALL "CBL_CLOSE_FILE"
             USING FILE-HANDLE
             RETURNING RETURN-CODE
           END-CALL

           GOBACK.

#CBL_WRITE_FILE

Yes, it all works now. Just to close the loop, here's the complete working test program. Thank you!

IDENTIFICATION DIVISION.

PROGRAM-ID. IOTEST.

DATA DIVISION.

WORKING-STORAGE SECTION.

01 FILE-STATUS-GROUP.

03 FILE-STATUS PIC XX COMP-X.

03 REDEFINES FILE-STATUS.

05 FS-BYTE-1 PIC X.

05 FS-BYTE-2 PIC X COMP-X.

01 CREATE-FILE-PARAMS.

03 FILENAME PIC X(32) VALUE "test.txt".

03 ACCESS-MODE PIC X COMP-X VALUE 3.

03 DENY-MODE PIC X COMP-X VALUE 0.

03 DEVICE PIC X(4) COMP-X VALUE 0.

03 FILE-HANDLE PIC X(4) COMP-X VALUE 0.

01 WRITE-FILE-PARAMS.

03 WRITE-OFFSET PIC X(8) COMP-X VALUE 0.

03 WRITE-COUNT PIC X(4) COMP-X VALUE 32.

03 WRITE-FLAGS PIC X(4) COMP-X VALUE 0.

03 WRITE-BUFFER PIC X(32) VALUE "HELLO".

01 READ-FILE-PARAMS.

03 READ-OFFSET PIC X(8) COMP-X VALUE 0.

03 READ-COUNT PIC X(4) COMP-X VALUE 32.

03 READ-FLAGS PIC X(4) COMP-X VALUE 0.

03 READ-BUFFER PIC X(32) VALUE SPACE.

01 my-val pic 99.

01 fourth-value pic x comp-x value 0.

PROCEDURE DIVISION.

CALL "CBL_CREATE_FILE"

USING FILENAME,

ACCESS-MODE,

DENY-MODE,

DEVICE,

FILE-HANDLE

RETURNING FILE-STATUS

END-CALL

DISPLAY "After CBL_CREATE_FILE:"

DISPLAY " File handle: " FILE-HANDLE

DISPLAY " File status: " FILE-STATUS

CALL "CBL_WRITE_FILE"

USING FILE-HANDLE,

WRITE-OFFSET,

WRITE-COUNT,

WRITE-FLAGS,

WRITE-BUFFER

RETURNING FILE-STATUS

END-CALL

DISPLAY "After CBL_WRITE_FILE:"

DISPLAY " File status: " FILE-STATUS

CALL "CBL_FLUSH_FILE"

USING FILE-HANDLE

RETURNING FILE-STATUS

END-CALL

DISPLAY "After CBL_FLUSH_FILE:"

DISPLAY " File status: " FILE-STATUS

CALL "CBL_READ_FILE"

USING FILE-HANDLE,

READ-OFFSET,

READ-COUNT,

READ-FLAGS,

READ-BUFFER

RETURNING FILE-STATUS

END-CALL

DISPLAY "After CBL_READ_FILE:"

DISPLAY " File status: " FILE-STATUS

DISPLAY " Read buffer: " READ-BUFFER

CALL "CBL_CLOSE_FILE"

USING FILE-HANDLE

RETURNING FILE-STATUS

END-CALL

DISPLAY "After CBL_CLOSE_FILE:"

DISPLAY " File status: " FILE-STATUS

DISPLAY "Press any key to continue . . ."

ACCEPT OMITTED

GOBACK.

       IDENTIFICATION DIVISION.
       PROGRAM-ID.  IOTEST.

       DATA DIVISION.
       WORKING-STORAGE SECTION.
       01  FILE-STATUS-GROUP.
           03  FILE-STATUS    PIC XX    COMP-X.
           03  REDEFINES FILE-STATUS.
               05  FS-BYTE-1  PIC X.
               05  FS-BYTE-2  PIC X     COMP-X.

       01  FILENAME     PIC X(32)  VALUE "test.txt".

       01  ACCESS-MODE  PIC X     COMP-X  VALUE 3.
       01  DENY-MODE    PIC X     COMP-X  VALUE 0.
       01  FILE-HANDLE  PIC X(4)  COMP-X  VALUE 0.

       01  OFFSET       PIC X(8)  COMP-X  VALUE 0.
       01  WRITE-COUNT  PIC X(4)  COMP-X  VALUE 32.
       01  READ-COUNT   PIC X(4)  COMP-X  VALUE 32.
       01  GREETING     PIC X(32)         VALUE "HELLO".
       01  REPLY        PIC X(32)         VALUE SPACE.

       PROCEDURE DIVISION.
           CALL "CBL_OPEN_FILE"
               USING FILENAME, ACCESS-MODE, DENY-MODE, 1, FILE-HANDLE
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_WRITE_FILE"
               USING FILE-HANDLE, OFFSET, WRITE-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           CALL "CBL_READ_FILE"
               USING FILE-HANDLE, OFFSET, READ-COUNT, 0, GREETING
               RETURNING RETURN-CODE
           END-CALL

           IF NOT RETURN-CODE = 0
               MOVE RETURN-CODE TO FILE-STATUS
           END-IF

           DISPLAY "Reply: " REPLY

           CALL "CBL_CLOSE_FILE"
             USING FILE-HANDLE
             RETURNING RETURN-CODE
           END-CALL

           GOBACK.

#CBL_WRITE_FILE

Oops. These two lines are not needed:

01 my-val pic 99.

01 fourth-value pic x comp-x value 0.

Sign up

Please log in or register:

Welcome to the Rocket Forum!

Please log in or register:

Scanning file for viruses.

This file cannot be downloaded