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

[Hein van den Heuvel]

For yucks I typed in a MACRO subroutine. Compiled and linked in one. Yeah.. I can still do it :-)

Hein

---------- my_get_cdt.mar --------
$FABDEF
.psect data,noexe,wrt
xabdat: $xabdat
.psect code,exe,nowrt
.entry my_get_cdt, 0
CALLS #0, G^DCOB$RMS_CURRENT_FAB ; pick up FAB address
MOVL R0, R8
MOVL FAB$L_XAB(r8), R2 ; Save old contents
MOVAL xabdat, FAB$L_XAB(r8) ; Insert our XAB
PUSHL r8
CALLS #1, G^SYS$DISPLAY ; Please
BLBC R0, 10$ ; Problem?
PUSHL #0 ; Time and Date
PUSHAL xabdat + XAB$Q_CDT ; RMS provided Creation Date
PUSHL 4(ap) ; Caller provided Ascci time buffer
PUSHL #0 ; No return length
CALLS #4, G^SYS$ASCTIM
MOVL R2, FAB$L_XAB(r8) ; Restore as found
10$: RET
.end

----------- Sample cobol caller ----------------

OPEN I-O TEST_FILE.
IF FILE_STATUS NOT = "00" THEN
DISPLAY "ERROR: TEST FILE OPEN ERROR, STATUS: ", FILE_STATUS
STOP RUN
END-IF.

CALL "my_get_cdt" USING BY DESCRIPTOR CDT_TIME GIVING rtn_status.
IF rtn_status IS FAILURE CALL "sys$exit" USING BY VALUE rtn_status.

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

[Mick O'Brien]

Hein,

Maybe this is a silly question but is there any way of getting the file creation date without opening the file - I'm just s trifle (raspberry) worried that the date may not be available if the file is already open (for exclusive access) by another process?

Regards
Mick
(PS - I'm happy you still have it. Do you know if it's contagious?)

[Hein van den Heuvel]

Yes, Macro is contagious. It takes a good bit of exposure to catch it, but once infected it's hard to shake. :-)

>> worried that the date may not be available if the file is already open

That's a very valid concern.
This is the same problem say F$FILE (filename,"CDT") has.

DIRECTORY/DATE=CREATE does NOT have that problem. It uses QIO access, does not open the file, and only requires the right to look at the file.

I have some examples for that (NOT using Cobol :-), some on the RMS_TOOLS directory under VMS Freeware, overdue for refresh.

But now we have to ask 'what problem are you really trying to solve'.

And without waiting for the answer, but assuming it is a silly management request, how about spawning DIR/DATE from COBOL and just tell them you'll need a bigger box if they really want to have this done?
:-)

Cheers,
Hein

Note 1 : I'm waiting for my flight home in the lounge for 'special people' in DTW, not feeing like 'real' work. So I had an hour or two to burn.

Note 2: Forgot the 'retain formatting' checkmark on the Macro reply. Sorry. Source attached as .TXT to make up for that.

[Mick O'Brien]

Hein,

What I'm trying to do is capture the creation date of a log file whilst it is still open hence my questions. I have found example COBOL code that calls a macro to get the file fid and then makes calls to sys$qiow to get creation date, however as the GETFID macro still opens the file its just not quite right. Could you let me have details of programs that user ONLY sys$qiow (i.e. no file opens) to get creation date?

Thanks,
Mick

[Richard J Maher]

Hi Ungrateful,

Guess there's nothing quite as tragic as unrequited love - I'll try and soldier on :-)

IIRC GETFID was only needed to get the FID/DID so that the $QIO IO$_ACPCONTROL (or io$_access) could use it to do the directory lookup?

If I'm also not mistaken sys$parse outputs the File ID and Directory ID without openong the file (or maybe even has a channel that can be re-used?) See attached for an example of $parse_s and other stuff.

Either way, my money's on your requirement of "creation date without having to open the file" being doable. (But I'm also guessing that detailed spec is worth about one point, so hold out for someone to come and play the aeroplane game. Open wide, boosh, woosh :-)

Maybe if you posted your current FIB definition and $qio code it might speed things up a little bit?

Cheers Richard Maher

PS. Bougainvillia: 1 People with skin: 0

PPS. Bojan great to see you're still around! (as it is Hein) If you get a few minutes and think you might know why FF3 is giving me "too much recursion" please look at:
http://groups.google.com/group/comp.lang.javascript/msg/43b32679ec125b17
Chrome is fine! FF2 is Fine! IE9 craps out after a while in the "innerHTML ="

[Mick O'Brien]

As Roy Orbison sang...

"Only the lonely (dum-dum-dum-dumdy-doo-wah)
Know the way I feel tonight
(ooh-yay-yay-yay-yeah)
Only the lonely (dum-dum-dum-dumdy-doo-wah)
Know this feelinâ ainâ t right
(dum-dum-dum-dumdy-doo-wah)"

I think that last line's for you!

Anyways I have attached the code for you to view (note your name on GETFID.CBL)

I have not tried to run the attached .txt as a .com but should not be too many problems. The 'bit' that needs changing is get_creation_date.cbl where a call to GETFID is made.

Any help appreciated.

[Richard J Maher]

Hi Mick,

Just had a look at: -
http://h71000.www7.hp.com/doc/731final/4523/4523pro_030.html#parse_service_routine

And saw this: -
NAM$W_FID 1 File identification (zeroed).

I have to say that "zeroed" bit at the end is a bit discouraging :-) Anyway I've downloaded your example code and will get back if I have anything useful to say.

Cheers Richard Maher

PS. The Big O eh. Best comeback since Lazarus and then he drops dead. There's a moral in there somewhere.

[Richard J Maher]

Me again,

The bad news is RMS looks next to useless in this case (Hein "Mr RMS" Van den Heuvel may prove me wrong)

The good news is I started hacking away at my DIR_WATCH.COM routine (why this has never been included in VMS escapes me!) and I've come up with something that appears to work even on open files. (i.e. no additional "open" required, just a dir lookup)

As with my UWSS, this code does an io$_access on the name and then gets the FID from the FIB. (RMS still being used to get the DID to pass to the $QIO)

Anyway it seems to work, but if I stuff around a bit more I'm sure I can get the creation date directly and save your code the: -

lib$find_file
get directory
$assign
dickie getfid
$qio
$dassgn
etc

Hopefully more later, but in the meantime here's the documentation to go with my DIR_WATCH UWSSs. They really are quite clever and the code is being re-used here so could aid in understanding?

Cheers Richard Maher

PS. Don't worry, all user-mode code in the new stuff.

[Hein van den Heuvel]

Richard, most true artist are only recognized when it's way too late. You know that. You will we redeemed. Eventually. Nice work on the directory watch. Looks neat.


Mick, check out the attached. It does what you want with a cute 'hack' exploiting the fact that the LIB$FIND_FILE context is in fact... drum roll... a FAB.
And a nice FAB at that, as it has a hooked up and populated NAM upon success.
So stuff the Cobol IO and go naked.
Not to worry. This has worked for 20+ years, and there's no-one left to break it.

fwiw, I pretty much replaced the getfid with an OTS$MOVE3 to de-reference the NAM from the FAB. Hardcoded ATR$ stuff to make kitting easier. This values can't be changed. They are baked in to too many programs.
And added a sanity check on the QIO IOSB

Enjoy.
Hein

SMOP to pick up the full file name from the RSA (Resultant File Name String Address) or indeed why not from the lib$find_file return.

[Richard J Maher]

Hi Mick,

I'd go with Hein's purely as it is fiendishly clever (although I contend that mine is demonstrable "better" :-)

The lack of Macro's probably also a maintenance bonus for some. Anyway OTY. . .

Cheers Richard Maher

[Richard J Maher]

Hi Hein,

I was curious how lib$find_file was populating the FID without opening the file. Do you (or anyone) have the source handy to check which RMS service(s) is called? Or does it hand-build the NAM?

Anyway, after I checked that yours works with a file opened with NOSHARE (how could I have doubted you :-) I thought "Oops! I better test mine". Anyway, in my haste for the original file I put in a few typos and realized Mick traditionally doesn't do a lot of call_status checking. When I thought my code was failing it just didn't like the SYS$MANAGER search list. (ss$_badparam) Feel free to drop that check if it bothers anyone.

Cheers Richard Maher

PS. Attached better version of com file.

PPS. Mick where are you? IIRC you used to leave at 3:00pm and used to be in early(ish) Perhaps another bank holiday at club you-know-what on the costa del you-know-what :-)

[Hein van den Heuvel]

Libb$find_file(_end) is just a friendly wrapper around SYS$PARSE + loop with around SYS$SEARCH, anchored by a FAB.
So you could use those RMS service to get FID and DID. RMS gets thos FID and DID from the on disk and in cache directories. It does not do an access, does not get to the file header in this context.

Cheers,
Hein

[Mick O'Brien]

I must admit I like both solutions albeight Hein's one (via his 'hack') seems easier to implement and maintain. Addtionally to this the comment in his code (are you taking note Richard)....
*
* Attribute list. Values hard-coded. Obtained from :
* $ pipe libr/extr=$atrdef/out=sys$output sys$library:starlet.mlb | sea sys$pipe credate
*
*

...indicates how other file attributes can be accessed.

Now all I have to do is stick it into a BASIC program (maybe I should have started a forum entitled BASIC and XAB).

PS: Richard, COIN is now on 8.3 - that's what I was doing Friday night/Saturday morning

[John Gillings]

Mick,

>Now all I have to do is stick it into a
>BASIC program

This type of function is typically much more compact, easy to read and more general written in MACRO32.

Clearly portability cannot be a concern.

See attached file GETCRE.MAR

routine GET_CREATION_DATE(
file: input string by descriptor,
date: output quadword by reference)

No need for compiler licenses.

[John Gillings]

>...indicates how other file attributes can
>be accessed.

Oops, forgot... to add attributes, add arguments and extend the attribute block. For example:

PUSHL #0 ; build attribute block on stack
PUSHAB @8(AP) ; return address for creation date
PUSHL #<!ATR$S_CREDATE>
PUSHAB @12(AP) ; return address for REVDATE
PUSHL #<!ATR$S_REVDATE>
PUSHAB @16(AP) ; return address for EXPDATE
PUSHL #<!ATR$S_EXPDATE>