Portal | Manuals | References | Downloads | Info | Programs | JCLs | Mainframe wiki | Quick Ref
IBM Mainframe Forum Index
 
Register
 
IBM Mainframe Forum Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Profile Log in to check your private messages Log in
 
Generic Sequence number generator program
Goto page Previous  1, 2
 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming
View previous topic :: :: View next topic  
Author Message
agkshirsagar

Active Member


Joined: 27 Feb 2007
Posts: 691
Location: Earth

PostPosted: Sat Jun 23, 2012 12:56 am    Post subject:
Reply with quote

OP did not put his requirement correctly. Truly random numbers can't be unique by definition.

There is an intrinsic function in COBOL to generate random numbers. Also, there is DB2 function RAND that provides this same functionality.
Read the manual my friend!

Esentially, OP is looking for a semaphore like mechanism to avoid contention. I fully agree with Naish that it can be achieved with DB2 SEQUENCES.
Back to top
View user's profile Send private message

Bill O'Boyle

CICS Moderator


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

PostPosted: Sat Jun 23, 2012 1:39 am    Post subject: Reply to: Generic Sequence number in Cobol
Reply with quote

Here's the example sub-program I had described -

Code:

*PROCESS RENT                      PROGRAM IS RE-ENTRANT
***********************************************************************
*---------------------------------------------------------------------*
*                                                                     *
*        THIS SUB-PROGRAM CAN BE CALLED FROM BATCH OR ON-LINE COBOL   *
*        AND RETURNS THE DECIMAL EQUIVILENT OF AN 8-BYTE 'STCK' AS    *
*        9-BYTES, PACKED-DECIMAL SIGNED.                              *
*                                                                     *
*        WHEN CALLED FROM CICS, THE CALLER NEEDS TO USE CICS 'ENQ'    *
*        BEFORE THE CALL AND CICS 'DEQ' AFTER THE CALL, ENSURING      *
*        SERIALIZATION.                                               *
*                                                                     *
*        WHEN CALLED FROM BATCH, THIS SUB-PROGRAM WILL ISSUE MVS      *
*        'ENQ/DEQ' MACROS, ENSURING SERIALIZATION.                    *
*                                                                     *
*        THIS SUB-PROGRAM DETERMINES THE RUN-ENVIRONMENT, SO THERE'S  *
*        NO NEED TO PASS THIS INFORMATION.                            *
*                                                                     *
*        NOTE THE 88-BYTES AFTER THE HALFWORD RETURN-CODE. THIS STG   *
*        IS NECESSARY FOR RE-ENTRANCY AND IS REQUIRED IN A CICS       *
*        ENVIRONMENT.                                                 *
*                                                                     *
*        EXAMPLE SYNTAX:                                              *
*                                                                     *
*        03  WS-RANDOM-PARM.                                          *
*            05  WS-RANDOM-NBR     PIC S9(17)      PACKED-DECIMAL.    *
*            05  WS-RANDOM-RTNCODE PIC  9(04)      BINARY.            *
*                88  WS-RANDOM-SUCCESS             VALUE ZERO.        *
*            05  FILLER            PIC  X(88).                        *
*        03  WS-RANDOM             PIC  X(08).     VALUE 'RANDOM'.    *
*                                                                     *
*        CALL WS-RANDOM            USING WS-RANDOM-PARM.              *
*                                                                     *
*---------------------------------------------------------------------*
***********************************************************************
STGDSECT DSECT                     CALLER-STG (R7)
         USING *,R7                INFORM ASSEMBLER
STGAREA  DS    0XL88               DYNAMIC-STG WORKAREA (FROM CALLER)
QUADWORD DS    L                   ALIGNED-QUADWORD
REGSAVEA DS    XL72                REGISTER-SAVEAREA
PRMDSECT DSECT                     PARMAREA (R9)
         USING *,R9                INFORM ASSEMBLER
PRMAREA  DS    0XL11               PARMAREA FROM CALLER
PRMRNDOM DS    PL9                 PARM RANDOM-NBR (PACKED-DECIMAL)
PRMRETCD DS    XL2                 PARM RETURN-CODE (HWORD)
RANDOM   CSECT
         USING *,R3                INFORM ASSEMBLER
         SAVE (14,12)              SAVE REGISTERS
         LA    R3,0(,R15)          CSECT-ADDRESSABILITY
         B     ADDRPARM            ADDRESS THE PARMAREA
********
******** ASSEMBLY DATE/TIME 'EYECATCHER'
********
EYECTCHR DS    0CL46
         DC    CL46' <<< ASSEMBLY DATE/TIME: &SYSDATC/&SYSTIME..00 >>>'
         ORG   EYECTCHR+6          REDEFINITION
         DC    X'A2A285948293A8'   LOWER-CASE 'SSEMBLY'
         ORG   EYECTCHR+15         REDEFINITION
         DC    X'81A385'           LOWER-CASE 'ATE'
         ORG   EYECTCHR+20         REDEFINITION
         DC    X'899485'           LOWER-CASE 'IME'
         ORG   EYECTCHR+L'EYECTCHR RESET LOCATION-KTR
         DC    CL1' '              SEPARATOR-SPACE
********
******** CONSTANTS USED IN 'BATCH' ONLY
********
ENQNAME  DS    0CL18
         DC    CL18'$$RANDOM/ENQ/DEQ$$'
         ORG   ENQNAME+3           REDEFINITION
         DC    X'8195849694'       LOWER-CASE 'ANDOM'
         ORG   ENQNAME+10          REDEFINITION
         DC    X'9598'             LOWER-CASE 'NQ'
         ORG   ENQNAME+14          REDEFINITION
         DC    X'8598'             LOWER-CASE 'EQ'
         ORG   ENQNAME+L'ENQNAME   RESET LOCATION-KTR
         DC    CL1' '              SEPARATOR-SPACE
ENQRES   DC    0CL24
         DC    CL24'$$RANDOM/NBR/GENERATOR$$'
         ORG   ENQRES+3            REDEFINITION
         DC    X'8195849694'       LOWER-CASE 'ANDOM'
         ORG   ENQRES+10           REDEFINITION
         DC    X'8299'             LOWER-CASE 'BR'
         ORG   ENQRES+14           REDEFINITION
         DC    X'8595859981A39699' LOWER-CASE 'ENERATOR'
         ORG   ENQRES+L'ENQRES     RESET LOCATION-KTR
         DC    CL1' '              SEPARATOR-SPACE
********
******** BEGIN EXECUTION
********
ADDRPARM DS    0H
         L     R9,0(,R1)           PARMAREA-ADDRESSABILITY
         LA    R9,0(,R9)           CLEAR TOP-BIT
         XC    PRMAREA,PRMAREA     ENSURE X'00'S
         OI    PRMRNDOM+L'PRMRNDOM-1,X'0C'
         LA    R7,L'PRMAREA(,R9)   STORAGE-ADDRESSABILITY
         XC    STGAREA,STGAREA     ENSURE X'00'S
         LA    R15,REGSAVEA        POINT TO OUR 'RSA'
         ST    R13,4(,R15)         BACKWORD-CHAIN
         ST    R15,8(,R13)         FORWARD-CHAIN
         LR    R13,R15             POINT TO OUR 'RSA'
         L     R15,X'21C'          ADDRESS CURRENT TCB
         L     R15,X'D0'(,R15)     ADDRESS TCB EXTN
         L     R15,X'14'(,R15)     ADDRESS AFCB
         LTR   R15,R15             BATCH-ENVIRONMENT?
         BZ    BATCHENQ            YES, ISSUE BATCH 'ENQ'
         CLC   =CL3'AFC',0(R15)    BATCH-ENVIRONMENT?
         BNE   BATCHENQ            YES, ISSUE BATCH 'ENQ'
         XR    R2,R2               ENSURE X'00'S FOR 'CICS'
         B     STCKRQST            REQUEST FOR 'STORE-CLOCK'
BATCHENQ EQU   *
         LA    R2,16               SET TO NON-ZERO FOR 'BATCH'
         ENQ   (ENQNAME,ENQRES,E,L'ENQRES,SYSTEMS),RET=NONE
STCKRQST EQU   *
         MVC   PRMRETCD,=AL2(4095) LOAD 'INVALID' RETURN-CODE
         STCK  QUADWORD            REQUEST FOR 'STORE-CLOCK'
         OC    QUADWORD,QUADWORD   VALID NON-ZERO VALUE?
         BZ    CHKRNENV            NO, CHECK RUN-ENVIRONMENT
         XC    PRMRETCD,PRMRETCD   ENSURE 'VALID' RETURN-CODE
         LG    R1,QUADWORD         PREPARE FOR 'CVDG'
         LPGR  R1,R1               ENSURE IT'S POSITIVE
         CVDG  R1,QUADWORD         MAKE IT 16-BYTES DECIMAL
         OI    QUADWORD+L'QUADWORD-1,X'0F'
         ZAP   PRMRNDOM,QUADWORD   POPULATE AS A PL9
CHKRNENV EQU   *
         LTR   R2,R2               CICS ENVIRONMENT?
         BZ    RTN2CLLR            YES, RETURN TO THE CALLER
         DEQ   (ENQNAME,ENQRES,L'ENQRES,SYSTEMS),RET=NONE
RTN2CLLR EQU   *
         L     R13,4(,R13)         RESTORE CALLER'S R13
         MVC   QUADWORD(L'PRMRETCD),PRMRETCD
         LH    R15,QUADWORD        LOAD AS HWORD
         XC    STGAREA,STGAREA     ENSURE X'00'S
         RETURN (14,12),RC=(15)    RESTORE AND RETURN
         LTORG ,
         YREGS ,
RANDOM   AMODE 31
RANDOM   RMODE ANY
         END   ,

Note that lower-case letters are constructed using ORG (Redefines) statements, so that some "goof ball" doesn't come along, issue a CAPS ON and accidentally hits a line where lower-case letters have been specified. I know this, because I've done it many times. icon_redface.gif

I understand that you need a 9-Byte Display-Numeric value, but the sub-program returns a 9-Byte (PIC S9(17) COMP-3) value, so you can possibly develop a method to choose different digits for your Display-Numeric field? It's good to have choices. icon_wink.gif

Usage instructions can be found in the comments. Must be Assembled/Linked as AMODE(31), RMODE(ANY).

And yes, I'm still stuck on using 8-Byte labels or less. icon_eek.gif

HTH....
Back to top
View user's profile Send private message
View previous topic :: :: View next topic  
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> COBOL Programming All times are GMT + 6 Hours
Goto page Previous  1, 2
Page 2 of 2

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts Running a REXX exec program using ZOSMF Sakthi344 CLIST & REXX 1 Tue Oct 15, 2019 3:13 pm
No new posts How to handle NULL in COBOL program bhaskar_kanteti COBOL Programming 8 Mon Oct 07, 2019 3:54 pm
No new posts REXX - CLIST program to be invoked af... pkmurali CLIST & REXX 5 Wed Sep 04, 2019 4:31 pm
No new posts Verify WITH UR present inside program... priyankakir CLIST & REXX 23 Wed Jun 12, 2019 3:37 pm
No new posts S0C7 abend while running a Cobol Program amitc23 COBOL Programming 2 Tue May 07, 2019 4:06 pm

Facebook
Back to Top
 
Job Vacancies | Forum Rules | Bookmarks | Subscriptions | FAQ | Polls | Contact Us