Ethiopian multiplication: Difference between revisions
Added PL/M
Thundergnat (talk | contribs) m (syntax highlighting fixup automation) |
(Added PL/M) |
||
Line 4,375:
<pre>
578
</pre>
=={{header|PL/M}}==
{{Trans|Action!}}
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="plm">
100H: /* ETHOPIAN MULTIPLICATION */
/* CP/M SYSTEM CALL AND I/O ROUTINES */
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$CHAR( 0DH ); CALL PR$CHAR( 0AH ); 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;
/* RETURNS THE RESULT OF A * B USING ETHOPIAN MULTIPLICATION */
ETHIOPIAN$MULTIPLICATION: PROCEDURE( A, B )ADDRESS;
DECLARE ( A, B ) ADDRESS;
DECLARE RES ADDRESS;
CALL PR$STRING( .'ETHIOPIAN MULTIPLICATION OF $' );
CALL PR$NUMBER( A );
CALL PR$STRING( .' BY $' );
CALL PR$NUMBER( B );
CALL PR$NL;
RES = 0;
DO WHILE A >= 1;
CALL PR$NUMBER( A );
CALL PR$CHAR( ' ' );
CALL PR$NUMBER( B );
IF A MOD 2 = 0 THEN DO;
CALL PR$STRING( .' STRIKE$' );
END;
ELSE DO;
CALL PR$STRING( .' KEEP$' );
RES = RES + B;
END;
CALL PR$NL;
A = SHR( A, 1 );
B = SHL( B, 1 );
END;
RETURN( RES );
END ETHIOPIAN$MULTIPLICATION;
DECLARE RES ADDRESS;
RES = ETHIOPIAN$MULTIPLICATION( 17, 34 );
CALL PR$STRING( .'RESULT IS $' );
CALL PR$NUMBER( RES );
EOF
</syntaxhighlight>
{{out}}
<pre>
ETHIOPIAN MULTIPLICATION OF 17 BY 34
17 34 KEEP
8 68 STRIKE
4 136 STRIKE
2 272 STRIKE
1 544 KEEP
RESULT IS 578
</pre>
| |||