aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

100
Task/Five-weekends/360-Assembly/five-weekends.360 Normal file
View file

@ -0,0 +1,100 @@
* 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