85 lines
3.3 KiB
Plaintext
85 lines
3.3 KiB
Plaintext
100H: /* FIND SOME ARITHMETIC NUMBERS: NUMBERS WHOSE AVERAGE DIVISOR IS AN */
|
|
/* IS AN INTEGER - I.E. DIVISOR SUM MOD DIVISOR COUNT = 0 */
|
|
|
|
/* CP/M BDOS SYSTEM CALL, IGNORE THE RETURN VALUE */
|
|
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
|
|
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
|
|
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
|
|
PR$NL: PROCEDURE; CALL PR$STRING( .( 0AH, 0DH, '$' ) ); END;
|
|
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
|
|
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 PR$STRING( .N$STR( W ) );
|
|
END PR$NUMBER;
|
|
PR$NUMBER4: PROCEDURE( N ); /* PRINT A NUMBER IN AT LEAST 4 CHARACTERS */
|
|
DECLARE N ADDRESS;
|
|
IF N < 10 THEN CALL PR$CHAR( ' ' );
|
|
IF N < 100 THEN CALL PR$CHAR( ' ' );
|
|
IF N < 1000 THEN CALL PR$CHAR( ' ' );
|
|
CALL PR$NUMBER( N );
|
|
END PR$NUMBER4;
|
|
|
|
DECLARE ( D$COUNT, D$SUM ) ( 4001 )ADDRESS;
|
|
DECLARE ( I, J, D$POS, I$POS, J$POS ) ADDRESS;
|
|
/* SHOW THE FIRST 100TH ARITHMETIC NUMBER AND THE 1000TH AND THE 10000TH */
|
|
/* ALSO SHOW HOW MANY ARE COMPOSITE */
|
|
DECLARE ( DIVISOR$START, DIVISOR$END ) ADDRESS;
|
|
DECLARE ( A$COUNT, C$COUNT ) ADDRESS;
|
|
A$COUNT, C$COUNT, DIVISOR$START, DIVISOR$END = 0;
|
|
I, D$POS = 1;
|
|
DO WHILE( I <= 60000 AND A$COUNT < 10000 );
|
|
IF I > DIVISOR$END THEN DO;
|
|
/* PAST THE END OF THE DIGIT SUMS AND COUNTS - GET THE NEXT BATCH */
|
|
DIVISOR$START = DIVISOR$END + 1;
|
|
DIVISOR$END = DIVISOR$START + ( LAST( D$COUNT ) ) - 1;
|
|
DO I$POS = 1 TO LAST( D$COUNT );
|
|
D$COUNT( I$POS ), D$SUM( I$POS ) = 1;
|
|
END;
|
|
DO I = 2 TO DIVISOR$END;
|
|
DO J = I TO DIVISOR$END BY I;
|
|
IF J >= DIVISOR$START AND J <= DIVISOR$END THEN DO;
|
|
J$POS = J - ( DIVISOR$START - 1 );
|
|
D$COUNT( J$POS ) = D$COUNT( J$POS ) + 1;
|
|
D$SUM( J$POS ) = D$SUM( J$POS ) + I;
|
|
END;
|
|
END;
|
|
END;
|
|
I = DIVISOR$START;
|
|
D$POS = 1;
|
|
END;
|
|
IF D$SUM( D$POS ) MOD D$COUNT( D$POS ) = 0 THEN DO; /* I IS ARITHMETIC */
|
|
IF D$COUNT( D$POS ) > 2 THEN DO; /* I IS COMPOSITE */
|
|
C$COUNT = C$COUNT + 1;
|
|
END;
|
|
A$COUNT = A$COUNT + 1;
|
|
IF A$COUNT <= 100 THEN DO;
|
|
CALL PR$NUMBER4( I );
|
|
IF A$COUNT MOD 10 = 0 THEN CALL PR$NL;
|
|
END;
|
|
ELSE IF A$COUNT = 1000 OR A$COUNT = 10000 THEN DO;
|
|
CALL PR$NL;
|
|
CALL PR$STRING( .'THE $' );
|
|
CALL PR$NUMBER( A$COUNT );
|
|
CALL PR$STRING( .'TH ARITHMETIC NUMBER IS: $' );
|
|
CALL PR$NUMBER( I );
|
|
CALL PR$NL;
|
|
CALL PR$STRING( .' THERE ARE $' );
|
|
CALL PR$NUMBER( C$COUNT );
|
|
CALL PR$STRING( .' COMPOSITE NUMBERS UP TO $' );
|
|
CALL PR$NUMBER( I );
|
|
CALL PR$NL;
|
|
END;
|
|
END;
|
|
I = I + 1;
|
|
D$POS = D$POS + 1;
|
|
END;
|
|
|
|
EOF
|