103 lines
3.7 KiB
Plaintext
103 lines
3.7 KiB
Plaintext
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
|