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