COBOL and XAB

[Mick O'Brien]

How can I get file creation date on XAB from a COBOL program?

[Richard J Maher]

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]

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]

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]

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]

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.

[Mick O'Brien]

Thanks for the replies.

Hein - I'm a little confused with pointers. I have been looking at documentation and from that I see all the XAB blocks are chained (please see attached excel spreadsheet) but your code appears to go directly to the XABRDT block i.e. by-passing need to chain. Can you explain to me how this works then I can go direct to XABDAT block for creation date.

Thanks
Mick

[Hein van den Heuvel · Accepted solution]

[ I missed a NOT in a feeble attempt to make a joke/poke in the prior reply. Sorry.]

>> all the XAB blocks are chained

Yes, any XAB that need to be considered, be it for input or output, need to be chained through XAB$L_NXT starting from FAB$L_XAB (or the RAB).

In this case we can save whatever there was (nothing, but better save than sorry).
Hook up the 1 we need, do the deed, restore as found.

Working CDT example below.

My threshold for OTS$MOVC3, LIB$INSV and the likes calls in Cobol program is about 3.
Any more and I prefer switching to a more suitable language to do referencing and bit-twiddling.
MACRO is always there, so is a fine alternate choice for me.


Hein


$ type cdt.cob
IDENTIFICATION DIVISION.
PROGRAM-ID. cdt_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 XAB_CDT_PT POINTER.
01 FAB_XAB POINTER.

* skeleton XAB DAT V2, this is the easy/short one
01 XAB_CDT_REC.
05 XABRDT_BLN_COD PIC S9(9) COMP VALUE 9234.
05 NXT USAGE IS POINTER VALUE 0.
05 rvn PIC 9(9) COMP.
05 rdt PIC 9(18) COMP.
05 CDT PIC 9(18) COMP.
05 EDT PIC 9(18) COMP.
05 BDT PIC 9(18) COMP.

01 REC_LEN PIC 9(4) COMP.
01 RTN_STATUS PIC 9(9) COMP.
01 CDT_TIME PIC X(23).
01 SAVE_XAB_PTR USAGE IS POINTER.

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.

* Get currect XAB value (if any), hook up our XAB, DISPLAY and restore.

ADD 36 TO FAB_PT GIVING FAB_XAB.
CALL "OTS$MOVE3" USING BY VALUE 4, BY VALUE FAB_XAB, BY REFERENCE SAVE_XAB_PTR.
SET XAB_CDT_PT TO REFERENCE OF XAB_CDT_REC.
CALL "OTS$MOVE3" USING BY VALUE 4, BY REFERENCE XAB_CDT_PT, BY VALUE FAB_XAB.
CALL "SYS$DISPLAY" USING BY VALUE FAB_PT GIVING RTN_STATUS.
IF RTN_STATUS IS FAILURE CALL "SYS$EXIT" USING BY VALUE RTN_STATUS.
CALL "OTS$MOVE3" USING BY VALUE 4, BY REFERENCE SAVE_XAB_PTR BY VALUE FAB_XAB.

CALL "SYS$ASCTIM" USING BY VALUE 0, BY DESCRIPTOR CDT_TIME, BY REFERENCE CDT, BY VALUE 0.

DISPLAY "Create Date : ", CDT_TIME.
CLOSE TEST_FILE.
STOP RUN.

[Mick O'Brien]

Hein,

Thanks - I think I begin to understand i.e. within COBOL code the call to sys$display statement populates record according to value in BLN/COD field. Can you point me in the right direction (a link please) where these codes and associated records are detailed?

Thanks,
Mick

[Hein van den Heuvel]

Correct.
A piece of memory becomes an XAB if the first byte (XAB$B_BID) has one of a dozen valid XAB code, and if the second byte (XAB$B_BLN) has one of the valid length indicator.
The XAB$L_NXT had better be reasonable or NULL, once RMS decides it is a valid XAB flavor.

All languages EXCEPT Cobol have reasonable methods to define XAB structures. So you can use the PASCAL, C, BASIC,... defintions from the STARLET libraries.
Personally, I just use the MACRO definitions for Cobol (ab)use.

$ libr/extr=$xabdatdef/out=xabdat.mar sys$library:starlet.mlb

Hein