Title : Routine to generate 8 byte CHKP IDs

Submitter : Dougie Lawson
            Consultant Systems Programmer
            IBM UK

Phone : 01256 341061

Release Submitter Details - Y

Text :-

The following assembler subroutine will generate 8 byte checkpoint IDs.

The code appears to require an 8 byte area to be passed which will be
used as a workarea and will contain the CHKP ID on return.



CHKID    TITLE 'ROUTINE TO BUILD UNIQUE 8 BYTE CHKPT IDENTIFIER'
CHKID    CSECT
CHKID    AMODE ANY
CHKID    RMODE 24
         EJECT
R0       EQU   0
R1       EQU   1
R2       EQU   2
R3       EQU   3
R4       EQU   4
R5       EQU   5
R6       EQU   6
R7       EQU   7
R8       EQU   8
R9       EQU   9
R10      EQU   10
R11      EQU   11
R12      EQU   12
R13      EQU   13
R14      EQU   14
R15      EQU   15
         EJECT
*             HOUSEKEEPING
         SPACE
         USING *,R15
         B     ENDEYE
         DC    AL1(ENDEYE-EYECATCH)
EYECATCH DC    C'CHKID - &SYSDATE. - &SYSTIME. '
ENDEYE   DS    0H
         STM   R14,R12,12(R13)         SAVE REGS
         LR    R11,R15                 SET UP BASE (USE R11 FOR PL/1)
         DROP  R15
         USING CHKID,R11               ADDRESSABILITY
         L     R10,0(R1)               PICK UP ADDR OF RETURN FIELD
         USING OUTPUT,R10
         EJECT
*        NOW FIND THE ASID FOR PREFIX OF CHKPT ID
         SPACE
         LA    R2,16                   ADDR OF PSA
         L     R2,0(R2)                ADDR OF CVT
         L     R2,CVTTCBP-CVT(,R2)     TCBS AND ASCBS PARM LIST
         L     R2,CURRASCB-TCBPMAP(,R2) ADDR OF CURRENT ASCB
         LH    R2,ASCBASID-ASCB(,R2)   PICK UP ASID
         SLL   R2,20                   SHIFT IT TO TOP OF R6
         EJECT
*        NOW GET THE TIME IN HEX
*        THE MAXIMUM POSSIBLE VALUE FOR TIME IS D2EFF,
*        FOR 23:59:59.9
         SPACE
         TIME  BIN
         LR    R5,R0                   MOVE TIME TO R5
         XR    R4,R4                   CLEAR R4 FOR DIVIDE
         D     R4,=F'10'               LOSE THE HUNDREDTHS
         OR    R2,R5                   COMBINE ASID AND TIME
         EJECT
*            HEX VALUE IS IN R2
*            NOW MAKE IT PRINTABLE
*            THIS ROUTINE WORKS WITHIN THE CALLERS 8 BYTE AREA TO
*            MAKE IT RE-ENTRANT.
         SPACE
         XC    WORKAREA,WORKAREA       CLEAR WORK AREA
         STCM  R2,B'1111',WORKAREA+1   SAVE HEX CHECKPOINT ID
         MVO   WORKAREA(7),WORKAREA(7) SHIFT BY ONE NIBBLE
         UNPK  WORKAREA,WORKAREA(5)    UNPACK TO OUTPUT AREA
         NC    WORKAREA,PATTERN        RESET TOP BYTES
         TR    WORKAREA,TRANTAB        TRANSLATE 00-0F TO F0-F9/C1-C6
         EJECT
*        HOUSEKEEPING TIDY UP
         SPACE
         SR    R15,R15                 RC = 0
         L     R14,12(R13)             RESTORE R14
         LM    R0,R12,20(R13)          RESTORE OTHER REGS
         BR    R14                     RETURN
         EJECT
PATTERN  DC    8X'0F'
TRANTAB  DC    C'0123456789ABCDEF'
         LTORG
OUTPUT   DSECT
WORKAREA DS    CL8
TCBPMAP  DSECT
NEXTTCB  DS    F
CURRTCB  DS    F
NEXTASCB DS    F
CURRASCB DS    F
         IHAASCB
         CVT   DSECT=YES
         END

<END>