Special divisors: Difference between revisions

→‎{{header|PL/M}}: Syntax highlighting, added "See also", added Polyglot:PL/I and PL/M
(→‎{{header|PL/I}}: Added "see also")
(→‎{{header|PL/M}}: Syntax highlighting, added "See also", added Polyglot:PL/I and PL/M)
Line 1,476:
 
=={{header|PL/M}}==
<lang plmpli>100H: /* FIND NUMBERS WHOSE REVERSED DIVISORS DIVIDE THE REVERSED NUMBER */
 
DECLARE TRUE LITERALLY '0FFH';
Line 1,546:
CALL PRINT$NL;
EOF</lang>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 11
13 17 19 22 23 26 27 29 31 33
37 39 41 43 44 46 47 53 55 59
61 62 66 67 69 71 73 77 79 82
83 86 88 89 93 97 99 101 103 107
109 113 121 127 131 137 139 143 149 151
157 163 167 169 173 179 181 187 191 193
197 199
FOUND 72 ''SPECIAL DIVISORS'' BELOW 200
</pre>
 
See also [[#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)
Should work with many PL/I implementations.
<lang pli>/* FIND NUMBERS WHOSE REVERSED DIVISORS DIVIDE THE REVERSED NUMBER */
special_divisors_100H: procedure options (main);
declare eof binary;
/* CP/M BDOS SYSTEM CALL AND CONSOLE OUTPUT ROUTINES, ETC. */ /*
DECLARE BINARY LITERALLY 'ADDRESS', CHARACTER LITERALLY 'BYTE';
DECLARE PUT LITERALLY '/*', BIT LITERALLY 'BYTE';
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PRSTRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END; /* */
PRCHAR: PROCEDURE( C ); DECLARE C CHARACTER; PUT edit(c)(a(1)) /* */ /*
CALL BDOS( 2, C ) /* */;
END PRCHAR;
PRNL: PROCEDURE; put skip /*
CALL PRSTRING( .( 0DH, 0AH, '$' ) ) /* */; END PRNL;
PRNUMBER: PROCEDURE( N ); DECLARE N BINARY; /* */
if n < 10 then put edit(n)(f(1)); /* */
else if n < 100 then put edit(n)(f(2)); /* */
else if n < 1000 then put edit(n)(f(3)); /* */
else put edit(n)(f(6)); /*
*//*
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
N$STR( W := LAST( N$STR ) ) = '$';
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 )returns (
BINARY )
;
DECLARE ( A, B )BINARY;
RETURN ( mod( A ,/*
MOD /* */ B ) );
END MODF;
REVERSE: PROCEDURE( N )returns (
BINARY )
; /* RETURNS THE REVERSED DIGITS OF N */
DECLARE N BINARY;
DECLARE ( R, V ) BINARY;
V = N;
R = MODF( V, 10 );
V = V / 10;
DO WHILE( V > 0 );
R = ( R * 10 ) + MODF( V, 10 );
V = V / 10;
END;
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 */
DECLARE ( N, RN, SDCOUNT, D, DMAX ) BINARY;
DECLARE ISSD BIT;
DECLARE MAXSD BINARY static INITIAL( 199 );
SDCOUNT = 0;
DO N = 1 TO MAXSD;
RN = REVERSE( N );
ISSD = TRUE;
D = 2; DMAX = N / 2;
DO WHILE( ISSD & /*
AND /* */ D < DMAX );
IF MODF( N, D ) = 0 THEN DO;
/* HAVE A DIVISOR OF N */
ISSD = ( MODF( RN, REVERSE( D ) ) = 0 );
END;
D = D + 1;
END;
IF ISSD THEN DO;
/* ALL THE REVERSED DIVISORS OF N DIVIDE N REVERSED */
CALL PRCHAR( ' ' );
IF N < 100 THEN DO;
CALL PRCHAR( ' ' );
IF N < 10 THEN CALL PRCHAR( ' ' );
END;
CALL PRNUMBER( N );
SDCOUNT = SDCOUNT + 1;
IF MODF( SDCOUNT, 10 ) = 0 THEN CALL PRNL;
END;
END;
CALL PRNL;
put list /*
CALL PRSTRING( ./* */ ( 'FOUND ' /*
, '$'
) /* */
);
CALL PRNUMBER( SDCOUNT );
put list /*
CALL PRSTRING( ./* */ ( ' ''''SPECIAL DIVISORS'''' BELOW ' /*
, '$'
) /* */
);
CALL PRNUMBER( MAXSD + 1 );
CALL PRNL;
EOF = 1;
end special_divisors_100H;</lang>
{{out}}
<pre>
3,032

edits