Rep-string: Difference between revisions

4,033 bytes added ,  3 years ago
Added PL/M
(Rep-string en FreeBASIC)
(Added PL/M)
Line 2,844:
00 is a rep-string containing 0
1 is not a rep-string
</pre>
 
=={{header|PL/M}}==
<lang plmi>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</lang>
{{out}}
<pre>
1001110011: LONGEST REP STRING: 10011
1110111011: LONGEST REP STRING: 1110
0010010010: LONGEST REP STRING: 001
1010101010: LONGEST REP STRING: 1010
1111111111: LONGEST REP STRING: 11111
0100101101: NO REP STRING
0100100: LONGEST REP STRING: 010
101: NO REP STRING
11: LONGEST REP STRING: 1
00: LONGEST REP STRING: 0
1: NO REP STRING
</pre>
 
3,038

edits