Data commit

Task/Smith-numbers/PL-M/smith-numbers.plm

@@ -0,0 +1,90 @@
+100H:
+
+/* CP/M BDOS FUNCTIONS */
+BDOS: PROCEDURE (F,A); DECLARE F BYTE, A ADDRESS; GO TO 5; END BDOS;
+EXIT: PROCEDURE; GO TO 0; END EXIT;
+PRINT: PROCEDURE (S); DECLARE S ADDRESS; CALL BDOS(9,S); END PRINT;
+
+/* PRINT NUMBER */
+PR$NUM: PROCEDURE (N);
+    DECLARE S (6) BYTE INITIAL ('     $');
+    DECLARE N ADDRESS, I BYTE;
+    I = 5;
+    DIGIT: S(I := I-1) = '0' + N MOD 10;
+    IF (N := N / 10) > 0 THEN GO TO DIGIT;
+    DO WHILE I>0;
+        S(I := I-1) =' ';
+    END;
+    CALL PRINT(.S);
+END PR$NUM;
+
+/* SUM OF DIGITS OF N */
+DIGIT$SUM: PROCEDURE (N) BYTE;
+    DECLARE N ADDRESS, SUM BYTE;
+    SUM = 0;
+    DO WHILE N > 0;
+        SUM = SUM + N MOD 10;
+        N = N / 10;
+    END;
+    RETURN SUM;
+END DIGIT$SUM;
+
+/* FIND AND COUNT FACTORS OF N */
+FACTORS: PROCEDURE (N, FACBUF) BYTE;
+    DECLARE (N, FACBUF, FAC, FACS BASED FACBUF) ADDRESS;
+    DECLARE COUNT BYTE;
+    COUNT = 0;
+    IF N <= 1 THEN RETURN 0;
+
+    /* TAKE OUT FACTORS OF TWO */
+    DO WHILE NOT N;
+        FACS(COUNT) = 2;
+        COUNT = COUNT + 1;
+        N = SHR(N, 1);
+    END;
+
+    /* TAKE OUT ODD FACTORS */
+    FAC = 3;
+    DO WHILE FAC <= N;
+        DO WHILE N MOD FAC = 0;
+            N = N / FAC;
+            FACS(COUNT) = FAC;
+            COUNT = COUNT + 1;
+        END;
+        FAC = FAC + 2;
+    END;
+
+    RETURN COUNT;
+END FACTORS;
+
+/* SEE IF A NUMBER IS A SMITH NUMBER */
+SMITH: PROCEDURE (N) BYTE;
+    DECLARE FACS (16) ADDRESS;
+    DECLARE N ADDRESS, (F, NFACS, FACSUM) BYTE;
+    IF (NFACS := FACTORS(N, .FACS)) <= 1 THEN
+        RETURN 0; /* PRIMES ARE NOT SMITH NUMBERS */
+
+    FACSUM = 0;
+    DO F = 0 TO NFACS-1;
+        FACSUM = FACSUM + DIGIT$SUM(FACS(F));
+    END;
+
+    RETURN FACSUM = DIGIT$SUM(N);
+END SMITH;
+
+/* PRINT ALL SMITH NUMBERS UP TO 10.000 */
+DECLARE (I, COUNT) ADDRESS;
+COUNT = 0;
+DO I = 2 TO 9$999;
+    IF SMITH(I) THEN DO;
+        CALL PR$NUM(I);
+        COUNT = COUNT + 1;
+        IF (COUNT AND 0FH) = 0 THEN
+            CALL PRINT(.(13,10,'$'));
+    END;
+END;
+CALL PRINT(.(13,10,'FOUND $'));
+CALL PR$NUM(COUNT);
+CALL PRINT(.' SMITH NUMBERS.$');
+CALL EXIT;
+EOF