76 lines
2.7 KiB
Text
76 lines
2.7 KiB
Text
100H: /* FIND SOME HUMBLE NUMBERS - NUMBERS WITH NO PRIME FACTORS ABOVE 7 */
|
|
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
|
|
DECLARE FN BYTE, ARG ADDRESS;
|
|
GOTO 5;
|
|
END BDOS;
|
|
PRINT$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
|
|
PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
|
|
PRINT$NL: PROCEDURE; CALL PRINT$STRING( .( 0DH, 0AH, '$' ) ); END;
|
|
PRINT$NUMBER: PROCEDURE( N );
|
|
DECLARE N ADDRESS;
|
|
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
|
|
V = N;
|
|
W = LAST( N$STR );
|
|
N$STR( W ) = '$';
|
|
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
|
|
DO WHILE( ( V := V / 10 ) > 0 );
|
|
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
|
|
END;
|
|
CALL PRINT$STRING( .N$STR( W ) );
|
|
END PRINT$NUMBER;
|
|
MIN: PROCEDURE( A, B ) ADDRESS;
|
|
DECLARE ( A, B ) ADDRESS;
|
|
IF A < B THEN RETURN( A ); ELSE RETURN( B );
|
|
END MIN;
|
|
/* DISPLAY A STATISTIC ABOUT HUMBLE NUMBERS */
|
|
PRINT$H$STAT: PROCEDURE( S, D );
|
|
DECLARE ( S, D ) ADDRESS;
|
|
CALL PRINT$STRING( .'THERE ARE $' );
|
|
IF S < 10 THEN CALL PRINT$CHAR( ' ' );
|
|
IF S < 100 THEN CALL PRINT$CHAR( ' ' );
|
|
CALL PRINT$NUMBER( S );
|
|
CALL PRINT$STRING( .' HUMBLE NUMBERS WITH $' );
|
|
CALL PRINT$NUMBER( D );
|
|
CALL PRINT$STRING( .' DIGIT$' );
|
|
IF D > 1 THEN CALL PRINT$CHAR( 'S' );
|
|
CALL PRINT$NL;
|
|
END PRINT$H$STAT;
|
|
/* FIND AND PRINT HUMBLE NUMBERS */
|
|
DECLARE MAX$HUMBLE LITERALLY '400';
|
|
DECLARE H( MAX$HUMBLE ) ADDRESS;
|
|
DECLARE ( P2, P3, P5, P7, M
|
|
, LAST2, LAST3, LAST5, LAST7
|
|
, H1, H2, H3, H4, H5, H6, HPOS
|
|
) ADDRESS;
|
|
/* 1 IS THE FIRST HUMBLE NUMBER */
|
|
H( 0 ) = 1;
|
|
H1 = 0; H2 = 0; H3 = 0; H4 = 0; H5 = 0; H6 = 0;
|
|
LAST2 = 0; LAST3 = 0; LAST5 = 0; LAST7 = 0;
|
|
P2 = 2; P3 = 3; P5 = 5; P7 = 7;
|
|
DO HPOS = 1 TO MAX$HUMBLE - 1;
|
|
/* THE NEXT HUMBLE NUMBER IS THE LOWEST OF THE NEXT MULTIPLES OF */
|
|
/* 2, 3, 5, 7 */
|
|
M = MIN( MIN( MIN( P2, P3 ), P5 ), P7 );
|
|
H( HPOS ) = M;
|
|
IF M = P2 THEN P2 = 2 * H( LAST2 := LAST2 + 1 );
|
|
IF M = P3 THEN P3 = 3 * H( LAST3 := LAST3 + 1 );
|
|
IF M = P5 THEN P5 = 5 * H( LAST5 := LAST5 + 1 );
|
|
IF M = P7 THEN P7 = 7 * H( LAST7 := LAST7 + 1 );
|
|
END;
|
|
DO HPOS = 0 TO 49;
|
|
CALL PRINT$CHAR( ' ' );
|
|
CALL PRINT$NUMBER( H( HPOS ) );
|
|
END;
|
|
CALL PRINT$NL;
|
|
DO HPOS = 0 TO MAX$HUMBLE - 1;
|
|
M = H( HPOS );
|
|
IF M < 10 THEN H1 = H1 + 1;
|
|
ELSE IF M < 100 THEN H2 = H2 + 1;
|
|
ELSE IF M < 1000 THEN H3 = H3 + 1;
|
|
ELSE IF M < 10000 THEN H4 = H4 + 1;
|
|
END;
|
|
CALL PRINT$H$STAT( H1, 1 );
|
|
CALL PRINT$H$STAT( H2, 2 );
|
|
CALL PRINT$H$STAT( H3, 3 );
|
|
CALL PRINT$H$STAT( H4, 4 );
|
|
EOF
|