100H: /* SHOW THE DIGITAL ROOT AND PERSISTENCE OF SOME NUMBERS              */

   /* BDOS SYSTEM CALL */
   BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
   /* PRINTS A BYTE AS A CHARACTER */
   PRINT$CHAR: PROCEDURE( CH ); DECLARE CH BYTE; CALL BDOS( 2, CH ); END;
   /* PRINTS A BYTE AS A NUMBER */
   PRINT$BYTE: PROCEDURE( N );
      DECLARE N BYTE;
      DECLARE ( V, D2 ) BYTE;
      IF ( V := N / 10 ) <> 0 THEN DO;
         D2 = V MOD 10;
         IF ( V := V / 10 ) <> 0 THEN CALL PRINT$CHAR( '0' + V );
         CALL PRINT$CHAR( '0' + D2 );
      END;
      CALL PRINT$CHAR( '0' + N MOD 10 );
   END PRINT$BYTE;
   /* PRINTS A $ TERMINATED STRING */
   PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;

   /* PRINTS N1, N2, N3 AS A SINGLE NUMBER                       */
   /*        N1, N2, N3 MUST ALL BE BETWEEN 0 AND 9999 INCLUSIVE */
   PRINT$NUMBER3: PROCEDURE( N1, N2, N3 );
      DECLARE ( N1, N2, N3 ) ADDRESS;
      DECLARE V ADDRESS, N$STR( 14 ) BYTE, ( W, I, J ) BYTE;
      W = LAST( N$STR );
      N$STR( W ) = '$';
      /* ADD THE DIGITS OF THE THREE NUMBERS TO N$STR */
      DO I = 0 TO 2;
         DO CASE I;
            V = N3;
            V = N2;
            V = N1;
         END;
         DO J = 1 TO 4;
            N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
            V = V / 10;
         END;
      END;
      /* SPACE FILL THE REMAINDER OF THE NUMBER */
      I = W;
      DO WHILE( I > 0 );
         N$STR( I := I - 1 ) = ' ';
      END;
      /* SUPPRESS LEADING ZEROS */
      DO WHILE( W < LAST( N$STR ) - 1 AND N$STR( W ) = '0' );
         N$STR( W ) = ' ';
         W = W + 1;
      END;
      CALL PRINT$STRING( .N$STR );
   END PRINT$NUMBER3;

   /* CALCULATES THE DIGITAL ROOT AND PERSISTENCE OF AN INTEGER IN BASE 10 */
   /* IN ORDER TO ALLOW FOR NUMBERS LARGER THAN 2^15, THE NUMBER IS PASSED */
   /* AS THE UPPER, MIDDLE AND LOWER DIGITS IN N1, N2 AND N3               */
   /* E.G. 393900588225 CAN BE PROCESSED BY N1=3939, N2=0058, N3=8225      */
   FIND$DIGITAL$ROOT: PROCEDURE( N1, N2, N3, ROOT$PTR, PERSISTENCE$PTR );
      DECLARE ( N1, N2, N3, ROOT$PTR, PERSISTENCE$PTR ) ADDRESS;
      DECLARE DIGITAL$ROOT BASED ROOT$PTR        BYTE;
      DECLARE PERSISTENCE  BASED PERSISTENCE$PTR BYTE;

      SUM$DIGITS: PROCEDURE( N ) ADDRESS;
         DECLARE N      ADDRESS;
         DECLARE DIGITS ADDRESS, SUM BYTE;
         DIGITS = N;
         SUM    = 0;
         DO WHILE DIGITS > 0;
            SUM    = SUM + ( DIGITS MOD 10 );
            DIGITS =         DIGITS  /  10;
         END;
         RETURN SUM;
      END SUM$DIGITS;

      DIGITAL$ROOT = SUM$DIGITS( N1 ) + SUM$DIGITS( N2 ) + SUM$DIGITS( N3 );
      PERSISTENCE = 1;
      DO WHILE( DIGITAL$ROOT > 9 );
         PERSISTENCE  = PERSISTENCE + 1;
         DIGITAL$ROOT = SUM$DIGITS( DIGITAL$ROOT );
      END;
   END FIND$DIGITAL$ROOT ;

   /* CALCULATES AND PRINTS THE DIGITAL ROOT AND PERSISTENCE OF THE */
   /* NUMBER FORMED FROM THE CONCATENATION OF  N1, N2 AND N3        */
   PRINT$DR$AND$PERSISTENCE: PROCEDURE( N1, N2, N3 );
      DECLARE ( N1, N2, N3 ) ADDRESS;
      DECLARE ( DIGITAL$ROOT, PERSISTENCE ) BYTE;
      CALL FIND$DIGITAL$ROOT( N1, N2, N3, .DIGITAL$ROOT, .PERSISTENCE );
      CALL PRINT$NUMBER3( N1, N2, N3 );
      CALL PRINT$STRING( .': DIGITAL ROOT: $' );
      CALL PRINT$BYTE( DIGITAL$ROOT );
      CALL PRINT$STRING( .', PERSISTENCE: $' );
      CALL PRINT$BYTE( PERSISTENCE );
      CALL PRINT$STRING( .( 0DH, 0AH, '$' ) );
   END PRINT$DR$AND$PERSISTENCE;

   /* TEST THE DIGITAL ROOT AND PERSISTENCE PROCEDURES */
   CALL PRINT$DR$ANDPERSISTENCE(    0,   62, 7615 );
   CALL PRINT$DR$ANDPERSISTENCE(    0,    3, 9390 );
   CALL PRINT$DR$ANDPERSISTENCE(    0,   58, 8225 );
   CALL PRINT$DR$ANDPERSISTENCE( 3939, 0058, 8225 );

EOF