Rosetta Code

Special divisors: Difference between revisions

Page Discussion

Special divisors (view source)

Revision as of 19:07, 17 December 2021

1,154 bytes removed ,  2 years ago
→‎{{header|Polyglot:PL/I and PL/M}}: Use new include file
m (→‎{{header|PL/M}}: Added "works with".)
Line 1,564:
=={{header|Polyglot:PL/I and PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
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 */
special_divisors_100H: procedure options (main);
 
declare eof binary;
/* CPPL/MI DEFINITIONS BDOS SYSTEM CALL AND CONSOLE OUTPUT ROUTINES, ETC. */ /*/
%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 PUT SADDR LITERALLY '/*.', BIT LITERALLY 'BYTE';
DECLARE TRUE LITERALLY '1', FALSE LITERALLY '0';
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;▼
PRSTRINGBDOSF: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9FN, SARG )BYTE; END; /* */
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; PUTCALL editBDOS(c)(a(1)) 2, C ); /* */ /*END;
PRNL: PROCEDURE; put skip /*
PRNL: PROCEDURE; CALL PRCHAR( 0DH ); CALL PRSTRINGPRCHAR( .( 0DH, 0AH, '$' ) ) /* */; END PRNL;
PRNUMBER: PROCEDURE( N ); DECLARE N BINARY; /* */
DECLARE N ( A, B )BINARYADDRESS;▼
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)); /* */
N$STR( W := W else- 1 ) = '0' + ( ( V := N ) MOD 10 put edit(n)(f(6)); /*
DO WHILE( ( V := V / 10 ) > 0 );▼
*//*
DECLARE V ADDRESS, N$STR( 6W := W - 1 ) BYTE,= W'0' BYTE+ ( V MOD 10 );
END; ▼
▲ N$STR( W := LAST( N$STR ) ) = '$';
CALL BDOS( 9, .N$STR( W := W - 1 ) = '0' + ( ( V := N ) MOD 10 );
▲ DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
▲ END;
CALL BDOS( 9, .N$STR( W ) ) /* */;
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 LANGUAGE DEFINITIONS */
 
/* TASK */
 
REVERSE: PROCEDURE( N )returns (
BINARY )
Line 1,614:
RETURN ( R );
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 */
Line 1,650 ⟶ 1,645:
END;
CALL PRNL;
CALL PRSTRING( SADDR( 'FOUND $' ) );
put list /*
CALL PRSTRING( ./* */ ( 'FOUND ' /*
, '$'
) /* */
);
CALL PRNUMBER( SDCOUNT );
CALL PRSTRING( ./* */ SADDR( ' ''''SPECIAL DIVISORS'''' BELOW $' ) /*);▼
put list /*
▲ CALL PRSTRING( ./* */ ( ' ''''SPECIAL DIVISORS'''' BELOW ' /*
, '$'
) /* */
);
CALL PRNUMBER( MAXSD + 1 );
CALL PRNL;
 
EOF = 1;
EOF: end special_divisors_100H;</lang>
{{out}}
<pre>
Tigerofdarkness
3,045

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/310269"