The SynChk source.
MODULE SynChk02;
(* SynChk is a syntax checker for a Modula-2 compiler for many target processors.
SynChk will be the first step in such a multipass compiler. It will ensure that the
actual compiler will be fed with correct Modula-2 source code, which will make the
compiler easier to make for us.
Ver Dated Change
--- -------- ----------------------------------------------------------
0.1 15-03-04 Get it working as a 'comment ignorer'.
Make it accept sources from command line.
0.2 23-03-04 Make it accept MODULE/END statements.
0.3 Make it accept VAR and CONST declarations.
*)
IMPORT ASCII;
IMPORT TextIO;
FROM Arguments IMPORT GetArgs, ArgTable;
FROM InOut IMPORT Write, WriteBf, WriteLn, WriteString, WriteCard;
FROM MemPools IMPORT MemPool, NewPool, KillPool, PoolAllocate;
FROM Strings IMPORT Assign, StrEq;
FROM TextIO IMPORT File, OpenInput, Close;
FROM SYSTEM IMPORT ADDRESS, TSIZE;
CONST MaxScratchPad = 15;
TYPE QuoteType = (singleQ, doubleQ);
SymPointer = POINTER TO SymRecord;
Identifier = ARRAY [0..31] OF CHAR;
symType = (Constant, Pointer, Typedef, Variable);
varType = (Boolean, BitSet, Cardinal, Char, Integer, LongInt,
Procedure, Real, ShortCard);
SymRecord = RECORD
previous : SymPointer;
next : SymPointer;
name : Identifier;
address : CARDINAL;
SymKind : symType;
VarKind : varType;
Used : BOOLEAN;
END;
VAR CommentDepth, (* record current nesting depth *)
ProcedureDepth, (* record nesting depth of procedures *)
EndCounter, (* Keeps track of upcoming END statement *)
Line, Column : CARDINAL;
termCH : CHAR;
ScratchPad : ARRAY [0..MaxScratchPad] OF Identifier;
Flag,
ProgramEnd, Syntax : BOOLEAN;
inFile : File;
LastSymbolRecord : SymPointer;
SymPool, ProcPool : MemPool;
args : ArgTable;
Word : Identifier;
ProcBegin : BOOLEAN;
ModuleNamed, MainEnd, MainBegin : BOOLEAN;
ModuleName, ProcedureName : Identifier;
PROCEDURE ErrorMessage (errorNr : CARDINAL);
BEGIN
CASE errorNr OF
9 : WriteString ('Semicolon expected') |
11 : WriteString ('BEGIN not allowed') |
12 : WriteString ('Final END statement without BEGIN.') |
13 : WriteString ('MODULE name does not match END name.') |
14 : WriteString ('PROCEDURE and END names do not match.') |
15 : WriteString ('VARname exceeds 32 tokens') |
16 : WriteString ('Illegal token in symbol name') |
17 : WriteString ('Symbol starts with digit') |
18 : WriteString ('Unexpected token in') |
19 : WriteString ('Unknown TYPE defined') |
20 : WriteString ('Unknown keyword')
ELSE
WriteString ("Strange errornumber encountered")
END;
WriteString (' in line'); WriteCard (Line, 6);
WriteString (', column'); WriteCard (Column, 4); WriteLn; WriteBf;
END ErrorMessage;
PROCEDURE UserMessage (errorNr : CARDINAL);
BEGIN
CASE errorNr OF
1 : WriteString ('Could not open input file. ');
WriteString ('Please check the name and retry.'); |
2 : WriteString ('Cannot open file.') |
3 : WriteString ('Aborting.') |
4 : WriteString ('No source file specified on command line.') |
5 : WriteString ('No nesting of MODULEs allowed.') |
6 : WriteString ('No MODULE name specified.') |
7 : WriteString ('No matching END for main MODULE.') |
8 : WriteString ('Final END must be terminated with a PERIOD.')
ELSE
WriteString ('Illegal error requested');
WriteString (' in line'); WriteCard (Line, 6);
WriteString (', column'); WriteCard (Column, 4);
WriteLn;
END;
WriteLn
END UserMessage;
PROCEDURE DecodeType (str : Identifier) : varType;
VAR type : varType;
BEGIN
IF StrEq (str, 'BOOLEAN') THEN type := Boolean
ELSIF StrEq (str, 'BITSET') THEN type := BitSet
ELSIF StrEq (str, 'CARDINAL') THEN type := Cardinal
ELSIF StrEq (str, 'CHAR') THEN type := Char
ELSIF StrEq (str, 'INTEGER') THEN type := Integer
ELSIF StrEq (str, 'LONGINT') THEN type := LongInt
ELSIF StrEq (str, 'PROCEDURE') THEN type := Procedure
ELSIF StrEq (str, 'REAL') THEN type := Real
ELSIF StrEq (str, 'SHORTCARD') THEN type := ShortCard
ELSE
ErrorMessage (19);
HALT
END;
RETURN type;
END DecodeType;
PROCEDURE ReadChar (VAR chr : CHAR);
BEGIN
TextIO.GetChar (inFile, chr);
IF TextIO.EOF (inFile) = TRUE THEN ProgramEnd := TRUE END;
INC (Column);
IF chr = ASCII.LF THEN
INC (Line);
Column := 1
END
END ReadChar;
PROCEDURE SkipWhite; (* Skip over whitespace *)
VAR ch : CHAR;
BEGIN
LOOP
ReadChar (ch);
IF ch > 40C THEN EXIT END;
END;
TextIO.UndoGetChar (inFile);
END SkipWhite;
PROCEDURE ReadSymbol (VAR buffer : Identifier);
VAR ch : CHAR;
n : CARDINAL;
BEGIN
SkipWhite;
n := 0;
LOOP
ReadChar (ch);
CASE ch OF
'A'..'Z',
'a'..'z',
'0'..'9',
'(', ')', '*' : buffer [n] := ch |
'=', ',', ':',
';', '.' : TextIO.UndoGetChar (inFile);
EXIT |
0C..40C : EXIT
ELSE
ErrorMessage (16);
HALT
END;
INC (n);
IF n > HIGH (buffer) THEN
ErrorMessage (15);
HALT
END
END;
IF (buffer [0] >= '0') AND (buffer [0] <= '9') THEN
ErrorMessage (17);
HALT
END;
IF n <= HIGH (buffer) THEN buffer [n] := 0C END
END ReadSymbol;
PROCEDURE StoreVars; (* Store the VARs in a linked list *)
(* Under construction *)
VAR ch : CHAR;
i, j : CARDINAL;
Flag : BOOLEAN;
str : Identifier;
ptr : SymPointer;
type : varType;
BEGIN (* VAR keyword found => process VARS *)
LOOP (* LOOP to catch multiple TYPE declarations *)
i := 0;
LOOP (* LOOP to catch multiple declarations of one TYPE *)
ReadSymbol (str);
Assign (str, ScratchPad [i]);
SkipWhite;
ReadChar (ch);
IF ch = ':' THEN EXIT END;
IF ch # ',' THEN
ErrorMessage (18);
HALT
END;
INC (i)
END;
ReadSymbol (str);
ReadChar (ch);
IF ch # ';' THEN
ErrorMessage ( 9);
HALT
END;
type := DecodeType (str);
j := 0;
REPEAT
PoolAllocate (SymPool, ptr, TSIZE (SymRecord));
WITH LastSymbolRecord^ DO
next := ptr;
END;
WITH ptr^ DO
previous := LastSymbolRecord;
next := NIL;
Assign (name, ScratchPad [i]);
address := 0;
SymKind := Variable;
VarKind := type;
Used := FALSE;
END;
LastSymbolRecord := ptr;
INC (j);
UNTIL j = i;
END;
END StoreVars;
PROCEDURE StoreConsts;
VAR ch : CHAR;
BEGIN
LOOP (* Handle multiple CONST's *)
SkipWhite;
END;
END StoreConsts;
PROCEDURE SkipComment;
VAR ch, chr : CHAR;
BEGIN
WriteString ('Skipping comment... '); WriteBf;
INC (CommentDepth); (* Nested comments are allowed *)
REPEAT
ReadChar (ch);
IF (ch = '"') OR (ch = "'") THEN
LOOP
ReadChar (chr);
IF chr = ch THEN EXIT END
END
ELSIF ch = '(' THEN
ReadChar (ch);
IF ch = '*' THEN
INC (CommentDepth);
WriteCard (CommentDepth, 4); WriteBf;
ELSIF (ch = '"') OR (ch = "'") THEN
TextIO.UndoGetChar (inFile)
END
ELSIF ch = '*' THEN
ReadChar (ch);
IF ch = ')' THEN
DEC (CommentDepth);
WriteCard (CommentDepth, 4); WriteBf;
END
END;
UNTIL (CommentDepth = 0) OR ProgramEnd;
END SkipComment;
PROCEDURE Init;
VAR count : SHORTCARD;
BEGIN
ModuleNamed := FALSE;
MainEnd := FALSE;
MainBegin := FALSE;
MainEnd := FALSE;
NewPool (SymPool);
NewPool (ProcPool);
PoolAllocate (SymPool, LastSymbolRecord, TSIZE (SymRecord));
WITH LastSymbolRecord^ DO
previous := NIL;
next := NIL;
Assign (name, "End of list");
address := 0;
SymKind := Variable;
VarKind := Cardinal;
Used := FALSE;
END;
Line := 1; Column := 1;
GetArgs (count, args);
IF count = 1 THEN
UserMessage (4);
UserMessage (3);
HALT
END;
OpenInput (inFile, args^ [1]^);
IF TextIO.Done () = FALSE THEN
UserMessage (2);
UserMessage (3);
HALT
ELSE
WriteString ('File opened!'); WriteLn
END
END Init;
PROCEDURE Wrapup;
BEGIN
IF CommentDepth > 0 THEN
WriteString ('Unclosed comments :'); WriteCard (CommentDepth, 4);
WriteLn
END;
KillPool (SymPool);
KillPool (ProcPool);
END Wrapup;
PROCEDURE CheckKeyword (str : ARRAY OF CHAR);
VAR ch : CHAR;
BEGIN
WriteString ("Checking keyword : "); WriteString (str); WriteBf;
IF StrEq (str, 'MODULE') THEN
WriteString (" In MODULE ");
IF ModuleNamed = FALSE THEN (* MODULE already defined? *)
ModuleNamed := TRUE; (* If not, define it now *)
ReadSymbol (Word); (* Get name, ; terminated *)
ReadChar (ch);
IF ch = ';' THEN (* Wrong terminator? *)
ModuleName := Word;
RETURN
ELSE
ErrorMessage (9); (* Semicolon expected *)
HALT
END
ELSE
UserMessage (5); (* MODULEs may not be nested *)
HALT
END
ELSIF StrEq (str, 'CONST') THEN
StoreConsts;
RETURN
ELSIF StrEq (str, 'VAR') THEN
StoreVars;
RETURN
ELSIF StrEq (str, 'LOOP') THEN
INC (EndCounter);
RETURN
ELSIF StrEq (str, 'BEGIN') THEN
WriteString (" in BEGIN ");
IF MainBegin = TRUE THEN
ErrorMessage (11); (* BEGIN not allowed here *)
HALT
END;
IF ProcedureDepth = 0 THEN
MainBegin := TRUE
ELSE
ProcBegin := TRUE
END;
RETURN
ELSIF StrEq (str, '(*') THEN
SkipComment;
RETURN
ELSIF StrEq (str, 'END') THEN
WriteString (" checking end ");
WriteString ("Proceduredepth : "); WriteCard (ProcedureDepth, 4);
WriteBf;
IF ProcedureDepth > 0 THEN
ReadSymbol (Word);
ReadChar (ch);
IF ch # ';' THEN
ErrorMessage (9); (* Semicolon expected *)
HALT
ELSE
IF StrEq (Word, ProcedureName) THEN
DEC (ProcedureDepth);
ProcBegin := FALSE;
ELSE
ErrorMessage (14);
HALT
END
END
ELSE
IF MainBegin = FALSE THEN
ErrorMessage (12);
HALT
ELSE
ReadSymbol (Word);
ReadChar (ch);
IF ch # '.' THEN
UserMessage (8);
HALT
END;
IF StrEq (Word, ModuleName) = FALSE THEN
ErrorMessage (13);
HALT
END
END
END;
ProgramEnd := TRUE;
RETURN
ELSE
ErrorMessage (20);
HALT
END
END CheckKeyword;
BEGIN
Init;
LOOP
ReadSymbol (Word);
WriteString ("Line :"); WriteCard (Line, 3); WriteString (" -> ");
WriteString (Word); Write (" ");
WriteBf;
CheckKeyword (Word);
WriteString (" eXit "); WriteBf;
IF ProgramEnd = TRUE THEN
WriteLn;
WriteString ("End of source reached. Quiting.");
WriteLn;
WriteBf;
EXIT
END;
WriteString (" Exit ");
WriteLn; WriteBf;
END;
WriteString ("Wrapping up."); WriteLn;
Wrapup;
END SynChk02.
Page created December 2005,
Page equipped with GoogleBuster technology