Syntax highlighting using Mediawiki formatting: Difference between revisions
Content added Content deleted
m (→{{header|Julia}}: change default file name) |
(Added PL/M) |
||
| Line 694: | Line 694: | ||
'''puts'''(1,out) |
'''puts'''(1,out) |
||
{} = '''wait_key'''() |
{} = '''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}}== |
=={{header|Python}}== |
||