Operating System - OpenVMS
cancel
Showing results for 
Search instead for 
Did you mean: 

COBOL and XAB

 
SOLVED
Go to solution
Mick O'Brien
Advisor

COBOL and XAB

How can I get file creation date on XAB from a COBOL program?
34 REPLIES 34
Richard J Maher
Trusted Contributor

Re: COBOL and XAB

Biggus Mickus,

Rush, rush, rush, so off the top of my head: - with Alpha & Itanium there are those routines that look very much like dcob$get_current_rab and $get_current_fab. I imagine that you can trace the XAB chain from the FAB pointer until you get the one for dates and then locate the date you want.

Alternatively (and I think you'll have code for this somewhere) there should be something like a io$acp_control on the disk driver that returns "blocks" like statistics and stuff and I reakon one of them is the date you want.

Cheers Richard Maher
Mick O'Brien
Advisor

Re: COBOL and XAB

Richard,

I looked at those DCOB routines and wrote a test program that opened a file then called DCOB$get_current_fab but the XAB address was set to zero! So looking within documentation it appears (to me) that thet address needs to be set up prior to opening the file in order to get fields populated (i.e. calling dcob$get_current_fab AFTER the open does not help me). Can you give me a bit more information on the system call and how I can use that?

Mick
Richard J Maher
Trusted Contributor

Re: COBOL and XAB

Hi Mick,

Bummer about the XAB :-(

Goin out now, jogging (still in denial) tomorrow morning, then getting ripped to shreads by my mum's bougainvillea. If no ones given you the answer by then I'll fire up the VAX and try to see if that codes any use.

Cheers Richard Maher.

PS. We are now officially paying twice as much for a pint as you :-( *West London or City* -vs- Perth!
Bojan Nemec
Honored Contributor

Re: COBOL and XAB

Mick,

There is the link to the documentation of the routines that Richard mentioned:

http://h71000.www7.hp.com/doc/82final/6296/6296pro_110.html#rtl_rout

The example gives you how to get the FAB block. I dont know
if the FAB$L_XAB is filled by COBOL. This is the pointer to the next XAB block.
Probably the best vay is to create a XABDAT structure, set the reference of the FAB$L_XAB (XAB-ADD field in the example) to this structure and call SYS$DISPLAY so that the structure fget filled.
Remember to set the XAB$B_COD and XAB$B_BLN fields to the apropriate value.

Some more pointers to the documentation:


XABDAT specification:
http://h71000.www7.hp.com/doc/731final/4523/4523pro_014.html#index_x_668

SYS$DISPLAY specification:
http://h71000.www7.hp.com/doc/731final/4523/4523pro_024.html#index_x_961


Bojan
Hein van den Heuvel
Honored Contributor

Re: COBOL and XAB


Below is an example I made a while (decade?) ago to SET the Modification date in Cobol.

You'd need to call SYS$DISPLAY after hooking up the XAB, and SYS$ASCTIM after that passing the CDT field which needs to be added to the XAB layout


If you can't change that to GET the CDT in cobol, then you should be programming in cobol.

Actually, considering how contrived pointer handling and creating an XAB layout is, I would never really code this in Cobol.
Just make a little MACRO or C subroutine to do the job passing the current-fab and an output buffer.
In the routine save the current xab, hookup yours, display, restore.

Cheers,
Hein.

IDENTIFICATION DIVISION.
PROGRAM-ID. rdt_test.
ENVIRONMENT DIVISION.
INPUT-OUTPUT SECTION.
FILE-CONTROL.
SELECT TEST_FILE
ASSIGN TO TEST_NAME
FILE STATUS IS FILE_STATUS.

DATA DIVISION.
FILE SECTION.
FD TEST_FILE.
01 TEST_RECORD.
03 SOME-DATA PIC X(80).

WORKING-STORAGE SECTION.

01 FILE_STATUS PIC X(02) VALUE " ".
01 FAB_PT POINTER.
01 XABRDT_PT POINTER.
01 FAB_XAB POINTER.

01 XABRDT_REC.
05 XABRDT_BLN_COD PIC S9(9) COMP VALUE 5150.
05 NXT USAGE IS POINTER.
05 RVN PIC 9(9) COMP.
05 RDT PIC 9(18) COMP.

01 REC_LEN PIC 9(4) COMP.
01 RTN_STATUS PIC 9(9) COMP.
01 NEW_TIME PIC X(23) VALUE "01-APR-2001 01:23:45.67".

PROCEDURE DIVISION.

MY_MAIN SECTION.
MAIN.

OPEN I-O TEST_FILE.
IF FILE_STATUS = "00" THEN
CALL "DCOB$RMS_CURRENT_FAB" GIVING FAB_PT
ELSE
DISPLAY "ERROR: TEST FILE OPEN ERROR, STATUS: ", FILE_STATUS
STOP RUN
END-IF.

CALL "SYS$BINTIM" USING BY DESCRIPTOR NEW_TIME, BY REFERENCE RDT.

ADD 36 TO FAB_PT GIVING FAB_XAB.
SET XABRDT_PT TO REFERENCE OF XABRDT_REC.
CALL "OTS$MOVE3" USING BY VALUE 4,
BY REFERENCE XABRDT_PT,
BY VALUE FAB_XAB.

CLOSE TEST_FILE.
STOP RUN.