IBM Mainframe Forum Index
 
Log In
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Register
 

Time Delay in COBOL


IBM Mainframe Forums -> COBOL Programming
Post new topic   Reply to topic
View previous topic :: View next topic  
Author Message
himanshupant

New User


Joined: 21 Mar 2007
Posts: 46
Location: India

PostPosted: Wed Apr 08, 2009 9:33 am
Reply with quote

Hi

Is there any way to induce DELAY in a simple cobol module ( without DB2 / CICS).

Basically I have a requirement to generate Random number to be made as a part of VSAM key and I might have to generate it repeatedly if the earlier generated key already exists in the VSAM.

I tried using the below code fragment to generate Random number.

03 WS-TIME.
05 WS-HH PIC 99.
05 WS-MM PIC 99.
05 WS-SS PIC 99.
05 WS-MS PIC 99.
.
.
.
.
.
PROCEDURE DIVISION.
MOVE 10 TO WS-RANDOM
ACCEPT WS-TIME FROM TIME.
COMPUTE WS-RANDOM = FUNCTION RANDOM(WS-MS).
.
.
.
.
.
.
ACCEPT WS-TIME FROM TIME.
COMPUTE WS-RANDOM = FUNCTION RANDOM(WS-MS).
.
.
.
.
.
.
.
ACCEPT WS-TIME FROM TIME.
COMPUTE WS-RANDOM = FUNCTION RANDOM(WS-MS).

I am taking in system time 3 times seperated by a sequence of instructions but it so happens that all the time the millisecond component of system time is coming out to be same ( I obviously need a smaller subdivison than time to get unique value). In DB2 , I believe timestamp would have taken care of this to a certain extent and so in CICS but in a simple COBOL module how do we take care of this ?
Back to top
View user's profile Send private message
Terry Heinze

JCL Moderator


Joined: 14 Jul 2008
Posts: 1249
Location: Richfield, MN, USA

PostPosted: Wed Apr 08, 2009 9:18 pm
Reply with quote

I didn't take the time to read all the links referred to, but one easy way to get what you want (if timestamp will do, not random) would be to use the HHMMSS retrieved from COBOL then generate your own millisecond value by incrementing it manually.
Back to top
View user's profile Send private message
Mickeydusaor

Active User


Joined: 24 May 2006
Posts: 258
Location: Salem, Oregon

PostPosted: Thu Apr 09, 2009 2:52 am
Reply with quote

Have you look at the intrinsic FUNCTION RANDOM
Back to top
View user's profile Send private message
CICS Guy

Senior Member


Joined: 18 Jul 2007
Posts: 2146
Location: At my coffee table

PostPosted: Thu Apr 09, 2009 3:09 am
Reply with quote

After the initial ACCEPT, instead of
ACCEPT WS-TIME FROM TIME.
COMPUTE WS-RANDOM = FUNCTION RANDOM(WS-MS).
try
COMPUTE WS-RANDOM = FUNCTION RANDOM(RANDOM).
No delay will be needed and the pesky duplicates will be gone.
If a subsequent reference specifies argument-1, a new sequence of pseudorandom numbers is started.
Back to top
View user's profile Send private message
Bill O'Boyle

CICS Moderator


Joined: 14 Jan 2008
Posts: 2501
Location: Atlanta, Georgia, USA

PostPosted: Thu Apr 09, 2009 4:52 am
Reply with quote

How many bytes does this random number need to occupy?

You could call an Assembler sub-program, which issues a STCK (Store Clock) instruction, which is 8-Bytes binary and then shaves off the low-order 12-Bits and returns this value to the caller.

Upon return, the low-order bit represents one 4096 of a millisecond or is also known as 1/4 of a nanosecond.

Whenever a STCK is issued, it is guaranteed to be unique.

The sub-program below is not tested, but it will return either a 16 (STCK error) or ZERO (STCK successful) return-code. You can test the COBOL RETURN-CODE SPECIAL REGISTER for these values.

You need to pass it a single PIC 9(18) BINARY field, which does not need to be initialised. Upon return, this field will be populated with the above STCK value, already shifted right 12-Bits, with high-order X'00's.

I purposely did NOT save (or touch) R13, because there wasn't any need. However, you must NOT use R13 as it contains the address of the callers RSA and if it gets corrupted, you'll crash and burn.

Code:

RANDOM   CSECT
         USING *,R3               INFORM ASSEMBLER
         SAVE  (14,12)            SAVE CALLER'S REGISTERS
         LA    R3,0(,R15)         R3 IS OUR BASE-REGISTER
         L     R7(,R1)            PARAMETER ADDRESSABILITY
         USING DBLDSECT,R7        INFORM ASSEMBLER
         XC    DBLWORD,DBLWORD    ENSURE X'00'S
         STCK  DBLWORD            POPULATE DBLWORD
         LA    R15,16             SET 'BAD' RETURN-CODE
         OC    DBLWORD,DBLWORD    SUCCESSFUL 'STCK'?
         BZ    RTN2CLLR           NO, RETURN TO CALLER
         LM    R14,R15,DBLWORD    PREPARE FOR 'SHIFT RIGHT DBL LOGICAL'
         SRDL  R14,12             GRIND OFF LOW-ORDER 12-BITS (DIVIDE BY 4096)
         STM   R14,R15,DBLWORD    STORE BACK IN PARAMETER
         SLR   R15,R15            INFORM CALLER ALL IS WELL
RTN2CLLR EQU   *
         RETURN (14,12),RC=(15)   RESTORE AND RETURN (RC IN R15)
         YREGS                    REGISTER-EQUATES MACRO         
DBLDSECT DSECT                    PARAMETER DSECT (R7)
DBLWORD  DS    D                  STCK PARAMETER DBLWORD
         END

Regards,
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic View Bookmarks
All times are GMT + 6 Hours
Forum Index -> COBOL Programming

 


Similar Topics
Topic Forum Replies
No new posts Replace each space in cobol string wi... COBOL Programming 3
No new posts COBOL -Linkage Section-Case Sensitive COBOL Programming 1
No new posts COBOL ZOS Web Enablement Toolkit HTTP... COBOL Programming 0
No new posts Calling DFSORT from Cobol, using OUTF... DFSORT/ICETOOL 5
No new posts Generate random number from range of ... COBOL Programming 3
Search our Forums:

Back to Top