TITLE 'ALEXTDAT - PROGRAM TO PROCESS DATE INFORMATION' ******************************************************************** * AUTHOR - BILL SWEENEY * * SSC, INC. (703) 777-2771) * * WHSWEENEY@SSCMAINFRAME.COM * * WWW.SSCMAINFRAME.COM * * DATE - (C) COPYRIGHT JULY 1997 * * * * FUNCTION - PROGRAM IS INVOKED TO GENERATE RELATIVE DATE, TIME, * * MONTH, DAY, YEAR, DAY OF WEEK INFORMATION. * * * * REGISTER USAGE * * R1 - PARAMETER LIST ADDRESS * * R12 - FIRST BASE REGISTER * * R11 - ADDRESSABILITY TO DSECT * * R0-R10,R14-R15 - VARIOUS WORK REGISTER UTILIZATION * * * * LINKAGE ATTRIBUTES - AMODE 24, RMODE 24, REENTRANT * * THOUGH ALEXCMDS IS NOT REENTRANT * ******************************************************************** ALEXTDAT CSECT ALEXTDAT AMODE 24 ALEXTDAT RMODE 24 PRINT ON,GEN R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 NO_STORAGE EQU 20 EJECT **************************************************************** * SAVE LOGIC AND ENTRY SETUP OF PROGRAM. * **************************************************************** STM R14,R12,12(R13) SAVE IN CALLERS SAVEAREA LR R12,R15 USING ALEXTDAT,R12 * LR R6,R1 LOAD UP THE PARAMETER LIST L R6,0(R1) LOAD UP THE PARAMETER LIST USING PARMLIST,R6 GOOD_FUNCTION EQU * LA R3,STORAGE_SIZE GET THE SIZE OF OUR STORAGE GETMAIN RC,LV=(3) LTR R15,R15 SEE IF VALID GETMAIN BZ GOOD_STORAGE YES, THEN CONTINUE MACDUFF LA R15,NO_STORAGE LOAD UP PREDETERMINED RC B RETURN2 AND GET OUT GOOD_STORAGE EQU * ST R1,8(R13) SAVE OUR SAVERAREA ST R13,4(R1) SAVE THEIR SAVEAREA LR R13,R1 LOAD OURS USING STORAGE,R13 **************************************************************** * THE DATE AND TIME WILL BE PROCESSED HERE. THE TIME WILL BE * * EDITED TO COMPARE AGAINST THE TIME IN A JES2 AUTOMATIC CMD * * AND THE DATE WILL BE PROCESSED FOR DAY OF WEEK AND CURRENT * * DATE. * **************************************************************** GETTIME LA R1,2(0,0) LOAD REG1 FOR TIME SVC SVC 11 ISSUE SVC FOR TIME ST R0,TIMEFW STORE ADJUSTED TIME * STCM R0,8,TIMEHOUR GET THE HOUR IN THIS FIELD TR TIMEHOUR(1),NEXTHOUR INCR TO NEXT HOUR MVC AUTOHOUR(6),HOURMASK MOVE IN THE MASK ED AUTOHOUR(3),TIMEHOUR EDIT THE HOUR MVC HOURNEXT(5),AUTOHOUR+1 MOVE IT IN TO END USER * MVC HOLDTIME(9),TIMEMASK ED HOLDTIME(9),TIMEFW EDIT TIME INTO HEADER FIELD CLI HOLDTIME+1,C' ' HI ORDER BLANK BNE MOVETIME NO, THEN LEAVE ALONE MVI HOLDTIME+1,C'0' MOVE IN A ZERO FOR HDR TIME AS WELL MOVETIME MVC HOUR(8),HOLDTIME+1 DODATE LTR R1,R1 IS THERE EVEN A DATE BZ FREESTOR YES, THEN GO AROUND GOTDATE ST R1,DOUBLE_WORD+4 SAVE THE DATE FROM SYSTEM UNPK JULIAN_DAY(3),DOUBLE_WORD+6(2) OI JULIAN_DAY+2,X'F0' MVC TWO_YEAR(3),YEARMASK MVC YEAR(2),=C'19' MOVE IN 19 AS CENTURY CLI DOUBLE_WORD+4,X'00' IS IT 19 AS THE CENTURY BE NOT20 MVC YEAR(2),=C'20' MOVE IN 20 AS CENTURY NOT20 ED TWO_YEAR(3),DOUBLE_WORD+5 EDIT THE YEAR MVC YEAR+2(2),TWO_YEAR+1 MOVE IN REMAINDER OF YEAR CLI YEAR+2,C' ' SEE IF IT IS BLANK BNE SETYY NO, THEN GO AROUND MVI YEAR+2,C'0' SET TO ZERO SETYY MVC YY(2),YEAR+2 SET IT HERE ALSO MVI MM+2,C'/' SET DELIMETERS MVI DD+2,C'/' CHKLPYR TM DOUBLE_WORD+5,X'01' IS THIS A LEAP YEAR BO GETYEAR ODD, THEN JUST GO AROUND TM DOUBLE_WORD+5,X'12' HOW ABOUT LEAP YEAR NOW BM GETYEAR MIXED, THEN NOT LEAP YEAR MVI PFEB,29 SET TO 29 DAYS EJECT GETYEAR SLR R11,R11 CLEAR FOR CENTURY SLR R10,R10 AND YEAR ICM R11,8,=X'F0' MOVE IN SIGN BITS FOR YEAR IC R10,DOUBLE_WORD+5 MOVE IN YEAR ICM R10,2,=X'19' MOVE IN 20TH CENTURY CLI DOUBLE_WORD+4,X'00' IS IT 19 BE SHIFT_SIGN YES, THEN SHIFT IN SIGN ICM R10,2,=X'20' MOVE IN 21ST CENTURY SHIFT_SIGN EQU * SLDL R10,4 MOVE IN THE SIGN XC DOUBLE_WORD(6),DOUBLE_WORD SET TO ZERO FIRST 6 BYTES SLR R0,R0 START WITH ZERO CVB R1,DOUBLE_WORD GET DDDF CONVERTED TO BINARY LA R2,YEARTABL-3 START AT -2 INTO TABLE SLR R14,R14 CLEAR R14 FOR MONTH COUNT SPACE 1 GETDAY SLR R1,R0 SUBTRACT NUMBER OF DAYS IN MONTH LA R2,3(,R2) POSITION TO NEXT ENTRY IC R0,0(,R2) GET NUMBER OF DAYS IN MONTH LA R14,1(R14) INCREMENT THE MONTH COUNT CLR R0,R1 COMPARE THE TO SEE IF DONE BL GETDAY IF LT STILL NOT FINISHED MVC MM(2),1(R2) SAVE EBCDIC MONTH CHECK_LAST EQU * CR R1,R0 SEE IF LAST DAY OF MONTH BNE CONVERT_DAY MVI LASTDAY,C'Y' FLAG TO SAY LAST DAY CONVERT_DAY EQU * CVD R1,DOUBLE_WORD GET THE DAY UNPK DD(2),DOUBLE_WORD+6(2) OI DD+1,X'F0' SIGN BIT ST R10,DOUBLE_WORD+4 GET THE YEAR BACK IN CVB R10,DOUBLE_WORD CONVERT TO BINARY * GET DAY OF WEEK * * * OUTPUT - DAY_NUMBER * * N = D + 2M + 3(M+1)/5 + Y + Y/4 - Y/100 + Y/400 + 2 * * WHERE M = 3-14 (JAN,FEB ARE 13,14 OF Y-1) * * N/7 LEAVES REMAINDER 0-6, 0 INDICATING SATURDAY * TOWEEK LR R15,R10 GET YEAR FROM EARLIER CH R14,=H'2' JAN OR FEB? BH WEEKMMOK BE WEEKFEB LA R14,13 SET M=13 B WEEKYMIN WEEKFEB LA R14,14 SET M=14 WEEKYMIN BCTR R15,0 SET Y = Y-1 WEEKMMOK LR R0,R14 COPY M ALR R0,R0 GET 2M ALR R1,R0 SET N = N + 2M LR R0,R15 SAVE REDEFINED Y SPACE LA R14,1(,R14) GET M+1 MH R14,=H'3' GET 3(M+1) SRDL R14,32 SHIFT INTO R15, ZERO R14 D R14,=F'5' GET 3(M+1)/5 IN R15 ALR R1,R15 SET N = N + 3(M+1)/5 SPACE LR R15,R0 GET Y ALR R1,R15 SET N = N + Y SLR R14,R14 ZERO R14 D R14,=F'4' GET Y/4 ALR R1,R15 SET N = N + Y/4 SPACE LR R15,R0 GET Y SLR R14,R14 ZERO R14 D R14,=F'100' GET Y/100 SLR R1,R15 SET N = N - Y/100 SPACE LR R15,R0 GET Y SLR R14,R14 ZERO R14 D R14,=F'400' GET Y/400 ALR R1,R15 SET N = N + Y/400 LA R15,2 GET 2 ALR R1,R15 SET N = N + 2 SLR R0,R0 ZERO R0 D R0,=F'7' SET N = N/7 STC R0,DAY_NUMBER SAVE REMAINDER * GO AHEAD AND MOVE IN THE DAY OF THE WEEK LR R1,R0 MH R1,HW9 LA R14,WEEKDAYS(R1) POINT TO NAME MVC DAY_WEEK(9),0(R14) MOVE NAME PACK DOUBLE_WORD(8),MM(2) CVB R14,DOUBLE_WORD BCTR R14,0 MH R14,HW9 LA R15,MONTH_TABLE LA R15,0(R14,R15) MVC MONTH(9),0(R15) FREESTOR EQU * L R0,GETMAIN_LENGTH LR R1,R13 L R13,4(R13) SO WE CAN GET OUT OF HERE FREEMAIN RC,A=(1),LV=(0) RETURN1 LR R15,R4 RETURN2 L R14,12(R13) LM R0,R12,20(R13) BR R14 *********************** HW9 DC H'9' TIMEMASK DC X'4021204B20204B2020' YEARTABL DC AL1(31),CL2'01',AL1(28),CL2'02' DC AL1(31),CL2'03',AL1(30),CL2'04' DC AL1(31),CL2'05',AL1(30),CL2'06' DC AL1(31),CL2'07',AL1(31),CL2'08' DC AL1(30),CL2'09',AL1(31),CL2'10' DC AL1(30),CL2'11',AL1(31),CL2'12' PFEB EQU YEARTABL+3 MONTH_TABLE EQU * DC CL9'JANUARY ' DC CL9'FEBRUARY' DC CL9'MARCH ' DC CL9'APRIL ' DC CL9'MAY ' DC CL9'JUNE ' DC CL9'JULY ' DC CL9'AUGUST ' DC CL9'SEPTEMBER' DC CL9'OCTOBER ' DC CL9'NOVEMBER ' DC CL9'DECEMBER ' WEEKDAYS DC CL36'SATURDAY SUNDAY MONDAY TUESDAY ' DC CL27'WEDNESDAYTHURSDAY FRIDAY ' YEARMASK DC X'402120' MASK FOR YEAR HOURMASK DC X'F02120',CL3'.00' MASK FOR HOUR AND 0'S * 0 1 2 3 4 5 6 7 8 9 A B C D E F NEXTHOUR DC X'01020304050607080910000000000000' DC X'11121314151617181920000000000000' DC X'2122232400' LTORG STORAGE DSECT SAVEAREA DS 18F DOUBLE_WORD DS D GETMAIN_LENGTH DS F TIMEFW DS F TIMEHOUR DS X AUTOHOUR DS CL6 HOLDTIME DS CL9 TWO_YEAR DS CL3 ** STORAGE_SIZE EQU *-SAVEAREA * PARMLIST DSECT HOUR DS CL2 DS C MINUTE DS CL2 DS C SECOND DS CL2 HOURNEXT DS CL5 MM DS CL2 DS C DD DS CL2 DS C YY DS CL2 JULIAN_DAY DS CL3 DAY_NUMBER DS X LASTDAY DS C DAY_WEEK DS CL9 MONTH DS CL9 YEAR DS CL4 END