100H: /* FIND SOME PERFECT NUMBERS: NUMBERS EQUAL TO THE SUM OF THEIR PROPER */
      /* DIVISORS                                                            */
   /* CP/M SYSTEM CALL AND I/O ROUTINES                                      */
   BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
      DECLARE FN BYTE, ARG ADDRESS;
      GOTO 5;
   END BDOS;
   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$CHAR( 0DH ); CALL PR$CHAR( 0AH );  END;
   PR$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 PR$STRING( .N$STR( W ) );
   END PR$NUMBER;

   /* TASK - TRANSLATION OF ACTION!                                          */
   DECLARE MAX$NUM LITERALLY '10$000';
   DECLARE PDS( 10$001 ) ADDRESS;
   DECLARE ( I, J )      ADDRESS;

   DO I = 2 TO MAX$NUM;
      PDS( I ) = 1;
   END;
   DO I = 2 TO MAX$NUM;
      DO J = I + I TO MAX$NUM BY I;
         PDS( J ) = PDS( J ) + I;
      END;
   END;

   DO I = 2 TO MAX$NUM;
      IF PDS( I ) = I THEN DO;
         CALL PR$NUMBER( I );
         CALL PR$NL;
      END;
   END;
EOF