Special divisors: Difference between revisions

Content added Content deleted
m (→‎{{header|PL/M}}: Added "works with".)
Line 1,564: Line 1,564:
=={{header|Polyglot:PL/I and PL/M}}==
=={{header|Polyglot:PL/I and PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
Should work with many PL/I implementations.
Should work with many PL/I implementations.<br>
The PL/I include file "pg.inc" can be found on the [[Polyglot:PL/I and PL/M]] page.
Note the use of text in column 81 onwards to hide the PL/I specifics from the PL/M compiler.
<lang pli>/* FIND NUMBERS WHOSE REVERSED DIVISORS DIVIDE THE REVERSED NUMBER */
<lang pli>/* FIND NUMBERS WHOSE REVERSED DIVISORS DIVIDE THE REVERSED NUMBER */
special_divisors_100H: procedure options (main);
special_divisors_100H: procedure options (main);

declare eof binary;
/* CP/M BDOS SYSTEM CALL AND CONSOLE OUTPUT ROUTINES, ETC. */ /*
/* PL/I DEFINITIONS */
%include 'pg.inc';
/* PL/M DEFINITIONS: CP/M BDOS SYSTEM CALL AND CONSOLE I/O ROUTINES, ETC. */ /*
DECLARE BINARY LITERALLY 'ADDRESS', CHARACTER LITERALLY 'BYTE';
DECLARE BINARY LITERALLY 'ADDRESS', CHARACTER LITERALLY 'BYTE';
DECLARE PUT LITERALLY '/*', BIT LITERALLY 'BYTE';
DECLARE SADDR LITERALLY '.', BIT LITERALLY 'BYTE';
DECLARE TRUE LITERALLY '1', FALSE LITERALLY '0';
⚫
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PRSTRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END; /* */
BDOSF: PROCEDURE( FN, ARG )BYTE;
DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
⚫
PRCHAR: PROCEDURE( C ); DECLARE C CHARACTER; PUT edit(c)(a(1)) /* */ /*
⚫
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
CALL BDOS( 2, C ) /* */;
PRSTRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
END PRCHAR;
⚫
PRCHAR: PROCEDURE( C ); DECLARE C CHARACTER; CALL BDOS( 2, C ); END;
PRNL: PROCEDURE; put skip /*
CALL PRSTRING( .( 0DH, 0AH, '$' ) ) /* */; END PRNL;
PRNL: PROCEDURE; CALL PRCHAR( 0DH ); CALL PRCHAR( 0AH ); END;
PRNUMBER: PROCEDURE( N ); DECLARE N BINARY; /* */
PRNUMBER: PROCEDURE( N );
⚫
DECLARE N ADDRESS;
if n < 10 then put edit(n)(f(1)); /* */
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
else if n < 100 then put edit(n)(f(2)); /* */
⚫
N$STR( W := LAST( N$STR ) ) = '$';
else if n < 1000 then put edit(n)(f(3)); /* */
else put edit(n)(f(6)); /*
N$STR( W := W - 1 ) = '0' + ( ( V := N ) MOD 10 );
⚫
DO WHILE( ( V := V / 10 ) > 0 );
*//*
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
⚫
END;
⚫
N$STR( W := LAST( N$STR ) ) = '$';
N$STR( W := W - 1 ) = '0' + ( ( V := N ) MOD 10 );
CALL BDOS( 9, .N$STR( W ) );
⚫
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
⚫
END;
CALL BDOS( 9, .N$STR( W ) ) /* */;
END PRNUMBER;
END PRNUMBER;
MODF: PROCEDURE( A, B )ADDRESS;

DECLARE ( A, B )ADDRESS;
MODF: PROCEDURE( A, B )returns (
⚫
RETURN( A MOD B );
BINARY )
;
⚫
DECLARE ( A, B )BINARY;
RETURN ( mod( A ,/*
⚫
MOD /* */ B ) );
END MODF;
END MODF;
/* END LANGUAGE DEFINITIONS */

/* TASK */

REVERSE: PROCEDURE( N )returns (
REVERSE: PROCEDURE( N )returns (
BINARY )
BINARY )
Line 1,614: Line 1,614:
RETURN ( R );
RETURN ( R );
END REVERSE ;
END REVERSE ;

DECLARE TRUE BIT static INITIAL( '1'b/*
⚫
1 /* */ )
, FALSE BIT static INITIAL( '0'b/*
0 /* */ );


/* FIND AND SHOW THE NUMBERS UP TO 200 */
/* FIND AND SHOW THE NUMBERS UP TO 200 */
Line 1,650: Line 1,645:
END;
END;
CALL PRNL;
CALL PRNL;
CALL PRSTRING( SADDR( 'FOUND $' ) );
put list /*
CALL PRSTRING( ./* */ ( 'FOUND ' /*
, '$'
) /* */
);
CALL PRNUMBER( SDCOUNT );
CALL PRNUMBER( SDCOUNT );
⚫
CALL PRSTRING( SADDR( ' ''''SPECIAL DIVISORS'''' BELOW $' ) );
put list /*
⚫
CALL PRSTRING( ./* */ ( ' ''''SPECIAL DIVISORS'''' BELOW ' /*
, '$'
) /* */
);
CALL PRNUMBER( MAXSD + 1 );
CALL PRNUMBER( MAXSD + 1 );
CALL PRNL;
CALL PRNL;

EOF = 1;
end special_divisors_100H;</lang>
EOF: end special_divisors_100H;</lang>
{{out}}
{{out}}
<pre>
<pre>
Retrieved from "https://rosettacode.org/wiki/Special_divisors"