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

47
Task/Perfect-numbers/360-Assembly/perfect-numbers-1.360 Normal file
View file

@ -0,0 +1,47 @@
* Perfect numbers 15/05/2016
PERFECTN CSECT
USING PERFECTN,R13 prolog
SAVEAREA B STM-SAVEAREA(R15) "
DC 17F'0' "
STM STM R14,R12,12(R13) "
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
LA R6,2 i=2
LOOPI C R6,NN do i=2 to nn
BH ELOOPI
LR R1,R6 i
BAL R14,PERFECT
LTR R0,R0 if perfect(i)
BZ NOTPERF
XDECO R6,PG edit i
XPRNT PG,L'PG print i
NOTPERF LA R6,1(R6) i=i+1
B LOOPI
ELOOPI L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PERFECT SR R9,R9 function perfect(n); sum=0
LA R7,1 j
LR R8,R1 n
SRA R8,1 n/2
LOOPJ CR R7,R8 do j=1 to n/2
BH ELOOPJ
LR R4,R1 n
SRDA R4,32
DR R4,R7 n/j
LTR R4,R4 if mod(n,j)=0
BNZ NOTMOD
AR R9,R7 sum=sum+j
NOTMOD LA R7,1(R7) j=j+1
B LOOPJ
ELOOPJ SR R0,R0 r0=false
CR R9,R1 if sum=n
BNE NOTEQ
BCTR R0,0 r0=true
NOTEQ BR R14 return(r0); end perfect
NN DC F'10000'
PG DC CL12' ' buffer
YREGS
END PERFECTN

76
Task/Perfect-numbers/360-Assembly/perfect-numbers-2.360 Normal file
View file

@ -0,0 +1,76 @@
* Perfect numbers 15/05/2016
PERFECPO CSECT
USING PERFECPO,R13 prolog
SAVEAREA B STM-SAVEAREA(R15) "
DC 17F'0' "
STM STM R14,R12,12(R13) "
ST R13,4(R15) "
ST R15,8(R13) "
LR R13,R15 "
ZAP I,I1 i=i1
LOOPI CP I,I2 do i=i1 to i2
BH ELOOPI
LA R1,I r1=@i
BAL R14,PERFECT perfect(i)
LTR R0,R0 if perfect(i)
BZ NOTPERF
UNPK PG(16),I unpack i
OI PG+15,X'F0'
XPRNT PG,16 print i
NOTPERF AP I,=P'1' i=i+1
B LOOPI
ELOOPI L R13,4(0,R13) epilog
LM R14,R12,12(R13) "
XR R15,R15 "
BR R14 exit
PERFECT EQU * function perfect(n);
ZAP N,0(8,R1) n=%r1
CP N,=P'6' if n=6
BNE NOT6
L R0,=F'-1' r0=true
B RETURN return(true)
NOT6 ZAP PW,N n
SP PW,=P'1' n-1
ZAP PW2,PW n-1
DP PW2,=PL8'9' (n-1)/9
ZAP R,PW2+8(8) if mod((n-1),9)<>0
BZ ZERO
SR R0,R0 r0=false
B RETURN return(false)
ZERO ZAP PW2,N n
DP PW2,=PL8'2' n/2
ZAP SUM,PW2(8) sum=n/2
AP SUM,=P'3' sum=n/2+3
ZAP J,=P'3' j=3
LOOPJ ZAP PW,J do loop on j
MP PW,J j*j
CP PW,N while j*j<=n
BH ELOOPJ
ZAP PW2,N n
DP PW2,J n/j
CP PW2+8(8),=P'0' if mod(n,j)<>0
BNE NEXTJ
AP SUM,J sum=sum+j
ZAP PW2,N n
DP PW2,J n/j
AP SUM,PW2(8) sum=sum+j+n/j
NEXTJ AP J,=P'1' j=j+1
B LOOPJ next j
ELOOPJ SR R0,R0 r0=false
CP SUM,N if sum=n
BNE RETURN
BCTR R0,0 r0=true
RETURN BR R14 return(r0); end perfect
I1 DC PL8'1'
I2 DC PL8'200000000000'
I DS PL8
PG DC CL16' ' buffer
N DS PL8
SUM DS PL8
J DS PL8
R DS PL8
C DS CL16
PW DS PL8
PW2 DS PL16
YREGS
END PERFECPO