IMPLEMENTATION MODULE Scan ;
IMPORT StdIO ;
FROM ASCII IMPORT nul, lf, cr, bs, del, bel ;
FROM StdIO IMPORT Write ;
FROM StrLib IMPORT StrEqual, StrLen, StrCopy ;
FROM NumberIO IMPORT WriteCard, CardToStr ;
FROM FIO IMPORT OpenToRead, IsNoError, Close, File, ReadChar ;
FROM StrIO IMPORT WriteLn, WriteString ;
FROM libc IMPORT exit ;
CONST
MaxLength = 255 ;
VAR
FileName,
CurrentString : ARRAY [0..MaxLength] OF CHAR ;
CurrentLineNo : CARDINAL ;
CurrentCursorPos : CARDINAL ;
EOF : BOOLEAN ;
LengthOfCurSym : CARDINAL ;
f : File ;
Opened : BOOLEAN ;
HaltOnError : BOOLEAN ;
AllowComments : BOOLEAN ;
CommentLeader,
CommentTrailer : ARRAY [0..MaxLength] OF CHAR ;
TerminateOnEndOfLine: BOOLEAN ;
InString : BOOLEAN ;
PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
BEGIN
StrCopy(a, FileName) ;
f := OpenToRead(a) ;
IF IsNoError(f)
THEN
StrCopy( '', CurrentString ) ;
LengthOfCurSym := 0 ;
CurrentCursorPos := 0 ;
EOF := FALSE ;
CurrentLineNo := 1 ;
Opened := TRUE
ELSE
Opened := FALSE
END ;
RETURN( Opened )
END OpenSource ;
PROCEDURE CloseSource ;
BEGIN
IF Opened
THEN
Close( f ) ;
Opened := FALSE
END
END CloseSource ;
PROCEDURE IsStartOfComment () : BOOLEAN ;
VAR
i, h: CARDINAL ;
BEGIN
IF AllowComments
THEN
i := 0 ;
h := StrLen(CommentLeader) ;
WHILE (i<h) AND (CommentLeader[i]=CurrentString[CurrentCursorPos+i]) DO
INC(i)
END ;
RETURN( i=h )
ELSE
RETURN( FALSE )
END
END IsStartOfComment ;
PROCEDURE IsEndOfComment () : BOOLEAN ;
VAR
i, h: CARDINAL ;
BEGIN
IF AllowComments
THEN
IF TerminateOnEndOfLine AND (SymbolChar()=nul)
THEN
NextChar ;
RETURN( TRUE )
ELSE
i := 0 ;
h := StrLen(CommentTrailer) ;
WHILE (i<h) AND (CommentTrailer[i]=CurrentString[CurrentCursorPos+i]) DO
INC(i)
END ;
IF (i=h) AND (h#0)
THEN
INC(CurrentCursorPos, i) ;
RETURN( TRUE )
ELSE
RETURN( FALSE )
END
END
ELSE
RETURN( FALSE )
END
END IsEndOfComment ;
PROCEDURE IsQuote () : BOOLEAN ;
BEGIN
RETURN( SymbolChar()='"' )
END IsQuote ;
PROCEDURE GetNextSymbol (VAR a: ARRAY OF CHAR) ;
VAR
index,
High : CARDINAL ;
BEGIN
index := 0 ;
High := HIGH( a ) ;
ChuckUpToSymbol ;
IF InString
THEN
IF (NOT EOF) AND (NOT IsStartOfComment()) AND (index<High) AND IsQuote()
THEN
a[index] := SymbolChar() ;
NextChar ;
INC(index) ;
InString := FALSE ;
ELSE
WHILE (index<High) AND (NOT EOF) AND (SymbolChar()#nul) AND (NOT IsQuote()) DO
a[index] := SymbolChar() ;
NextChar ;
INC(index)
END ;
IF NOT IsQuote()
THEN
WriteError('unterminated string, strings must terminate before the end of a line')
END ;
END
ELSE
IF (NOT EOF) AND (NOT IsStartOfComment())
THEN
IF (index<High) AND IsQuote()
THEN
a[index] := SymbolChar() ;
NextChar ;
INC(index) ;
InString := TRUE ;
ELSE
WHILE (index<High) AND (NOT NonSymbolChar()) AND (NOT IsStartOfComment()) DO
a[index] := SymbolChar() ;
NextChar ;
INC(index)
END
END
END
END ;
IF index<High
THEN
a[index] := nul
END ;
LengthOfCurSym := index
END GetNextSymbol ;
PROCEDURE ChuckUpToSymbol ;
BEGIN
REPEAT
IF (NOT EOF) AND IsStartOfComment()
THEN
NextChar ;
WHILE (NOT EOF) AND (NOT IsEndOfComment()) DO
NextChar
END
END ;
WHILE (NOT EOF) AND NonSymbolChar() DO
NextChar
END
UNTIL EOF OR (NOT IsStartOfComment())
END ChuckUpToSymbol ;
PROCEDURE SymbolChar () : CHAR ;
BEGIN
IF EOF
THEN
RETURN( nul )
ELSE
IF CurrentCursorPos<StrLen(CurrentString)
THEN
RETURN( CurrentString[CurrentCursorPos] )
ELSE
RETURN( nul )
END
END
END SymbolChar ;
PROCEDURE NextChar ;
BEGIN
IF NOT EOF
THEN
IF CurrentCursorPos<StrLen(CurrentString)
THEN
INC(CurrentCursorPos)
ELSE
ReadString(CurrentString) ;
INC(CurrentLineNo) ;
CurrentCursorPos := 0 ;
LengthOfCurSym := 0
END
END
END NextChar ;
PROCEDURE NonSymbolChar () : BOOLEAN ;
BEGIN
RETURN( CurrentString[CurrentCursorPos]<=' ' )
END NonSymbolChar ;
PROCEDURE WriteError (a: ARRAY OF CHAR) ;
VAR
i, j : CARDINAL ;
LineNo: ARRAY [0..20] OF CHAR ;
BEGIN
WriteString(FileName) ;
Write(':') ;
CardToStr(CurrentLineNo, 0, LineNo) ;
WriteString(LineNo) ;
Write(':') ;
WriteString( CurrentString ) ; WriteLn ;
WriteString(FileName) ;
Write(':') ;
WriteString(LineNo) ;
Write(':') ;
i := 0 ;
j := CurrentCursorPos-LengthOfCurSym ;
WHILE i<j DO
Write(' ') ;
INC( i )
END ;
FOR i := 1 TO LengthOfCurSym DO
Write('^')
END ;
WriteLn ;
WriteString(FileName) ;
Write(':') ;
WriteString(LineNo) ;
Write(':') ;
WriteString( a ) ; WriteLn ;
IF HaltOnError
THEN
exit(1)
END
END WriteError ;
PROCEDURE ReadString (VAR a: ARRAY OF CHAR) ;
VAR
n ,
high : CARDINAL ;
ch : CHAR ;
BEGIN
high := HIGH( a ) ;
n := 0 ;
REPEAT
Read( ch ) ;
IF (ch=del) OR (ch=bs)
THEN
IF n=0
THEN
Write( bel )
ELSE
Write( bs ) ;
Write(' ') ;
Write( bs ) ;
DEC( n )
END
ELSIF n <= high
THEN
IF (ch = cr) OR (cr = lf)
THEN
a[n] := nul
ELSE
a[n] := ch
END ;
INC( n )
ELSE
ch := cr
END
UNTIL ch = cr
END ReadString ;
PROCEDURE Read (VAR ch: CHAR) ;
BEGIN
IF Opened
THEN
ch := ReadChar(f) ;
EOF := NOT IsNoError(f)
ELSE
StdIO.Read( ch )
END ;
IF ch=lf THEN ch := cr END
END Read ;
PROCEDURE TerminateOnError ;
BEGIN
HaltOnError := TRUE
END TerminateOnError ;
PROCEDURE DefineComments (Start, End: ARRAY OF CHAR; eoln: BOOLEAN) ;
BEGIN
TerminateOnEndOfLine := eoln ;
StrCopy(Start, CommentLeader) ;
StrCopy(End, CommentTrailer) ;
AllowComments := StrLen(CommentLeader)>0
END DefineComments ;
BEGIN
InString := FALSE ;
AllowComments := FALSE ;
TerminateOnEndOfLine := FALSE ;
StrCopy('' , CurrentString) ;
LengthOfCurSym := 0 ;
CurrentCursorPos := 0 ;
EOF := FALSE ;
CurrentLineNo := 1 ;
Opened := FALSE ;
HaltOnError := FALSE
END Scan.