101 lines
4.0 KiB
Plaintext
101 lines
4.0 KiB
Plaintext
* Five weekends 31/05/2016
|
|
FIVEWEEK CSECT
|
|
USING FIVEWEEK,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 "
|
|
LM R10,R11,=AL8(0) nko=0; nok=0
|
|
LH R6,Y1 y=y1
|
|
LOOPY CH R6,Y2 do y=y1 to y2
|
|
BH ELOOPY
|
|
MVI YF,X'00' yf=0
|
|
LA R7,1 im=1
|
|
LOOPIM C R7,=F'7' do im=1 to 7
|
|
BH ELOOPIM
|
|
LR R1,R7 im
|
|
SLA R1,1 *2 (H)
|
|
LH R2,ML-2(R1) ml(im)
|
|
ST R2,M m=ml(im)
|
|
MVC D,=F'1' d=1
|
|
L R4,M m
|
|
C R4,=F'2' if m<=2
|
|
BH MSUP2
|
|
L R8,M m
|
|
LA R8,12(R8) mw=m+12
|
|
LR R9,R6 y
|
|
BCTR R9,0 yw=y-1
|
|
B EMSUP2
|
|
MSUP2 L R8,M mw=m
|
|
LR R9,R6 yw=y
|
|
EMSUP2 LR R4,R9 ym
|
|
SRDA R4,32 .
|
|
D R4,=F'100' yw/100
|
|
ST R5,J j=yw/100
|
|
ST R4,K k=yw//100
|
|
LR R4,R8 mw
|
|
LA R4,1(R4) mw+1
|
|
MH R4,=H'26' (mw+1)*26
|
|
SRDA R4,32 .
|
|
D R4,=F'10' (mw+1)*26/10
|
|
LR R2,R5 "
|
|
A R2,D d
|
|
A R2,K d+k
|
|
L R3,K k
|
|
SRA R3,2 k/4
|
|
AR R2,R3 (mw+1)*26/10+k/4
|
|
L R3,J j
|
|
SRA R3,2 j/4
|
|
AR R2,R3 (mw+1)*26/10+k/4+j/4
|
|
LA R5,5 5
|
|
M R4,J 5*j
|
|
AR R2,R5 (mw+1)*26/10+k/4+j/4
|
|
SRDA R2,32 .
|
|
D R2,=F'7' (d+(mw+1)*26/10+k+k/4+j/4+5*j)/7
|
|
C R2,=F'6' if dow=friday
|
|
BNE NOFRIDAY
|
|
XDECO R6,XDEC y
|
|
MVC PG+0(4),XDEC+8 output y
|
|
LR R1,R7 im
|
|
MH R1,=H'3' *3
|
|
LA R14,MN-3(R1) @mn(im)
|
|
MVC PG+5(3),0(R14) output mn(im)
|
|
XPRNT PG,8 print buffer
|
|
LA R11,1(R11) nok=nok+1
|
|
MVI YF,X'01' yf=1
|
|
NOFRIDAY LA R7,1(R7) im=im+1
|
|
B LOOPIM
|
|
ELOOPIM L R4,YF yf
|
|
CLI YF,X'00' if yf=0
|
|
BNE EYFNE0
|
|
LA R10,1(R10) nko=nko+1
|
|
EYFNE0 LA R6,1(R6) y=y+1
|
|
B LOOPY
|
|
ELOOPY XDECO R11,XDEC nok
|
|
MVC PG+0(4),XDEC+8 output nok
|
|
MVC PG+4(12),=C' occurrences'
|
|
XPRNT PG,80 print buffer
|
|
XDECO R10,XDEC nko
|
|
MVC PG+0(4),XDEC+8 output nko
|
|
MVC PG+4(33),=C' years with no five weekend month'
|
|
XPRNT PG,80 print buffer
|
|
L R13,4(0,R13) epilog
|
|
LM R14,R12,12(R13) "
|
|
XR R15,R15 "
|
|
BR R14 exit
|
|
Y1 DC H'1900' year start
|
|
Y2 DC H'2100' year stop
|
|
ML DC H'1',H'3',H'5',H'7',H'8',H'10',H'12'
|
|
MN DC C'jan',C'mar',C'may',C'jul',C'aug',C'oct',C'dec'
|
|
YF DS X year flag
|
|
M DS F month
|
|
D DS F day
|
|
J DS F j=yw/100
|
|
K DS F j=mod(yw,100)
|
|
PG DC CL80'....-' buffer
|
|
XDEC DS CL12 temp for XDECO
|
|
YREGS
|
|
END FIVEWEEK
|