90 lines
2 KiB
Text
90 lines
2 KiB
Text
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
|