Macro
&Name    AsmDate &Type
.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
.**
.**                                Written by M. Stack, 12/10/72
.**              Updated for Assembler (H) by M. Stack, 10/17/85
.**              Updated for HLASM and Y2K by M. Stack, 01/31/97
.**                  Miscellaneous changes by M. Stack, 04/30/01
.**
.**      This macro uses the High Level Assembler system variable
.**      symbol &SysDatC to provide the current (assembly) date.
.**      There are four output formats (SHORT is the default):
.**        SHORT - "MM/DD/YY" with leading zeroes present
.**        LONG -  "MMM D, YYYY" or "MMM DD, YYYY"
.**        SUPERLONG - Same as long except month is complete
.**        JULIAN - "YYYYDDD"   always with a length of seven
.**      The global SetC symbol &AsmDate is set to the date computed
.**      as described above
.**
.**      If &Name is not omitted then a DC is generated with &Name as
.**      the label and C'&AsmDate' as the operand
.**
.**      If 'MNOTE' is specified as the second positional operand, an
.**      MNote is generated with the text 'AsmDate=&AsmDate'
.**
.**      If a third positional operand is specified, it is a date in
.**      the format YYYYMMDD and wil be used in place of &SysDatC
.**
.**      If &ASMDATE is to be referred to outside this macro, it must
.**      be declared as GblC &AsmDate
.**
.**      This macro may be used only with the High Level Assembler
.**
.** * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *
         GblC  &AsmDate            Variable to return current date
.*
&MonT(1) SetC  'Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','O*
               ct','Nov','Dec'
&MoLT(1) SetC  'January','February','March','April','May','June','July'*
               ,'August','September','October','November','December'
&Days(1) SetA  0,31,59,90,120,151,181,212,243,273,304,334
.*
.*       Extract values from HLASM &SysDatC format YYYYMMDD
.*
&Date    SetC  '&SysList(3)'       Was a test date supplied?
         AIf   ('&Date' NE '').Test  Go if a test date was supplied
&Date    SetC  '&SysDatC'          Else set to today's date
.Test    ANOP
.*
&Year    SetC  '&Date'(1,4)        Get first four chars of &SysDatC
&Month   SetC  '&Date'(5,2)        Get month
&Day     SetC  '&Date'(7,2)        Get day of month
&W       SetA  &Year               Get numeric year value
.*
&Leap    SetB  ((&W/4)*4 EQ &W)  1 if year divisible by 4
&Leap    SetB  (&Leap And Not ((&W/100)*100 EQ &W)) 0 if century
&Leap    SetB  (&Leap Or (((&W/400)*400) EQ &W)) 1 if 400 years
.*
         AIf   ('&Type' EQ '' or '&Type' EQ 'SHORT').Short
.*
.*       Do LONG or JULIAN format date - first get character month
.*       and Julian day of year
.*
&W       SetA  &Day                Get numeric form of day
&M       SetA  &Month              Get numeric form of month
&Mon     SetC  '&MonT(&M)'         Pick out short and long months
&MonL    SetC  '&MoLT(&M)'
&X       SetA  &Day+&Days(&M)      Get day of year
         AIf   (&M eq 1).GotM      Skip if this is January
&X       SetA  &X+&Leap            Correct for leap year
.*
.GotM    AIf   ('&Type' EQ 'JULIAN').Julian
&Month   SetC  '&MonL'
         AIf   ('&Type' EQ 'SUPERLONG').Super
&Month   SetC  '&Mon'
.*
.*       Do LONG or SUPERLONG format date
.*
.Super   ANOP
&W       SetA  &Day                Eliminate any leading zero
&AsmDate SetC  '&Month'.' '.'&W'.', '.'&Year' Assign date
         AGO   .NameGen            Go generate DC if desired
.*
.Short   ANOP
.*
.*       Assign short date
.*
&AsmDate SetC  '&Month'.'/'.'&Day'.'/'.'&Year'(3,2)
         AGo   .NameGen            Go generate DC if desired
.*
.Julian  ANOP
.*       MNote *,'&&W=&W  &&M=&M  &&X=&X  &&LEAP=&LEAP'
.*       Assign Julian Date
.*
&W       SetA  &X+1000             Get four-character numeric date
&AsmDate SetC  '&Year'.'&W'(2,3)   Get Julian date, length=7
.*
.NameGen AIf   ('&SysList(2)' NE 'MNOTE').DC
         MNote *,'&&AsmDate=''&AsmDate'''
.*
.DC      AIf   (T'&Name EQ 'O').EndIt
.*
.*       Generate assembly date as DC
.*
&Name    DC    C'&AsmDate'         Assembly Date
.EndIt   Mend