Create your own text control codes: Difference between revisions
Create your own text control codes (view source)
Revision as of 19:54, 28 November 2021
, 2 years agoAdded PL/M
(Added PL/M) |
|||
Line 103:
case '=': res = pad.repeat(half) + res + pad.repeat(padlen-half); break;
case '|': res = pad.repeat(padlen-half) + res + pad.repeat(half); break;</lang>
=={{header|PL/M}}==
PL/M doesn't have a standard printf function, or indeed a standard library.<br><br>
This sample implements a PRINTF procedure somewhat like the standard C library routine.<br><br>
Although CP/M uses ASCII, Kildall's original 8080 PL/M compiler only supports a limited character set for the program's source. In particular the compiler doesn't like lowercase letters, % or \. PL/M also requires procedures to be called with the same number of parameters they were defined with. The PRINTF defined here has the format string plus seven parameters, if fewer parameters are required, additional dummy parameters must be supplied<br>
As % and lowercase are not available, the format frames are preceeded by / and must be in uppercase.<br>
The following are supported:
<pre>
/S -> print a string
/LS -> print a string in lowercase
/C -> print a single character
/LC -> print a single character in lowercase
/D or /I -> print a signed integer in decimal
/U -> print an unsigned integer in decimal
/H or /X -> print an unsigned integer in hexadecimal
/O -> print an unsigned integer in octal
/N -> print a newline
/anything-else
-> print the anything-else character, e.g. /$ prints a $ without terminating the format
</pre>
The additional options such as field width available in C's printf are not allowed in this PRINTF.
<br><br>
Note that under CP/M, strings are terminated by $, not a nul character, hence the need for /$.<br>
The original 8080 PL/M compiler also only supports unsigned 8 and 16 bit values. If a number must be treated as signed, the values 65535 downto 32768 represent -1 downto -32768, hence the somewhat cryptic handling of the D and I frames.
<lang pli>100H: /* FORMATTED OUTPUT */
/* CP/M BDOS SYSTEM CALL */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5;END;
/* CONSOLE OUTPUT ROUTINES */
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$STRING( .( 0DH, 0AH, '$' ) ); END;
PR$NUMBER: PROCEDURE( N );
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR( 6 ) BYTE INITIAL( '.....$' ), W BYTE;
N$STR( W := LAST( N$STR ) - 1 ) = '0' + ( ( V := N ) 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;
PR$OCTAL: PROCEDURE( N );
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR( 7 ) BYTE INITIAL( '......$' ), W BYTE;
DO W = 0 TO LAST( N$STR ) - 2; N$STR( W ) = '0'; END;
N$STR( W := LAST( N$STR ) - 1 ) = '0' + ( ( V := N ) AND 7 );
DO WHILE( ( V := SHR( V, 3 ) ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V AND 7 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$OCTAL;
/* FORMATTED PRINT ROUTINE - VAGUELY LIKE THE C ROUTINE */
PRINTF: PROCEDURE( FMT, A, B, C, D, E, F, G );
DECLARE ( FMT, A, B, C, D, E, F, G ) ADDRESS;
PR$HEX: PROCEDURE( B ); /* PRINTS B AS A 2 DIGIT HEX NUMBER */
DECLARE B BYTE;
DECLARE D BYTE;
D = SHR( B, 4 );
IF D > 9
THEN CALL PR$CHAR( ( D - 10 ) + 'A' );
ELSE CALL PR$CHAR( D + '0' );
D = B AND 0FH;
IF D > 9
THEN CALL PR$CHAR( ( D - 10 ) + 'A' );
ELSE CALL PR$CHAR( D + '0' );
END PR$HEX ;
DECLARE FRAME LITERALLY '''/''';
DECLARE P ( 7 )ADDRESS;
DECLARE FPTR ADDRESS;
DECLARE ( PPOS, FCH BASED FPTR ) BYTE;
P( 0 ) = A; P( 1 ) = B; P( 2 ) = C; P( 3 ) = D;
P( 4 ) = E; P( 5 ) = F; P( 6 ) = G;
PPOS = 0;
FPTR = FMT;
DO WHILE( FCH <> '$' );
IF FCH <> FRAME THEN DO;
/* NOT A FORMAT FRAME */
CALL PR$CHAR( FCH );
END;
ELSE DO;
/* FORMAT FRAME */
FPTR = FPTR + 1;
IF FCH = 'S' THEN DO;
/* STRING */
CALL PR$STRING( P( PPOS ) );
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'I' OR FCH = 'D' THEN DO;
/* SIGNED DECIMAL INTEGER */
DECLARE V ADDRESS;
V = P( PPOS );
IF V > 32767 THEN DO;
CALL PR$CHAR( '-' );
V = - V;
END;
CALL PR$NUMBER( V );
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'U' THEN DO;
/* UNSIGNED DECIMAL INTEGER */
CALL PR$NUMBER( P( PPOS ) );
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'C' THEN DO;
/* CHARACTER */
CALL PR$CHAR( LOW( P( PPOS ) ) );
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'L' THEN DO;
/* CHARACTER OR STRING CONVERTED TO LOWER CASE */
FPTR = FPTR + 1;
IF FCH = 'S' THEN DO;
/* LOWERCASE STRING */
DECLARE SPTR ADDRESS;
DECLARE SCH BASED SPTR BYTE;
SPTR = P( PPOS );
DO WHILE( SCH <> '$' );
IF SCH >= 'A' AND SCH <= 'Z' THEN SCH = SCH + 32;
CALL PR$CHAR( SCH );
SPTR = SPTR + 1;
END;
END;
ELSE DO;
/* LOWERCASE CHARACTER */
DECLARE V BYTE;
V = LOW( P( PPOS ) );
IF V >= 'A' AND V <= 'Z' THEN V = V + 32;
CALL PR$CHAR( V );
END;
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'H' OR FCH = 'X' THEN DO;
/* UNSIGNED INTEGER IN HEX */
DECLARE V ADDRESS;
V = P( PPOS );
CALL PR$CHAR( '$' );
CALL PR$HEX( HIGH( V ) );
CALL PR$HEX( LOW( V ) );
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'O' THEN DO;
/* UNSIGNED OCTAL INTEGER */
CALL PR$OCTAL( P( PPOS ) );
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'N' THEN DO;
/* PRINT NEWLINE */
CALL PR$NL;
END;
ELSE DO;
/* ANYTHING ELSE - JUST PRINT IT */
CALL PR$CHAR( FCH );
END /* IF VARIOUS FRAMES;; */ ;
END /* IF FCH <> FRAME;; */ ;
FPTR = FPTR + 1;
END /* WHILE FCH <> '$' */ ;
END PRINTF ;
DECLARE ( P3, P4, P5, P6, P7 ) ADDRESS;
P3 = 301; P4, P5, P6 = 0;
P3 = - P3;
P4 = P4 - 1; P5 = P5 - 2; P6 = P6 - 3;
P7 = 65535;
CALL PRINTF( .'HELLO, /S/C /I/$ /D /U /X./N(END)/O/N$'
, .'WORLD$', 33, P3, P4, P5, P6, P7
);
CALL PRINTF( .'H/LC/LC/LC/LC, W/LS/C$'
, 'E', 'L', 'L', 'O', .'ORLD$', 33, 0
);
EOF</lang>
{{out}}
<pre>
HELLO, WORLD! -301$ -1 65534 $FFFD.
(END)177777
Hello, World!</pre>
=={{header|Raku}}==
| |||