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

99
Task/Mertens-function/360-Assembly/mertens-function.360 Normal file
View file

@ -0,0 +1,99 @@
* Mertens function - 01/05/2023
MERTENS CSECT
USING MERTENS,R13 base register
B 72(R15) skip savearea
DC 17F'0' savearea
SAVE (14,12) save previous context
ST R13,4(R15) link backward
ST R15,8(R13) link forward
LR R13,R15 set addressability
LA R0,1 1
STH R0,MM m(1)=1
LA R6,2 i=2
DO WHILE=(CH,R6,LE,=AL2(NN)) do i=2 to n
LR R1,R6 i
SLA R1,1 *2 (H)
LA R0,1 1
STH R0,MM-2(R1) m(i)=1
LA R7,2 j=2
DO WHILE=(CR,R7,LE,R6) do j=2 to i
LR R4,R6 i
SRDA R4,32 ~
LR R1,R7 j
DR R4,R1 i/j
LR R8,R5 d=i/j
LR R4,R6 i
SLA R4,1 *2 (H)
LH R2,MM-2(R4) m(i)
LR R1,R8 d
SLA R1,1 *2 (H)
LH R3,MM-2(R1) m(d)
SR R2,R3 m(i)-m(d)
STH R2,MM-2(R4) m(i)=m(i)-m(d)
LA R7,1(R7) j++
ENDDO , enddo j
LA R6,1(R6) i++
ENDDO , enddo i
XPRNT =C'the first 99 Mertens numbers are:',34 print buffer
LA R9,PG @buffer=pg
MVC PG,=CL80' ' clean buffer
MVC 0(3,R9),=CL3' ' output ' '
LA R9,3(R9) @buffer+=3
LA R7,9 j=9
LA R6,1 i=1
DO WHILE=(CH,R6,LE,=AL2(99)) do i=1 to 99
LR R1,R6 i
SLA R1,1 *2 (H)
LH R2,MM-2(R1) m(i)
XDECO R2,XDEC edit m(i)
MVC 0(3,R9),XDEC+9 output m(i)
LA R9,3(R9) @buffer+=3
BCTR R7,0 j=j-1
IF LTR,R7,Z,R7 THEN if j=0 then do;
LA R7,10 j=10
XPRNT PG,L'PG print buffer
LA R9,PG @buffer=pg
ENDIF , endif
LA R6,1(R6) i++
ENDDO , enddo i
SR R10,R10 zero=0
SR R11,R11 cross=0
LA R6,1 i=2
DO WHILE=(CH,R6,LE,=AL2(NN)) do i=2 to n
LR R1,R6 i
SLA R1,1 *2 (H)
LH R2,MM-2(R1) m(i)
IF LTR,R2,Z,R2 THEN if m(i)=0 then
LA R10,1(R10) zero=zero+1
LR R1,R6 i
BCTR R1,0 i-1
SLA R1,1 *2 (H)
LH R2,MM-2(R1) m(i-1)
IF LTR,R2,NZ,R2 THEN if m(i-1)^=0 then
LA R11,1(R11) cross=cross+1
ENDIF , endif
ENDIF , endif
LA R6,1(R6) i++
ENDDO , enddo i
MVC PG,=CL80' ' clean buffer
MVC PG(13),=C'm(i) is zero '
XDECO R10,XDEC edit zero
MVC PG+13(2),XDEC+10 output zero
MVC PG+15(7),=C' times.'
XPRNT PG,L'PG print buffer
MVC PGI,=H'0'
MVC PG,=CL80' ' clean buffer
MVC PG(18),=C'm(i) crosses zero '
XDECO R11,XDEC edit cross
MVC PG+18(2),XDEC+10 output cross
MVC PG+20(7),=C' times.'
XPRNT PG,L'PG print buffer
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling save
NN EQU 1000 n
PG DS CL80 buffer
PGI DC H'0' buffer index
XDEC DS CL12 temp for xdeci xdeco
MM DS (NN)H m
REGEQU
END MERTENS