|
View previous topic :: View next topic
|
| Author |
Message |
Gary Lin
Warnings : 1
New User
Joined: 08 Mar 2009
Posts: 15
Location: Taipei, Taiwan
|
|
|
|
| is anyone have a COBOL program which will do the function like the assembler STCKCONV ? |
|
| Back to top |
|
 |
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hello,
Doubtful as cobol does not have STore ClocK (stck) capability. Why not just use the assembler macro in a small module as is? |
|
| Back to top |
|
|
Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
Gary,
I dug up this COBOL code (TODCONV), so give it a try or adjust as needed. The minimum version/release is COBOL/370 as this code uses FUNCTION's and it converts an existing STCK value, passed in WS-TOD-DWORD -
| Code: |
03 WS-CCYYMMDD PIC 9(008).
03 WS-CCYYMMDD-X REDEFINES WS-CCYYMMDD
PIC X(008).
03 WS-HHMMSS PIC 9(006).
03 FILLER REDEFINES WS-HHMMSS.
05 WS-TIME-HH PIC 9(002).
05 WS-TIME-MM PIC 9(002).
05 WS-TIME-SS PIC 9(002).
03 WS-MSECS-PACKED PIC S9(015) PACKED-DECIMAL.
03 WS-MSECS-PACKED-X REDEFINES WS-MSECS-PACKED
PIC X(008).
03 WS-DWORD PIC S9(015) PACKED-DECIMAL.
03 WS-DWORD-X REDEFINES WS-DWORD
PIC X(008).
03 WS-TOD-DWORD PIC S9(018) BINARY.
03 WS-TOD-DWORD-X REDEFINES WS-TOD-DWORD
PIC X(008).
03 WS-BINARY-DWORD PIC S9(018) BINARY.
03 WS-BINARY-DWORD-X REDEFINES WS-BINARY-DWORD
PIC X(008).
03 WS-INTEGER-OF-DATE PIC S9(009) PACKED-DECIMAL.
03 WS-SAVE-MSECS PIC S9(015) PACKED-DECIMAL.
03 WS-SAVE-MSECS-X REDEFINES WS-SAVE-MSECS
PIC X(008).
03 WS-DBLWORD PIC S9(015) PACKED-DECIMAL.
03 WS-DBLWORD-X REDEFINES WS-DBLWORD
PIC X(008).
03 WS-CALC-SECS PIC S9(015) PACKED-DECIMAL.
03 WS-CALC-SECS-V999 REDEFINES WS-CALC-SECS
PIC S9(012)V999 PACKED-DECIMAL.
03 WS-CALC-SECS-X REDEFINES WS-CALC-SECS
PIC X(008).
*
* FIRST, SHIFT-RIGHT ONE-BYTE, THEN SHIFT-RIGHT 4-BITS. DIVIDE
* THE BINARY-DOUBLEWORD BY 60000000 WITH THE RESULTING DIVIDEND
* IN 'WS-DWORD' AND THE REMAINDER IN 'WS-DBLWORD'. ADJUST BOTH
* OF THESE PACKED-DOUBLEWORDS ACCORDINGLY AND CALCULATE INTO
* 'WS-MSECS-PACKED' AND YOU'LL NOW HAVE NUMBER OF MILLISECONDS
* SINCE JANUARY 1, 1900.
*
* NOTE THAT DIVIDING THE BINARY-DOUBLEWORD BY 4096 (TO SHIFT
* RIGHT 12-BITS) _W I L L_ RESULT IN A S0C7. SO, THIS IS THE
* REASON FOR THE RIGHT-SHIFTING OF ONE-BYTE FOLLOWED BY THE
* RIGHT-SHIFTING OF 4-BITS (DIVIDE DOUBLEWORD BY 16).
*
* WHEN ALL IS SAID AND DONE, WS-CCYYMMDD WILL CONTAIN THE
* DATE AND WS-HHMMSS WILL CONTAIN THE TIME.
*
MOVE LOW-VALUE TO WS-BINARY-DWORD-X (1:1).
MOVE WS-TOD-DWORD-X TO WS-BINARY-DWORD-X (2:).
COMPUTE WS-BINARY-DWORD = (WS-BINARY-DWORD / 16).
DIVIDE WS-BINARY-DWORD BY 60000000
GIVING WS-DWORD
REMAINDER WS-DBLWORD.
COMPUTE WS-MSECS-PACKED = (WS-DWORD * 60000) +
(WS-DBLWORD / 1000).
MOVE WS-MSECS-PACKED TO WS-SAVE-MSECS.
COMPUTE WS-DBLWORD = (WS-SAVE-MSECS / 86400000).
COMPUTE WS-INTEGER-OF-DATE = (WS-DBLWORD + 109208).
COMPUTE WS-CALC-SECS = (WS-SAVE-MSECS -
(WS-DBLWORD * 86400000)).
MOVE WS-CALC-SECS-V999 TO WS-DBLWORD.
MOVE WS-DBLWORD TO WS-CALC-SECS.
*
IF WS-SAVE-MSECS-X (7:1) > X'49'
ADD 1 TO WS-CALC-SECS
END-IF.
*
COMPUTE WS-TIME-HH = (WS-CALC-SECS / 3600).
COMPUTE WS-CALC-SECS = (WS-CALC-SECS -
(WS-TIME-HH * 3600)).
COMPUTE WS-TIME-MM = (WS-CALC-SECS / 60).
COMPUTE WS-TIME-SS = (WS-CALC-SECS -
(WS-TIME-MM * 60)).
COMPUTE WS-CCYYMMDD = FUNCTION DATE-OF-INTEGER
(WS-INTEGER-OF-DATE).
|
FWIW, adding 109208 to WS-DBLWORD will yield the number of days since 1 January 1601 and 1 January 1900.
HTH....
Bill |
|
| Back to top |
|
|
Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
Gary,
In my previous post -
"FWIW, adding 109208 to WS-DBLWORD will yield the number of days since 1 January 1601 and 1 January 1900." is not a true statement. What it will do is to calculate the CCYYMMDD associated with your converted STCK <---> Millisecond value.
Bill |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hi Bill,
How does the calculation code obtain this vaue (WS-TOD-DWORD)? |
|
| Back to top |
|
|
Bill O'Boyle
CICS Moderator
Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA
|
|
|
|
Dick,
Oops, that's the input STCK value to be converted. 
I wrote it over five years ago and I hope it still works!
Bill |
|
| Back to top |
|
|
dick scherrer
Moderator Emeritus
Joined: 23 Nov 2006
Posts: 19244
Location: Inside the Matrix
|
|
|
|
Hi Bill,
| Quote: |
| I wrote it over five years ago and I hope it still works! |
Should be ok (or we're all in big trouble if code gets "dusty" and clogs after sitting around for a while  ).
Now, if there was just a cobol function for stck/stcke. . . . |
|
| Back to top |
|
|
|
|
