Getting CCYYMMDD from TIME macro into COBOL 
Author Message
 Getting CCYYMMDD from TIME macro into COBOL

         TITLE 'Documentation - 29 Apr 93 - TMR.'                      
00010000
***********************************************************************
00020000
*                                                                     *
00030000
*    This routine returns the date and time from the system.          *
00040004
* The date includes the century.                                      *
00050004
*                                                                     *
00060004
*    The calling program supplies all variable areas.  This makes     *
00070004
* the subroutine reusable, reentrant, and refreshable.                *
00080004
*                                                                     *
00090000
***********************************************************************
00100000
         TITLE 'Assembler initializations - 29 Apr 93 - TMR.'          
00110000
         LCLC  &NAME                                                  
00120000
         SPACE 3                                                      
00130000
&NAME    SETC  'GOODTIME'                                              
00140000
         TITLE '&NAME - Equates - 29 Apr 93 - TMR.'                    
00150000
R15      EQU   15         Scratch register.                            
00160000
R14      EQU   14         Scratch register.                            
00170000
LINK     EQU   14         Subroutine linkage register.                
00180000
BASE1    EQU   12         Program's first base register.              
00190000
GTBASE   EQU   11         DSECT base register.                        
00200004
R3       EQU    3         Work register.                              
00210000
R2       EQU    2         Scratch register.                            
00220000
R1       EQU    1         Scratch register.                            
00230000
R0       EQU    0         Scratch register.                            
00240000
         TITLE '&NAME - Program dummy sections - 29 Apr 93 - TMR.'    
00250000
GTDS     DSECT , GoodTime Working-storage definition(s).              
00260000
*====== Cut this out for the COBOL copybook.                          
00270008
*     ************* GT COBOL WORKING-STORAGE DEFINITION  **************
00280008
*     *                                                               *
00290008
*     *****************************************************************
00300008
*                                                                      
00310008
*          05 GT-ROUTINE        PIC  X(08) VALUE 'GOODTIME'.          
00320008
*          05 GT-PROGINFO.                                            
00330008
*             10 GT-MODULE      PIC  X(08) VALUE 'ProgInfo'.          
00340008
*             10 FILLER         PIC  X(01) VALUE SPACE.                
00350008
*             10 GT-COMPILE-DATE.                                      
00360008
*                15 MM          PIC  9(02) VALUE ZERO.                
00370008
*                15 FILLER      PIC  X(01) VALUE '/'.                  
00380008
*                15 DD          PIC  9(02) VALUE ZERO.                
00390008
*                15 FILLER      PIC  X(01) VALUE '/'.                  
00400008
*                15 YY          PIC  9(02) VALUE ZERO.                
00410008
*             10 FILLER         PIC  X(01) VALUE SPACE.                
00420008
*             10 GT-COMPILE-TIME.                                      
00430008
*                15 HH          PIC  9(02) VALUE ZERO.                
00440008
*                15 FILLER      PIC  X(01) VALUE ':'.                  
00450008
*                15 MM          PIC  9(02) VALUE ZERO.                
00460008
*                15 FILLER      PIC  X(01) VALUE ':'.                  
00470008
*                15 SS          PIC  9(02) VALUE ZERO.                
00480008
*             10 FILLER         PIC  X(01) VALUE SPACE.                
00490008
*             10 GT-COMPILER    PIC  X(04) VALUE '????'.              
00500008
*             10 FILLER         PIC  X(01) VALUE '.'.                  
00510008
*                                                                      
00520008
*          05 GT-DBLE           PIC S9(15)       COMP SYNC.            
00530008
*          05 GT-STCK           PIC S9(15)       COMP SYNC.            
00540008
*          05 GT-PILEN          PIC S9(07)       COMP SYNC VALUE +32.  
00550008
*          05 GT-OK             PIC S9(07)       COMP SYNC VALUE +00.  
00560008
*          05 GT-SAVE           PIC  X(72).                            
00570008
*          05 GT-RPL            PIC  X(32).                            
00580010
*          05 GT-TIME-AREA      PIC  X(16).                            
00590009
*          05 GT-RAW-TIME       PIC S9(07)V9(06) COMP-3.              
00600008
*          05 GT-RAW-DATE       PIC S9(09)       COMP-3.              
00610008
*          05 FILLER            PIC  X(02).                            
00620008
*          05 GT-CCYYMMDD-X.                                          
00630008
*             10 CC             PIC S9(02).                            
00640008
*             10 GT-YYMMDD-X.                                          
00650008
*                15 YY          PIC S9(02).                            
00660008
*                15 MM          PIC S9(02).                            
00670008
*                15 DD          PIC S9(02).                            
00680008
*          05 GT-CCYYMMDD       REDEFINES GT-CCYYMMDD-X                
00690008
*                               PIC S9(08).                            
00700008
*          05 FILLER            PIC  X(02).                            
00710008
*          05 GT-HHMMSS-X.                                            
00720008
*             10 HH             PIC S9(02).                            
00730008
*             10 MM             PIC S9(02).                            
00740008
*             10 SS             PIC S9(02)V9(06).                      
00750008
*          05 GT-HHMMSS         REDEFINES GT-HHMMSS-X                  
00760008
*                               PIC S9(06)V9(06).                      
00770008
*                                                                      
00780008
*     ********** END OF GoodTime WORKING-STORAGE DEFINITION  **********
00790008
*====== End of COBOL copybook.                                        
00800008
         EJECT                                                        
00810000
***********************************************************************
00820000
*                                                                     *
00830000
***********************************************************************
00840000
         SPACE 1                                                      
00850000
GTRTN    DC    CL8'&NAME'                                              
00860000
GTINFO   DC    CL32'ProgInfo not filled in yet.'                      
00870000
         SPACE 3                                                      
00880000
         SPACE 1                                                      
00890000
         DS    0D               Force double-word alignment.          
00900000
GTSTCK   DS    1XL08            STCK data.                            
00910002
GTDBLE   DS    1XL08            Work area.                            
00920000
GTPILEN  DC    1A(L'GTINFO)     GTINFO length.                        
00930006
GTOK     DC    1A(0000)         Good return code.                      
00940006
GTSAVE   DS    1XL72            Register save area.                    
00950004
GTRPL    DS    1XL32            TIME macro remote parameter list.      
00960010
GTTMA    DS    0XL16            Time PC returns data here.            
00970000
GTTMATM  DS     1XL06            Returns HH MM SS SS SS SS time here.  
00980000
         DS     1XL02                                                  
00990000
GTTMADT  DS     1XL04            Returns CCYYMMDD date here.          
01000000
         DS     1XL04                                                  
01010000
         SPACE 1                                                      
01020000
*                0H HM MS SS SS SS SF'                                
01030000
GTPCTM   DC    PL7'0'                                                  
01040000
         SPACE 1                                                      
01050000
*                0C CY YM MD DF                                        
01060000
GTPCDT   DC    PL5'0'                                                  
01070000
         SPACE 1                                                      
01080000
*                   F 0 C Y Y Y M M D D.                              
01090001
GTDATE   DS    0CL10                                                  
01100000
         DS     1CL02           Fill character + first digit.          
01110000
GTDTYY   DS     1CL04           CCYY, really.                          
01120000
GTDTMM   DS     1CL02           MM month (1-12)                        
01130000
GTDTDD   DS     1CL02           DD day (1-31).                        
01140000
         SPACE 1                                                      
01150000
*                   F 0 H H M M S S.S S S S S S.                      
01160001
GTTIME   DS    0CL14                                                  
01170001
         SPACE 1                                                      
01180000
*--------End of GTWS.                                                  
01190000
         TITLE '&NAME - Prelude code - 29 Apr 93 - TMR.'              
01200000
&NAME    CSECT                                                        
01210000
         SPACE 3                                                      
01220005
&NAME    AMODE 31                                                      
01230005
&NAME    RMODE ANY                                                    
01240005
         SPACE 3                                                      
01250005
         USING &NAME,15                                                
01260000
         SPACE 1                                                      
01270000
         B     BEGIN                                                  
01280000
         SPACE 1                                                      
01290000
PILEN    DC    1AL01(PILENEQU)                                        
01300006
PROGINFO DC    1CL08'&NAME'                                            
01310000
PISPACE  DC    1CL01' '                                                
01320000
         DC    1CL08'&SYSDATE'                                        
01330000
         DC    1CL01' '                                                
01340000
         DC    1CL08'&SYSTIME'                                        
01350000
         DC    1CL01' '                                                
01360000
         DC    1CL04'ASMH'                                            
01370000
         DC    1CL01' '                                                
01380000
PILENEQU EQU   *-PROGINFO                                              
01390006
         TITLE '&NAME - Variable Data Areas - 29 Apr 93 - TMR.'        
01400000
         CNOP  0,8                                                    
01410000
         SPACE 1                                                      
01420000
*--------Doubleword-aligned variables.                                
01430000
         SPACE 1                                                      
01440000
         SPACE 3                                                      
01450000
*--------Fullword-aligned variables.                                  
01460000
         SPACE 1                                                      
01470000
         SPACE 3                                                      
01480000
*--------Half-word aligned variables.                                  
01490000
         SPACE 3                                                      
01500000
*--------Unaligned variables.                                          
01510000
         SPACE 1                                                      
01520000
         SPACE 3                                                      
01530000
*--------Messages.                                                    
01540000
         SPACE 1                                                      
01550000
         SPACE 1                                                      
01560000
         TITLE '&NAME - Constant Data Areas - 29 Apr 93 - TMR.'        
01570000
         CNOP  0,8                                                    
01580000
         SPACE 3                                                      
01590000
*--------Doubleword-aligned constants.                                
01600000
         SPACE 1                                                      
01610000
         SPACE 3                                                      
01620000
*--------Fullword-aligned constants.                                  
01630000
         SPACE 1                                                      
01640000
         SPACE 3                                                      
01650000
*--------Halfword-aligned constants.                                  
01660000
         SPACE 1                                                      
01670000
         SPACE 3                                                      
01680000
*--------Unaligned constants.                                          
01690000
         SPACE 1                                                      
01700000
SPACE    DC    C' '                                                    
01710000
         SPACE 1                                                      
01720000
*                 F 0 C C Y Y M M D D                                  
01730000
GTDTMSK DC     X'F0202020202020202020'                                
01740003
         SPACE 1                                                      
01750000
*                 F 0 H H M M S S.S S S S S S                          
01760000
GTTMMSK DC     X'F020202020202020202020202020'                        
01770003
         TITLE '&NAME - Initialization code - 29 Apr 93 - TMR.'        
01780000
BEGIN    DS    0H                Start here.  Yeah, that's it!        
01790003
         SPACE 1                                                      
01800000
         SAVE  (14,12)           Save caller's registers.              
01810000
         SPACE 1                                                      
01820000
         L     GTBASE,0(0,1)     Load address of parameter list.      
01830000
         USING GTDS,GTBASE       Tell the assembler about parm list    
01840000
         SPACE 1                                                      
01850000
         LA    R14,0(0,13)       Load address of parent save area.    
01860000
         LA    13,GTSAVE         Load address of our save area.        
01870000
         ST    R14,4(0,13)       Store parent SA address in us.        
01880000
         ST    13,8(0,R14)       Store our SA address in parent.      
01890000
         SPACE 1                                                      
01900000
         LA    BASE1,&NAME       Load base register with our addr.    
01910000
         DROP  15                Drop temporary OS base register.      
01920000
         SPACE 1                                                      
01930000
         USING &NAME,BASE1       Tell assembler about our base reg.    
01940000
         TITLE '&NAME - "Initialization routine - 19 May 94 - TMR.'    
01950000
***********************************************************************
01960000
*                                                                     *
01970000
*    Move compiler information (date and time of compilation,         *
01980003
* compiler), and convert the date returned from the TIME SVC          *
01990003
* to the calling program.                                             *
02000003
*                                                                     *
02010000
*    The PC format of the TIME macro gets the current time with a     *
02020000
* high degree of precision (1 microsecond).  This alone is useful.    *
02030000
*                                                                     *
02040000
***********************************************************************
02050000
         SPACE 1                                                      
02060000
INIT     DS    0H                                                      
02070000
         SPACE 1                                                      
02080003
******** AGO   .PIEND2                Might not want ProgInfo "fluff".
02090004
         SPACE 1                                                      
02100000
*------- Move ProgInfo into calling program.                          
02110003
         SPACE 1                                                      
02120000
         LA    R0,GTINFO              Load ProgInfo target address.    
02130004
         L     R1,GTPILEN             Load ProgInfo target length.    
02140006
         LA    R14,PROGINFO           Load ProgInfo source address.    
02150004
         SR    R15,R15                Clear source length register.    
02160000
         ICM   R15,B'1000',SPACE      Load fill character.            
02170000
         ICM   R15,B'0001',PILEN      Load ProgInfo target length.    
02180006
         MVCL  R0,R14                 Move ProgInfo to caller.        
02190004
         SPACE 1                                                      
02200003
.PIEND2  ANOP                                                          
02210003
         EJECT                                                        
02220000
         TIME  DEC,                   Return data format;            
102230004
               GTTMA,                 Return data here;              
202240004
               LINKAGE=SYSTEM,        PC call (as opposed to SVC);    
302250004
               ZONE=LT,               Local time (as opposed to GMT);
402260004
               DATETYPE=YYYYMMDD,     CCYYMMDD date returned;        
502270009
               MF=(E,GTRPL)           Modify remote parameter list.    
02280009
         SPACE 3                                                      
02290000
         STCK  GTSTCK                 Here's a no-extra-charge option!
02300004
         SPACE 3                                                      
02310002
*------> Make date and time COBOL-friendly.                            
02320000
         SPACE 1                                                      
02330000
         MVO   GTPCTM,GTTMATM    Move time and append sign nybble.    
02340000
         MVC   GTTIME,GTTMMSK    Move time edit mask to target field.  
02350000
         ED    GTTIME,GTPCTM     Edit time into HHMMSSSSSSSS format.  
02360000
         SPACE 1                                                      
02370000
         MVO   GTPCDT,GTTMADT    Move date and append sign nybble.    
02380000
         MVC   GTDATE,GTDTMSK    Move time edit mask to target field.  
02390000
         ED    GTDATE,GTPCDT     Edit time into CCYYMMDD format.      
02400000
         SPACE 1                                                      
02410000
         L     15,GTOK           Load good return code.                
02420000
         SPACE 1                                                      
02430000
INITRET  B     RETURN            Return to caller.                    
02440000
         SPACE 1                                                      
02450000
RETURN   L     13,4(0,13)        Restore save area pointer.            
02460000
         SPACE 1                                                      
02470000
         RETURN (14,12),RC=(15)  Return to caller.                    
02480000
         TITLE '&NAME - End things - 13 Jul 93 - TMR.'                
02490000
         CNOP  0,8      Align to a multiple of 8.                      
02500000
         SPACE 1                                                      
02510000
LTORG    LTORG ,        Here's the literal pool.                      
02520000
         SPACE 1                                                      
02530000
         CNOP  0,8      Nice to end on a multiple of 8.                
02540000
         SPACE 1                                                      
02550000
         END   ,        End here, but no entry point for subroutine.  
02560000



Sat, 21 Aug 1999 03:00:00 GMT  
 
 [ 1 post ] 

 Relevant Pages 

1. Getting the server time from Relia COBOL

2. Load-time problem with a macro that defines a macro

3. Converting Macros from HP-Cobol II under MPE/iX to MF Cobol under HP-UX 11i

4. A macro involving two sub-macros - where the 2nd macro needs results from the first

5. getting undefined op-code with macros

6. Getting rid of macros in Clipper 5.2

7. getting a list into a macro

8. Getting started with macros

9. bytecodehacks 0.20 - Python gets macros

10. TIME macro, unique timestamps

11. TIME Macro Expansion

12. TIME Macro Expansion MVS/ESA

 

 
Powered by phpBB® Forum Software