Portal | Manuals | References | Downloads | Info | Programs | JCLs | Master the Mainframes
IBM Mainframe Computers Forums Index
 
Register
 
IBM Mainframe Computers Forums Index Mainframe: Search IBM Mainframe Forum: FAQ Memberlist Usergroups Profile Log in to check your private messages Log in
 

 

Assembler Program "GETGMTO"

 
Post new topic   Reply to topic    IBMMAINFRAMES.com Support Forums -> PL/I & Assembler
View previous topic :: :: View next topic  
Author Message
Bill O'Boyle

CICS Moderator


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

PostPosted: Wed Nov 13, 2013 6:46 pm    Post subject: Assembler Program "GETGMTO"
Reply with quote

Below, please find Assembler Sub-Program "GETGMTO", which returns the Local <---> GMT Offset, with a format of "+/-HHMM". It is fully re-entrant and can be used in both Batch and CICS.

For those who prefer a COBOL version, please refer to "COBGMTO" in the Mainframe COBOL Forum.

Code:

*PROCESS RENT                      PROGRAM IS RE-ENTRANT               
***********************************************************************
*---------------------------------------------------------------------*
*                                                                     *
*        THIS SUB-PROGRAM RETURNS THE CURRENT GMT-OFFSET TO LOCAL     *
*        TIME, WITH A FORMAT OF C'-/+HHMM' AND CAN BE USED IN BOTH    *
*        CICS AND BATCH. IN CICS, THE PPT EXECUTION-KEY CAN BE USER   *
*        OR IT CAN BE STATICALLY CALLED (NO PPT-ENTRY REQUIRED).      *
*                                                                     *
*        EG: EASTERN STANDARD TIME = '-0500' (GMT-0500).              *
*                                                                     *
*        MINUTES ARE RETURNED (WHEN APPLICABLE) AND WILL ONLY BE A    *
*        VALUE OF 30 OR 15. AREAS OF THE WORLD, SUCH AS INDIA AND     *
*        PAKISTAN, RESPECTIVELY.                                      *
*                                                                     *
*        R15 WILL CONTAIN THE RETURN-CODE (KNOWN AS THE RETURN-CODE   *
*        SPECIAL-REGISTER IN COBOL), WITH VALUES OF:                  *
*                                                                     *
*        0000 (OFFSET IS NON-ZERO --- ALL IS WELL)                    *
*        0004 (OFFSET IS ZERO     --- WARNING TO CALLER)              *
*                                                                     *
*        CALL SYNTAX:                                                 *
*                                                                     *
*        03  WS-GETGMTO-PARM.                                         *
*            05  WS-GETGMTO-VALUE  PIC  X(05).                        *
*            05  FILLER            REDEFINES WS-GETGMTO-VALUE.        *
*                07  WS-GETGMTO-SIGN                                  *
*                                  PIC  X(01).                        *
*                    88  WS-GETGMTO-BEHIND-GMT     VALUE '-'.         *
*                07  WS-GETGMTO-HHMM                                  *
*                                  PIC  9(04).                        *
*            05  WS-GETGMTO-WKAREA PIC  X(80).                        *
*        03  WS-GETGMTO            PIC  X(08)      VALUE 'GETGMTO'.   *
*                                                                     *
*        CALL WS-GETGMTO               USING WS-GETGMTO-PARM.         *
*                                                                     *
*---------------------------------------------------------------------*
***********************************************************************
         PRINT NOGEN                   SUPPRESS MACRO EXPANSION         
         CVT   DSECT=YES,LIST=YES      CVT-DSECT (PREFIX=NO)           
         PRINT GEN                     ACTIVATE MACRO EXPANSION         
PARMAREA DSECT                         PARMAREA (R7)                   
         USING *,R7                    INFORM ASSEMBLER                 
PARMOFST DS    CL5                     GMT-OFFSET (FORMAT=+/-HHMM)     
WORKAREA DSECT                         WORK-AREA (FROM CALLER)         
         USING *,R9                    INFORM ASSEMBLER                 
DWORD    DS    D                       ALIGNED-DBLWORD WORKAREA         
REGSAVEA DS    XL72                    REGISTER-SAVEAREA (18F)         
WORKLGTH EQU   *-WORKAREA              WORK-AREA LGTH                   
GETGMTO  CSECT                         BEGIN CSECT (R3)                 
         USING *,R3                    INFORM ASSEMBLER                 
         SAVE (14,12)                  SAVE REGISTERS                   
         LR    R3,R15                  CSECT ADDRESSABIITY             
         B     ADDRPLST                ADDRESS PARMLIST                 
EYECTCHR DS    0CL48                   PROGRAM EYECATCHER               
         DC    PL2'407'                X'407C'                         
         DC    CL10'EYECATCHER'        EYECATCHER-LITERAL               
         DC    PL1'7'                  X'7C'                           
         DC    CL6' ===>'                                               
PROGNAME DC    CL8'GETGMTO'                                             
         DC    CL2','                                                   
         DC    CL8'&SYSDATC'           ASSEMBLY-DATE AS C'CCYYMMDD'     
         DC    CL2','                                                   
         DC    CL9'&SYSTIME..00'       ASSEMBLY-TIME AS C'HH.MM.00'     
ADDRPLST DS    0H                      ENSURE ALIGNMENT                 
         L     R7,0(,R1)               PARMAREA ADDRESSABILITY         
         LA    R9,L'PARMOFST(,R7)      WORK-AREA ADDRESSABLITY         
         XC    WORKAREA(WORKLGTH),WORKAREA                             
         LA    R15,REGSAVEA            POINT TO OUR SAVEAREA           
         ST    R13,4(,R15)             BACKWARD CHAIN                   
         ST    R15,8(,R13)             FORWARD CHAIN                   
         LR    R13,R15                 POINT TO OUR SAVEAREA           
         L     R15,CVTPTR              CVT-ADDRESSABILITY               
         L     R10,CVTTZ-CVT(,R15)     LOAD WITH 'CVTTZ' AS-IS         
         LPR   R15,R10                 ENSURE POSITIVE VALUE           
         CVD   R15,DWORD               PREPARE FOR DECIMAL-MULTIPLICATN
         MP    DWORD,=P'1048576'       CALCULATE NBR-OF-SECONDS         
         SRP   DWORD,(64-6),0          DIVIDE BY 1000000/NO ROUNDING   
         CVB   R14,DWORD               PREPARE FOR BINARY-DIVIDE       
         SRDA  R14,32                  ALGEBRAICALLY SHIFT INTO R15     
         DL    R14,=F'3600'            CALCULATE NBR-OF-HOURS           
         CVD   R15,DWORD               MAKE IT DECIMAL (FMT=00HH)       
         SRP   DWORD,2,0               MULTIPLY BY 100 (FMT=HH00)       
         OI    DWORD+L'DWORD-1,X'0F'   ENSURE 'F' SIGN-NIBBLE           
         UNPK  PARMOFST,DWORD          UNPACK AS C'0HH00'               
         CHI   R14,60                  ANY MINUTES REMAINING?           
         BL    CHKCVTTZ                NO, CHECK CVTTZ-SIGN             
         SRDA  R14,32                  ALGEBRAICALLY SHIFT INTO R15     
         DL    R14,=F'60'              CALCULATE NBR-OF-MINUTES         
         LA    R14,30                  ENSURE 30-MINUTES               
         CHI   R15,30                  30-MINUTE BOUNDARY?             
         BNL   UNPKMINS                YES, UNPACK OFFSET-MINUTES       
         LA    R14,15                  ENSURE 15-MINUTES               
UNPKMINS EQU   *                                                       
         CVD   R14,DWORD               MAKE IT DECIMAL                 
         OI    DWORD+L'DWORD-1,X'0F'   ENSURE 'F' SIGN-NIBBLE           
         UNPK  PARMOFST+3(2),DWORD     UNPACK OFFSET-MINUTES           
CHKCVTTZ EQU   *                                                       
         MVI   PARMOFST,C'-'           SET NEGATIVE-SIGN (DEFAULT)     
         CHI   R10,0                   NEGATIVE 'CVTTZ'?               
         BL    SETRTNCD                YES, SET RETURN-CODE             
         MVI   PARMOFST,C'+'           RESET TO POSITIVE-SIGN           
SETRTNCD EQU   *                                                       
         XR    R15,R15                 SET 'ALL IS WELL' RC             
         CLC   =CL4'0000',PARMOFST+1   OFFSET IS NON-ZERO?             
         BNE   RTN2CLLR                YES, RETURN TO CALLLER           
         LA    R15,4                   SET 'WARNING' RC                 
RTN2CLLR EQU   *                                                       
         L     R13,4(,R13)             RESTORE CALLER'S R13             
         XC    WORKAREA(WORKLGTH),WORKAREA                             
         RETURN (14,12),RC=(15)        RESTORE REGISTERS AND RETURN     
         LTORG ,                                                       
         YREGS ,                       MVS REGISTER-EQUATE             
GETGMTO  AMODE 31 ,                                                     
GETGMTO  RMODE ANY ,                                                   
         END   ,                       END 'GETGMTO'                                     
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 -> PL/I & Assembler All times are GMT + 6 Hours
Page 1 of 1

 

Search our Forum:

Similar Topics
Topic Author Forum Replies Posted
No new posts SQL query not working in Cobol program. CuriousMainframer COBOL Programming 14 Wed Feb 22, 2017 5:56 pm
No new posts Executing OO COBOL program invoking J... Virendra Shambharkar COBOL Programming 2 Tue Jan 10, 2017 6:37 pm
No new posts Need Suggestion on COBOL program vickey_dw COBOL Programming 5 Thu Jan 05, 2017 10:55 pm
No new posts A not very Christmassy PL/I tale, wit... prino PL/I & Assembler 3 Mon Dec 26, 2016 1:01 am
No new posts I can not compile my program PL1 V3.R... Miguel Fernandez PL/I & Assembler 13 Tue Dec 06, 2016 8:30 pm


Facebook
Back to Top
 
Mainframe Wiki | Forum Rules | Bookmarks | Subscriptions | FAQ | Tutorials | Contact Us