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

Initial data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 72d218235f
commit f23f22d71c
199087 changed files with 3378941 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

107
Task/Rep-string/PL-M/rep-string.plm Normal file
View file

@ -0,0 +1,107 @@
100H:
DECLARE MAX$REP LITERALLY '32';
DECLARE FALSE LITERALLY '0';
DECLARE TRUE LITERALLY '1';
DECLARE CR LITERALLY '0DH';
DECLARE LF LITERALLY '0AH';
/* CP/M BDOS SYSTEM CALL */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
/* PRINTS A BYTE AS A CHARACTER */
PRINT$CHAR: PROCEDURE( CH ); DECLARE CH BYTE; CALL BDOS( 2, CH ); END;
/* PRINTS A $ TERMINATED STRING */
PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
/* PRINTS A BYTE AS A NUMBER */
PRINT$BYTE: PROCEDURE( N );
DECLARE N BYTE;
DECLARE ( V, D2, D3 ) BYTE;
V = N;
D3 = V MOD 10;
IF ( V := V / 10 ) <> 0 THEN DO;
D2 = V MOD 10;
IF ( V := V / 10 ) <> 0 THEN CALL PRINT$CHAR( '0' + V );
CALL PRINT$CHAR( '0' + D2 );
END;
CALL PRINT$CHAR( '0' + D3 );
END PRINT$BYTE;
/* PRINTS A FIXED LENGTH STRING */
PRINT$SUBSTRING: PROCEDURE( S$PTR, LEN );
DECLARE S$PTR ADDRESS, LEN BYTE, S BASED S$PTR ( MAX$REP )BYTE;
DECLARE S$POS BYTE;
DO S$POS = 0 TO LEN - 1;
CALL PRINT$CHAR( S( S$POS ) );
END;
END PRINT$SUBSTRING;
/* RETURNS THE LENGTH OF A $ TERMINATED STRING */
STR$LENGTH: PROCEDURE( S$PTR )BYTE;
DECLARE S$PTR ADDRESS, S BASED S$PTR ( MAX$REP )BYTE;
DECLARE RESULT BYTE;
RESULT = 0;
DO WHILE( S( RESULT ) <> '$' );
RESULT = RESULT + 1;
END;
RETURN RESULT;
END STR$LENGTH;
/* RETURNS THE LENGTH OF THE LONGEST REP-STRING IN S$PTR, */
LONGEST$REP$STRING: PROCEDURE( S$PTR )BYTE;
DECLARE S$PTR ADDRESS, S BASED S$PTR ( MAX$REP )BYTE;
DECLARE ( S$LEN, RESULT, S$POS, R$POS, I, FOUND ) BYTE;
RESULT = 0;
FOUND = FALSE;
S$LEN = STR$LENGTH( S$PTR );
S$POS = ( S$LEN / 2 ) - 1; /* IF ( S$LEN / 2 ) = 0, S$POS WILL BE 255 */
DO WHILE( NOT FOUND AND S$POS < 255 ); /* AS BYTE/ADDRESS ARE UNSIGNED */
/* CHECK THE POTENTIAL REP-STRING REPEATED A SUFFICIENT NUMBER */
/* OF TIMES (TRUNCATED IF NECESSARY) EQUALS THE ORIGINAL STRING */
FOUND = TRUE;
R$POS = S$POS + 1;
DO WHILE( FOUND AND R$POS < S$LEN AND FOUND );
I = 0;
DO WHILE( I <= S$POS AND R$POS < S$LEN AND FOUND );
FOUND = S( R$POS ) = S( I );
R$POS = R$POS + 1;
I = I + 1;
END;
END;
IF NOT FOUND THEN DO;
/* HAVEN'T FOUND A REP-STRING, TRY A SHORTER ONE */
S$POS = S$POS - 1; /* S$POS WILL BECOME 255 IF S$POS = 0 */
END;
END;
IF FOUND THEN DO;
RESULT = S$POS + 1;
END;
RETURN RESULT;
END LONGEST$REP$STRING;
DECLARE ( TEST$NUMBER, REP$STRING$LEN ) BYTE;
DECLARE TESTS ( 11 )ADDRESS;
TESTS( 0 ) = .'1001110011$';
TESTS( 1 ) = .'1110111011$';
TESTS( 2 ) = .'0010010010$';
TESTS( 3 ) = .'1010101010$';
TESTS( 4 ) = .'1111111111$';
TESTS( 5 ) = .'0100101101$';
TESTS( 6 ) = .'0100100$';
TESTS( 7 ) = .'101$';
TESTS( 8 ) = .'11$';
TESTS( 9 ) = .'00$';
TESTS( 10 ) = .'1$';
DO TEST$NUMBER = 0 TO LAST( TESTS );
REP$STRING$LEN = LONGEST$REP$STRING( TESTS( TEST$NUMBER ) );
CALL PRINT$STRING( TESTS( TEST$NUMBER ) );
IF REP$STRING$LEN = 0 THEN DO;
CALL PRINT$STRING( .': NO REP STRING$' );
END;
ELSE DO;
CALL PRINT$STRING( .': LONGEST REP STRING: $' );
CALL PRINT$SUBSTRING( TESTS( TEST$NUMBER ), REP$STRING$LEN );
END;
CALL PRINT$STRING( .( CR, LF, '$' ) );
END;
EOF