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

June 2018 Update

Browse source
This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions
Download patch file Download diff file Expand all files Collapse all files

127
Task/Pythagorean-triples/360-Assembly/pythagorean-triples.360 Normal file
View file

@ -0,0 +1,127 @@
* Pythagorean triples - 12/06/2018
PYTHTRI CSECT
USING PYTHTRI,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
MVC PMAX,=F'1' pmax=1
LA R6,1 i=1
DO WHILE=(C,R6,LE,=F'6') do i=1 to 6
L R5,PMAX pmax
MH R5,=H'10' *10
ST R5,PMAX pmax=pmax*10
MVC PRIM,=F'0' prim=0
MVC COUNT,=F'0' count=0
L R1,PMAX pmax
BAL R14,ISQRT isqrt(pmax)
SRA R0,1 /2
ST R0,NMAX nmax=isqrt(pmax)/2
LA R7,1 n=1
DO WHILE=(C,R7,LE,NMAX) do n=1 to nmax
LA R9,1(R7) m=n+1
LR R5,R9 m
AR R5,R7 +n
MR R4,R9 *m
SLA R5,1 *2
LR R8,R5 p=2*m*(m+n)
DO WHILE=(C,R8,LE,PMAX) do while p<=pmax
LR R1,R9 m
LR R2,R7 n
BAL R14,GCD gcd(m,n)
IF C,R0,EQ,=F'1' THEN if gcd(m,n)=1 then
L R2,PRIM prim
LA R2,1(R2) +1
ST R2,PRIM prim=prim+1
L R4,PMAX pmax
SRDA R4,32 ~
DR R4,R8 /p
A R5,COUNT +count
ST R5,COUNT count=count+pmax/p
ENDIF , endif
LA R9,2(R9) m=m+2
LR R5,R9 m
AR R5,R7 +n
MR R4,R9 *m
SLA R5,1 *2
LR R8,R5 p=2*m*(m+n)
ENDDO , enddo n
LA R7,1(R7) n++
ENDDO , enddo n
L R1,PMAX pmax
XDECO R1,XDEC edit pmax
MVC PG+15(9),XDEC+3 output pmax
L R1,COUNT count
XDECO R1,XDEC edit count
MVC PG+33(9),XDEC+3 output count
L R1,PRIM prim
XDECO R1,XDEC edit prim
MVC PG+55(9),XDEC+3 output prim
XPRNT PG,L'PG print
LA R6,1(R6) i++
ENDDO , enddo i
L R13,4(0,R13) restore previous savearea pointer
RETURN (14,12),RC=0 restore registers from calling sav
NMAX DS F nmax
PMAX DS F pmax
COUNT DS F count
PRIM DS F prim
PG DC CL80'Max Perimeter: ........., Total: ........., Primitive:'
XDEC DS CL12
GCD EQU * --------------- function gcd(a,b)
STM R2,R7,GCDSA save context
LR R3,R1 c=a
LR R4,R2 d=b
GCDLOOP LR R6,R3 c
SRDA R6,32 ~
DR R6,R4 /d
LTR R6,R6 if c mod d=0
BZ GCDELOOP then leave loop
LR R5,R6 e=c mod d
LR R3,R4 c=d
LR R4,R5 d=e
B GCDLOOP loop
GCDELOOP LR R0,R4 return(d)
LM R2,R7,GCDSA restore context
BR R14 return
GCDSA DS 6A context store
ISQRT EQU * --------------- function isqrt(n)
STM R3,R10,ISQRTSA save context
LR R6,R1 n=r1
LR R10,R6 sqrtn=n
SRA R10,1 sqrtn=n/2
IF LTR,R10,Z,R10 THEN if sqrtn=0 then
LA R10,1 sqrtn=1
ELSE , else
LA R9,0 snm2=0
LA R8,0 snm1=0
LA R7,0 sn=0
LA R3,0 okexit=0
DO UNTIL=(C,R3,EQ,=A(1)) do until okexit=1
AR R10,R7 sqrtn=sqrtn+sn
LR R9,R8 snm2=snm1
LR R8,R7 snm1=sn
LR R4,R6 n
SRDA R4,32 ~
DR R4,R10 /sqrtn
SR R5,R10 -sqrtn
SRA R5,1 /2
LR R7,R5 sn=(n/sqrtn-sqrtn)/2
IF C,R7,EQ,=F'0',OR,CR,R7,EQ,R9 THEN if sn=0 or sn=snm2 then
LA R3,1 okexit=1
ENDIF , endif
ENDDO , enddo until
ENDIF , endif
LR R5,R10 sqrtn
MR R4,R10 *sqrtn
IF CR,R5,GT,R6 THEN if sqrtn*sqrtn>n then
BCTR R10,0 sqrtn=sqrtn-1
ENDIF , endif
LR R0,R10 return(sqrtn)
LM R3,R10,ISQRTSA restore context
BR R14 return
ISQRTSA DS 8A context store
YREGS
END PYTHTRI