September 2017 Update
This commit is contained in:
Ingy döt Net
parent
bba7bfd280
commit
ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions
|
|
@ -0,0 +1,181 @@
|
|||
* CALENDAR FOR REAL PROGRAMMERS 05/03/2017
|
||||
CALENDAR CSECT
|
||||
USING CALENDAR,R13 BASE REGISTER
|
||||
B 72(R15) SKIP MY SAVEAREA
|
||||
DC 17F'0' MY SAVEAREA
|
||||
STM R14,R12,12(R13) SAVE CALLER'S REGISTERS
|
||||
ST R13,4(R15) LINK BACKWARD
|
||||
ST R15,8(R13) LINK FORWARD
|
||||
LR R13,R15 SET ADDRESSABILITY
|
||||
L R4,YEAR YEAR
|
||||
SRDA R4,32 .
|
||||
D R4,=F'4' YEAR//4
|
||||
LTR R4,R4 IF YEAR//4=0
|
||||
BNZ LYNOT
|
||||
L R4,YEAR YEAR
|
||||
SRDA R4,32 .
|
||||
D R4,=F'100' YEAR//100
|
||||
LTR R4,R4 IF YEAR//100=0
|
||||
BNZ LY
|
||||
L R4,YEAR YEAR
|
||||
SRDA R4,32 .
|
||||
D R4,=F'400' IF YEAR//400
|
||||
LTR R4,R4 IF YEAR//400=0
|
||||
BNZ LYNOT
|
||||
LY MVC ML+2,=H'29' ML(2)=29 LEAPYEAR
|
||||
LYNOT SR R10,R10 LTD1=0
|
||||
LA R6,1 I=1
|
||||
LOOPI1 C R6,=F'31' DO I=1 TO 31
|
||||
BH ELOOPI1
|
||||
XDECO R6,XDEC EDIT I
|
||||
LA R14,TD1 TD1
|
||||
AR R14,R10 TD1+LTD1
|
||||
MVC 0(3,R14),XDEC+9 SUB(TD1,LTD1+1,3)=PIC(I,3)
|
||||
LA R10,3(R10) LTD1+3
|
||||
LA R6,1(R6) I=I+1
|
||||
B LOOPI1
|
||||
ELOOPI1 LA R6,1 I=1
|
||||
LOOPI2 C R6,=F'12' DO I=1 TO 12
|
||||
BH ELOOPI2
|
||||
ST R6,M M=I
|
||||
MVC D,=F'1' D=1
|
||||
MVC YY,YEAR YY=YEAR
|
||||
L R4,M M
|
||||
C R4,=F'3' IF M<3
|
||||
BNL GE3
|
||||
L R2,M M
|
||||
LA R2,12(R2) M+12
|
||||
ST R2,M M=M+12
|
||||
L R2,YY YY
|
||||
BCTR R2,0 YY-1
|
||||
ST R2,YY YY=YY-1
|
||||
GE3 L R2,YY YY
|
||||
LR R1,R2 YY
|
||||
SRA R1,2 YY/4
|
||||
AR R2,R1 YY+(YY/4)
|
||||
L R4,YY YY
|
||||
SRDA R4,32 .
|
||||
D R4,=F'100' YY/100
|
||||
SR R2,R5 YY+(YY/4)-(YY/100)
|
||||
L R4,YY YY
|
||||
SRDA R4,32 .
|
||||
D R4,=F'400' YY/400
|
||||
AR R2,R5 YY+(YY/4)-(YY/100)+(YY/400)
|
||||
A R2,D R2=YY+(YY/4)-(YY/100)+(YY/400)+D
|
||||
LA R5,153 153
|
||||
M R4,M 153*M
|
||||
LA R5,8(R5) 153*M+8
|
||||
D R4,=F'5' (153*M+8)/5
|
||||
AR R5,R2 ((153*M+8)/5+R2
|
||||
LA R4,0 .
|
||||
D R4,=F'7' R4=MOD(R5,7) 0=SUN 1=MON ... 6=SAT
|
||||
LTR R4,R4 IF J=0
|
||||
BNZ JNE0
|
||||
LA R4,7 J=7
|
||||
JNE0 BCTR R4,0 J-1
|
||||
MH R4,=H'3' J*3
|
||||
LR R10,R4 J1=J*3
|
||||
LR R1,R6 I
|
||||
SLA R1,1 *2
|
||||
LH R11,ML-2(R1) ML(I)
|
||||
MH R11,=H'3' J2=ML(I)*3
|
||||
MVC TD2,BLANK TD2=' '
|
||||
LA R4,TD1 @TD1
|
||||
LR R5,R11 J2
|
||||
LA R2,TD2 @TD2
|
||||
AR R2,R10 @TD2+J1
|
||||
LR R3,R5 J2
|
||||
MVCL R2,R4 SUB(TD2,J1+1,J2)=SUB(TD1,1,J2)
|
||||
LR R1,R6 I
|
||||
MH R1,=H'144' *144
|
||||
LA R14,DA-144(R1) @DA(I)
|
||||
MVC 0(144,R14),TD2 DA(I)=TD2
|
||||
LA R6,1(R6) I=I+1
|
||||
B LOOPI2
|
||||
ELOOPI2 XPRNT SNOOPY,132 PRINT SNOOPY
|
||||
L R1,YEAR YEAR
|
||||
XDECO R1,PG+56 EDIT YEAR
|
||||
XPRNT PG,L'PG PRINT YEAR
|
||||
MVC WDLINE,BLANK WDLINE=' '
|
||||
LA R10,1 LWDLINE=1
|
||||
LA R8,1 K=1
|
||||
LOOPK3 C R8,=F'6' DO K=1 TO 6
|
||||
BH ELOOPK3
|
||||
LA R4,WDLINE @WDLINE
|
||||
AR R4,R10 +LWDLINE
|
||||
MVC 0(20,R4),WDNA SUB(WDLINE,LWDLINE+1,20)=WDNA
|
||||
LA R10,20(R10) LWDLINE=LWDLINE+20
|
||||
C R8,=F'6' IF K<6
|
||||
BNL ITERK3
|
||||
LA R10,2(R10) LWDLINE=LWDLINE+2
|
||||
ITERK3 LA R8,1(R8) K=K+1
|
||||
B LOOPK3
|
||||
ELOOPK3 LA R6,1 I=1
|
||||
LOOPI4 C R6,=F'12' DO I=1 TO 12 BY 6
|
||||
BH ELOOPI4
|
||||
MVC MOLINE,BLANK MOLINE=' '
|
||||
LA R10,6 LMOLINE=6
|
||||
LR R8,R6 K=I
|
||||
LOOPK4 LA R2,5(R6) I+5
|
||||
CR R8,R2 DO K=I TO I+5
|
||||
BH ELOOPK4
|
||||
LR R1,R8 K
|
||||
MH R1,=H'10' *10
|
||||
LA R3,MO-10(R1) MO(K)
|
||||
LA R4,MOLINE @MOLINE
|
||||
AR R4,R10 +LMOLINE
|
||||
MVC 0(10,R4),0(R3) SUB(MOLINE,LMOLINE+1,10)=MO(K)
|
||||
LA R10,22(R10) LMOLINE=LMOLINE+22
|
||||
LA R8,1(R8) K=K+1
|
||||
B LOOPK4
|
||||
ELOOPK4 XPRNT MOLINE,L'MOLINE PRINT MONTHS
|
||||
XPRNT WDLINE,L'WDLINE PRINT DAYS OF WEEK
|
||||
LA R7,1 J=1
|
||||
LOOPJ4 C R7,=F'106' DO J=1 TO 106 BY 21
|
||||
BH ELOOPJ4
|
||||
MVC PG,BLANK CLEAR BUFFER
|
||||
LA R9,PG PGI=0
|
||||
LR R8,R6 K=I
|
||||
LOOPK5 LA R2,5(R6) I+5
|
||||
CR R8,R2 DO K=I TO I+5
|
||||
BH ELOOPK5
|
||||
LR R1,R8 K
|
||||
MH R1,=H'144' *144
|
||||
LA R4,DA-144(R1) DA(K)
|
||||
BCTR R4,0 -1
|
||||
AR R4,R7 +J
|
||||
MVC 0(21,R9),0(R4) SUBSTR(DA(K),J,21)
|
||||
LA R9,22(R9) PGI=PGI+22
|
||||
LA R8,1(R8) K=K+1
|
||||
B LOOPK5
|
||||
ELOOPK5 XPRNT PG,L'PG PRINT BUFFER
|
||||
LA R7,21(R7) J=J+21
|
||||
B LOOPJ4
|
||||
ELOOPJ4 LA R6,6(R6) I=I+6
|
||||
B LOOPI4
|
||||
ELOOPI4 L R13,4(0,R13) RESTORE PREVIOUS SAVEAREA POINTER
|
||||
LM R14,R12,12(R13) RESTORE CALLER'S REGISTERS
|
||||
XR R15,R15 SET RETURN CODE TO 0
|
||||
BR R14 RETURN TO CALLER
|
||||
SNOOPY DC CL57' ',CL18'INSERT SNOOPY HERE',CL57' '
|
||||
YEAR DC F'1969' <== 1969
|
||||
MO DC CL10' JANUARY ',CL10' FEBRUARY ',CL10' MARCH '
|
||||
DC CL10' APRIL ',CL10' MAY ',CL10' JUNE '
|
||||
DC CL10' JULY ',CL10' AUGUST ',CL10'SEPTEMBER '
|
||||
DC CL10' OCTOBER ',CL10' NOVEMBER ',CL10' DECEMBER '
|
||||
ML DC H'31',H'28',H'31',H'30',H'31',H'30'
|
||||
DC H'31',H'31',H'30',H'31',H'30',H'31'
|
||||
WDNA DC CL20'MO TU WE TH FR SA SU'
|
||||
M DS F
|
||||
D DS F
|
||||
YY DS F
|
||||
TD1 DS CL93
|
||||
TD2 DS CL144
|
||||
MOLINE DS CL132
|
||||
WDLINE DS CL132
|
||||
PG DC CL132' ' BUFFER FOR THE LINE PRINTER
|
||||
XDEC DS CL12
|
||||
BLANK DC CL144' '
|
||||
DA DS 12CL144
|
||||
YREGS
|
||||
END CALENDAR
|
||||
Loading…
Add table
Add a link
Reference in a new issue