Syntax highlighting using Mediawiki formatting: Difference between revisions
Syntax highlighting using Mediawiki formatting (view source)
Revision as of 17:25, 28 October 2023
, 7 months agoAdded PL/M
m (→{{header|Julia}}: change default file name) |
(Added PL/M) |
||
Line 694:
'''puts'''(1,out)
{} = '''wait_key'''()
=={{header|PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
Note that PL/M doesn't have in-built I/O or standard libraries, hence the need to define the various BDOS system calls.<br>
|As CP/M doesn't have redirection, the source file and output file names must be specified on the command line, e.g. if the source is in D:SYNTAX.PLM and the desired output file is D:SYNTAX.OUT and the program is compiled to D:SYNTAX.COM, then the command:<br>
<code>D:SYNTAX D:SYNTAX.PLM D:SYNTAX.OUT</code><br> will create SYNTAX.OUT as a copy of SYNTAX.PLM with the markup for the highlighting.Note the output file must not exist before running the program.<br>
The output is also echoed to the console.
100H: ''/* SYNTAX HIGHLIGHT A PL/M SOURCE USING MEDIAWIKI MARKUP */''
'''DECLARE''' FALSE '''LITERALLY''' '0', TRUE '''LITERALLY''' '0FFH';
'''DECLARE''' NL$CHAR '''LITERALLY''' '0AH'; ''/* NEWLINE: CHAR 10 */''
'''DECLARE''' CR$CHAR '''LITERALLY''' '0DH'; ''/* CARRIAGE RETURN, CHAR 13 */''
'''DECLARE''' EOF$CHAR '''LITERALLY''' '26'; ''/* EOF: CTRL-Z */''
'''DECLARE''' AMP '''LITERALLY''' '026H'; ''/* AMPERSAND */''
'''DECLARE''' LCA '''LITERALLY''' '061H'; ''/* LOWER CASE 'A' */''
'''DECLARE''' LCG '''LITERALLY''' '067H'; ''/* LOWER CASE 'G' */''
'''DECLARE''' LCL '''LITERALLY''' '06CH'; ''/* LOWER CASE 'L' */''
'''DECLARE''' LCM '''LITERALLY''' '06DH'; ''/* LOWER CASE 'M' */''
'''DECLARE''' LCO '''LITERALLY''' '06FH'; ''/* LOWER CASE 'O' */''
'''DECLARE''' LCP '''LITERALLY''' '070H'; ''/* LOWER CASE 'P' */''
'''DECLARE''' LCS '''LITERALLY''' '073H'; ''/* LOWER CASE 'S' */''
'''DECLARE''' LCT '''LITERALLY''' '074H'; ''/* LOWER CASE 'T' */''
''/* CP/M BDOS SYSTEM CALL, RETURNS A VALUE */''
BDOS: '''PROCEDURE'''( FN, ARG )'''BYTE'''; '''DECLARE''' FN '''BYTE''', ARG '''ADDRESS'''; '''GOTO''' 5; '''END''';
''/* CP/M BDOS SYSTEM CALL, NO RETURN VALUE */''
BDOS$P: '''PROCEDURE'''( FN, ARG ); '''DECLARE''' FN '''BYTE''', ARG '''ADDRESS'''; '''GOTO''' 5; '''END''';
EXIT: '''PROCEDURE'''; '''CALL''' BDOS$P( 0, 0 ); '''END'''; ''/* CP/M SYSTEM RESET */''
PR$CHAR: '''PROCEDURE'''( C ); '''DECLARE''' C '''BYTE'''; '''CALL''' BDOS$P( 2, C ); '''END''';
PR$STRING: '''PROCEDURE'''( S ); '''DECLARE''' S '''ADDRESS'''; '''CALL''' BDOS$P( 9, S ); '''END''';
PR$NL: '''PROCEDURE'''; '''CALL''' PR$STRING( .( 0DH, NL$CHAR, '$' ) ); '''END''';
FL$EXISTS: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* RETURNS TRUE IF THE FILE NAMED IN THE */''
'''DECLARE''' FCB '''ADDRESS'''; ''/* FCB EXISTS */''
'''RETURN''' ( BDOS( 17, FCB ) < 4 );
'''END''' FL$EXISTS ;
FL$OPEN: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* OPEN THE FILE WITH THE SPECIFIED FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 15, FCB ) < 4 );
'''END''' FL$OPEN;
FL$MAKE: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* CREATE AND OPEN THE FILE WITH THE */''
'''DECLARE''' FCB '''ADDRESS'''; ''/* SPECIFIED FCB */''
'''RETURN''' ( BDOS( 22, FCB ) < 4 );
'''END''' FL$MAKE;
FL$READ: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* READ THE NEXT RECORD FROM FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 20, FCB ) = 0 );
'''END''' FL$READ;
FL$WRITE: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* WRITE A RECORD TO FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 21, FCB ) = 0 );
'''END''' FL$WRITE;
FL$CLOSE: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* CLOSE THE FILE WITH THE SPECIFIED FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 16, FCB ) < 4 );
'''END''' FL$CLOSE;
DMA$SET: '''PROCEDURE'''( DMA ); ''/* SET THE DMA BUFFER ADDRESS FOR I/O */''
'''DECLARE''' DMA '''ADDRESS''';
'''CALL''' BDOS$P( 26, DMA );
'''END''' DMA$SET;
''/* I/O USES FILE CONTROL BLOCKS CONTAINING THE FILE-NAME, POSITION, ETC. */''
''/* WHEN THE PROGRAM IS RUN, THE CCP WILL FIRST PARSE THE COMMAND LINE AND */''
''/* PUT THE FIRST PARAMETER IN FCB1, THE SECOND PARAMETER IN FCB2 */''
''/* BUT FCB2 OVERLAYS THE END OF FCB1 AND THE DMA BUFFER OVERLAYS THE END */''
''/* OF FCB2 */''
'''DECLARE''' FCB$SIZE '''LITERALLY''' '36'; ''/* SIZE OF A FCB */''
'''DECLARE''' FCB1 '''LITERALLY''' '5CH'; ''/* ADDRESS OF FIRST FCB */''
'''DECLARE''' FCB2 '''LITERALLY''' '6CH'; ''/* ADDRESS OF SECOND FCB */''
'''DECLARE''' DMA$BUFFER '''LITERALLY''' '80H'; ''/* DEFAULT DMA BUFFER ADDRESS */''
'''DECLARE''' DMA$SIZE '''LITERALLY''' '128'; ''/* SIZE OF THE DMA BUFFER */''
INIT$FCB: '''PROCEDURE'''( FCB ); ''/* INITIALISE A FILE-CONTROL-BLOCK */''
'''DECLARE''' FCB '''ADDRESS''';
'''DECLARE''' F$PTR '''ADDRESS''';
'''DECLARE''' F '''BASED''' F$PTR '''BYTE''', P '''BYTE''';
F$PTR = FCB;
F = 0; ''/* DEFAULT DRIVE */''
'''DO''' F$PTR = FCB + 1 '''TO''' FCB + 11; ''/* NO NAME */''
F = ' ';
'''END''';
'''DO''' F$PTR = FCB + 12 '''TO''' FCB + ( FCB$SIZE - 1 ); ''/* OTHER FIELDS */''
F = 0;
'''END''';
'''END''' INIT$FCB;
MOVE$FCB: '''PROCEDURE'''( FROM$FCB, TO$FCB ); ''/* MOVE THE CONTENTS OF AN FCB */''
'''DECLARE''' ( FROM$FCB, TO$FCB ) '''ADDRESS''';
'''DECLARE''' ( F$PTR, T$PTR ) '''ADDRESS''';
'''DECLARE''' F '''BASED''' F$PTR '''BYTE''', T '''BASED''' T$PTR '''BYTE''', P '''BYTE''';
'''CALL''' INIT$FCB( TO$FCB );
F$PTR = FROM$FCB;
T$PTR = TO$FCB;
'''DO''' P = 0 '''TO''' 11; ''/* COPY DRIVE, FILENAME AND EXTENSION */''
T = F;
F$PTR = F$PTR + 1;
T$PTR = T$PTR + 1;
'''END''';
'''END''' MOVE$FCB;
SHOW$FCB: '''PROCEDURE'''( FCB ); ''/* SHOW THE CONTENTS OF AN FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''DECLARE''' F$PTR '''ADDRESS''';
'''DECLARE''' F '''BASED''' F$PTR '''BYTE''', P '''BYTE''';
F$PTR = FCB;
'''DO''' P = 0 '''TO''' 11; ''/* DRIVE, FILENAME AND EXTENSION */''
'''IF''' P = 9 '''THEN''' '''CALL''' PR$CHAR( '.' );
'''IF''' P = 1 '''THEN''' '''CALL''' PR$CHAR( ':' );
'''CALL''' PR$CHAR( F );
F$PTR = F$PTR + 1;
'''END''';
'''END''' SHOW$FCB;
'''DECLARE''' F$PTR '''ADDRESS''', F$CHAR '''BASED''' F$PTR '''BYTE''';
'''DECLARE''' W$PTR '''ADDRESS''', W$CHAR '''BASED''' W$PTR '''BYTE''';
'''DECLARE''' FCB$OUT$DATA ( FCB$SIZE )'''BYTE''';
'''DECLARE''' OUT$DMA ( DMA$SIZE )'''BYTE''';
'''DECLARE''' OUT$BUFFER '''LITERALLY''' '.OUT$DMA';
'''DECLARE''' FCB$IN '''LITERALLY''' 'FCB1';
'''DECLARE''' FCB$OUT '''LITERALLY''' '.FCB$OUT$DATA';
'''DECLARE''' K '''LITERALLY''' 'CALL ADDKW';
'''DECLARE''' KW ( 34 )'''ADDRESS''';
'''DECLARE''' KW$MAX '''BYTE''';
KW$MAX = -1;
ADDKW: '''PROCEDURE'''( ADDR ); ''/* ADDS A KEYWORD TO KW */''
'''DECLARE''' ADDR '''ADDRESS''';
KW( KW$MAX := KW$MAX + 1 ) = ADDR;
'''END''' ADDKW ;
K(.'ADDRESS$');K(.'AND$');K(.'BASED$');K(.'BY$');K(.'BYTE$');K(.'CALL$');
K(.'CASE$');K(.'DATA$');K(.'DECLARE$');K(.'DISABLE$');K(.'DO$');K(.'ELSE$');
K(.'ENABLE$');K(.'END$');K(.'EOF$');K(.'GO$');K(.'GOTO$');K(.'HALT$');
K(.'IF$');K(.'INITIAL$');K(.'INTERRUPT$');K(.'LABEL$');K(.'LITERALLY$');
K(.'MINUS$');K(.'MOD$');K(.'NOT$');K(.'OR$');K(.'PLUS$');K(.'PROCEDURE$');
K(.'RETURN$');K(.'THEN$');K(.'TO$');K(.'WHILE$');K(.'XOR$');
''/* MOVE THE SECOND FCB TO A NEW PLACE SO IT ISN'T OVERWRITTEN BY FCB1 */''
'''CALL''' MOVE$FCB( FCB2, FCB$OUT );
''/* CLEAR THE PARTS OF FCB1 OVERLAYED BY FCB2 */''
'''DO''' F$PTR = FCB1 + 12 '''TO''' FCB1 + ( FCB$SIZE - 1 );
F$CHAR = 0;
'''END''';
STR$EQUAL: '''PROCEDURE'''( S1, S2 )'''BYTE'''; ''/* RETURN TRUE IF S1 = S2 */''
'''DECLARE''' ( S1, S2 ) '''ADDRESS''';
'''DECLARE''' ( S1$PTR, S2$PTR ) '''ADDRESS''';
'''DECLARE''' C1 '''BASED''' S1$PTR '''BYTE''', C2 '''BASED''' S2$PTR '''BYTE''', SAME '''BYTE''';
S1$PTR = S1; S2$PTR = S2;
'''DO''' '''WHILE''' ( SAME := C1 = C2 ) '''AND''' C1 <> '$' '''AND''' C2 <> '$';
S1$PTR = S1$PTR + 1; S2$PTR = S2$PTR + 1;
'''END''';
'''RETURN''' SAME;
'''END''' STR$EQUAL ;
IS$WORD$CHAR: '''PROCEDURE'''( CH )'''BYTE'''; ''/* RETURN TRUE IF CH IS PART OF A WORD */''
'''DECLARE''' CH '''BYTE''';
'''RETURN''' ( CH >= 'A' '''AND''' CH <= 'Z' ) '''OR''' CH = '$'
'''OR''' ( CH >= '0' '''AND''' CH <= '9' );
'''END''' IS$WORD$CHAR ;
'''IF''' '''NOT''' FL$EXISTS( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' SHOW$FCB( FCB$IN );
'''CALL''' PR$STRING( .': INPUT FILE NOT FOUND$' );'''CALL''' PR$NL;
'''END''';
'''ELSE''' '''IF''' FL$EXISTS( FCB$OUT ) '''THEN''' '''DO''';
'''CALL''' SHOW$FCB( FCB$OUT );
'''CALL''' PR$STRING( .': OUTPUT FILE ALREADY EXISTS$' );'''CALL''' PR$NL;
'''END''';
'''ELSE''' '''IF''' '''NOT''' FL$OPEN( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO OPEN THE INPUT FILE$' );'''CALL''' PR$NL;
'''END''';
'''ELSE''' '''IF''' '''NOT''' FL$MAKE( FCB$OUT ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO OPEN THE OUTPUT FILE$' );'''CALL''' PR$NL;
'''IF''' '''NOT''' FL$CLOSE( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO CLOSE THE INPUT FILE$' ); '''CALL''' PR$NL;
'''END''';
'''END''';
'''ELSE''' '''DO'''; ''/* FILES OPENED OK - ATTEMPT TO FORMAT THE SOURCE */''
'''DECLARE''' ( GOT$RCD, IS$HEADING ) '''BYTE''', ( DMA$END, OUT$END ) '''ADDRESS''';
'''DECLARE''' IN$STRING '''BYTE''', COMMENT$STATE '''ADDRESS''', GOT$NEXT '''BYTE''';
IN$CHAR: '''PROCEDURE''';
F$PTR = F$PTR + 1;
'''IF''' F$PTR > DMA$END '''THEN''' '''DO'''; ''/* END OF BUFFER */''
GOT$RCD = FL$READ( FCB$IN ); ''/* GET THE NEXT RECORDD */''
'''IF''' '''NOT''' GOT$RCD '''THEN''' F$CHAR = EOF$CHAR;
F$PTR = DMA$BUFFER;
'''END''';
'''END''' IN$CHAR ;
OUT$CHAR: '''PROCEDURE'''( CH ); ''/* OUTPUT A CHARECTER TO THE OUTPOUT FILE */''
'''DECLARE''' CH '''BYTE''';
'''IF''' CH <> EOF$CHAR '''THEN''' '''CALL''' PR$CHAR( CH );
W$CHAR = CH;
W$PTR = W$PTR + 1;
'''IF''' W$PTR > OUT$END '''OR''' CH = EOF$CHAR '''THEN''' '''DO''';
''/* THE OUTPUT BUFFER IS FULL OR WE ARE WRITTING EOF */''
'''IF''' CH = EOF$CHAR '''THEN''' '''DO'''; ''/* EOF - FILL THE BUFFER WITH NULS */''
'''DO''' '''WHILE''' W$PTR <= OUT$END;
W$CHAR = 0;
W$PTR = W$PTR + 1;
'''END''';
'''END''';
'''CALL''' DMA$SET( OUT$BUFFER ); ''/* SWITCH DMA TO THE OUTOUT BUFFER */''
'''IF''' '''NOT''' FL$WRITE( FCB$OUT ) '''THEN''' '''DO'''; ''/* I/O ERROR */''
'''CALL''' PR$STRING( .'I/O ERROR ON WRITING $' );
'''CALL''' SHOW$FCB( FCB$OUT );
'''CALL''' PR$NL;
'''CALL''' EXIT;
'''END''';
'''CALL''' DMA$SET( DMA$BUFFER ); ''/* RESET DMA TO THE DEFAULT BUFFER */''
W$PTR = OUT$BUFFER;
'''END''';
'''END''' OUT$CHAR;
OUT$STRING: '''PROCEDURE'''( STR ); ''/* OUTPUT A STRING */''
'''DECLARE''' STR '''ADDRESS''';
'''DECLARE''' S$PTR '''ADDRESS''';
'''DECLARE''' S$CHAR '''BASED''' S$PTR '''BYTE''';
S$PTR = STR;
'''DO''' '''WHILE''' S$CHAR <> '$';
'''CALL''' OUT$CHAR( S$CHAR );
S$PTR = S$PTR + 1;
'''END''';
'''END''' OUT$STRING;
DMA$END = DMA$BUFFER + ( DMA$SIZE - 1 );
OUT$END = OUT$BUFFER + ( DMA$SIZE - 1 );
GOT$RCD = FL$READ( FCB$IN ); ''/* GET THE FIRST RECORD */''
F$PTR = DMA$BUFFER;
W$PTR = OUT$BUFFER;
IN$STRING = FALSE;
GOT$NEXT = FALSE;
COMMENT$STATE = 0;
'''CALL''' OUT$CHAR( ' ' );
'''DO''' '''WHILE''' GOT$RCD;
'''IF''' F$CHAR = CR$CHAR '''THEN''' '''DO'''; ''/* CARRIAGE RETURN */''
'''IF''' COMMENT$STATE > 1 '''THEN''' '''DO''';
COMMENT$STATE = 2;
'''CALL''' OUT$STRING( .'''''$' );
'''END''';
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''ELSE''' '''IF''' F$CHAR = NL$CHAR '''THEN''' '''DO''';
'''CALL''' OUT$CHAR( F$CHAR );
'''CALL''' OUT$CHAR( ' ' );
'''IF''' COMMENT$STATE > 1 '''THEN''' '''CALL''' OUT$STRING( .'''''$' );
'''END''';
'''ELSE''' '''IF''' F$CHAR = AMP '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCA, LCM, LCP, ';$' ) );
'''END''';
'''ELSE''' '''IF''' F$CHAR = '''' '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCA, LCP, LCO, LCS, ';$' ) );
IN$STRING = COMMENT$STATE = 0 '''AND''' '''NOT''' IN$STRING;
'''END''';
'''ELSE''' '''IF''' F$CHAR = '<' '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCL, LCT, ';$' ) );
'''END''';
'''ELSE''' '''IF''' F$CHAR = '>' '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCG, LCT, ';$' ) );
'''END''';
'''ELSE''' '''IF''' IN$STRING '''THEN''' '''CALL''' OUT$CHAR( F$CHAR );
'''ELSE''' '''IF''' COMMENT$STATE = 1 '''THEN''' '''DO'''; ''/* HAVE A CHARACTER AFTER / */''
'''IF''' F$CHAR = '*' '''THEN''' '''DO''';
COMMENT$STATE = 2;
'''CALL''' OUT$STRING( .'''''/*$' );
'''END''';
'''ELSE''' '''DO''';
COMMENT$STATE = 0;
'''CALL''' OUT$CHAR( '/' );
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''END''';
'''ELSE''' '''IF''' COMMENT$STATE = 2 '''THEN''' '''DO'''; ''/* IN A COMMENT */''
'''IF''' F$CHAR = '*' '''THEN''' COMMENT$STATE = 3;
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''ELSE''' '''IF''' COMMENT$STATE = 3 '''THEN''' '''DO'''; ''/* IN A COMMENT, EXPECTING / */''
'''IF''' F$CHAR = '/' '''THEN''' '''DO'''; ''/* END OF COMMENT */''
'''CALL''' OUT$STRING( .'/''''$' );
COMMENT$STATE = 0;
'''END''';
'''ELSE''' '''DO'''; ''/* NOT END OF COMMENT */''
'''CALL''' OUT$CHAR( F$CHAR );
'''IF''' F$CHAR <> '*' '''THEN''' COMMENT$STATE = 2;
'''END''';
'''END''';
'''ELSE''' '''IF''' F$CHAR = '/' '''THEN''' '''DO''';
'''IF''' COMMENT$STATE = 0 '''THEN''' COMMENT$STATE = 1;
'''ELSE''' '''IF''' COMMENT$STATE = 3 '''THEN''' '''DO''';
''/* END OF COMMENT */''
'''CALL''' OUT$STRING( .'/''''$' );
COMMENT$STATE = 0;
'''END''';
'''ELSE''' '''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''ELSE''' '''IF''' F$CHAR = EOF$CHAR '''THEN''' GOT$RCD = FALSE; ''/* END OF FILE */''
'''ELSE''' '''IF''' F$CHAR >= 'A' '''AND''' F$CHAR <= 'Z' '''THEN''' '''DO'''; ''/* WORD */''
'''DECLARE''' W ( 10 )'''BYTE''', W$POS '''BYTE''', HAS$DOLLAR '''BYTE''';
OUT$WORD: '''PROCEDURE'''; ''/* OUTPUT W (WHICH MAY CONTAIN $ */''
'''DECLARE''' I '''BYTE''';
'''DO''' I = 0 '''TO''' W$POS - 1; '''CALL''' OUT$CHAR( W( I ) ); '''END''';
'''END''' OUT$WORD ;
W$POS = 0;
HAS$DOLLAR = FALSE;
'''DO''' '''WHILE''' W$POS < 9 '''AND''' IS$WORD$CHAR( F$CHAR );
'''IF''' F$CHAR = '$' '''THEN''' HAS$DOLLAR = TRUE;
W( W$POS ) = F$CHAR; W$POS = W$POS + 1; '''CALL''' IN$CHAR;
'''END''';
W( W$POS ) = '$';
'''IF''' IS$WORD$CHAR( F$CHAR ) '''THEN''' '''DO'''; ''/* WORD IS TOO LONG FOE A */''
'''CALL''' OUT$WORD; ''/* KEYWORD */''
'''DO''' '''WHILE''' IS$WORD$CHAR( F$CHAR );
'''CALL''' OUT$CHAR( F$CHAR );'''CALL''' IN$CHAR;
'''END''';
'''END''';
'''ELSE''' '''IF''' HAS$DOLLAR '''THEN''' '''DO'''; ''/* ASSUME IT ISN'T A KEYWORD */''
'''CALL''' OUT$WORD; ''/* I.E., THE PROGRAMMER HASN'T WRITTEN E.G.: */''
'''END'''; ''/* RE$TURN X; */''
'''ELSE''' '''DO'''; ''/* SHORT WORD - COULD BE A KEYWORD */''
'''DECLARE''' ( IS$KW, KW$POS ) '''BYTE''';
IS$KW = FALSE;
KW$POS = 0;
'''DO''' '''WHILE''' '''NOT''' IS$KW '''AND''' KW$POS <= KW$MAX;
IS$KW = STR$EQUAL( .W, KW( KW$POS ) );
KW$POS = KW$POS + 1;
'''END''';
'''IF''' IS$KW '''THEN''' '''CALL''' OUT$STRING( .'''''''$' );
'''CALL''' OUT$WORD;
'''IF''' IS$KW '''THEN''' '''CALL''' OUT$STRING( .'''''''$' );
'''END''';
GOT$NEXT = TRUE;
'''END''';
'''ELSE''' '''DO'''; ''/* HAVE ANOTHER CHARACTER */''
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''IF''' '''NOT''' GOT$NEXT '''THEN''' '''CALL''' IN$CHAR;
GOT$NEXT = FALSE;
'''END''';
'''CALL''' OUT$CHAR( EOF$CHAR );
''/* CLOSE THE FILES */''
'''IF''' '''NOT''' FL$CLOSE( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO CLOSE THE INPUT FILE$' ); '''CALL''' PR$NL;
'''END''';
'''IF''' '''NOT''' FL$CLOSE( FCB$OUT ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO CLOSE THE OUTPUT FILE$' ); '''CALL''' PR$NL;
'''END''';
'''END''';
'''CALL''' EXIT;
'''EOF'''
=={{header|Python}}==
|