Initial data commit

Task/Digital-root/PL-M/digital-root.plm

@@ -0,0 +1,102 @@
+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