You are invited to browse the list of mainframe-loving sites.
[ Join Now | Ring Hub | Random | << Prev | Next >> ]
© Copyright Edward Soto 2003. All rights reserved.
This software is free; you can redistribute it and/or modify it
under the terms of the GNU General Public License as published by the Free
Software Foundation; either
version 2 of the License,
or (at your option) any later version.
More information is available from
the Free Software Foundation or
the Open Source Initiative.
This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
You should have received a copy of the GNU General Public License along with this software; if not, write to either of the following:
|
the Free Software Foundation, Inc. 59 Temple Place, Suite 330 Boston, MA 02111-1307 United States of America |
B.V. Bixoft Rogge 9 7261 JA Ruurlo The Netherlands |
|
email: bixoft@bixoft.nl phone: +31-6-22755401 |
Remark:
This software - and more programs and macros - are available in a format more
suitable for uploading to your mainframe. Please e-mail
B.V. Bixoft with your request
and you will receive a zipped IEBUPDTE job with the program sources.
* 00000100
* This program is free software; you can redistribute it and/or modify 00000200
* it under the terms of the GNU General Public License as published by 00000300
* the Free Software Foundation; either version 2 of the License 00000400
* or (at your option) any later version. 00000500
* The license text is available at the following internet addresses: 00000600
* - http://www.bixoft.com/english/gpl.htm 00000700
* - http://fsf.org 00000800
* - http://opensource.org 00000900
* 00001000
* This program is distributed in the hope that it will be useful, 00001100
* but WITHOUT ANY WARRANTY; without even the implied warranty of 00001200
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 00001300
* See the GNU General Public License for more details. 00001400
* 00001500
* You should have received a copy of the GNU General Public License 00001600
* along with this program; if not, write to either of the following: 00001700
* the Free Software Foundation, Inc. B.V. Bixoft 00001800
* 59 Temple Place, Suite 330 Rogge 9 00001900
* Boston, MA 02111-1307 7261 JA Ruurlo 00002000
* United States of America The Netherlands 00002100
* 00002200
* e-mail: bixoft@bixoft.nl 00002300
* phone : +31-6-22755401 00002400
* 00002500
TITLE 'RE-ENTRANT GREGORIAN(YYYMMDDS)->JULIAN(0YYYDDDS)DATE'
*---------------------------------------------------------------------*
* CALL GREGJUL,(GDATE,JDATE) 1020710C->0102191C
* LTR R15,R15 Q, GOOD DATE CONVERSION?
* BNZ ERRDATE NO, HANDLE INVALID INPUT GREG-DATE.
*---------------------------------------------------------------------*
SPACE 2
GREGJUL CSECT , RE-ENTRANT 2006JAN18ESOTO
USING *,R15
USING SAVREGS,R13 USER RE-ENTRANT WORK AREA.
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
STM R14,R12,12(R13) STORE USER REGISTERS.
B GREG000
DC CL8'GREGJUL',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
GREG000 DS 0D
LM R4,R5,0(R1) LOAD USER INPUT/OUTPUT ADDRESSES.
UNPK GREGDT,0(4,R4) UNPACK/SAVE INPUT GREGORIAN DATE.
PACK DWORK,GREGYY PACK GREGORIAN YEAR ONLY.
CVB R4,DWORK R4 NOW 0000YYY.
LA R2,=Y(0,31,59,90,120,151,181,212,243,273,304,334,365)
LTR R3,R4 Q, YEAR ZERO(1900; 365 DAYS)?
BZ GREG100 YES, 365 DAYS CORRECT.
N R3,=A(3) Q, LEAP YEAR(366 DAYS)?
BNZ GREG100 NO, MUST BE A 365 DAYS YEAR.
LA R2,=Y(0,31,60,91,121,152,182,213,244,274,305,335,366)
GREG100 DS 0H
MH R4,=Y(1000) R4/FROM 0000YYY TO 0YYY000.
PACK DWORK,GREGMM PACK GREGORIAN MONTH.
CVB R3,DWORK R3 NOW 00000MM.
LTR R3,R3 Q, POSITIVE(VALID) GREGORIAN MONTH?
BNP GREG900 NO, EXIT,INVALID GREGORIAN MONTH.
CH R3,=Y(12) Q, GREGORIAN MONTH > 12 ?
BH GREG900 YES, EXIT,INVALID GREGORIAN MONTH.
BCTR R3,R0 R3 NOW 0-11.
AR R3,R3 R3 NOW 0-22.
AR R3,R2 R3 NOW CORRECT MONTH ENTRY.
PACK DWORK,GREGDD PACK GREGORIAN DAY.
CVB R2,DWORK R2 NOW 00000DD.
LTR R2,R2 Q, POSITIVE(VALID) GREGORIAN DAY?
BNP GREG900 NO, EXIT,INVALID GREGORIAN DAY.
AH R2,0(,R3) GREGDD PLUS PREV MONTHS DAYS.
CH R2,2(,R3) Q, GREGORIAN DAY > END OF MONTH?
BH GREG900 YES, EXIT, INVALID GREGORIAN DAY.
AR R2,R4 R2 = 0YYYDDD = 0YYY000 + 0000DDD.
CVD R2,DWORK DWORK NOW 000000000YYYDDDS.
MVC 0(L'JDATE,R5),JDATE MOVE JULIAN DATE TO USER OUTPUT.
XR R15,R15 RETURN CODE: GOOD CONVERSION.
GREG900 DS 0H
LM R0,R12,20(R13) RESTORE USER REGISTERS.
BR R14 RETURN TO USER CONTROL.
*
LTORG
*
SAVREGS DSECT
DS 0D,18A 1x7 USER SAVEREGS.
DWORK DS 0D,4X 2X7 DOUBLE WORD WORK AREA
JDATE DS PL4 3X7 0YYYDDDS (OUTPUT JULIAN DATE)
GREGDT DS 0CL7 4x7 YYYMMDD (INPUT GREGORIAN DATE)
GREGYY DS CL3 5x7 YYY
GREGMM DS CL2 6x7 MM
GREGDD DS CL2 7x7 DD
*
END
TITLE 'RE-ENTRANT JULIAN(0YYYDDDS)->GREGORIAN(YYYMMDDS)DATE'
*---------------------------------------------------------------------*
* CALL JULGREG,(JDATE,GDATE) 0100366C->1001231C
* LTR R15,R15 Q, GOOD DATE CONVERSION?
* BNZ ERRDATE NO, HANDLE INVALID JULIAN DATE.
*---------------------------------------------------------------------*
SPACE 2
JULGREG CSECT , RE-ENTRANT 2006JAN18ESOTO
USING *,R15
USING SAVREGS,R13 USER RE-ENTRANT WORK AREA.
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
STM R14,R12,12(R13) STORE USER REGISTERS.
B JUL000
DC CL8'JULGREG',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
JUL000 DS 0D
LM R4,R5,0(R1) LOAD USER INPUT/OUTPUT ADDRESES.
UNPK JULDTE,0(4,R4) UNPACK INPUT JULIAN DATE.
PACK DWORK,JULYYY PACK JULIAN YEAR (3 DIGITS).
CVB R3,DWORK R3 NOW 0000YYY.
LA R2,=Y(0,31,59,90,120,151,181,212,243,273,304,334,365)
LTR R1,R3 Q, YEAR ZERO(1900)?
BZ JUL100 YES, 1900 NOT A LEAP YEAR.
N R1,=A(3) Q, LEAP YEAR(366 DAYS)?
BNZ JUL100 NO, 365 DAYS YEAR CORRECT.
LA R2,=Y(0,31,60,91,121,152,182,213,244,274,305,335,366)
JUL100 DS 0H
PACK DWORK,JULDDD PACK JULIAN DAY (3 DIGITS).
CVB R4,DWORK R4 NOW 0000DDD.
CH R4,24(,R2) Q, JULIAN DAY > EOY(365/366)?
BH JUL900 YES, EXIT, ERROR JULIAN DAY.
LTR 1,4 LOAD/TEST JULIAN DAY.
BNP JUL900 EXIT, ERROR JULIAN DAY.
SRL R1,5 DIV BY 32; R1 NOW 0-11.
LR R0,R1 R0 NOW 0-11.
AR R0,R0 R0 NOW 0-22.
AR R2,R0 R2=CORRECT TABLE ENTRY, MAYBE.
LA R1,1(,R1) R1=CORRECT MONTH, MAYBE.
CH R4,2(,R2) Q, JULIAN DAY > NEXT ENTRY.
BNH JUL200 NO, R1/R2 CORRECT MONTH/ENTRY.
LA R1,1(,R1) R1 NOW CORRECT MONTH(1-12).
LA R2,2(,R2) R2 NOW CORRECT ENTRY.
JUL200 DS 0H
SH R4,0(,R2) R4 NOW CORRECT GREG DAY.
MH R1,=Y(100) R1/FROM 00000MM TO 000MM00.
AR R1,R4 R1=000MMDD = 000MM00 + 00000DD.
MH R3,=Y(10000) R3 FROM 0000YYY TO YYY0000.
AR R3,R1 R3=YYYMMDD = YYY0000 + 000MMDD.
CVD R3,DWORK DWORK NOW 00000000YYYMMDDC.
MVC 0(L'GDATE,R5),GDATE MOVE GREG-DATE TO USER OUTPUT.
XR R15,R15 RETURN CODE: GOOD CONVERSION.
JUL900 DS 0H
LM R0,R12,20(R13) RESTORE USER REGISTERS.
BR R14 RETURN TO USER CONTROL.
*
LTORG
*
SAVREGS DSECT
DS 0D,18A 1X6 USER SAVEREGS.
DWORK DS 0D,4X 2X6
GDATE DS PL4 3X6 YYYMMDDS (OUTPUT GREG DATE)
JULDTE DS 0CL6 4X6 YYYDDD (INPUT JULIAN DATE)
JULYYY DS CL3 5X6 YYY
JULDDD DS CL3 6X6 DDD
*
END
TITLE 'RE-ENTRANT PERPETUAL(DDDDDS)DATE->GREGORIAN(YYYMMDDS)'
*---------------------------------------------------------------------*
* CALL PERPGREG,(PDATE,GDATE) 36525C=>1001231C
* LTR R15,R15 Q, GOOD DATE CONVERSION?
* BNZ ERRDATE NO, HANDLE INVALID INPUT PERP-DATE.
*---------------------------------------------------------------------*
SPACE 2
PERPGREG CSECT , RE-ENTRANT 2006JAN18ESOTO
USING *,R15
USING SAVREGS,R13 USER RE-ENTRANT WORK AREA.
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
STM R14,R12,12(R13) STORE USER REGISTERS.
B PERP000
DC CL8'PERPGREG',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
PERP000 DS 0D
LM R4,R5,0(R1) LOAD USER INPUT/OUTPUT ADDRESSES.
ZAP DWORK,0(3,R4) MOVE/TEST INPUT PERP-DATE.
BNP PERP900 EXIT, INVALID INPUT PERP-DATE.
CVB R4,DWORK R4 NOW BINARY PERPETUAL DATE.
LR R3,R4 R3=R4
XR R2,R2 NEEDED FOR NEXT INSTR.
D R2,=A(365) R3 PROBABLY GOOD WORK YEAR.
LR R1,R3 R1=R3
SRL R1,2 R1 NUMBER OF LEAP YEAR DAYS.
CR R1,R2 Q, LEAP YEAR DAYS < REMAINDER?
BL PERP100 YES, R3 GOOD WORK YEAR.
BCTR R3,R0 NO, R3 NOW GOOD WORK YEAR.
PERP100 DS 0H
LR R2,R3 NEEDED FOR LEAP YEAR DAYS CALC.
LR R1,R3 NEEDED BY NEXT INSTR.
M R0,=A(365) R1 NOW DAYS W/O LEAP YEAR DAYS.
SRL R2,2 R2 NOW CORRECT LEAP YEAR DAYS.
AR R2,R1 R2 NOW DAYS IN PREV-YEARS.
SR R4,R2 R4 NOW CURRENT YEAR DAYS.
LA R3,1(,R3) R3 NOW CURRENT OUTPUT GREG-YEAR.
LA R0,=Y(0,31,59,90,120,151,181,212,243,273,304,334,365)
N 2,=A(3) Q, A LEAP YEAR?
BNZ PERP200 NO, ASSUMPTION CORRECT.
LA R0,=Y(0,31,60,91,121,152,182,213,244,274,305,335,366)
PERP200 DS 0H
LR R2,R4 MOVE DAYS IN CURRENT YEAR.
SRL R2,5 DIVIDE BY 32; R2 NOW 0-11.
LR R1,R2 R1 NOW 0-11.
AR R1,R1 R1 NOW 0-22.
AR R1,R0 R1 MAYBE CORRECT MONTH ENTRY.
LA R2,1(,R2) R2 MAYBE CORRECT MONTH (1-12).
CH R4,2(,R1) Q, CORRECT MONTH ENTRY?
BNH PERP300 YES, SKIP ADJUSTMENT.
LA R1,2(,R1) R1 NOW CORRECT MONTH (1-12).
LA R2,1(,R2) R2 NOW CORRECT GREG-MONTH.
PERP300 DS 0H
SH R4,0(,R1) R4 NOW OUTPUT GREG DAY(00000DD).
MH R3,=Y(10000) R3/FROM 0000YYY TO YYY0000.
MH R2,=Y(100) R2/FROM 00000MM TO 000MM00.
AR R2,R3 R2 NOW YYYMM00.
AR R2,R4 R2 NOW YYYMMDD.
CVD R2,DWORK DWORK NOW 00000000YYYMMDDS.
MVC 0(L'GDATE,R5),GDATE MOVE GREG-DATE TO USER OUTPUT.
XR R15,R15 RETURN CODE: GOOD CONVERSION.
PERP900 DS 0H
LM R0,R12,20(R13) RESTORE USER REGISTERS.
BR R14 RETURN TO USER CONTROL.
*
LTORG
*
SAVREGS DSECT
DS 0D,18A 1X3 USER SAVEREGS.
DWORK DS 0D,4X 2X3
GDATE DS PL4 3X3 YYYMMDDS (OUTPUT GREG DATE)
*
END
TITLE 'RE-ENTRANT GREGORIAN(YYYMMDDS)->PERPETUAL(DDDDDS)DATE'
*---------------------------------------------------------------------*
* CALL GREGPERP,(GDATE,PDATE) 1001231C->36525C
* LTR R15,R15 Q, GOOD DATE CONVERSION?
* BNZ ERRDATE NO, HANDLE INVALID GREGORIAN DATE.
*---------------------------------------------------------------------*
SPACE 2
GREGPERP CSECT , RE-ENTRANT 2006JAN18ESOTO
USING *,R15
USING SAVREGS,R13 USER RE-ENTRANT WORK AREA.
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
STM R14,R12,12(R13) STORE USER REGISTERS.
B GREG000
DC CL8'GREGPERP',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
GREG000 DS 0D
LM R4,R5,0(R1) LOAD USER INPUT/OUTPUT ADDRESSES.
UNPK GREGDT,0(4,R4) SAVE/UNPACK INPUT GREGORIAN-DATE.
PACK DWORK,GREGYY PACK INPUT GREGORIAN YEAR.
CVB R4,DWORK R4 NOW 00000YYY.
LTR R3,R4 Q, YEAR ZERO(1900)?
BZ GREG900 YES, EXIT; INVALID OUTPUT YEAR.
LA R2,=Y(0,31,59,90,120,151,181,212,243,273,304,334,365)
N R3,=A(3) Q, A LEAP YEAR(366 DAYS)?
BNZ GREG100 NO, MUST BE 365 DAYS YEAR.
LA R2,=Y(0,31,60,91,121,152,182,213,244,274,305,335,366)
GREG100 DS 0H
PACK DWORK,GREGMM PACK INPUT GREGORIAN MONTH.
CVB R3,DWORK R3 NOW BINARY GREGORIAN MONTH.
LTR R3,R3 Q, POSITIVE GREGORIAN MONTH?
BNP GREG900 NO, EXIT; INVALID INPUT GREG-MONTH.
CH R3,=Y(12) Q, INPUT GREGORIAN MONTH > 12 ?
BH GREG900 YES, EXIT; INVALID GREGORIAN MONTH.
BCTR R3,R0 R3 NOW 0-11.
AR R3,R3 R3 NOW 0-22.
AR R3,R2 R3 NOW CORRECT MONTH-TBL ENTRY.
PACK DWORK,GREGDD PACK INPUT GREGORIAN DAY.
CVB R2,DWORK
LTR R2,R2 Q, POSITIVE INPUT GREGORIAN DAY?
BNP GREG900 NO, EXIT; INVALID INPUT GREG-DAY.
AH R2,0(,R3) PREV MONTH DAYS TO GREGORIAN DAY.
CH R2,2(,R3) Q, GREGORIAN DAY > END OF MONTH ?
BH GREG900 YES, EXIT; INVALID GREGORIAN DAY.
BCTR R4,R0 DECREMENT BY 1 INPUT GREGORIAN YEAR.
LR R3,R4 R3=R4.
SRL R3,2 R3 NOW LEAP YEAR DAYS.
MH R4,=Y(365) R4 DAYS IN PREV YRS LESS LEAP.
AR R4,R3 R4 NOW DAYS IN PREV YEARS.
AR R4,R2 R4 NOW BINARY PERPETUAL DATE.
CVD R4,DWORK DWORK NOW 0000000000DDDDDS.
MVC 0(L'PDATE,R5),PDATE MOVE PERP-DATE TO USER OUTPUT.
XR R15,R15 RETURN CODE: GOOD CONVERSION.
GREG900 DS 0H
LM R0,R12,20(R13) RESTORE USER REGISTERS.
BR R14 RETURN TO USER CONTROL.
*
LTORG
*
SAVREGS DSECT
DS 0D,18A 1X7 USER SAVEREGS.
DWORK DS 0D,5X 2X7
PDATE DS PL3 3X7 DDDDDS
GREGDT DS 0CL7 4X7 YYYMMDD
GREGYY DS CL3 5X7 YYY
GREGMM DS CL2 6X7 MM
GREGDD DS CL2 7X7 DD
*
END
TITLE 'RE-ENTRANT PERPETUAL(DDDDDS) TO JULIAN(0YYYDDDS)DATE'
*---------------------------------------------------------------------*
* CALL PERPJUL,(PDATE,JDATE) 36525C=>0100366C
* LTR 15,15 Q, GOOD DATE CONVERSION?
* BNZ ERRDATE NO, HANDLE INVALID PERPETUAL DATE.
*---------------------------------------------------------------------*
SPACE 2
PERPJUL CSECT , RE-ENTRANT 2006JAN18ESOTO
USING *,R15
USING SAVREGS,R13 USER RE-ENTRANT WORK AREA.
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
STM R14,R12,12(R13) STORE USER REGISTERS.
B PERP000
DC CL8'PERPJUL',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
PERP000 DS 0D
LM R4,R5,0(R1) LOAD USER INPUT/OUTPUT ADDRESSES.
ZAP DWORK,0(3,R4) MOVE/TEST INPUT PERPETUAL DATE.
BNP PERP900 EXIT, BAD INPUT PERPETUAL DATE.
CVB R4,DWORK R4 NOW BINARY PERPETUAL DATE.
LR R3,R4 R3=R4.
XR R2,R2 NEEDED FOR NEXT INSTR.
D R2,=A(365) R3 NOW PROBABLY GOOD WORK YEAR.
LR R1,R3 R1=R3.
SRL R1,2 DIV BY 4; R1 NOW LEAP YEAR DAYS.
CR R1,R2 Q, LEAP YEAR DAYS < REMAINDER?
BL PERP100 YES, R3 GOOD WORK YEAR.
BCTR R3,R0 NO, R3 NOW GOOD WORK YEAR.
PERP100 DS 0H
LR R2,R3 R2=R3.
LR R1,R3 R1=R3.
M R0,=A(365) R1=PREV YRS DAYS,W/O LEAP DAYS.
SRL R2,2 R2 NOW PREV LEAP YEAR DAYS.
AR R2,R1 R2 NOW PREV YEARS DAYS.
SR R4,R2 R4 NOW DAYS IN CURRENT YEAR.
LA R3,1(,R3) R3 NOW CORRECT OUTPUT JUL-YEAR.
MH R3,=Y(1000) R3 FROM 0000YYY TO 0YYY000.
AR R3,R4 R3 NOW 0YYYDDD=0YYY000+0000DDD.
CVD R3,DWORK DWORK NOW 000000000YYYDDDS.
MVC 0(L'JDATE,R5),JDATE MOVE JULIAN DATE TO USER OUTPUT.
XR R15,R15 RETURN CODE: GOOD CONVERSION.
PERP900 DS 0H
LM R0,R12,20(R13) RESTORE USER REGISTERS.
BR R14 RETURN TO USER CONTROL.
*
LTORG
*
SAVREGS DSECT
DS 0D,18A 1X3 USER SAVEREGS.
DWORK DS 0D,4X 2X3 DOUBLE WORD WORK AREA.
JDATE DS PL4 3X3 0YYYDDDS
*
END
TITLE 'RE-ENTRANT JULIAN(0YYYDDDS) TO PERPETUAL(DDDDDS)DATE'
*---------------------------------------------------------------------*
* CALL JULPERP,(JDATE,PDATE) 0100366C->36525C
* LTR R15,R15 Q, GOOD DATE CONVERSION?
* BNZ ERRDATE NO, HANDLE INVALID JULIAN DATE.
*---------------------------------------------------------------------*
SPACE 2
JULPERP CSECT , RE-ENTRANT 2006JAN18ESOTO
USING *,R15
USING SAVREGS,R13 USER RE-ENTRANT WORK AREA.
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
STM R14,R12,12(R13) STORE USER REGISTERS.
B JUL000
DC CL8'JULPERP',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
JUL000 DS 0D
LM R2,R3,0(R1) LOAD USER INPUT/OUTPUT ADDRESSES.
UNPK JULDTE,0(4,R2) JULDTE NOW CHARACTERS(YYYDDD).
PACK DWORK,JULYYY PACK INPUT JULIAN YEAR.
CVB R6,DWORK R6 NOW 00000YYY.
LTR R4,R6 TEST/MOVE INPUT JULIAN YEAR.
BNP JUL900 EXIT, IF BAD INPUT JULIAN-YEAR.
BCTR R6,R0 R6/JULIAN YEAR LESS ONE.
LR R5,R6 R5=R6.
SRL 5,2 DIV BY 4; R5 NOW LEAP YEAR DAYS.
MH R6,=Y(365) R6 DAYS IN PREV YEARS.
AR R6,R5 PLUS PREV LEAP YEAR DAYS.
LA R5,365 ASSUMES NOT LEAP YEAR (365 DAYS).
N R4,=A(3) Q, A LEAP YEAR?
BNZ JUL100 NO, 365 DAYS YEAR.
LA R5,366 YES, 366 DAYS YEAR.
JUL100 DS 0H
PACK DWORK,JULDDD PACK INPUT JULIAN DAY.
CVB R4,DWORK
LTR R4,R4 Q, POSITIVE INPUT JULIAN DAY.
BNP JUL900 NO, EXIT, INVALID INPUT JUL-DAY.
CR R4,R5 Q, DAYS > EOY (365/366)?
BH JUL900 YES, EXIT, INVALID INPUT JUL-DAY.
AR R4,R6 R4 NOW BINARY PERPETUAL DATE.
CVD R4,DWORK DWORK NOW 0000000000DDDDDS.
MVC 0(L'PDATE,R3),PDATE MOVES PERP-DATE TO USER OUTPUT.
XR R15,R15 RETURN CODE: GOOD CONVERSION.
JUL900 DS 0H
LM R0,R12,20(R13) RESTORE USER REGISTERS.
BR R14 RETURN TO USER CONTROL.
*
LTORG
*
SAVREGS DSECT
DS 0D,18A 1X6 USER SAVEREGS.
DWORK DS 0D,5X 2X6 DOUBLE WORD WORK AREA
PDATE DS PL3 3X6 OUTPUT PERPETUAL DATE
JULDTE DS 0CL6 4X6 YYYDDD
JULYYY DS CL3 5X6 YYY
JULDDD DS CL3 6X6 DDD
*
END
TITLE 'RE-ENTRANT PERPETUAL DATE TO DAY OF WEEK'
*---------------------------------------------------------------------*
* CALL PERPDOW,(PDATE,DAYWEEK)
* LTR R15,R15 Q, GOOD DAY OF WEEK?
* BNZ ERRDATE NO, HANDLE INVALID PERPETUAL DATE.
*---------------------------------------------------------------------*
SPACE 2
PERPDOW CSECT , RE-ENTRANT 2006JAN18ESOTO
USING *,R15
USING SAVREGS,R13 USER RE-ENTRANT WORK AREA.
PRINT NOGEN
YREGS , EQUATES REGISTERS 0-15 TO R0-R15.
STM R14,R12,12(R13) STORE USER REGISTERS.
B PERP000
DC CL8'PERPDOW',CL8'&SYSDATE',CL8'&SYSTIME',CL8'&VER'
PERP000 DS 0D
LM R3,R4,0(R1) LOAD USER INPUT/OUTPUT ADDRESSES.
ZAP DWORK,0(3,R3) MOVE/TEST INPUT PERPETUAL DATE.
BNP PERP900 EXIT, ZERO OR NEGATIVE INPUT DATE.
CVB R3,DWORK CONVERT PACKED DECIMAL TO BINARY.
XR R2,R2 NEEDED FOR NEXT (DIVIDE) INSTR.
D R2,=A(7) R2 (REMAINDER) NOW 0-6 (MON-SUN).
MH R2,=Y(3) R2 NOW 0-18 (MON-SUN).
LA R2,DOWTBL(R2) R2 NOW POINTS TO DAY OF WEEK.
MVC 0(3,R4),0(R2) MOVE DAY OF WEEK TO OUTPUT ADDRESS.
XR R15,R15 RETURN CODE: VALID INPUT/RESULTS.
PERP900 DS 0H
LM R0,R12,20(R13) RESTORE USER REGISTERS.
BR R14 RETURN TO USER CONTROL.
*
LTORG
* 0 1 2 3 4 5 6 POSSIBLE REMAINDERS (0-6).
DOWTBL DC C'MONTUEWEDTHUFRISATSUN'
*
SAVREGS DSECT
DS 0D,18A 1X2 USER SAVEREGS.
DWORK DS D 2X2 USER RE-ENTRANT WORK AREA
*
END
|
This site is a member of WebRing. You are invited to browse the list of mainframe-loving sites. |
|
Dinos are not dead. They are alive and well and living in data centers all around you. They speak in tongues and work strange magics with computers. Beware the dino! And just in case you're waiting for the final demise of these dino's: remember that dinos ruled the world for 155-million years! |
|
Dinos and other anachronisms [ Join Now | Ring Hub | Random | << Prev | Next >> ] |
||
Below you find the logo of our sponsor and logos of the web-standards that this page adheres to.
|
|
|
|
||