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 ?
Joined: 14 Jul 2008 Posts: 1249 Location: Richfield, MN, USA
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.
Joined: 14 Jan 2008 Posts: 2501 Location: Atlanta, Georgia, USA
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