aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

84
Task/Nth/PL-M/nth.plm Normal file
View file

@ -0,0 +1,84 @@
100H: /* SUFFIX NUMBERS WITH ST, ND, RD OR TH AS APPROPRIATE */
/* CP/M BDOS 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;
/* TASK */
DECLARE LD LITERALLY '100' /* LOWER CASE LETTERS NEEDED FOR THE SUFFICES */
, LH LITERALLY '104'
, LN LITERALLY '110'
, LR LITERALLY '114'
, LS LITERALLY '115'
, LT LITERALLY '116'
;
/* RETURNS THE TWO CHARACTER ORDINAL SUFFIX FOR N */
SUFFIX: PROCEDURE( N )ADDRESS;
DECLARE N ADDRESS;
DECLARE ( S1, S2 ) BYTE;
S1 = LT;
S2 = LH;
IF N MOD 100 < 4 OR N MOD 100 > 20 THEN DO;
DECLARE N10 ADDRESS;
N10 = N MOD 10;
IF N10 = 1 THEN DO;
S1 = LS;
S2 = LT;
END;
ELSE IF N10 = 2 THEN DO;
S1 = LN;
S2 = LD;
END;
ELSE IF N10 = 3 THEN DO;
S1 = LR;
S2 = LD;
END;
END;
RETURN ( S1 * 256 ) + S2;
END SUFFIX;
/* PRINTS THE TWO CHARACTER SUFFIX IN S */
PR$SUFFIX: PROCEDURE( S );
DECLARE S ADDRESS;
CALL PR$CHAR( HIGH( S ) );
CALL PR$CHAR( LOW( S ) );
END PR$SUFFIX ;
DECLARE I ADDRESS;
DO I = 0 TO 25;
IF I < 10 THEN CALL PR$CHAR( ' ' );
CALL PR$CHAR( ' ' );CALL PR$NUMBER( I );CALL PR$SUFFIX( SUFFIX( I ) );
IF ( I + 1 ) MOD 10 = 0 THEN CALL PR$NL;
END;
CALL PR$NL;
CALL PR$NL;
DO I = 250 TO 265;
CALL PR$CHAR( ' ' );CALL PR$NUMBER( I );CALL PR$SUFFIX( SUFFIX( I ) );
IF ( I - 249 ) MOD 10 = 0 THEN CALL PR$NL;
END;
CALL PR$NL;
CALL PR$NL;
DO I = 1000 TO 1025;
CALL PR$CHAR( ' ' );CALL PR$NUMBER( I );CALL PR$SUFFIX( SUFFIX( I ) );
IF ( I - 999 ) MOD 10 = 0 THEN CALL PR$NL;
END;
CALL PR$NL;
EOF