path: root/gcc/m2/gm2-compiler/M2Lex.mod

(* M2Lex.mod provides a non tokenised lexical analyser.

Copyright (C) 2001-2023 Free Software Foundation, Inc.
Contributed by Gaius Mulley <gaius.mulley@southwales.ac.uk>.

This file is part of GNU Modula-2.

GNU Modula-2 is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 3, or (at your option)
any later version.

GNU Modula-2 is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
General Public License for more details.

You should have received a copy of the GNU General Public License
along with GNU Modula-2; see the file COPYING3.  If not see
<http://www.gnu.org/licenses/>.  *)

IMPLEMENTATION MODULE M2Lex ;


FROM FIO IMPORT File, OpenToRead, ReadChar, Close, IsNoError ;
FROM StrIO IMPORT ReadString, WriteString, WriteLn ;
FROM StdIO IMPORT Write ;
FROM NumberIO IMPORT WriteCard ;
FROM ASCII IMPORT nul, lf, cr, EOL ;
FROM StrLib IMPORT StrCopy, StrEqual, StrLen ;


CONST
   LineBuf = 1 ;
   Wrap    = LineBuf+1 ;
   eof     = 032C ;
   MaxStack= 10 ;

VAR
   f: File ;
   Opened        : BOOLEAN ;
   CurrentChar   : CHAR ;
   NextChar      : CHAR ;
   FileName      : ARRAY [0..MaxLine] OF CHAR ;
   Lines         : ARRAY [0..LineBuf] OF ARRAY [0..255] OF CHAR ;
                (* Need two lines since the delimiter of the CurrentSymbol *)
                (* maybe on the next line.                                 *)
   HighNext      : CARDINAL ;  (* Length of the NextChar line.             *)
   CurLine       : CARDINAL ;  (* Line number of the Current Char Line.    *)
   NextLine      : CARDINAL ;  (* Line number of the Next Char Line.       *)
   IndexCur      : CARDINAL ;  (* Index to the Lines array for Current Ln  *)
   IndexNext     : CARDINAL ;  (* Index to the Lines array for NextChar Ln *)
   CurSym        : CARDINAL ;  (* Character start of the CurrentSymbol     *)
   CurSymLine    : CARDINAL ;  (* Line number of the CurrentSymbol         *)
   CurCharIndex  : CARDINAL ;  (* Character number of CurChar.             *)
   NextCharIndex : CARDINAL ;  (* Character number of NextChar.            *)
   Eof           : BOOLEAN ;   (* End of source file.                      *)
   InQuotes      : BOOLEAN ;   (* If we are in quotes.                     *)
   QuoteChar     : CHAR ;      (* Quote character expected.                *)
   Stack         : ARRAY [0..MaxStack] OF ARRAY [0..255] OF CHAR ;
   StackPtr      : CARDINAL ;


(*
   IsSym - returns the result of the comparison between CurrentSymbol
           and Name.
*)

PROCEDURE IsSym (Name: ARRAY OF CHAR) : BOOLEAN ;
BEGIN
   RETURN( StrEqual(CurrentSymbol, Name) )
END IsSym ;


(*
   SymIs - if Name is equal to the CurrentSymbol the next Symbol is read
           and true is returned, otherwise false is returned.
*)

PROCEDURE SymIs (Name: ARRAY OF CHAR) : BOOLEAN ;
BEGIN
   IF StrEqual(CurrentSymbol, Name)
   THEN
      GetSymbol ;
      RETURN( TRUE )
   ELSE
      RETURN( FALSE )
   END
END SymIs ;


(*
   WriteError - displays the source line and points to the symbol in error.
                The message, a, is displayed.
*)

PROCEDURE WriteError (a: ARRAY OF CHAR) ;
VAR
   i: CARDINAL ;
BEGIN
   WriteString(FileName) ; Write(':') ; WriteCard(CurSymLine, 0) ; Write(':') ; WriteString(a) ;
   WriteLn ;
   WriteString( Lines[IndexCur] ) ; WriteLn ;
   i := CurSym ;
   WHILE i>0 DO
      Write(' ') ;
      DEC(i)
   END ;
   i := StrLen(CurrentSymbol) ;
   WHILE i>0 DO
      Write('^') ;
      DEC(i)
   END ;
   WriteLn ;
   WriteString(a) ; WriteLn ;
END WriteError ;


(*
   OpenSource - Attempts to open the source file, a.
                The success of the operation is returned.
*)

PROCEDURE OpenSource (a: ARRAY OF CHAR) : BOOLEAN ;
BEGIN
   f := OpenToRead(a) ;
   IF IsNoError(f)
   THEN
      StrCopy(a, FileName) ;
      Opened := TRUE ;
      Init ;
      RETURN( TRUE )
   ELSE
      Opened := FALSE ;
      Eof := TRUE ;
      RETURN( FALSE )
   END
END OpenSource ;


(*
   CloseSource - Closes the current open file.
*)

PROCEDURE CloseSource ;
BEGIN
   IF Opened=TRUE
   THEN
      Opened := FALSE ;
      Close( f )
   END
END CloseSource ;


(*
   GetSymbol - gets the next Symbol into CurrentSymbol.
*)

PROCEDURE GetSymbol ;
BEGIN
   StrCopy( CurrentSymbol, LastSymbol ) ;
   IF StackPtr>0
   THEN
      DEC(StackPtr) ;
      StrCopy( Stack[StackPtr], CurrentSymbol )
   ELSE
      ReadSymbol( CurrentSymbol )
   END
END GetSymbol ;


(*
   PutSymbol - pushes a symbol, Name, back onto the input.
               GetSymbol will set CurrentSymbol to, Name.
*)

PROCEDURE PutSymbol (Name: ARRAY OF CHAR) ;
BEGIN
   IF StackPtr=MaxStack
   THEN
      WriteError('Maximum push back symbol exceeded - Increase CONST MaxStack')
   ELSE
      StrCopy(Name, Stack[StackPtr]) ;
      INC(StackPtr)
   END
END PutSymbol ;


PROCEDURE ReadSymbol (VAR a: ARRAY OF CHAR) ;
VAR
   high,
   i    : CARDINAL ;
   ok   : BOOLEAN ;
BEGIN
   high := HIGH(a) ;
   IF NOT Eof
   THEN
      IF InQuotes
      THEN
         i := 0 ;
         IF CurrentChar=QuoteChar
         THEN
            InQuotes := FALSE ;
            a[i] := QuoteChar ;
            INC(i) ;
            AdvanceChar
         ELSE
            (* Fill in string or character *)
            i := 0 ;
            REPEAT
               a[i] := CurrentChar ;
               INC(i) ;
               AdvanceChar
            UNTIL (CurrentChar=QuoteChar) OR Eof OR (i>high) ;
         END
      ELSE
         (* Get rid of all excess spaces *)

         REPEAT
            IF CurrentChar=' '
            THEN
               WHILE (CurrentChar=' ') AND (NOT Eof) DO
                  AdvanceChar
               END ;
               ok := FALSE
            ELSIF (CurrentChar='(') AND (NextChar='*')
            THEN
      	       ConsumeComments ;
               ok := FALSE
            ELSE
              ok := TRUE
            END
         UNTIL ok ;
         i := 0 ;
         CurSym := CurCharIndex ;
         CurSymLine := CurLine ;
         IF (CurrentChar='"') OR (CurrentChar="'")
         THEN
            InQuotes := TRUE ;
            QuoteChar := CurrentChar ;
            a[i] := CurrentChar ;
            AdvanceChar ;
            INC(i)
         ELSIF DoubleDelimiter()
         THEN
            a[i] := CurrentChar ;
            AdvanceChar ;
            INC(i) ;
            a[i] := CurrentChar ;
            AdvanceChar ;
            INC(i)
         ELSIF Delimiter()
         THEN
            a[i] := CurrentChar ;
            AdvanceChar ;
            INC(i)
         ELSE
            REPEAT
               a[i] := CurrentChar ;
               AdvanceChar ;
               INC(i)
            UNTIL Delimiter() OR (i>high) OR (CurrentChar=' ') OR Eof
         END
      END
   ELSE
      (* eof *)
      i := 0 ;
      a[i] := eof ;
      INC(i)
   END ;
   IF i<=HIGH(a)
   THEN
      a[i] := nul
   END
END ReadSymbol ;


(*
   ConsumeComments - consumes Modula-2 comments.
*)

PROCEDURE ConsumeComments ;
VAR
   Level: CARDINAL ;
BEGIN
   Level := 0 ;
   REPEAT
      IF (CurrentChar='(') AND (NextChar='*')
      THEN
         INC(Level)
      ELSIF (CurrentChar='*') AND (NextChar=')')
      THEN
         DEC(Level)
      END ;
      AdvanceChar ;
   UNTIL (Level=0) OR Eof ;
   AdvanceChar
END ConsumeComments;


(* Delimiter returns true if and only if CurrentChar is a delimiter *)

PROCEDURE Delimiter() : BOOLEAN ;
BEGIN
   IF (CurrentChar='-') OR
      (CurrentChar='+') OR (CurrentChar='*') OR (CurrentChar='\') OR
      (CurrentChar='|') OR (CurrentChar='(') OR (CurrentChar=')') OR
      (CurrentChar='"') OR (CurrentChar="'") OR (CurrentChar='{')
   THEN
      RETURN( TRUE )
   ELSIF
      (CurrentChar='}') OR (CurrentChar='[') OR (CurrentChar=']') OR
      (CurrentChar='#') OR (CurrentChar='=') OR (CurrentChar='<')
   THEN
      RETURN( TRUE )
   ELSIF
      (CurrentChar='>') OR (CurrentChar='.') OR (CurrentChar=';') OR
      (CurrentChar=':') OR (CurrentChar='^') OR (CurrentChar=',')
   THEN
      RETURN( TRUE )
   ELSE
      RETURN( FALSE )
   END
END Delimiter ;


PROCEDURE DoubleDelimiter () : BOOLEAN ;
BEGIN
   RETURN (
           ((CurrentChar='>') AND (NextChar='=')) OR
           ((CurrentChar='<') AND (NextChar='=')) OR
           ((CurrentChar='<') AND (NextChar='>')) OR
           ((CurrentChar=':') AND (NextChar='=')) OR
           ((CurrentChar='.') AND (NextChar='.'))
          )
END DoubleDelimiter ;


PROCEDURE AdvanceChar ;
BEGIN
   IF NOT Eof
   THEN
      CurrentChar := NextChar ;
      CurCharIndex := NextCharIndex ;
      IndexCur := IndexNext ;
      CurLine := NextLine ;
      IF CurrentChar=eof
      THEN
         Eof := TRUE
      ELSIF NextCharIndex=HighNext
      THEN
         IndexNext := (IndexCur+1) MOD Wrap ;
         HighNext := 0 ;
         REPEAT
            NextChar := ReadChar(f) ;
            IF NOT IsNoError(f)
            THEN
               NextChar := eof ;
               Lines[IndexNext][HighNext] := NextChar ;
               INC( HighNext )
            END ;
            WHILE (NextChar#eof) AND (NextChar#lf) AND (NextChar#cr) AND (HighNext<MaxLine) DO
               Lines[IndexNext][HighNext] := NextChar ;
               INC( HighNext ) ;
               NextChar := ReadChar(f) ;
               IF NOT IsNoError(f)
               THEN
                  NextChar := eof
               END
            END ;
            IF (NextChar=eof) OR (NextChar=lf) OR (NextChar=cr)
            THEN
               IF InQuotes
               THEN
                  Lines[IndexNext][HighNext] := ' ' ;  (* Space for delimiter *)
                  Lines[IndexNext][HighNext+1] := nul ;
                  WriteError('missing end of quote on this source line') ; HALT
               END ;
               INC( NextLine )
            END
         UNTIL HighNext>0 ;
         IF HighNext>=MaxLine THEN WriteError('Line too long') ; HALT END ;
         Lines[IndexNext][HighNext] := ' ' ;  (* Space for delimiter *)
         Lines[IndexNext][HighNext+1] := nul ;
         NextCharIndex := 0 ;
         NextChar := Lines[IndexNext][NextCharIndex]
      ELSE
         INC(NextCharIndex) ;
         NextChar := Lines[IndexNext][NextCharIndex]
      END
   END
END AdvanceChar ;


PROCEDURE Init ;
BEGIN
   StackPtr := 0 ;
   InQuotes := FALSE ;
   Eof := FALSE ;
   IndexCur := 1 ;
   IndexNext := 0 ;
   CurCharIndex := 0 ;
   Lines[IndexCur][0] := nul ;
   HighNext := 0 ;
   NextCharIndex := 0 ;
   CurLine := 1 ;
   NextLine := 1 ;
   CurrentChar := ' ' ;
   NextChar := ' ' ;
   StrCopy("", CurrentSymbol) ;
   StrCopy("", LastSymbol) ;
   IndexCur := IndexNext
END Init ;


BEGIN
   Init
END M2Lex.