RosettaCodeData/Task/Amicable-pairs/PL-M/amicable-pairs.plm
2023-08-01 14:31:52 -07:00

45 lines
1 KiB
Text

100H:
/* CP/M CALLS */
BDOS: PROCEDURE (FN, ARG); DECLARE FN BYTE, ARG ADDRESS; GO TO 5; END BDOS;
EXIT: PROCEDURE; CALL BDOS(0,0); END EXIT;
PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
/* PRINT A NUMBER */
PRINT$NUMBER: PROCEDURE (N);
DECLARE S (6) BYTE INITIAL ('.....$');
DECLARE (N, P) ADDRESS, C BASED P BYTE;
P = .S(5);
DIGIT:
P = P - 1;
C = N MOD 10 + '0';
N = N / 10;
IF N > 0 THEN GO TO DIGIT;
CALL PRINT(P);
END PRINT$NUMBER;
/* CALCULATE SUMS OF PROPER DIVISORS */
DECLARE DIV$SUM (20$001) ADDRESS;
DECLARE (I, J) ADDRESS;
DO I=2 TO 20$000; DIV$SUM(I) = 1; END;
DO I=2 TO 10$000;
DO J = I*2 TO 20$000 BY I;
DIV$SUM(J) = DIV$SUM(J) + I;
END;
END;
/* TEST EACH PAIR */
DO I=2 TO 20$000;
J = DIVSUM(I);
IF J > I AND J <= 20$000 THEN DO;
IF DIV$SUM(J) = I THEN DO;
CALL PRINT$NUMBER(I);
CALL PRINT(.', $');
CALL PRINT$NUMBER(J);
CALL PRINT(.(13,10,'$'));
END;
END;
END;
CALL EXIT;
EOF