181 lines
7.0 KiB
Plaintext
181 lines
7.0 KiB
Plaintext
* calendar 08/06/2016
|
|
CALENDAR CSECT
|
|
USING CALENDAR,R13 base register
|
|
B 72(R15) skip savearea
|
|
DC 17F'0' savearea
|
|
STM R14,R12,12(R13) prolog
|
|
ST R13,4(R15) "
|
|
ST R15,8(R13) "
|
|
LR R13,R15 "
|
|
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 L R1,YEAR year
|
|
XDECO R1,PG+23 edit year
|
|
XPRNT PG,35 print year
|
|
MVC WDLINE,BLANK wdline=' '
|
|
LA R10,1 lwdline=1
|
|
LA R8,1 k=1
|
|
LOOPK3 C R8,=F'3' do k=1 to 3
|
|
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'3' if k<3
|
|
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 3
|
|
BH ELOOPI4
|
|
MVC MOLINE,BLANK moline=' '
|
|
LA R10,6 lmoline=6
|
|
LR R8,R6 k=i
|
|
LOOPK4 LA R2,2(R6) i+2
|
|
CR R8,R2 do k=i to i+2
|
|
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,2(R6) i+2
|
|
CR R8,R2 do k=i to i+2
|
|
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,3(R6) i=i+3
|
|
B LOOPI4
|
|
ELOOPI4 L R13,4(0,R13) epilog
|
|
LM R14,R12,12(R13) "
|
|
XR R15,R15 "
|
|
BR R14 exit
|
|
LTORG
|
|
YEAR DC F'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 CL66
|
|
WDLINE DS CL66
|
|
PG DC CL66' '
|
|
XDEC DS CL12
|
|
BLANK DC CL144' '
|
|
DA DS 12CL144
|
|
YREG
|
|
END CALENDAR
|