Jump to content

Create your own text control codes: Difference between revisions

(→‎{{header|PL/M}}: Bug fix and tweaks)
Line 105:
 
=={{header|PL/M}}==
PL/M doesn't have a standard printf function, or indeed, a standard library.
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>
Line 162:
DECLARE B BYTE;
DECLARE D BYTE;
IF ( D := SHR( B, 4 ) ) > 9 THEN CALL PR$CHAR( ( D - 10 ) + 'A' );
ELSE CALL PR$CHAR( D + '0' );
IF D > 9
IF ( D := B AND 0FH ) > 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 ;
/* RETURNS A CONVERTED TO LOWERCASE, IF NECESSARY */
TO$LOWER: PROCEDURE( A )BYTE;
IFDECLARE DA > 9BYTE;
IF VA >= 'A' AND VA <= 'Z' THEN VRETURN =( VA + 32 ); ELSE RETURN A;
END TO$LOWER;
 
DECLARE FRAME LITERALLY '''/''';
DECLARE P ( 7 )ADDRESS;
DECLARE FPTR ADDRESS;
DECLARE ( PPOS, FCH BASED FPTR, IN$LOWERCASE ) BYTE;
P( 0 ) = A; P( 1 ) = B; P( 2 ) = C; P( 3 ) = D;
P( 4 ) = E; P( 5 ) = F; P( 6 ) = G;
Line 181 ⟶ 182:
FPTR = FMT;
DO WHILE( FCH <> '$' );
IF FCH <> FRAME THEN DO; /* NOT A FORMAT FRAME */
/* NOT A FORMAT FRAME */
CALL PR$CHAR( FCH );
END;
ELSE DO; /* IS A FORMAT FRAME */
/* FORMAT FRAME */
FPTR = FPTR + 1;
IF ( IN$LOWERCASE := FCH = 'SL' ) THEN DOFPTR = FPTR + 1;
IF FCH = /*'C' STRINGOR */FCH = 'S' THEN DO;
CALL/* CHARACTER OR PR$STRING( P(OPTIONALLY CONVERTED TO LOWER PPOSCASE ) );*/
PPOSIF FCH = PPOS'C' +THEN 1DO; /* CHARACTER */
END IF IN$LOWERCASE THEN CALL PR$CHAR( TO$LOWER( P( PPOS ) ) );
ELSE IFCALL PR$CHAR( P( FCHPPOS =) 'C' THEN DO);
/* CHARACTER */ END;
CALLELSE PRIF NOT IN$CHAR(LOWERCASE LOW(THEN P(DO; PPOS ) ) ); /* STRING AS-IS */
PPOS = CALL PR$STRING( P( PPOS +) 1);
END;
ELSE IFDO; FCH = 'L' THEN DO; /* LOWERCASE STRING */
/* CHARACTER OR STRING CONVERTED TO LOWER CASE */
DECLARE V BYTE;
FPTR = FPTR + 1;
IF FCH = 'S' THEN DO;
/* LOWERCASE STRING */
DECLARE SPTR ADDRESS;
DECLARE SCH BASED SPTR BYTE;
SPTR = P( PPOS );
DO WHILE( ( V := SCH ) <> '$' );
IFCALL VPR$CHAR( >=TO$LOWER( 'A'SCH AND) V <= 'Z' THEN V = V + 32);
CALL PR$CHAR( V );
SPTR = SPTR + 1;
END;
END;
ELSE DO;
/* LOWERCASE CHARACTER */
V = LOW( P( PPOS ) );
IF V >= 'A' AND V <= 'Z' THEN V = V + 32;
CALL PR$CHAR( V );
END;
PPOS = PPOS + 1;
Line 242 ⟶ 229:
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'O' THEN DO; /* UNSIGNED OCTAL INTEGER */
/* UNSIGNED OCTAL INTEGER */
CALL PR$OCTAL( P( PPOS ) );
PPOS = PPOS + 1;
END;
ELSE IF FCH = 'N' THEN DO; /* NEWLINE */
/* PRINT NEWLINE */
CALL PR$NL;
END;
ELSE DO; /* ANYTHING ELSE - JUST PRINT IT */
/* ANYTHING ELSE - JUST PRINT IT */
CALL PR$CHAR( FCH );
END /* IF VARIOUS FRAMES;; */ ;
Line 260 ⟶ 244:
END PRINTF ;
 
/* TEST 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;
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
Line 271 ⟶ 254:
, 'E', 'L', 'L', 'O', .'ORLD$', 33, 0
);
 
EOF</lang>
{{out}}
3,044

edits

Cookies help us deliver our services. By using our services, you agree to our use of cookies.