RosettaCodeData/Task/Attractive-numbers/PL-M/attractive-numbers.plm
2023-07-01 13:44:08 -04:00

73 lines
1.6 KiB
Text

100H:
BDOS: PROCEDURE (F, ARG); DECLARE F BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PUT$CHAR: PROCEDURE (CH); DECLARE CH BYTE; CALL BDOS(2,CH); END PUT$CHAR;
DECLARE MAXIMUM LITERALLY '120';
PRINT4: PROCEDURE (N);
DECLARE (N, MAGN, Z) BYTE;
CALL PUT$CHAR(' ');
MAGN = 100;
Z = 0;
DO WHILE MAGN > 0;
IF NOT Z AND N < MAGN THEN
CALL PUT$CHAR(' ');
ELSE DO;
CALL PUT$CHAR('0' + N/MAGN);
N = N MOD MAGN;
Z = 1;
END;
MAGN = MAGN/10;
END;
END PRINT4;
NEW$LINE: PROCEDURE;
CALL PUT$CHAR(13);
CALL PUT$CHAR(10);
END NEW$LINE;
SIEVE: PROCEDURE (MAX, PRIME);
DECLARE PRIME ADDRESS;
DECLARE (I, J, MAX, P BASED PRIME) BYTE;
P(0)=0;
P(1)=0;
DO I=2 TO MAX; P(I)=1; END;
DO I=2 TO SHR(MAX,1);
IF P(I) THEN DO J=SHL(I,1) TO MAX BY I;
P(J) = 0;
END;
END;
END SIEVE;
FACTORS: PROCEDURE (N, MAX, PRIME) BYTE;
DECLARE PRIME ADDRESS;
DECLARE (I, J, N, MAX, F, P BASED PRIME) BYTE;
F = 0;
DO I=2 TO MAX;
IF P(I) THEN DO WHILE N MOD I = 0;
F = F + 1;
N = N / I;
END;
END;
RETURN F;
END FACTORS;
ATTRACTIVE: PROCEDURE(N, MAX, PRIME) BYTE;
DECLARE PRIME ADDRESS;
DECLARE (N, MAX, P BASED PRIME) BYTE;
RETURN P(FACTORS(N, MAX, PRIME));
END ATTRACTIVE;
DECLARE (I, COL) BYTE INITIAL (0, 0);
CALL SIEVE(MAXIMUM, .MEMORY);
DO I=2 TO MAXIMUM;
IF ATTRACTIVE(I, MAXIMUM, .MEMORY) THEN DO;
CALL PRINT4(I);
COL = COL + 1;
IF COL MOD 18 = 0 THEN CALL NEW$LINE;
END;
END;
CALL EXIT;
EOF