Sample Java output from mainframe assembler modernization


On this page we show a sample translation to Java of some mainframe assembler code which performs date conversions. The original code was written by Jay Moseley and released on the cbttape.org website (All rights acknowledged). The translation was done using our recommended two stage process:

  • We first used Relogix to translate the assembler code to good-quality C, with some manual intervention to guide the translator. You can download a full account of what we did and see the intermediate C source code here.
  • We then used the Claude gen-AI system to refactor the Relogix-generated C code into Java.

The original assembler code

         TITLE 'Y2KDFMT - FORMAT DATE FOR OUTPUT'                       00010000
*                                                                     * 00020000
*   YY   YY   222   KK   KK DDDDDD  FFFFFFF M     MTTTTTTTT           * 00030000
*   YY   YY  2   2  KK  KK  DD   DD FF      MM   MM   TT              * 00040000
*   YY   YY      2  KK KK   DD   DD FF      MMM MMM   TT              * 00050000
*    YY YY       2  KKKK    DD   DD FFFFF   MMMMMMM   TT              * 00060000
*     YYY     222   KKKK    DD   DD FF      MM M MM   TT              * 00070000
*     YY     2      KK KK   DD   DD FF      MM   MM   TT              * 00080000
*     YY     2      KK  KK  DD   DD FF      MM   MM   TT              * 00090000
*     YY     22222  KK   KK DDDDDD  FF      MM   MM   TT              * 00100000
*                                                                     * 00110000
* ******************************************************************* * 00120000
* ******************************************************************* * 00130000
*    THIS SUBROUTINE FORMATS A GIVEN GREGORIAN DATE (MMDDYYYY) IN     * 00140000
*    A LARGE VARIETY OF FORMATS                                       * 00150000
*                                                                     * 00160000
*    1.  VALID INPUT YEARS FOR THIS ROUTINE ARE THE YEARS 1601        * 00170000
*        THROUGH 3399 A. D. (INCLUSIVE)                               * 00180000
*                                                                     * 00190000
*    2.  VALID INPUT MONTH VALUES FOR THIS ROUTINE ARE 01 THROUGH 12. * 00200000
*                                                                     * 00210000
*    3.  VALID INPUT DAY VALUES FOR THIS ROUTINE ARE 01 THROUGH 31    * 00220000
*        WITH EXCEPTIONS FOR THE MONTHS LISTED:                       * 00230000
*             MONTH          MAXIMUM DAY VALUE                        * 00240000
*              04                    30                               * 00250000
*              06                    30                               * 00260000
*              09                    30                               * 00270000
*              11                    30                               * 00280000
*              02                    28                               * 00290000
*              02 DURING LEAP YEAR   29                               * 00300000
*                                                                     * 00310000
*    4.  THE DATE FORMAT MUST BE MMDDYYYY, WHERE MM = THE 2 DIGIT     * 00320000
*        MONTH VALUE, DD = THE 2 DIGIT DAY VALUE, AND YYYY = THE      * 00330000
*        4 DIGIT YEAR VALUE.                                          * 00340000
*                                                                     * 00350000
*    5.  THE MAJOR FORMAT CODE DETERMINES THE OVERALL OUTPUT FORMAT   * 00360000
*        AND THE MINOR FORMAT CODE DETERMINES SUBTLE VARIATIONS OF    * 00370000
*        THE FORMAT:                                                  * 00380000
*          MAJOR                                  MINOR               * 00390000
*            1 = COMMERCIAL (01051997)              1 = NO INSERT     * 00400000
*            1 = COMMERCIAL (01 05 1997)            2 = SPACE         * 00410000
*            2 = EUROPEAN   (05/01/1997)            3 = SLASH         * 00420000
*            2 = EUROPEAN   (05-01-1997)            4 = HYPHEN        * 00430000
*            3 = F.I.P.S.   (YYYY.MM.DD)            5 = PERIOD        * 00440000
*          ---------------------------------------------------------  * 00450000
*            4 = TEXT 1 (JANUARY 5, 1997)           1 = U.S.          * 00460000
*            4 = TEXT 1 (5 JANUARY 1997)            2 = EUROPEAN      * 00470000
*            5 = TEXT 2 (JAN 5, 1997)               1 = U.S.          * 00480000
*            6 = TEXT 3 (SUNDAY, JANUARY 5, 1997)   1 = U.S.          * 00490000
*            7 = TEXT 4 (SUNDAY, 5 JAN 1997)        2 = EUROPEAN      * 00500000
*            8 = TEXT 5 (SUN, JANUARY 5, 1997)      1 = U.S.          * 00510000
*            9 = TEXT 6 (SUN, 5 JAN 1997)           2 = EUROPEAN      * 00520000
*                                                                     * 00530000
*    6.  SIX FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:          * 00540000
*        1)  AN 8 BYTE FIELD CONTAINING THE DATE (IN ZONED-           * 00550000
*            DECIMAL FORMAT) TO BE FORMATTED,                         * 00560000
*        2)  A 1 BYTE ZONED-DECIMAL MAJOR FORMAT CODE (SEE 5 ABOVE),  * 00570000
*        3)  A 1 BYTE ZONED-DECIMAL MINOR FORMAT CODE (SEE 5 ABOVE),  * 00580000
*        4)  A 1 BYTE ZONED-DECIMAL RETURN CODE,                      * 00590000
*        5)  A 2 BYTE FIELD WHICH WILL CONTAIN THE NUMBER OF BYTES    * 00600000
*            PLACED IN THE FOLLOWING FIELD (IN ZONED DECIMAL FORMAT), * 00610000
*        6)  AN OUTPUT FIELD TO RECEIVE THE FORMATTED DATE (NOTE:     * 00620000
*            THE SIZE OF THIS FIELD DEPENDS UPON THE FORMATTING       * 00630000
*            CODES ... IT IS THE CALLER'S RESPONSIBILITY TO PASS A    * 00640000
*            FIELD LONG ENOUGH TO RECEIVE THE REQUESTED FORMAT).      * 00650000
*        THE ROUTINE WILL NOT ALTER THE DATE OR FORMAT CODE FIELDS.   * 00660000
*                                                                     * 00670000
*        SUGGESTED CALLING SYNTAX FOR ALC CALLERS:                    * 00680000
*                                                                     * 00690000
*                      CALL  Y2KDFMT,(DATEIN)                         * 00700000
*                         . . .                                       * 00710000
*             DATEIN   DS    ZL8'01051997'                            * 00720000
*             MAJOR    DS    CL1'1'                                   * 00730000
*             MINOR    DS    CL1'3'                                   * 00740000
*             RC       DS    ZL1'0'                                   * 00750000
*             OUTSIZE  DS    ZL2'00'                                  * 00760000
*             OUTDATE  DS    CL29' '                                  * 00770000
*                                                                     * 00780000
*        SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  * 00790000
*                                                                     * 00800000
*             01  DFMT-PARAMETERS.                                    * 00810000
*                 02  DATEIN  PIC 9(8) VALUE 01011997.                * 00820000
*                 02  MAJOR   PIC 9(1) VALUE 1.                         00830000
*                 02  MINOR   PIC 9(1) VALUE 3.                         00840000
*                 02  RC      PIC 9(1) VALUE 0.                       * 00850000
*                 02  OUTSIZE PIC 9(2) VALUE 0.                       * 00860000
*                 02  OUTDATE PIC X(29).                              * 00870000
*             CALL 'Y2KDFMT' USING DFMT-PARAMETERS.                   * 00880000
*                                                                     * 00890000
*    7.  THE POSSIBLE VALUES FOR THE RETURN CODE FIELD ARE:           * 00900000
*                                                                     * 00910000
*        0 INDICATES SUCCESSFUL EXECUTION OF THE ROUTINE.             * 00920000
*                                                                     * 00930000
*        2 INDICATES INVALID DATA WAS FOUND IN THE DATE FIELD.        * 00940000
*        INVALID DATA ARE DETERMINED IF THE FIELD'S LOW ORDER         * 00950000
*        BYTE'S ZONE CONTAINS AN INVALID SIGN, (NOT ONE OF            * 00960000
*        X'C', X'D' OR X'F'), OR IF THE PRECEDING BYTES' ZONES        * 00970000
*        ARE OTHER THAN X'F', OR IF ANY BYTE'S LOW ORDER NIBBLE       * 00980000
*        CONTAINS A VALUE GREATER THAN X'9'.                          * 00990000
*                                                                     * 01000000
*        4 INDICATES THE VALUE OF THE YEAR SPECIFIED WAS NOT IN       * 01010000
*        THE RANGE SPECIFIED IN 1 (ABOVE).                            * 01020000
*                                                                     * 01030000
*        6 INDICATES THE VALUE OF THE MONTH SPECIFIED WAS NOT IN      * 01040000
*        THE RANGE SPECIFIED IN 2 (ABOVE).                            * 01050000
*                                                                     * 01060000
*        8 INDICATES THE VALUE OF THE DAY SPECIFIED WAS NOT IN        * 01070000
*        THE RANGE SPECIFIED IN 3 (ABOVE).                            * 01080000
*                                                                     * 01090000
*        3 INDICATES THE VALUE OF THE MAJOR FORMAT CODE SPECIFIED     * 01100000
*        WAS NOT ONE OF THE ACCEPTABLE VALUES (SEE 5 ABOVE).          * 01110000
*                                                                     * 01120000
*        5 INDICATES THE VALUE OF THE MINOR FORMAT CODE SPECIFIED     * 01130000
*        WAS NOT ONE OF THE ACCEPTABLE VALUES FOR THE MAJOR FORMAT    * 01140000
*        CODE SPECIFIED (SEE 5 ABOVE).                                * 01150000
*                                                                     * 01160000
*    8.  UPON SUCCESSFUL EXECUTION, THE FORMATTED DATE WILL BE        * 01170000
*        PLACED IN THE 6TH PARAMETER FIELD AND THE NUMBER OF BYTES    * 01180000
*        PLACED IN THE FIELD WILL BE PLACED IN THE 5TH FIELD.  IF     * 01190000
*        THE RETURN CODE CONTAINS A NON-ZERO VALUE (UNSUCCESSFUL      * 01200000
*        EXECUTION), THE 6TH FIELD WILL NOT BE MODIFIED BY THE        * 01210000
*        ROUTINE AND THE 5TH FIELD WILL CONTAIN ZERO.                 * 01220000
*                                                                     * 01230000
* ******************************************************************* * 01240000
* ******************************************************************* * 01250000
         EJECT                                                          01260000
Y2KDFMT  CSECT                                                          01270000
*         PRINT NOGEN                                                   01280001
         EYEC  'FORMAT DATE WITH FOR PRINT/DISPLAY'                     01290000
*                                                                       01300000
         SAVE  (14,12)                 SAVE CALLER'S REGISTERS          01310000
*                                                                       01320000
         LR    R12,R15                 LOAD BASE WITH ENTRY ADDRESS     01330000
         USING Y2KDFMT,R12             ESTABLISH ADDRESSABILITY         01340000
*                                                                       01350000
         L     R11,0(,R1)              LOAD A(PARAMETERS)               01360000
         USING $PARMS,R11              ESTABLISH ADDRESSABILITY         01370000
*                                                                       01380000
         GETMAIN R,LV=$DYNLEN          GETMAIN DYNAMIC WORKAREA         01390000
         LR    R10,R1                  SAVE A(MEMORY)                   01400000
*                                                                       01410000
         ST    R13,4(,R10)             STORE A(CALLER'S SAVE AREA)      01420000
         ST    R10,8(,R13)             BACK CHAIN A(MY SAVE AREA)       01430000
         LR    R13,R10                 SET A(MY SAVE AREA)              01440000
         USING $DYNMEM,R13             ESTABLISH ADDRESSABILITY         01450000
*                                                                       01460000
*    INSERT EYECATCHER MARKS AT BEGIN/END OF GETMAIN'D AREA.            01470000
*                                                                       01480000
         MVC   TOPFLAG,=C'Y2KDFMT GETMAIN BEGINS->'                     01490000
         MVC   BOTFLAG,=C'<-Y2KDFMT GETMAIN ENDS'                       01500000
*                                                                       01510000
*    INITIALIZE RETURN CODE AND OUTPUT BYTE COUNT.                      01520000
*                                                                       01530000
         MVI   PRC,C'0'                ASSUME GOOD RETURN               01540000
         MVC   PRC+1(2),PRC            ZERO RETURN SIZE                 01550000
*                                                                       01560000
*    CALL Y2KDOWN TO VERIFY DATE AND RETURN INTEGRAL DAY NUMBER.        01570000
*                                                                       01580000
         MVC   DDATE,PDATE             COPY YEAR TO Y2KDOWN PARM        01590000
         LA    R1,DOWNPARM             ADDRESS OF Y2KDOWN PARMS         01600000
         ST    R1,PLIST                STORE IN DYNAMIC AREA            01610000
         LA    R1,PLIST                ADDRESS TO PASS                  01620000
         L     R15,=V(Y2KDOWN)         ADDRESS OF ROUTINE               01630000
         BALR  R14,R15                 CALL ROUTINE                     01640000
*                                                                       01650000
*    SEE IF DATE WE RECEIVED FROM CALLER PASSED EDITS IN Y2KDOWN.       01660000
*    THIS MEANS WE DON'T HAVE TO REPEAT THE EDIT CODE HERE              01670000
*                                                                       01680000
         MVC   PRC,DRC                 ADOPT RECEIVED RETURN CODE       01690000
         CLI   DRC,C'0'                WAS EXECUTION SUCCESSFUL?        01700000
         BNE   RETURN                  IF NOT, EXIT TO CALLER           01710000
*                                                                       01720000
*    TEST MAJOR FORMAT CODE FOR INVALID VALUE.                          01730000
*                                                                       01740000
         XR    R1,R1                   CLEAR WORK REGISTER              01750000
         IC    R1,PMAJOR               GET MAJOR FORMAT CODE            01760000
         LA    R2,X'F1'                LOWEST VALID CODE                01770000
         LA    R3,9                    HIGHEST VALID CODE               01780000
MAJLOOP  CR    R1,R2                   IS FORMAT VALID?                 01790000
         BE    MAJOK                   YES, CONTINUE                    01800000
         LA    R2,1(,R2)               INCREMENT TO NEXT VALID CODE     01810000
         BCT   R3,MAJLOOP              AND CONTINUE TESTING             01820000
         MVI   PRC,C'3'                INDICATE INVALID CODE            01830000
         B                             RETURN                           01840000
*                                                                       01850000
*    TEST MINOR FORMAT CODE FOR INVALID VALUE.                          01860000
*                                                                       01870000
MAJOK    IC    R1,PMINOR               GET MINOR FORMAT CODE            01880000
         LA    R2,X'F1'                LOWEST VALID CODE                01890000
         LA    R3,5                    HIGHEST VALID CODE FOR MAJ:1-3   01900000
         CLI   PMAJOR,C'4'             IS MAJOR LESS THAN 4?            01910000
         BL    MINLOOP                 YES, BEGIN TEST                  01920000
         LA    R3,2                    ELSE SET HIGHEST FOR MAJ:4-9     01930000
MINLOOP  CR    R1,R2                   IS FORMAT VALID?                 01940000
         BE    MINOK                   YES, CONTINUE                    01950000
         LA    R2,1(,R2)               INCREMENT TO NEXT VALID CODE     01960000
         BCT   R3,MINLOOP              AND CONTINUE TESTING             01970000
         MVI   PRC,C'5'                INDICATE INVALID CODE            01980000
         B                             RETURN                           01990000
*                                                                       02000000
*    BRANCH TO FORMAT ROUTINE BASED ON MAJOR FORMAT CODE                02010000
*                                                                       02020000
MINOK    XR    R3,R3                   CLEAR WORK REGISTER              02030000
         IC    R3,PMAJOR               GET FORMAT NUMBER                02040000
         N     R3,=F'15'               CLEAR SIGN                       02050000
         BCTR  R3,0                    DECREMENT BY 1 (ZERO BASED)      02060000
         SLL   R3,2                    MULTIPLY BY 4 (LENGTH OF BRANCH) 02070000
         LA    R3,MFMTBR(R3)           LOAD ADDRESS OF BRANCH           02080000
         BR    R3                      GO BRANCH DEPENDING ON FORMAT    02090000
*                                                                       02100000
*    BRANCH TABLE TO SELECT ROUTINE FOR MAJOR FORMAT CODE               02110000
*                                                                       02120000
MFMTBR   B     MFMT1                                                    02130000
         B     MFMT2                                                    02140000
         B     MFMT3                                                    02150000
         B     MFMT4                                                    02160000
         B     MFMT5                                                    02170000
         B     MFMT6                                                    02180000
         B     MFMT7                                                    02190000
         B     MFMT8                                                    02200000
         B     MFMT9                                                    02210000
*                                                                       02220000
*    MAJOR FORMAT CODE 1: COMMERCIAL (MMDDYYYY)                         02230000
*                                                                       02240000
MFMT1    BAL   R9,MFMTSUB              GO GET SEPARATOR CHARACTOR       02250000
         LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         02260000
         MVC   0(2,R2),PDATE           MOVE MM                          02270000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              02280000
         LTR   R3,R3                   IS THERE AN INSERTION CHAR?      02290000
         BZ    MFMT1A                  NO, JUMP OVER                    02300000
         STC   R3,0(,R2)               INSERT CHARACTER                 02310000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              02320000
MFMT1A   MVC   0(2,R2),PDATE+2         MOVE DD                          02330000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              02340000
         LTR   R3,R3                   IS THERE AN INSERTION CHAR?      02350000
         BZ    MFMT1B                  NO, JUMP OVER                    02360000
         STC   R3,0(,R2)               INSERT CHARACTER                 02370000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              02380000
MFMT1B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        02390000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              02400000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            02410000
*                                                                       02420000
*    MAJOR FORMAT CODE 2: EUROPEAN (DDMMYYYY)                           02430000
*                                                                       02440000
MFMT2    BAL   R9,MFMTSUB              GO GET SEPARATOR CHARACTOR       02450000
         LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         02460000
         MVC   0(2,R2),PDATE+2         MOVE DD                          02470000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              02480000
         LTR   R3,R3                   IS THERE AN INSERTION CHAR?      02490000
         BZ    MFMT2A                  NO, JUMP OVER                    02500000
         STC   R3,0(,R2)               INSERT CHARACTER                 02510000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              02520000
MFMT2A   MVC   0(2,R2),PDATE           MOVE MM                          02530000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              02540000
         LTR   R3,R3                   IS THERE AN INSERTION CHAR?      02550000
         BZ    MFMT2B                  NO, JUMP OVER                    02560000
         STC   R3,0(,R2)               INSERT CHARACTER                 02570000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              02580000
MFMT2B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        02590000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              02600000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            02610000
*                                                                       02620000
*    MAJOR FORMAT CODE 3: F.I.P.S. (YYYYMMDD)                           02630000
*                                                                       02640000
MFMT3    BAL   R9,MFMTSUB              GO GET SEPARATOR CHARACTOR       02650000
         LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         02660000
         MVC   0(4,R2),PDATE+4         MOVE YYYY                        02670000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              02680000
         LTR   R3,R3                   IS THERE AN INSERTION CHAR?      02690000
         BZ    MFMT3A                  NO, JUMP OVER                    02700000
         STC   R3,0(,R2)               INSERT CHARACTER                 02710000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              02720000
MFMT3A   MVC   0(2,R2),PDATE           MOVE MM                          02730000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              02740000
         LTR   R3,R3                   IS THERE AN INSERTION CHAR?      02750000
         BZ    MFMT3B                  NO, JUMP OVER                    02760000
         STC   R3,0(,R2)               INSERT CHARACTER                 02770000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              02780000
MFMT3B   MVC   0(2,R2),PDATE+2         MOVE DD                          02790000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              02800000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            02810000
*                                                                       02820000
*    THIS SUBROUTINE PLACES THE INSERTION CHARACTER (IF ANY) INTO       02830000
*    REGISTER 3 BASED UPON MINOR CODE 1 THROUGH 5 (USED BY MAJOR        02840000
*    CODE ROUTINES 1 THROUGH 3 ABOVE.                                   02850000
*                                                                       02860000
MFMTSUB  XR    R3,R3                   ASSUME NO SEPARATOR              02870000
         XR    R4,R4                   CLEAR WORK REGISTER              02880000
         IC    R4,PMINOR               GET MINOR FORMAT NUMBER          02890000
         N     R4,=F'15'               CLEAR SIGN                       02900000
         BCTR  R4,0                    DECREMENT BY 1 (ZERO BASED)      02910000
         SLL   R4,2                    MULTIPLY BY 4 (LENGTH OF BRANCH) 02920000
         LA    R4,MFMTSBR(R4)          LOAD ADDRESS OF BRANCH           02930000
         BR    R4                      GO BRANCH DEPENDING ON FORMAT    02940000
*                                                                       02950000
*    BRANCH TABLE TO SELECT INSERTION CHARACTER                         02960000
*                                                                       02970000
MFMTSBR  B     MFMTSC1                 NONE                             02980000
         B     MFMTSC2                 SPACE                            02990000
         B     MFMTSC3                 SLASH                            03000000
         B     MFMTSC4                 HYPHEN                           03010000
         B     MFMTSC5                 PERIOD                           03020000
*                                                                       03030000
MFMTSC1  BR    R9                      RETURN TO MAJOR FORMAT           03040000
MFMTSC2  LA    R3,C' '                 SPACE IS INSERTION CHARACTER     03050000
         BR    R9                      RETURN TO MAJOR FORMAT           03060000
MFMTSC3  LA    R3,C'/'                 SPACE IS INSERTION CHARACTER     03070000
         BR    R9                      RETURN TO MAJOR FORMAT           03080000
MFMTSC4  LA    R3,C'-'                 SPACE IS INSERTION CHARACTER     03090000
         BR    R9                      RETURN TO MAJOR FORMAT           03100000
MFMTSC5  LA    R3,C'.'                 SPACE IS INSERTION CHARACTER     03110000
         BR    R9                      RETURN TO MAJOR FORMAT           03120000
*                                                                       03130000
*    MAJOR FORMAT CODE 4: TEXT 1 (MMMMMMMMM D, YYYY)                    03140000
*                                                                       03150000
MFMT4    LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         03160000
         CLI   PMINOR,C'2'             EUROPEAN?                        03170000
         BE    MFMT4A                  YES, USE ALTERNATE ORDER         03180000
         BAL   R9,MMONTHN              MOVE MONTH NAME                  03190000
         BAL   R9,MDAY                 MOVE DAY OF MONTH                03200000
         MVC   0(2,R2),=C', '          INSERT COMMA                     03210000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              03220000
         B     MFMT4B                  CONTINUE                         03230000
MFMT4A   BAL   R9,MDAY                 MOVE DAY OF MONTH                03240000
         MVI   0(R2),C' '              INSERT BLANK                     03250000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              03260000
         BAL   R9,MMONTHN              MOVE MONTH NAME                  03270000
MFMT4B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        03280000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              03290000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            03300000
*                                                                       03310000
*    MAJOR FORMAT CODE 5: TEXT 2 (MMM D, YYYY)                          03320000
*                                                                       03330000
MFMT5    LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         03340000
         CLI   PMINOR,C'2'             EUROPEAN?                        03350000
         BE    MFMT5A                  YES, USE ALTERNATE ORDER         03360000
         BAL   R9,MMONTHA              MOVE MONTH ABBREVIATION          03370000
         BAL   R9,MDAY                 MOVE DAY OF MONTH                03380000
         MVC   0(2,R2),=C', '          INSERT COMMA                     03390000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              03400000
         B     MFMT5B                  CONTINUE                         03410000
MFMT5A   BAL   R9,MDAY                 MOVE DAY OF MONTH                03420000
         MVI   0(R2),C' '              INSERT BLANK                     03430000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              03440000
         BAL   R9,MMONTHA              MOVE MONTH ABBREVIATION          03450000
MFMT5B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        03460000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              03470000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            03480000
*                                                                       03490000
*    MAJOR FORMAT CODE 6: TEXT 3 (DAYNAME, MMMMMMMMM D, YYYY)           03500000
*                                                                       03510000
MFMT6    LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         03520000
         BAL   R9,MDAYN                MOVE DAY OF WEEK NAME            03530000
         CLI   PMINOR,C'2'             EUROPEAN?                        03540000
         BE    MFMT6A                  YES, USE ALTERNATE ORDER         03550000
         BAL   R9,MMONTHN              MOVE MONTH NAME                  03560000
         BAL   R9,MDAY                 MOVE DAY OF MONTH                03570000
         MVC   0(2,R2),=C', '          INSERT COMMA                     03580000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              03590000
         B     MFMT6B                  CONTINUE                         03600000
MFMT6A   BAL   R9,MDAY                 MOVE DAY OF MONTH                03610000
         MVI   0(R2),C' '              INSERT BLANK                     03620000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              03630000
         BAL   R9,MMONTHN              MOVE MONTH NAME                  03640000
MFMT6B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        03650000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              03660000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            03670000
*                                                                       03680000
*    MAJOR FORMAT CODE 7: TEXT 4 (DAYNAME, MMM D, YYYY)                 03690000
*                                                                       03700000
MFMT7    LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         03710000
         BAL   R9,MDAYN                MOVE DAY OF WEEK NAME            03720000
         CLI   PMINOR,C'2'             EUROPEAN?                        03730000
         BE    MFMT7A                  YES, USE ALTERNATE ORDER         03740000
         BAL   R9,MMONTHA              MOVE MONTH ABBREVIATION          03750000
         BAL   R9,MDAY                 MOVE DAY OF MONTH                03760000
         MVC   0(2,R2),=C', '          INSERT COMMA                     03770000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              03780000
         B     MFMT7B                  CONTINUE                         03790000
MFMT7A   BAL   R9,MDAY                 MOVE DAY OF MONTH                03800000
         MVI   0(R2),C' '              INSERT BLANK                     03810000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              03820000
         BAL   R9,MMONTHA              MOVE MONTH ABBREVIATION          03830000
MFMT7B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        03840000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              03850000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            03860000
*                                                                       03870000
*    MAJOR FORMAT CODE 8: TEXT 5 (DAY, MMMMMMMMM D, YYYY)               03880000
*                                                                       03890000
MFMT8    LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         03900000
         BAL   R9,MDAYA                MOVE DAY OF WEEK ABBREVIATION    03910000
         CLI   PMINOR,C'2'             EUROPEAN?                        03920000
         BE    MFMT8A                  YES, USE ALTERNATE ORDER         03930000
         BAL   R9,MMONTHN              MOVE MONTH NAME                  03940000
         BAL   R9,MDAY                 MOVE DAY OF MONTH                03950000
         MVC   0(2,R2),=C', '          INSERT COMMA                     03960000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              03970000
         B     MFMT8B                  CONTINUE                         03980000
MFMT8A   BAL   R9,MDAY                 MOVE DAY OF MONTH                03990000
         MVI   0(R2),C' '              INSERT BLANK                     04000000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              04010000
         BAL   R9,MMONTHN              MOVE MONTH NAME                  04020000
MFMT8B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        04030000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              04040000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            04050000
*                                                                       04060000
*    MAJOR FORMAT CODE 9: TEXT 6 (DAY, MMM D, YYYY)                     04070000
*                                                                       04080000
MFMT9    LA    R2,POUTDATE             LOAD OUTPUT AREA ADDRESS         04090000
         BAL   R9,MDAYA                MOVE DAY OF WEEK ABBREVIATION    04100000
         CLI   PMINOR,C'2'             EUROPEAN?                        04110000
         BE    MFMT9A                  YES, USE ALTERNATE ORDER         04120000
         BAL   R9,MMONTHA              MOVE MONTH NAME                  04130000
         BAL   R9,MDAY                 MOVE DAY OF ABBREVIATION         04140000
         MVC   0(2,R2),=C', '          INSERT COMMA                     04150000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              04160000
         B     MFMT9B                  CONTINUE                         04170000
MFMT9A   BAL   R9,MDAY                 MOVE DAY OF MONTH                04180000
         MVI   0(R2),C' '              INSERT BLANK                     04190000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              04200000
         BAL   R9,MMONTHA              MOVE MONTH ABBREVIATION          04210000
MFMT9B   MVC   0(4,R2),PDATE+4         MOVE YYYY                        04220000
         LA    R2,4(,R2)               BUMP OUTPUT ADDRESS              04230000
         B     SETSIZE                 SET OUTPUT FIELD SIZE            04240000
*                                                                       04250000
*    MOVE WEEKDAY NAME TO OUTPUT AREA FOLLOWED BY ', ' (COMMON          04260000
*    ROUTINE PERFORMED BY MAJOR FORMAT CODE ROUTINES 6/7 ABOVE)         04270000
*                                                                       04280000
MDAYN    BAL   R8,LDAY                 GET ADDRESS/LENGTH OF DAYNAME    04290000
         BCTR  R7,0                    DECREMENT LENGTH FOR EX          04300000
         EX    R7,VARMOVE              MOVE DAY NAME                    04310000
         LA    R7,1(,R7)               RESTORE FULL NAME LENGTH         04320000
         AR    R2,R7                   BUMP OUTPUT ADDRESS              04330000
         MVC   0(2,R2),=C', '          INSERT COMMA/BLANK AFTER NAME    04340000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              04350000
         BR    R9                      AND RETURN                       04360000
*                                                                       04370000
*    MOVE WEEKDAY ABBR TO OUTPUT AREA FOLLOWED BY ', ' (COMMON          04380000
*    ROUTINE PERFORMED BY MAJOR FORMAT CODE ROUTINES 7/8 ABOVE)         04390000
*                                                                       04400000
MDAYA    BAL   R8,LDAY                 GET ADDRESS/LENGTH OF DAYNAME    04410000
         LA    R7,2                    ABBR LENGTH MINUS 1 FOR EX       04420000
         EX    R7,VARMOVE              MOVE DAY NAME                    04430000
         LA    R7,1(,R7)               RESTORE FULL MOVE LENGTH         04440000
         AR    R2,R7                   BUMP OUTPUT ADDRESS              04450000
         MVC   0(2,R2),=C', '          INSERT COMMA/BLANK AFTER NAME    04460000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              04470000
         BR    R9                      AND RETURN                       04480000
*                                                                       04490000
*    MOVE MONTH NAME TO OUTPUT AREA FOLLOWED BY A BLANK (COMMON         04500000
*    ROUTINE PERFORMED BY MAJOR FORMAT CODE ROUTINES 4/6/8 ABOVE)       04510000
*                                                                       04520000
MMONTHN  BAL   R8,LMONTH               GET ADDRESS/LENGTH OF MONTH      04530000
         BCTR  R7,0                    DECREMENT LENGTH FOR EX          04540000
         EX    R7,VARMOVE              MOVE MONTH NAME                  04550000
         LA    R7,1(,R7)               RESTORE FULL NAME LENGTH         04560000
         AR    R2,R7                   BUMP OUTPUT ADDRESS              04570000
         MVI   0(R2),C' '              INSERT BLANK AFTER NAME          04580000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              04590000
         BR    R9                      AND RETURN                       04600000
VARMOVE  MVC   0(0,R2),0(R6)           VARIABLE MOVE FOR EXECUTE        04610000
*                                                                       04620000
*    MOVE MONTH ABBR TO OUTPUT AREA FOLLOWED BY A BLANK (COMMON         04630000
*    ROUTINE PERFORMED BY MAJOR FORMAT CODE ROUTINES 5/7/9 ABOVE)       04640000
*                                                                       04650000
MMONTHA  BAL   R8,LMONTH               GET ADDRESS/LENGTH OF MONTH      04660000
         LA    R7,2                    ABBR LENGTH MINUS 1 FOR EX       04670000
         EX    R7,VARMOVE              MOVE MONTH NAME                  04680000
         LA    R7,1(,R7)               RESTORE FULL MOVE LENGTH         04690000
         AR    R2,R7                   BUMP OUTPUT ADDRESS              04700000
         MVI   0(R2),C' '              INSERT BLANK AFTER NAME          04710000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              04720000
         BR    R9                      AND RETURN                       04730000
*                                                                       04740000
*    MOVE DAY OF MONTH TO OUTPUT AREA (COMMON ROUTINE PERFORMED FROM    04750000
*    MAJOR FORMAT CODE ROUTINES 4 THROUGH 9 ABOVE)                      04760000
*                                                                       04770000
MDAY     CLI   PDATE+2,C'0'            IS FIRST DIGIT ZERO?             04780000
         BNE   MDAY2                   NO, MOVE BOTH DIGITS             04790000
MDAY1    MVC   0(1,R2),PDATE+3         MOVE ONLY RIGHT DIGIT            04800000
         LA    R2,1(,R2)               BUMP OUTPUT ADDRESS              04810000
         BR    R9                      AND RETURN                       04820000
MDAY2    MVC   0(2,R2),PDATE+2         MOVE BOTH DIGITS                 04830000
         LA    R2,2(,R2)               BUMP OUTPUT ADDRESS              04840000
         BR    R9                      AND RETURN                       04850000
*                                                                       04860000
*    LOAD ADDRESS OF DAY NAME IN R6, LENGTH IN R7 (COMMON ROUTINE       04870000
*    PERFORMED FROM MDAYN AND MDAYA ABOVE)                              04880000
*                                                                       04890000
LDAY     PACK  DWORK(1),DDOW(1)        PACK DAY INTEGRAL NUMBER         04900000
         ZAP   DWORK(8),DWORK(1)       EXPAND TO DOUBLEWORD             04910000
         CVB   R6,DWORK                CONVERT TO BINARY                04920000
         MH    R6,=H'12'               MULTIPLY BY 12 (LENGTH OF ENTRY) 04930000
         LA    R7,DNAME(R6)            LOAD ADDRESS OF NAME'S SIZE      04940000
         LA    R6,2(,R7)               LOAD ADDRESS OF DAY'S NAME       04950000
         LH    R7,0(,R7)               LOAD SIZE OF DAY'S NAME          04960000
         BR    R8                      AND RETURN                       04970000
*                                                                       04980000
*    LOAD ADDRESS OF MONTH NAME IN R6, LENGTH IN R7 (COMMON ROUTINE     04990000
*    PERFORMED FROM MMONTHN AND MMONTHA ABOVE)                          05000000
*                                                                       05010000
LMONTH   PACK  DWORK(2),PDATE(2)       PACK MONTH INTEGRAL NUMBER       05020000
         ZAP   DWORK(8),DWORK(2)       EXPAND TO DOUBLEWORD             05030000
         CVB   R6,DWORK                CONVERT TO BINARY                05040000
         BCTR  R6,0                    DECREMENT BY 1 (ZERO BASED)      05050000
         MH    R6,=H'12'               MULTIPLY BY 12 (LENGTH OF ENTRY) 05060000
         LA    R7,MNAME(R6)            LOAD ADDRESS OF NAME'S SIZE      05070000
         LA    R6,2(,R7)               LOAD ADDRESS OF MONTH'S NAME     05080000
         LH    R7,0(,R7)               LOAD SIZE OF MONTH'S NAME        05090000
         BR    R8                      AND RETURN                       05100000
*                                                                       05110000
*    RETURN THE SIZE OF THE OUTPUT FIELD IN BYTES (COMMON ROUTINE       05120000
*    BRANCHED TO BY ALL MAJOR FORMAT CODE ROUTINES ABOVE)               05130000
*                                                                       05140000
SETSIZE  LA    R1,POUTDATE             GET ADDRESS OF FIELD START       05150000
         SR    R2,R1                   COMPUTE LENGTH OF FIELD          05160000
         CVD   R2,DWORK                CONVERT TO DECIMAL               05170000
         UNPK  DWORK(3),DWORK+6(2)     UNPACK SIZE                      05180000
         OI    DWORK+2,X'F0'           CLEAR SIGN                       05190000
         MVC   PSIZE,DWORK+1           MOVE TO OUTPUT FIELD             05200000
*                                                                       05210000
*    RESTORE REGISTERS, FREE STORAGE, AND RETURN                        05220000
*                                                                       05230000
RETURN   LR    R1,R13                  LOAD ADDRESS OF GETMAINED AREA   05240000
         L     R13,4(,R13)             RELOAD PREVIOUS SAVE AREA        05250000
         LA    R0,$DYNLEN              LOAD LENGTH OF GETMAINED AREA    05260000
         FREEMAIN R,LV=(0),A=(1)       FREE GETMAINED AREA              05270000
         RETURN (14,12),RC=0           RETURN TO CALLER WITH RC=0       05280000
*                                                                       05290000
         EJECT                                                          05300000
* ******************************************************************* * 05310000
* **************************** CONSTANTS **************************** * 05320000
* ******************************************************************* * 05330000
*                                                                       05340000
*    DAY OF WEEK NAMES, PRECEEDED BY LENGTH ATTRIBUTE                   05350000
*                                                                       05360000
DNAME    DC    H'6',CL10'MONDAY  '                                      05370000
         DC    H'7',CL10'TUESDAY '                                      05380000
         DC    H'9',CL10'WEDNESDAY'                                     05390000
         DC    H'8',CL10'THURSDAY '                                     05400000
         DC    H'6',CL10'FRIDAY  '                                      05410000
         DC    H'8',CL10'SATURDAY '                                     05420000
         DC    H'6',CL10'SUNDAY  '                                      05430000
*                                                                       05440000
*    MONTH NAMES, PRECEEDED BY LENGTH ATTRIBUTE                         05450000
*                                                                       05460000
MNAME    DC    H'7',CL10'JANUARY '                                      05470000
         DC    H'8',CL10'FEBRUARY '                                     05480000
         DC    H'5',CL10'MARCH   '                                      05490000
         DC    H'5',CL10'APRIL   '                                      05500000
         DC    H'3',CL10'MAY     '                                      05510000
         DC    H'4',CL10'JUNE    '                                      05520000
         DC    H'4',CL10'JULY    '                                      05530000
         DC    H'6',CL10'AUGUST  '                                      05540000
         DC    H'9',CL10'SEPTEMBER'                                     05550000
         DC    H'7',CL10'OCTOBER '                                      05560000
         DC    H'8',CL10'NOVEMBER '                                     05570000
         DC    H'8',CL10'DECEMBER '                                     05580000
* ******************************************************************* * 05590000
         LTORG                                                          05600000
         EJECT                                                          05610000
* ******************************************************************* * 05620000
* ***************************** EQUATES ***************************** * 05630000
* ******************************************************************* * 05640000
         YREGS                                                          05650000
* ******************************************************************* * 05660000
         EJECT                                                          05670000
* ******************************************************************* * 05680000
* ***************************** DSECTS ****************************** * 05690000
* ******************************************************************* * 05700000
$DYNMEM  DSECT                         DYNAMICALLY ALLOCATED MEMORY     05710000
SAVEAREA DS    18F                     REGISTER SAVE AREA               05720000
TOPFLAG  DS    CL24                    EYECATCHER                       05730000
PLIST    DS    A                       PARMLIST ADDR FOR SUB CALLS      05740000
DOWNPARM DS    0H                      PARAMETERS FOR Y2KDOWN           05750000
DDATE    DS    CL8                       INPUT DATE                     05760000
DRC      DS    CL1                       RETURN CODE                    05770000
DDOW     DS    CL1                       INTEGRAL DAY OF WEEK           05780000
DWORK    DS    D                       DOUBLEWORD WORK FIELD            05790000
BOTFLAG  DS    CL22                    EYECATCHER                       05800000
*                                                                       05810000
$DYNLEN  EQU   (*-$DYNMEM)             LENGTH OF GETMAIN'D AREA         05820000
*                                                                       05830000
$PARMS   DSECT                         PARAMETERS FROM/TO CALLER        05840000
PDATE    DS    CL8                     DATE TO BE PROCESSED             05850000
PMAJOR   DS    CL1                     MAJOR FORMAT CODE                05860000
PMINOR   DS    CL1                     MINOR FORMAT CODE                05870000
PRC      DS    CL1                     RETURN CODE (0, 2-6, 8)          05880000
PSIZE    DS    CL2                     SIZE OF OUTPUT FIELD             05890000
POUTDATE DS    CL1                     OUTPUT DATE (SIZE WILL VARY!)    05900000
* ******************************************************************* * 05910000
         END                                                            05930000

         TITLE 'Y2KDOWN - DETERMINES DAY NUMBER FOR DATE'               00010000
*                                                                     * 00020000
*   YY   YY   222   KK   KK DDDDDD   OOOOO  WW   WW NN   NN           * 00030000
*   YY   YY  2   2  KK  KK  DD   DD OO   OO WW   WW NNN  NN           * 00040000
*   YY   YY      2  KK KK   DD   DD OO   OO WW   WW NNN  NN           * 00050000
*    YY YY       2  KKKK    DD   DD OO   OO WW   WW NNNN NN           * 00060000
*     YYY     222   KKKK    DD   DD OO   OO WW W WW NN NNNN           * 00070000
*     YY     2      KK KK   DD   DD OO   OO WWWWWWW NN  NNN           * 00080000
*     YY     2      KK  KK  DD   DD OO   OO WWW WWW NN  NNN           * 00090000
*     YY     22222  KK   KK DDDDDD   OOOOO   W   W  NN   NN           * 00100000
*                                                                     * 00110000
* ******************************************************************* * 00120000
* ******************************************************************* * 00130000
*    THIS SUBROUTINE DETERMINES THE INTEGRAL NUMBER OF THE DAY        * 00140000
*    OF THE WEEK A GREGORIAN DATE (MMDDYYYY) FALLS ON                 * 00150000
*                                                                     * 00160000
*    1.  VALID INPUT YEARS FOR THIS ROUTINE ARE THE YEARS 1601        * 00170000
*        THROUGH 3399 A. D. (INCLUSIVE)                               * 00180000
*                                                                     * 00190000
*    2.  VALID INPUT MONTH VALUES FOR THIS ROUTINE ARE 01 THROUGH 12. * 00200000
*                                                                     * 00210000
*    3.  VALID INPUT DAY VALUES FOR THIS ROUTINE ARE 01 THROUGH 31    * 00220000
*        WITH EXCEPTIONS FOR THE MONTHS LISTED:                       * 00230000
*             MONTH          MAXIMUM DAY VALUE                        * 00240000
*              04                    30                               * 00250000
*              06                    30                               * 00260000
*              09                    30                               * 00270000
*              11                    30                               * 00280000
*              02                    28                               * 00290000
*              02 DURING LEAP YEAR   29                               * 00300000
*                                                                     * 00310000
*    4.  THE DATE FORMAT MUST BE MMDDYYYY, WHERE MM = THE 2 DIGIT     * 00320000
*        MONTH VALUE, DD = THE 2 DIGIT DAY VALUE, AND YYYY = THE      * 00330000
*        4 DIGIT YEAR VALUE.                                          * 00340000
*                                                                     * 00350000
*    5.  THREE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:        * 00360000
*        1)  AN 8 BYTE FIELD CONTAINING THE DATE (IN ZONED-DECIMAL    * 00370000
*            FORMAT) TO BE PROCESSED,                                 * 00380000
*        2)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND                  * 00390000
*        3)  A 1 BYTE FIELD IN WHICH THE INTEGRAL DAY NUMBER (IN      * 00400000
*            ZONED-DECIMAL FORMAT) WILL BE PLACED.                    * 00410000
*        THE ROUTINE WILL NOT ALTER THE YEAR PASSED TO IT.            * 00420000
*                                                                     * 00430000
*        SUGGESTED CALLING SYNTAX FOR ALC CALLERS:                    * 00440000
*                                                                     * 00450000
*                      CALL  Y2KDOWN,(DATE)                           * 00460000
*                         . . .                                       * 00470000
*             DATE     DS    ZL8'04151997'                            * 00480000
*             RC       DS    ZL1'0'                                   * 00490000
*             DOWN     DS    ZL1'0'                                   * 00500000
*                                                                     * 00510000
*        SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  * 00520000
*                                                                     * 00530000
*             01  DOWN-PARAMETERS.                                    * 00540000
*                 02  DATE PIC 9(8) VALUE 04151997.                   * 00550000
*                 02  RC   PIC 9(1) VALUE 0.                          * 00560000
*                 02  DOWN PIC 9(1) VALUE 0.                          * 00570000
*             CALL 'Y2KDOWN' USING DOWN-PARAMETERS.                   * 00580000
*                                                                     * 00590000
*    6.  THE POSSIBLE VALUES FOR THE RETURN CODE FIELD ARE:           * 00600000
*                                                                     * 00610000
*        0 INDICATES SUCCESSFUL EXECUTION OF THE ROUTINE.             * 00620000
*                                                                     * 00630000
*        2 INDICATES INVALID DATA WAS FOUND IN THE DATE FIELD.        * 00640000
*        INVALID DATA ARE DETERMINED IF THE FIELD'S LOW ORDER         * 00650000
*        BYTE'S ZONE CONTAINS AN INVALID SIGN, (NOT ONE OF            * 00660000
*        X'C', X'A', X'E', OR X'F'), OR IF THE PRECEDING BYTES'       * 00670000
*        ZONES ARE OTHER THAN X'F', OR IF ANY BYTE'S LOW ORDER        * 00680000
*        NIBBLE CONTAINS A VALUE GREATER THAN X'9'.                   * 00690000
*                                                                     * 00700000
*        4 INDICATES THE VALUE OF THE YEAR SPECIFIED WAS NOT IN       * 00710000
*        THE RANGE SPECIFIED IN 1 (ABOVE).                            * 00720000
*                                                                     * 00730000
*        6 INDICATES THE VALUE OF THE MONTH SPECIFIED WAS NOT IN      * 00740000
*        THE RANGE SPECIFIED IN 2 (ABOVE).                            * 00750000
*                                                                     * 00760000
*        8 INDICATES THE VALUE OF THE DAY SPECIFIED WAS NOT IN        * 00770000
*        THE RANGE SPECIFIED IN 3 (ABOVE).                            * 00780000
*                                                                     * 00790000
*    4.  UPON SUCCESSFUL EXECUTION, THE INTEGRAL DAY NUMBER ON WHICH  * 00800000
*        THE INPUT DATE FALLS (0=MONDAY, 1=TUESDAY, ... 6=SUNDAY)     * 00810000
*        WILL BE PLACED IN THE 3RD PARAMETER FIELD.  IF THE RETURN    * 00820000
*        CODE IS A NON-ZERO VALUE (UNSUCCESSFUL EXECUTION), THE       * 00830000
*        3RD PARAMETER FIELD WILL CONTAIN THE VALUE OF 9 TO PROTECT   * 00840000
*        AGAINST UNINTENTIONAL USE OF AN INVALID RESULT.              * 00850000
*                                                                     * 00860000
* ******************************************************************* * 00870000
* ******************************************************************* * 00880000
         EJECT                                                          00890000
Y2KDOWN  CSECT                                                          00900000
*         PRINT NOGEN                                                   00910001
         EYEC  'RETURN DAY OF WEEK FOR DATE'                            00920000
*                                                                       00930000
         SAVE  (14,12)                 SAVE CALLER'S REGISTERS          00940000
*                                                                       00950000
         LR    R12,R15                 LOAD BASE WITH ENTRY ADDRESS     00960000
         USING Y2KDOWN,R12             ESTABLISH ADDRESSABILITY         00970000
*                                                                       00980000
         L     R11,0(,R1)              LOAD A(PARAMETERS)               00990000
         USING $PARMS,R11              ESTABLISH ADDRESSABILITY         01000000
*                                                                       01010000
         GETMAIN R,LV=$DYNLEN          GETMAIN DYNAMIC WORKAREA         01020000
         LR    R10,R1                  SAVE A(MEMORY)                   01030000
*                                                                       01040000
         ST    R13,4(,R10)             STORE A(CALLER'S SAVE AREA)      01050000
         ST    R10,8(,R13)             BACK CHAIN A(MY SAVE AREA)       01060000
         LR    R13,R10                 SET A(MY SAVE AREA)              01070000
         USING $DYNMEM,R13             ESTABLISH ADDRESSABILITY         01080000
*                                                                       01090000
*    INSERT EYECATCHER MARKS AT BEGIN/END OF GETMAIN'D AREA.            01100000
*                                                                       01110000
         MVC   TOPFLAG,=C'Y2KDOWN GETMAIN BEGINS->'                     01120000
         MVC   BOTFLAG,=C'<-Y2KDOWN GETMAIN ENDS'                       01130000
*                                                                       01140000
*    INITIALIZE RETURN CODE AND DAY OF WEEK NUMBER.                     01150000
*                                                                       01160000
         MVI   PRC,C'0'                ASSUME GOOD RETURN               01170000
         MVI   PDOWN,C'9'              UNDETERMINED DOWN                01180000
*                                                                       01190000
*    RETRIEVE ASTRONOMICAL NUMBER FOR DATE PASSED                       01200000
*                                                                       01210000
         MVC   GDATE,PDATE             LOAD DATE TO PASS                01220000
         LA    R1,GTOAPARM             ADDRESS OF Y2KGTOA PARMS         01230000
         ST    R1,PLIST                STORE IN DYNAMIC AREA            01240000
         LA    R1,PLIST                ADDRESS TO PASS                  01250000
         L     R15,=V(Y2KGTOA)         ADDRESS OF ROUTINE               01260000
         BALR  R14,R15                 CALL ROUTINE                     01270000
*                                                                       01280000
*    SEE IF DATE WE RECEIVED FROM CALLER PASSED EDITS IN Y2KGTOA.       01290000
*    THIS MEANS WE DON'T HAVE TO REPEAT THE EDIT CODE HERE              01300000
*                                                                       01310000
         MVC   PRC,RCG                 ADOPT RECEIVED RETURN CODE       01320000
         CLI   RCG,C'0'                WAS EXECUTION SUCCESSFUL?        01330000
         BNE   RETURN                  IF NOT, EXIT TO CALLER           01340000
*                                                                       01350000
*    INTEGRAL DAY NUMBER IS THE REMAINDER OF ASTRO NUMBER / 7.          01360000
*                                                                       01370000
P1OK     PACK  WORK(8),ANUM(7)         PACK ASTRO NUMBER                01380000
         DP    WORK,=P'7'              DIVIDE BY 7                      01390000
         UNPK  PDOWN,WORK+7(1)         UNPACK REMAINDER                 01400000
         OI    PDOWN,X'F0'             REMOVE SIGN                      01410000
*                                                                       01420000
*    RESTORE REGISTERS, FREE STORAGE, AND RETURN                        01430000
*                                                                       01440000
RETURN   LR    R1,R13                  LOAD ADDRESS OF GETMAINED AREA   01450000
         L     R13,4(,R13)             RELOAD PREVIOUS SAVE AREA        01460000
         LA    R0,$DYNLEN              LOAD LENGTH OF GETMAINED AREA    01470000
         FREEMAIN R,LV=(0),A=(1)       FREE GETMAINED AREA              01480000
         RETURN (14,12),RC=0           RETURN TO CALLER WITH RC=0       01490000
*                                                                       01500000
         LTORG                                                          01510000
         EJECT                                                          01520000
* ******************************************************************* * 01530000
* ***************************** EQUATES ***************************** * 01540000
* ******************************************************************* * 01550000
         YREGS                                                          01560000
* ******************************************************************* * 01570000
         EJECT                                                          01580000
* ******************************************************************* * 01590000
* ***************************** DSECTS ****************************** * 01600000
* ******************************************************************* * 01610000
$DYNMEM  DSECT                         DYNAMICALLY ALLOCATED MEMORY     01620000
SAVEAREA DS    18F                     REGISTER SAVE AREA               01630000
TOPFLAG  DS    CL24                    EYECATCHER                       01640000
PLIST    DS    A                       PARMLIST ADDR FOR SUB CALLS      01650000
GTOAPARM DS    0H                      PARAMETERS FOR Y2KGTOA           01660000
GDATE    DS    CL8                       DATE INPUT                     01670000
RCG      DS    CL1                       RETURN CODE                    01680000
ANUM     DS    ZL7                       ASTRO NUMBER                   01690000
WORK     DS    PL8                     WORK FIELD FOR DIVISION          01700000
BOTFLAG  DS    CL22                    EYECATCHER                       01710000
*                                                                       01720000
$DYNLEN  EQU   (*-$DYNMEM)             LENGTH OF GETMAIN'D AREA         01730000
*                                                                       01740000
$PARMS   DSECT                         PARAMETERS FROM/TO CALLER        01750000
PDATE    DS    CL8                     DATE TO BE PROCESSED             01760000
PRC      DS    CL1                     RETURN CODE (0/2/4/6/8)          01770000
PDOWN    DS    CL1                     INTEGRAL DAY NUMBER              01780000
* ******************************************************************* * 01790000
         END                                                            01810000


         TITLE 'Y2KGTOA - COMPUTE ASTRO NUMBER FROM GREGORIAN DATE'     00010000
*                                                                     * 00020000
*   YY   YY   222   KK   KK  GGGGG TTTTTTTT  OOOOO     A              * 00030000
*   YY   YY  2   2  KK  KK  GG   GG   TT    OO   OO   AAA             * 00040000
*   YY   YY      2  KK KK   GG   GG   TT    OO   OO  AA AA            * 00050000
*    YY YY       2  KKKK    GG        TT    OO   OO AA   AA           * 00060000
*     YYY     222   KKKK    GG  GGG   TT    OO   OO AA   AA           * 00070000
*     YY     2      KK KK   GG   GG   TT    OO   OO AAAAAAA           * 00080000
*     YY     2      KK  KK  GG   GG   TT    OO   OO AA   AA           * 00090000
*     YY     22222  KK   KK  GGGGG    TT     OOOOO  AA   AA           * 00100000
*                                                                     * 00110000
* ******************************************************************* * 00120000
* ******************************************************************* * 00130000
*    THIS SUBROUTINE COMPUTES THE ASTRONOMICAL NUMBER FOR A           * 00140000
*    GIVEN GREGORIAN DATE (MMDDYYYY)                                  * 00150000
*                                                                     * 00160000
*    1.  VALID INPUT YEARS FOR THIS ROUTINE ARE THE YEARS 1601        * 00170000
*        THROUGH 3399 A. D. (INCLUSIVE)                               * 00180000
*                                                                     * 00190000
*    2.  VALID INPUT MONTH VALUES FOR THIS ROUTINE ARE 01 THROUGH 12. * 00200000
*                                                                     * 00210000
*    3.  VALID INPUT DAY VALUES FOR THIS ROUTINE ARE 01 THROUGH 31    * 00220000
*        WITH EXCEPTIONS FOR THE MONTHS LISTED:                       * 00230000
*             MONTH          MAXIMUM DAY VALUE                        * 00240000
*              04                    30                               * 00250000
*              06                    30                               * 00260000
*              09                    30                               * 00270000
*              11                    30                               * 00280000
*              02                    28                               * 00290000
*              02 DURING LEAP YEAR   29                               * 00300000
*                                                                     * 00310000
*    4.  THE DATE FORMAT MUST BE MMDDYYYY, WHERE MM = THE 2 DIGIT     * 00320000
*        MONTH VALUE, DD = THE 2 DIGIT DAY VALUE, AND YYYY = THE      * 00330000
*        4 DIGIT YEAR VALUE.                                          * 00340000
*                                                                     * 00350000
*    5.  THREE FIELDS ARE PASSED AS PARAMETERS TO THE ROUTINE:        * 00360000
*        1)  AN 8 BYTE FIELD CONTAINING THE DATE (IN ZONED-           * 00370000
*            DECIMAL FORMAT) FOR WHICH THE ASTRONOMICAL NUMBER IS     * 00380000
*            TO BE CALCULATED,                                        * 00390000
*        2)  A 1 BYTE ZONED-DECIMAL RETURN CODE, AND                  * 00400000
*        3)  A 7 BYTE FIELD WHICH WILL RECEIVE THE ASTRONOMICAL       * 00410000
*            NUMBER (IN ZONED-DECIMAL FORMAT).                        * 00420000
*        THE ROUTINE WILL NOT ALTER THE DATE PASSED TO IT.            * 00430000
*                                                                     * 00440000
*        SUGGESTED CALLING SYNTAX FOR ALC CALLERS:                    * 00450000
*                                                                     * 00460000
*                      CALL  Y2KGTOA,(DATE)                           * 00470000
*                         . . .                                       * 00480000
*             DATE     DS    ZL8'01011997'                            * 00490000
*             RC       DS    ZL1'0'                                   * 00500000
*             ANUM     DS    ZL7'0000000'                             * 00510000
*                                                                     * 00520000
*        SUGGESTED CALLING SYNTAX FOR COBOL CALLERS:                  * 00530000
*                                                                     * 00540000
*             01  GTOA-PARAMETERS.                                    * 00550000
*                 02  DATE PIC 9(8) VALUE 01011997.                   * 00560000
*                 02  RC   PIC 9(1) VALUE 0.                          * 00570000
*                 02  ANUM PIC 9(7) VALUE 0.                          * 00580000
*             CALL 'Y2KGTOA' USING GTOA-PARAMETERS.                   * 00590000
*                                                                     * 00600000
*    6.  THE POSSIBLE VALUES FOR THE RETURN CODE FIELD ARE:           * 00610000
*                                                                     * 00620000
*        0 INDICATES SUCCESSFUL EXECUTION OF THE ROUTINE.             * 00630000
*                                                                     * 00640000
*        2 INDICATES INVALID DATA WAS FOUND IN THE DATE FIELD.        * 00650000
*        INVALID DATA ARE DETERMINED IF THE FIELD'S LOW ORDER         * 00660000
*        BYTE'S ZONE CONTAINS AN INVALID SIGN, (NOT ONE OF            * 00670000
*        X'C', X'D' OR X'F'), OR IF THE PRECEDING BYTES' ZONES        * 00680000
*        ARE OTHER THAN X'F', OR IF ANY BYTE'S LOW ORDER NIBBLE       * 00690000
*        CONTAINS A VALUE GREATER THAN X'9'.                          * 00700000
*                                                                     * 00710000
*        4 INDICATES THE VALUE OF THE YEAR SPECIFIED WAS NOT IN       * 00720000
*        THE RANGE SPECIFIED IN 1 (ABOVE).                            * 00730000
*                                                                     * 00740000
*        6 INDICATES THE VALUE OF THE MONTH SPECIFIED WAS NOT IN      * 00750000
*        THE RANGE SPECIFIED IN 2 (ABOVE).                            * 00760000
*                                                                     * 00770000
*        8 INDICATES THE VALUE OF THE DAY SPECIFIED WAS NOT IN        * 00780000
*        THE RANGE SPECIFIED IN 3 (ABOVE).                            * 00790000
*                                                                     * 00800000
*    7.  UPON SUCCESSFUL EXECUTION, THE ASTRONOMICAL NUMBER FOR THE   * 00810000
*        DATE WILL BE PLACED IN THE 3RD PARAMETER FIELD (ANUM).  IF   * 00820000
*        THE RETURN CODE IS A NON-ZERO VALUE (UNSUCCESSFUL            * 00830000
*        EXECUTION), THE ANUM FIELD WILL CONTAIN ZEROS.               * 00840000
*                                                                     * 00850000
* ******************************************************************* * 00860000
* ******************************************************************* * 00870000
         EJECT                                                          00880000
Y2KGTOA  CSECT                                                          00890000
*         PRINT NOGEN                                                   00900001
         EYEC  'RETURN ASTRO NUMBER FOR GREGORIAN DATE'                 00910000
*                                                                       00920000
         SAVE  (14,12)                 SAVE CALLER'S REGISTERS          00930000
*                                                                       00940000
         LR    R12,R15                 LOAD BASE WITH ENTRY ADDRESS     00950000
         USING Y2KGTOA,R12             ESTABLISH ADDRESSABILITY         00960000
*                                                                       00970000
         L     R11,0(,R1)              LOAD A(PARAMETERS)               00980000
         USING $PARMS,R11              ESTABLISH ADDRESSABILITY         00990000
*                                                                       01000000
         GETMAIN R,LV=$DYNLEN          GETMAIN DYNAMIC WORKAREA         01010000
         LR    R10,R1                  SAVE A(MEMORY)                   01020000
*                                                                       01030000
         ST    R13,4(,R10)             STORE A(CALLER'S SAVE AREA)      01040000
         ST    R10,8(,R13)             BACK CHAIN A(MY SAVE AREA)       01050000
         LR    R13,R10                 SET A(MY SAVE AREA)              01060000
         USING $DYNMEM,R13             ESTABLISH ADDRESSABILITY         01070000
*                                                                       01080000
*    INSERT EYECATCHER MARKS AT BEGIN/END OF GETMAIN'D AREA.            01090000
*                                                                       01100000
         MVC   TOPFLAG,=C'Y2KGTOA GETMAIN BEGINS->'                     01110000
         MVC   BOTFLAG,=C'<-Y2KGTOA GETMAIN ENDS'                       01120000
*                                                                       01130000
*    INITIALIZE RETURN CODE AND ANUM PARAMETER FIELDS.                  01140000
*                                                                       01150000
         MVI   PRC,C'0'                ASSUME GOOD RETURN               01160000
         MVC   PRC+1(7),PRC            NULL ASTRONOMICAL NUMBER         01170000
*                                                                       01180000
*    TEST DATE FOR INVALID CHARACTER                                    01190000
*                                                                       01200000
         LA    R2,PDATE                ADDRESS PASSED DATE              01210000
         LA    R3,7                    LENGTH MINUS 1                   01220000
P1VLOOP  CLI   0(R2),X'F0'             TEST LESS THAN C'0'              01230000
         BL    P1ERR1                  IF YES, DATE CONTAINS BAD DATA   01240000
         CLI   0(R2),X'F9'             TEST GREATER THAN C'9'           01250000
         BH    P1ERR1                  IF YES, DATE CONTAINS BAD DATA   01260000
         LA    R2,1(0,R2)              ADDRESS NEXT BYTE                01270000
         BCT   R3,P1VLOOP              CONTINUE TESTING                 01280000
         IC    R3,0(,R2)               LOAD RIGHT-MOST CHARACTER        01290000
         LR    R4,R3                   COPY INTO R4                     01300000
         N     R3,=F'15'               ISOLATE DIGIT PORTION            01310000
         CH    R3,=H'9'                TEST GREATER THAN 9              01320000
         BH    P1ERR1                  IF YES, DATE CONTAINS BAD DATA   01330000
         SRL   R4,4                    ISOLATE ZONE PORTION             01340000
         CH    R4,=H'12'               TEST FOR 'C' ZONE                01350000
         BE    P1OK1                   IF YES, DATE IS VALID NUMERIC    01360000
         CH    R4,=H'13'               TEST FOR 'D' ZONE                01370000
         BE    P1OK1                   IF YES, DATE IS VALID NUMERIC    01380000
         CH    R4,=H'15'               TEST FOR 'F' ZONE                01390000
         BE    P1OK1                   IF YES, DATE IS VALID NUMERIC    01400000
*                                                                       01410000
*    DATE CONTAINED AN INVALID CHARACTER                                01420000
*                                                                       01430000
P1ERR1   MVI   PRC,C'2'                INDICATE BAD DATA                01440000
         B     RETURN                  AND RETURN TO CALLER             01450000
*                                                                       01460000
*    TEST YEAR FOR VALID RANGE                                          01470000
*                                                                       01480000
P1OK1    PACK  YEAR(4),PDATE+4(4)      PACK PASSED YEAR                 01490000
         CP    YEAR(4),=P'1601'        IS YEAR PRIOR TO 1601?           01500000
         BL    P1ERR2                  IF YES, YEAR NOT VALID           01510000
         CP    YEAR(4),=P'3399'        IS YEAR AFTER 3399?              01520000
         BNH   P1OK2                   IF NOT, YEAR IS VALID            01530000
*                                                                       01540000
*    YEAR CONTAINED AN INVALID VALUE (OUT OF RANGE)                     01550000
*                                                                       01560000
P1ERR2   MVI   PRC,C'4'                INDICATE BAD VALUE               01570000
         B     RETURN                  AND RETURN TO CALLER             01580000
*                                                                       01590000
*    TEST MONTH FOR VALID RANGE                                         01600000
*                                                                       01610000
P1OK2    PACK  MONTH(2),PDATE(2)       PACK PASSED MONTH                01620000
         CP    MONTH(2),=P'1'          IS MONTH ZERO?                   01630000
         BL    P1ERR3                  IF YES, MONTH NOT VALID          01640000
         CP    MONTH(2),=P'12'         IS MONTH GREATER THAN 12?        01650000
         BNH   P1OK3                   IF NOT, MONTH IS VALID           01660000
*                                                                       01670000
*    MONTH CONTAINED AN INVALID VALUE (OUT OF RANGE)                    01680000
*                                                                       01690000
P1ERR3   MVI   PRC,C'6'                INDICATE BAD VALUE               01700000
         B     RETURN                  AND RETURN TO CALLER             01710000
*                                                                       01720000
*    DETERMINE LEAP YEAR STATUS                                         01730000
*                                                                       01740000
P1OK3    MVI   LEAP,C'0'               ASSUME NOT A LEAP YEAR           01750000
         ZAP   DWORK(5),YEAR           PUT YEAR INTO WORK FIELD         01760000
         DP    DWORK(5),=P'4'          DIVIDE YEAR BY 4                 01770000
         CP    DWORK+4(1),=P'0'        WAS IT EVENLY DIVISIBLE?         01780000
         BH    P1CON4                  IF NOT, IT IS *NOT* LEAP YEAR    01790000
         ZAP   DWORK(5),YEAR           PUT YEAR INTO WORK FIELD         01800000
         DP    DWORK(5),=P'100'        DIVIDE YEAR BY 100               01810000
         CP    DWORK+3(2),=P'0'        WAS IT EVENLY DIVISIBLE?         01820000
         BH    ISLEAP                  IF NOT, IT IS A LEAP YEAR        01830000
         ZAP   DWORK(5),YEAR           PUT YEAR INTO WORK FIELD         01840000
         DP    DWORK(5),=P'400'        DIVIDE YEAR BY 400               01850000
         CP    DWORK+3(2),=P'0'        WAS IT EVENLY DIVISIBLE?         01860000
         BH    P1CON4                  IF NOT, IT IS *NOT* LEAP YEAR    01870000
*                                                                       01880000
*    TEST FOR LEAP YEAR SUCCEEDED, RESET LEAP INDICATOR.                01890000
*                                                                       01900000
ISLEAP   MVI   LEAP,C'1'               INDICATE LEAP YEAR               01910000
*                                                                       01920000
*    DETERMINE MAXIMUM DAYS FOR GIVEN MONTH                             01930000
*                                                                       01940000
P1CON4   LA    R4,DIM                  GET ADDRESS OF DAY TABLE         01950000
         CLI   LEAP,C'0'               IS THIS LEAP YEAR?               01960000
         BE    P1CON4A                 IF NOT, ADDRESS IS OK            01970000
         LA    R4,2(,R4)               ELSE ADJUST TO LEAP ENTRY        01980000
P1CON4A  ZAP   DWORK(8),MONTH          GET MONTH INTO DOUBLEWORD        01990000
         CVB   R3,DWORK                CONVERT TO BINARY                02000000
         BCTR  R3,0                    DECREMENT BY 1 (ZERO BASE)       02010000
         SLL   R3,2                    MULTIPLY BY TABLE ENTRY LENGTH   02020000
         LA    R4,0(R3,R4)             LOAD ENTRY ADDRESS INTO R4       02030000
*                                                                       02040000
*    TEST DAY FOR VALID RANGE                                           02050000
*                                                                       02060000
         PACK  DAY(2),PDATE+2(2)       PACK PASSED DAY                  02070000
         ZAP   DAY,DAY                 CONVERT SIGN OF DAY TO X'C'      02080000
         CP    DAY(2),=P'1'            IS DAY ZERO?                     02090000
         BL    P1ERR4                  IF YES, DAY NOT VALID            02100000
         CLC   DAY(2),0(R4)            IS DAY GREATER THAN MAX?         02110000
         BNH   P1OK4                   IF NOT, MONTH IS VALID           02120000
*                                                                       02130000
*    DAY CONTAINED AN INVALID VALUE (OUT OF RANGE)                      02140000
*                                                                       02150000
P1ERR4   MVI   PRC,C'8'                INDICATE BAD VALUE               02160000
         B     RETURN                  AND RETURN TO CALLER             02170000
*                                                                       02180000
*    COMPUTE ASTRONOMICAL NUMBER                                        02190000
*                                                                       02200000
P1OK4    CP    MONTH(2),=P'2'          IS MONTH GREATER THAN 2?         02210000
         BH    COMP001                 YES                              02220000
*                                                                       02230000
         AP    MONTH(2),=P'9'          INCREMENT MONTH BY 9             02240000
         SP    YEAR(4),=P'1'           DECREMENT YEAR BY 1              02250000
         B     COMP002                 PROCEED WITH CONVERSION          02260000
*                                                                       02270000
COMP001  SP    MONTH(2),=P'3'          DECREMENT MONTH BY 3             02280000
*                                                                       02290000
COMP002  DP    YEAR,=P'100'            DIVIDE BY 100                    02300000
         ZAP   TA,YEAR(2)              SAVE QUOTIENT IN TA              02310000
         ZAP   TB,YEAR+2(2)            SAVE REMAINDER IN TB             02320000
         MP    TA,=P'146097'           MULTIPLY BY 146097               02330000
         DP    TA,=P'4'                DIVIDE BY 4                      02340000
         ZAP   TA,TA(7)                SHIFT QUOTIENT OVER REMAINDER    02350000
*                                                                       02360000
         MP    TB,=P'1461'             MULTIPLY BY 1461                 02370000
         DP    TB,=P'4'                DIVIDE BY 4                      02380000
         ZAP   TB,TB(7)                SHIFT QUOTIENT OVER REMAINDER    02390000
*                                                                       02400000
         ZAP   TC,MONTH                                                 02410000
         MP    TC,=P'153'              MULTIPLY BY 153                  02420000
         AP    TC,=P'2'                ADD 2                            02430000
         DP    TC,=P'5'                DIVIDE BY 5                      02440000
         ZAP   TC,TC(7)                SHIFT QUOTIENT OVER REMAINDER    02450000
         AP    TC,DAY                  ADD DAY                          02460000
         AP    TC,=P'1721119'          ADD 1721119                      02470000
*                                                                       02480000
         ZAP   TX,TA                   COMBINE THE ANSWERS              02490000
         AP    TX,TB                                                    02500000
         AP    TX,TC                                                    02510000
*                                                                       02520000
         UNPK  PANUM(7),TX+4(4)        UNPACK ANUM                      02530000
         OI    PANUM+6,X'F0'           CLEAR SIGN                       02540000
*                                                                       02550000
*    RESTORE REGISTERS, FREE STORAGE, AND RETURN                        02560000
*                                                                       02570000
RETURN   LR    R1,R13                  LOAD ADDRESS OF GETMAINED AREA   02580000
         L     R13,4(,R13)             RELOAD PREVIOUS SAVE AREA        02590000
         LA    R0,$DYNLEN              LOAD LENGTH OF GETMAINED AREA    02600000
         FREEMAIN R,LV=(0),A=(1)       FREE GETMAINED AREA              02610000
         RETURN (14,12),RC=0           RETURN TO CALLER WITH RC=0       02620000
         EJECT                                                          02630000
* ******************************************************************* * 02640000
* **************************** CONSTANTS **************************** * 02650000
* ******************************************************************* * 02660000
*                                                                       02670000
*    MAXIMUM DAYS IN MONTHS ... EACH ENTRY HAS 2 VALUES, THE 1ST FOR    02680000
*    A NORMAL (NON-LEAP) YEAR AND THE 2ND FOR A LEAP YEAR               02690000
*                                                                       02700000
DIM      DC    PL2'31',PL2'31'           JANUARY                        02710000
         DC    PL2'28',PL2'29'           FEBRUARY                       02720000
         DC    PL2'31',PL2'31'           MARCH                          02730000
         DC    PL2'30',PL2'30'           APRIL                          02740000
         DC    PL2'31',PL2'31'           MAY                            02750000
         DC    PL2'30',PL2'30'           JUNE                           02760000
         DC    PL2'31',PL2'31'           JULY                           02770000
         DC    PL2'31',PL2'31'           AUGUST                         02780000
         DC    PL2'30',PL2'30'           SEPTEMBER                      02790000
         DC    PL2'31',PL2'31'           OCTOBER                        02800000
         DC    PL2'30',PL2'30'           NOVEMBER                       02810000
         DC    PL2'31',PL2'31'           DECEMBER                       02820000
* ******************************************************************* * 02830000
         LTORG                                                          02840000
         EJECT                                                          02850000
* ******************************************************************* * 02860000
* ***************************** EQUATES ***************************** * 02870000
* ******************************************************************* * 02880000
         YREGS                                                          02890000
* ******************************************************************* * 02900000
         EJECT                                                          02910000
* ******************************************************************* * 02920000
* ***************************** DSECTS ****************************** * 02930000
* ******************************************************************* * 02940000
$DYNMEM  DSECT                         DYNAMICALLY ALLOCATED MEMORY     02950000
SAVEAREA DS    18F                     REGISTER SAVE AREA               02960000
TOPFLAG  DS    CL24                    EYECATCHER                       02970000
MONTH    DS    PL2                     GREGORIAN MONTH                  02980000
DAY      DS    PL2                     GREGORIAN DAY                    02990000
YEAR     DS    PL4                     GREGORIAN YEAR                   03000000
TA       DS    PL8                     INTERMEDIATE ANSWER              03010000
TB       DS    PL8                     INTERMEDIATE ANSWER              03020000
TC       DS    PL8                     INTERMEDIATE ANSWER              03030000
TX       DS    PL8                     INTERMEDIATE ANSWER              03040000
LEAP     DS    CL1                     LEAP STATUS                      03050000
DWORK    DS    D                       DOUBLEWORD WORK FIELD            03060000
BOTFLAG  DS    CL22                    EYECATCHER                       03070000
*                                                                       03080000
$DYNLEN  EQU   (*-$DYNMEM)             LENGTH OF GETMAIN'D AREA         03090000
*                                                                       03100000
$PARMS   DSECT                         PARAMETERS FROM/TO CALLER        03110000
PDATE    DS    CL8                     DATE TO BE PROCESSED             03120000
PRC      DS    CL1                     RETURN CODE (0/2/4/6/8)          03130000
PANUM    DS    ZL7                     ASTRONOMICAL NUMBER              03140000
* ******************************************************************* * 03150000
         END                                                            03170000

The Java code generated by AI from the Relogix C translation

// Y2KDateFormatter.java
package com.y2k.dateutil;

/**
 * Y2KDFMT - Date Formatting Utility
 * 
 * Formats Gregorian dates (MMDDYYYY) in various formats.
 * Valid years: 1601-3399 AD (inclusive)
 */
public class Y2KDateFormatter {
    
    // Day names with their lengths
    private static final String[] DAY_NAMES = {
        "MONDAY", "TUESDAY", "WEDNESDAY", "THURSDAY", 
        "FRIDAY", "SATURDAY", "SUNDAY"
    };
    
    // Month names with their lengths
    private static final String[] MONTH_NAMES = {
        "JANUARY", "FEBRUARY", "MARCH", "APRIL", "MAY", "JUNE",
        "JULY", "AUGUST", "SEPTEMBER", "OCTOBER", "NOVEMBER", "DECEMBER"
    };
    
    /**
     * Result class for date formatting operations
     */
    public static class FormatResult {
        public char returnCode;     // '0' = success, '2'/'3'/'4'/'5'/'6'/'8' = various errors
        public String formattedDate;
        public int outputSize;
        
        public FormatResult(char returnCode, String formattedDate) {
            this.returnCode = returnCode;
            this.formattedDate = formattedDate;
            this.outputSize = (formattedDate != null) ? formattedDate.length() : 0;
        }
        
        public boolean isSuccess() {
            return returnCode == '0';
        }
    }
    
    /**
     * Format a date according to the specified major and minor format codes.
     * 
     * @param date 8-character date string in MMDDYYYY format
     * @param majorFormat major format code ('1'-'9')
     * @param minorFormat minor format code ('1'-'5' for major 1-3, '1'-'2' for major 4-9)
     * @return FormatResult containing the formatted date and return code
     */
    public static FormatResult formatDate(String date, char majorFormat, char minorFormat) {
        // Validate date using Y2KDOWN
        Y2KDayOfWeek.DayResult dayResult = Y2KDayOfWeek.getDayOfWeek(date);
        if (dayResult.returnCode != '0') {
            return new FormatResult(dayResult.returnCode, null);
        }
        
        // Validate major format code (1-9)
        if (majorFormat < '1' || majorFormat > '9') {
            return new FormatResult('3', null);
        }
        
        // Validate minor format code
        int maxMinor = (majorFormat >= '4') ? 2 : 5;
        int minorValue = minorFormat - '0';
        if (minorValue < 1 || minorValue > maxMinor) {
            return new FormatResult('5', null);
        }
        
        // Format based on major code
        String formatted;
        switch (majorFormat) {
            case '1':
                formatted = formatCommercial(date, minorFormat);
                break;
            case '2':
                formatted = formatEuropean(date, minorFormat);
                break;
            case '3':
                formatted = formatFIPS(date, minorFormat);
                break;
            case '4':
                formatted = formatText1(date, minorFormat, dayResult.dayOfWeek);
                break;
            case '5':
                formatted = formatText2(date, minorFormat, dayResult.dayOfWeek);
                break;
            case '6':
                formatted = formatText3(date, minorFormat, dayResult.dayOfWeek);
                break;
            case '7':
                formatted = formatText4(date, minorFormat, dayResult.dayOfWeek);
                break;
            case '8':
                formatted = formatText5(date, minorFormat, dayResult.dayOfWeek);
                break;
            case '9':
                formatted = formatText6(date, minorFormat, dayResult.dayOfWeek);
                break;
            default:
                return new FormatResult('3', null);
        }
        
        return new FormatResult('0', formatted);
    }
    
    // Major format 1: Commercial (MMDDYYYY)
    private static String formatCommercial(String date, char minorFormat) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        String sep = getSeparator(minorFormat);
        return mm + sep + dd + sep + yyyy;
    }
    
    // Major format 2: European (DDMMYYYY)
    private static String formatEuropean(String date, char minorFormat) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        String sep = getSeparator(minorFormat);
        return dd + sep + mm + sep + yyyy;
    }
    
    // Major format 3: F.I.P.S. (YYYYMMDD)
    private static String formatFIPS(String date, char minorFormat) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        String sep = getSeparator(minorFormat);
        return yyyy + sep + mm + sep + dd;
    }
    
    // Major format 4: Text 1 (MONTH D, YYYY or D MONTH YYYY)
    private static String formatText1(String date, char minorFormat, int dayOfWeek) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        
        String monthName = getMonthName(mm);
        String dayStr = formatDay(dd);
        
        if (minorFormat == '2') {
            // European: D MONTH YYYY
            return dayStr + " " + monthName + " " + yyyy;
        } else {
            // US: MONTH D, YYYY
            return monthName + " " + dayStr + ", " + yyyy;
        }
    }
    
    // Major format 5: Text 2 (MON D, YYYY or D MON YYYY)
    private static String formatText2(String date, char minorFormat, int dayOfWeek) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        
        String monthAbbr = getMonthAbbr(mm);
        String dayStr = formatDay(dd);
        
        if (minorFormat == '2') {
            // European: D MON YYYY
            return dayStr + " " + monthAbbr + " " + yyyy;
        } else {
            // US: MON D, YYYY
            return monthAbbr + " " + dayStr + ", " + yyyy;
        }
    }
    
    // Major format 6: Text 3 (DAYNAME, MONTH D, YYYY or DAYNAME, D MONTH YYYY)
    private static String formatText3(String date, char minorFormat, int dayOfWeek) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        
        String dayName = getDayName(dayOfWeek);
        String monthName = getMonthName(mm);
        String dayStr = formatDay(dd);
        
        if (minorFormat == '2') {
            // European: DAYNAME, D MONTH YYYY
            return dayName + ", " + dayStr + " " + monthName + " " + yyyy;
        } else {
            // US: DAYNAME, MONTH D, YYYY
            return dayName + ", " + monthName + " " + dayStr + ", " + yyyy;
        }
    }
    
    // Major format 7: Text 4 (DAYNAME, MON D, YYYY or DAYNAME, D MON YYYY)
    private static String formatText4(String date, char minorFormat, int dayOfWeek) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        
        String dayName = getDayName(dayOfWeek);
        String monthAbbr = getMonthAbbr(mm);
        String dayStr = formatDay(dd);
        
        if (minorFormat == '2') {
            // European: DAYNAME, D MON YYYY
            return dayName + ", " + dayStr + " " + monthAbbr + " " + yyyy;
        } else {
            // US: DAYNAME, MON D, YYYY
            return dayName + ", " + monthAbbr + " " + dayStr + ", " + yyyy;
        }
    }
    
    // Major format 8: Text 5 (DAY, MONTH D, YYYY or DAY, D MONTH YYYY)
    private static String formatText5(String date, char minorFormat, int dayOfWeek) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        
        String dayAbbr = getDayAbbr(dayOfWeek);
        String monthName = getMonthName(mm);
        String dayStr = formatDay(dd);
        
        if (minorFormat == '2') {
            // European: DAY, D MONTH YYYY
            return dayAbbr + ", " + dayStr + " " + monthName + " " + yyyy;
        } else {
            // US: DAY, MONTH D, YYYY
            return dayAbbr + ", " + monthName + " " + dayStr + ", " + yyyy;
        }
    }
    
    // Major format 9: Text 6 (DAY, MON D, YYYY or DAY, D MON YYYY)
    private static String formatText6(String date, char minorFormat, int dayOfWeek) {
        String mm = date.substring(0, 2);
        String dd = date.substring(2, 4);
        String yyyy = date.substring(4, 8);
        
        String dayAbbr = getDayAbbr(dayOfWeek);
        String monthAbbr = getMonthAbbr(mm);
        String dayStr = formatDay(dd);
        
        if (minorFormat == '2') {
            // European: DAY, D MON YYYY
            return dayAbbr + ", " + dayStr + " " + monthAbbr + " " + yyyy;
        } else {
            // US: DAY, MON D, YYYY
            return dayAbbr + ", " + monthAbbr + " " + dayStr + ", " + yyyy;
        }
    }
    
    // Helper: Get separator character based on minor format
    private static String getSeparator(char minorFormat) {
        switch (minorFormat) {
            case '1': return "";
            case '2': return " ";
            case '3': return "/";
            case '4': return "-";
            case '5': return ".";
            default: return "";
        }
    }
    
    // Helper: Format day (remove leading zero)
    private static String formatDay(String dd) {
        if (dd.charAt(0) == '0') {
            return dd.substring(1);
        }
        return dd;
    }
    
    // Helper: Get full month name
    private static String getMonthName(String mm) {
        int month = Integer.parseInt(mm) - 1;
        return MONTH_NAMES[month];
    }
    
    // Helper: Get month abbreviation (first 3 letters)
    private static String getMonthAbbr(String mm) {
        return getMonthName(mm).substring(0, 3);
    }
    
    // Helper: Get full day name
    private static String getDayName(int dayOfWeek) {
        return DAY_NAMES[dayOfWeek];
    }
    
    // Helper: Get day abbreviation (first 3 letters)
    private static String getDayAbbr(int dayOfWeek) {
        return DAY_NAMES[dayOfWeek].substring(0, 3);
    }
}

// ============================================================================

// Y2KDayOfWeek.java
package com.y2k.dateutil;

/**
 * Y2KDOWN - Day of Week Calculator
 * 
 * Determines the integral day of the week for a Gregorian date (MMDDYYYY).
 * Valid years: 1601-3399 AD (inclusive)
 * Returns: 0=Monday, 1=Tuesday, 2=Wednesday, 3=Thursday, 4=Friday, 5=Saturday, 6=Sunday
 */
public class Y2KDayOfWeek {
    
    /**
     * Result class for day of week operations
     */
    public static class DayResult {
        public char returnCode;     // '0' = success, '2'/'4'/'6'/'8' = various errors
        public int dayOfWeek;       // 0-6 (Monday-Sunday), or 9 if error
        
        public DayResult(char returnCode, int dayOfWeek) {
            this.returnCode = returnCode;
            this.dayOfWeek = dayOfWeek;
        }
        
        public boolean isSuccess() {
            return returnCode == '0';
        }
    }
    
    /**
     * Get the day of the week for a given date.
     * 
     * @param date 8-character date string in MMDDYYYY format
     * @return DayResult containing the day of week (0-6) and return code
     */
    public static DayResult getDayOfWeek(String date) {
        // Get astronomical number
        Y2KGregorianToAstro.AstroResult astroResult = Y2KGregorianToAstro.gregorianToAstro(date);
        
        if (astroResult.returnCode != '0') {
            return new DayResult(astroResult.returnCode, 9);
        }
        
        // Day of week is astronomical number modulo 7
        long astroNum = astroResult.astronomicalNumber;
        int dayOfWeek = (int)(astroNum % 7);
        
        return new DayResult('0', dayOfWeek);
    }
}

// ============================================================================

// Y2KGregorianToAstro.java
package com.y2k.dateutil;

/**
 * Y2KGTOA - Gregorian to Astronomical Number Converter
 * 
 * Computes the astronomical number for a Gregorian date (MMDDYYYY).
 * Valid years: 1601-3399 AD (inclusive)
 */
public class Y2KGregorianToAstro {
    
    // Maximum days in each month (non-leap, leap)
    private static final int[][] DAYS_IN_MONTH = {
        {31, 31},  // January
        {28, 29},  // February
        {31, 31},  // March
        {30, 30},  // April
        {31, 31},  // May
        {30, 30},  // June
        {31, 31},  // July
        {31, 31},  // August
        {30, 30},  // September
        {31, 31},  // October
        {30, 30},  // November
        {31, 31}   // December
    };
    
    /**
     * Result class for astronomical number conversion
     */
    public static class AstroResult {
        public char returnCode;             // '0' = success, '2'/'4'/'6'/'8' = various errors
        public long astronomicalNumber;     // 0 if error
        
        public AstroResult(char returnCode, long astronomicalNumber) {
            this.returnCode = returnCode;
            this.astronomicalNumber = astronomicalNumber;
        }
        
        public boolean isSuccess() {
            return returnCode == '0';
        }
    }
    
    /**
     * Convert a Gregorian date to an astronomical number.
     * 
     * @param date 8-character date string in MMDDYYYY format
     * @return AstroResult containing the astronomical number and return code
     */
    public static AstroResult gregorianToAstro(String date) {
        // Validate date format and characters
        if (date == null || date.length() != 8) {
            return new AstroResult('2', 0);
        }
        
        // Check all characters are digits
        for (int i = 0; i < 8; i++) {
            if (!Character.isDigit(date.charAt(i))) {
                return new AstroResult('2', 0);
            }
        }
        
        // Parse components
        int month = Integer.parseInt(date.substring(0, 2));
        int day = Integer.parseInt(date.substring(2, 4));
        int year = Integer.parseInt(date.substring(4, 8));
        
        // Validate year range (1601-3399)
        if (year < 1601 || year > 3399) {
            return new AstroResult('4', 0);
        }
        
        // Validate month range (1-12)
        if (month < 1 || month > 12) {
            return new AstroResult('6', 0);
        }
        
        // Determine if leap year
        boolean isLeapYear = isLeapYear(year);
        
        // Validate day range
        int maxDay = DAYS_IN_MONTH[month - 1][isLeapYear ? 1 : 0];
        if (day < 1 || day > maxDay) {
            return new AstroResult('8', 0);
        }
        
        // Compute astronomical number
        long astroNum = computeAstronomicalNumber(year, month, day);
        
        return new AstroResult('0', astroNum);
    }
    
    /**
     * Determine if a year is a leap year.
     * Rules: Divisible by 4, except century years unless divisible by 400
     */
    private static boolean isLeapYear(int year) {
        if (year % 4 != 0) {
            return false;
        }
        if (year % 100 != 0) {
            return true;
        }
        return year % 400 == 0;
    }
    
    /**
     * Compute the astronomical number using the algorithm from the original code.
     * This uses the standard Julian Day Number algorithm.
     */
    private static long computeAstronomicalNumber(int year, int month, int day) {
        int y = year;
        int m = month;
        
        // Adjust month and year for the algorithm
        if (m > 2) {
            m -= 3;
        } else {
            m += 9;
            y -= 1;
        }
        
        int c = y / 100;      // Century
        int ya = y % 100;     // Year within century
        
        long ta = (c * 146097L) / 4;
        long tb = (ya * 1461L) / 4;
        long tc = ((m * 153L + 2) / 5) + day + 1721119L;
        
        return ta + tb + tc;
    }
}

// ============================================================================

// Y2KDateUtilDemo.java
package com.y2k.dateutil;

/**
 * Demonstration and test program for the Y2K Date Utility Library
 */
public class Y2KDateUtilDemo {
    
    public static void main(String[] args) {
        System.out.println("Y2K Date Utility Library - Java Translation");
        System.out.println("============================================\n");
        
        // Test various dates
        String[] testDates = {
            "01051997",  // January 5, 1997
            "04151997",  // April 15, 1997
            "12252000",  // December 25, 2000
            "02292000",  // February 29, 2000 (leap year)
            "07042024"   // July 4, 2024
        };
        
        for (String date : testDates) {
            System.out.println("Date: " + date);
            System.out.println("  Astronomical Number: " + 
                Y2KGregorianToAstro.gregorianToAstro(date).astronomicalNumber);
            
            Y2KDayOfWeek.DayResult dayResult = Y2KDayOfWeek.getDayOfWeek(date);
            if (dayResult.isSuccess()) {
                String[] days = {"Monday", "Tuesday", "Wednesday", "Thursday", 
                               "Friday", "Saturday", "Sunday"};
                System.out.println("  Day of Week: " + days[dayResult.dayOfWeek]);
            }
            
            // Test various format codes
            System.out.println("  Formats:");
            testFormat(date, '1', '3');  // Commercial with /
            testFormat(date, '2', '4');  // European with -
            testFormat(date, '3', '5');  // F.I.P.S. with .
            testFormat(date, '4', '1');  // Text 1 US
            testFormat(date, '6', '1');  // Text 3 US (with day name)
            
            System.out.println();
        }
        
        // Test error conditions
        System.out.println("\nError Testing:");
        testError("99991997", "Invalid month");
        testError("13011997", "Invalid month");
        testError("02302000", "Invalid day");
        testError("01011500", "Year too early");
        testError("01014000", "Year too late");
    }
    
    private static void testFormat(String date, char major, char minor) {
        Y2KDateFormatter.FormatResult result = 
            Y2KDateFormatter.formatDate(date, major, minor);
        if (result.isSuccess()) {
            System.out.println("    [" + major + "," + minor + "]: " + 
                result.formattedDate);
        }
    }
    
    private static void testError(String date, String description) {
        Y2KDateFormatter.FormatResult result = 
            Y2KDateFormatter.formatDate(date, '1', '1');
        System.out.println("  " + description + " (" + date + "): RC=" + 
            result.returnCode);
    }
}




How MicroAPL works with you →