Club Amiga de Montreal - CAM/CAM_CD_1.iso/files/549b.lha/M2P_v1.0_sources/source.lzh/FSM.mpp

Text File | 1991-08-10 | 23KB | 669 lines

(*======================================================================*)
(*            Modula-2 Lexical Analyzer  --  Finite State Machine       *)
(*======================================================================*)
(*  Version:  1.00              Author:   Dennis Brueni                 *)
(*  Date:     04-29-91          Changes:  original                      *)
(*======================================================================*)
(*  This module contains the definitions and initialization code for    *)
(*  the major tables used by the Finite State Machine of the Lexical    *)
(*  Analyzer.                                                           *)
(*======================================================================*)

IMPLEMENTATION MODULE FSM;

IMPORT SYSTEM,ASCII,FIO;
IMPORT Err,HashTab;

@INCLUDE "MACROS"

@NoRangeChecks
@NoVChecks

CONST FirstCh = MIN(Alphabet);
      LastCh  = MAX(Alphabet);

(************************************************************************)

TYPE HashTabEntry = POINTER TO HTEntry;

     HTEntry = RECORD
                  KW     : POINTER TO StringsType;
                  KWType : Lexicals;
               END;

(*----------------------------------------------------------------------*)
(*  Global (to module) variables.                                       *)
(*----------------------------------------------------------------------*)

VAR token:       Lexicals;

    KeyWords:    ARRAY [MIN(Lexicals)..M2NOT] OF HTEntry;
    HT:          HashTab.HashTable;

VAR ch:          CHAR;                          (* Current INPUT CHAR   *)
    PBack:       BOOLEAN;                       (* PBack done?          *)
    State:       States;                        (* Current State        *)
    CommNest:    CARDINAL;                      (* Current Nesting Level*)

(************************************************************************)
(**                             ACTIONS                                 *)
(************************************************************************)
(*--PUSHBACK--Pushes the most recently read charactor back--------------*)

@NoLongAddressing

PROCEDURE PushBack;
BEGIN
   @MACRO PushBack PBack:=TRUE @ENDM
   @PushBack;
END PushBack;

(*--EMIT--Adds the charactor to the output string-----------------------*)

PROCEDURE Emit;
BEGIN
   WITH Token DO
      IF Length >= TokenSize THEN
         Err.Message(Err.TokTooLong);
      ELSE
         String[Length]:=ch;
         INC(Length);
      END;
   END;
END Emit;

(*--UNEMIT--Removes a charactor from the output string------------------*)

PROCEDURE UnEmit;
BEGIN
   WITH Token DO
      DEC(Length);
      String[Length]:=ASCII.NUL;
   END;
END UnEmit;

(*--ERROR--Writes the appropriate error message-------------------------*)

PROCEDURE Error;

VAR mess: Err.Names;
BEGIN
   CASE State OF
      STStr:           mess:=Err.StrNotEnded;
     |STCommBeg,
      STCommSkip,
      STCommNest,
      STCommEnd,
      STCommLine:      mess:=Err.ComNotEnded;
   ELSE
      mess:=Err.IFail;
   END;
   Err.Message(mess);
   State:=STStart;
   Token.Length:=0;
   CommNest:=0;
END Error;

(*--NOTHING--ignores the current input charactor.-----------------------*)

PROCEDURE Nothing;
BEGIN END Nothing;

(*--LINEECHO--Echo the current INPUT charactor if a linefeed------------*)

PROCEDURE LineEcho;
BEGIN
   INC(Err.LineNum);
   IF IncludeLevel # 0 THEN
      ch:=' ';
      DEC(Err.LineNum);
   END;
   FIO.WriteChar(DestFile,ch);
END LineEcho;

(*--ECHOCOMMENT--Echo a charactor in a comment to the output file------*)

PROCEDURE EchoComment;
BEGIN
   IF NOT StripFlag THEN
      FIO.WriteChar(DestFile,ch);
   END;
END EchoComment;

(*--INCOMMENT--Increment the comment nesting level count----------------*)

PROCEDURE InComment;
BEGIN
   INC(CommNest);
   IF NOT StripFlag THEN
      FIO.WriteChar(DestFile,'(');
      FIO.WriteChar(DestFile,'*');
      EchoComment;
   END;
END InComment;

(*--OUTCOMMENT--Decrement the comment nesting level count---------------*)

PROCEDURE OutComment;
BEGIN
   DEC(CommNest);
   IF CommNest=0 THEN
      State:=STSkipSpaces;     (* replace comment with single space    *)
   END;
   EchoComment;
END OutComment;

(*--ACCATSIGN--Accept an '@'-------------------------------------------*)

@LongAddressing

PROCEDURE AccAtSign;
BEGIN Emit;
      Token.Class:=M2AtSign;
END AccAtSign;

(*--ACCNOT--Accept a tilde (not)---------------------------------------*)

PROCEDURE AccNot;
BEGIN Emit;
      Token.Class:=M2NOT;
END AccNot;

(*--ACCCOMMA--Accept a comma-------------------------------------------*)

PROCEDURE AccComma;
BEGIN Emit;
      Token.Class:=M2Comma;
END AccComma;

(*--ACCLPAREN--Accept a left parenthesis-------------------------------*)

PROCEDURE AccLParen;
BEGIN @PushBack;
      Token.Class:=M2LParen;
END AccLParen;

(*--ACCRPAREN--Accept a right parenthesis------------------------------*)

PROCEDURE AccRParen;
BEGIN Emit;
      Token.Class:=M2RParen;
END AccRParen;

(*--ACCAND--Accept a & (and)-------------------------------------------*)

PROCEDURE AccAnd;
BEGIN Emit;
      Token.Class:=M2AND;
END AccAnd;

(*--ACCOR--Accept a vertical bar (or)----------------------------------*)

PROCEDURE AccOr;
BEGIN Emit;
      Token.Class:=M2OR;
END AccOr;

(*--ACCString--Accept a string (for include filenames)-----------------*)

PROCEDURE AccString;
BEGIN
   Token.Class:=M2String;
END AccString;

(*--ACCString--Accept a single quoted string --------------------------*)

PROCEDURE AccStr;
BEGIN
   Token.Class:=M2Str;
END AccStr;

(*--ACCCH--Accept any charactor----------------------------------------*)

PROCEDURE Accch;
BEGIN Emit;
      Token.Class:=M2ch;
END Accch;

(*--ACCEOF--Accept EOF condition---------------------------------------*)

PROCEDURE AccEOF;
BEGIN Token.Class:=M2EOF;
END AccEOF;

(*--AccDir--Accept a directive start-----------------------------------*)

@NoLongAddressing

PROCEDURE AccDir;
BEGIN IF CommNest=0 THEN
         WITH Token DO
            String:='(*$';
            Class:=M2Block;
            Length:=3;
         END;
      ELSE
         State:=STCommSkip;
         INC(CommNest);
      END;
END AccDir;

(*--ACCSPACE--Accept a space-------------------------------------------*)

PROCEDURE AccSpace;
BEGIN @PushBack;
      WITH Token DO
         String[0]:=' ';
         Length:=1;
         Class:=M2ch;
      END;
END AccSpace;

(*--ACCID--Accept an identifier----------------------------------------*)

PROCEDURE AccID;
VAR KeyWord: POINTER TO HTEntry;
BEGIN
   @PushBack;
   WITH Token DO
      String[Length]:=ASCII.NUL;
      KeyWord:=HashTab.Search(HT,String);
      IF KeyWord # NIL THEN
         Class:=KeyWord^.KWType;
      ELSE
         Class:=M2ID;
      END;
   END;
END AccID;

(************************************************************************)
(*----------------------------------------------------------------------*)
(*  GETBSU      Gets the next Basic Syntactic Unit from the source      *)
(*              file.  This is the driver of the Finite State Machine.  *)
(*----------------------------------------------------------------------*)

PROCEDURE GetBSU;

VAR Delta:   StateTabEntry;
BEGIN
   Token.Length:=0;
   State:=STStart;
   WITH Delta DO
      WHILE State # STTerm DO
         IF NOT PBack THEN
            ch:=FIO.ReadChar(SourceFile);
         END;
         PBack:=FALSE;
         Delta:=Transitions[State,CharClass[ch]];
         State:=NextState;
         Action();
      END;
   END;
   WITH Token DO
      String[Length]:=ASCII.NUL;
   END;
END GetBSU;

(*----------------------------------------------------------------------*)
(*  LAMBDA      Fills in lambda transitions for finite state machine    *)
(*                                                                      *)
(*  PARAMETERS  State - the state to initialize                         *)
(*              next  - the next state to visit                         *)
(*              act   - the action to take                              *)
(*                                                                      *)
(*  CALLED BY   Main initialization code                                *)
(*----------------------------------------------------------------------*)

PROCEDURE Lambda(State,next: States; act: PROC);

VAR chclass:     Alphabet;              (* Counter used for Lambda defs *)
BEGIN
   FOR chclass := FirstCh TO LastCh DO
      Transitions[State,chclass].NextState:=next;
      Transitions[State,chclass].Action   :=act;
   END;
END Lambda;

(************************************************************************)
(*  Lots and Lots of Initialization code for Lexical Analyzer           *)
(************************************************************************)

BEGIN
   PBack:=FALSE;
   CommNest:=0;
   IncludeLevel:=0;
   StripFlag:=TRUE;
   SourceFile:=FIO.INPUT;
   DestFile:=FIO.OUTPUT;

(*----------------------------------------------------------------------*)
(* Set up the strings for the lexical units                             *)
(*----------------------------------------------------------------------*)

   Strings[M2IF]       := "IF";
   Strings[M2THEN]     := "THEN";
   Strings[M2ELSIF]    := "ELSIF";
   Strings[M2ELSE]     := "ELSE";
   Strings[M2END]      := "END";
   Strings[M2DEFINE]   := "DEFINE";
   Strings[M2UNDEF]    := "UNDEF";
   Strings[M2INCLUDE]  := "INCLUDE";
   Strings[M2MACRO]    := "MACRO";
   Strings[M2ENDM]     := "ENDM";
   Strings[M2LINE]     := "LINE";
   Strings[M2SPACE]    := "SPACE";
   Strings[M2STRIP]    := "STRIP";
   Strings[M2NOSTRIP]  := "NOSTRIP";
   Strings[M2AND]      := "AND";
   Strings[M2OR]       := "OR";
   Strings[M2NOT]      := "NOT";
   Strings[M2ID]       := "ID";
   Strings[M2RParen]   := "RParen";
   Strings[M2LParen]   := "LParen";
   Strings[M2AtSign]   := "AtSign";
   Strings[M2Comma]    := "Comma";
   Strings[M2ch]       := "ch";
   Strings[M2String]   := "String";
   Strings[M2Str]      := "Str";
   Strings[M2KillArg]  := "KillArg";     (* not a real token! *)
   Strings[M2EOF]      := "EOF";

(*----------------------------------------------------------------------*)
(* Populate the Hash table.                                             *)
(*----------------------------------------------------------------------*)

   HashTab.Create(HT,31);
   FOR token:=MIN(Lexicals) TO M2NOT DO
      KeyWords[token].KWType:=token;
      KeyWords[token].KW:=SYSTEM.ADR(Strings[token]);
      HashTab.Insert(HT,SYSTEM.ADR(KeyWords[token]));
   END;

(*----------------------------------------------------------------------*)
(* Each ASCII charactor falls into a distinct classification in order   *)
(* to cut down the size of the State-Change tables for the FSM.         *)
(*----------------------------------------------------------------------*)

   FOR ch:=MIN(CHAR) TO MAX(CHAR) DO
      CharClass[ch]:=CHNoClass;
   END;
   CharClass[ASCII.HT]:=CHSpace;
   CharClass[ASCII.LF]:=CHEOLN;
   CharClass[ASCII.VT]:=CHEOLN;
   CharClass[ASCII.FF]:=CHEOLN;
   CharClass[ASCII.CR]:=CHEOLN;
   CharClass[ASCII.FS]:=CHEOF;
   CharClass[' ']:=CHSpace;
   CharClass['"']:=CHDQuote;
   CharClass['$']:=CHDollar;
   CharClass['&']:=CHAnd;
   CharClass[47C]:=CHSQuote;
   CharClass['(']:=CHLParen;
   CharClass[')']:=CHRParen;
   CharClass['*']:=CHStar;
   CharClass[',']:=CHComma;
   FOR ch:='0' TO '9' DO
      CharClass[ch]:=CHDigit;
   END;
   CharClass['@']:=CHAtSign;
   FOR ch:='A' TO 'Z' DO
      CharClass[ch]:=CHLetter;
   END;
   CharClass[134C]:=CHBSlash;
   CharClass['_']:=CHLetter;
   FOR ch:='a' TO 'z' DO
      CharClass[ch]:=CHLetter;
   END;
   CharClass['|']:=CHOr;
   CharClass['~']:=CHNot;

(*----------------------------------------------------------------------*)
(*  Define the transitions for the Finite State Automata.               *)
(*----------------------------------------------------------------------*)
(*  For each states, the transitions and imbedded actions are defined   *)
(*  using the following convention.                                     *)
(*                                                                      *)
(*      (1)  The lambda transition is defined.                          *)
(*                                                                      *)
(*      (2)  Meaningful (non-Lambda) transitions are then defined.      *)
(*----------------------------------------------------------------------*)

(************************************************************************)
(*                      START STATE                                     *)
(************************************************************************)

   Lambda(STStart,STTerm,Accch);

   Transitions[STStart,CHLetter].NextState    :=STID;
   Transitions[STStart,CHLetter].Action       :=Emit;

   Transitions[STStart,CHEOF].NextState       :=STTerm;
   Transitions[STStart,CHEOF].Action          :=AccEOF;

   Transitions[STStart,CHEOLN].NextState      :=STStart;
   Transitions[STStart,CHEOLN].Action         :=LineEcho;

   Transitions[STStart,CHDQuote].NextState    :=STString;
   Transitions[STStart,CHDQuote].Action       :=Nothing;

   Transitions[STStart,CHSQuote].NextState    :=STStr;
   Transitions[STStart,CHSQuote].Action       :=Nothing;

   Transitions[STStart,CHComma].NextState     :=STTerm;
   Transitions[STStart,CHComma].Action        :=AccComma;

   Transitions[STStart,CHLParen].NextState    :=STLParen;
   Transitions[STStart,CHLParen].Action       :=Emit;

   Transitions[STStart,CHRParen].NextState    :=STTerm;
   Transitions[STStart,CHRParen].Action       :=AccRParen;

   Transitions[STStart,CHComma].NextState     :=STTerm;
   Transitions[STStart,CHComma].Action        :=AccComma;

   Transitions[STStart,CHOr].NextState        :=STTerm;
   Transitions[STStart,CHOr].Action           :=AccOr;

   Transitions[STStart,CHAnd].NextState       :=STTerm;
   Transitions[STStart,CHAnd].Action          :=AccAnd;

   Transitions[STStart,CHNot].NextState       :=STTerm;
   Transitions[STStart,CHNot].Action          :=AccNot;

   Transitions[STStart,CHAtSign].NextState    :=STTerm;
   Transitions[STStart,CHAtSign].Action       :=AccAtSign;

   Transitions[STStart,CHSpace].NextState     :=STSkipSpaces;
   Transitions[STStart,CHSpace].Action        :=Nothing;

(************************************************************************)
(*                      IDENTIFIER?                                     *)
(************************************************************************)

   Lambda(STID,STTerm,AccID);

   Transitions[STID,CHLetter].NextState       :=STID;
   Transitions[STID,CHLetter].Action          :=Emit;

   Transitions[STID,CHDigit].NextState        :=STID;
   Transitions[STID,CHDigit].Action           :=Emit;

(************************************************************************)
(*                        SKIP WHITESPACE                               *)
(************************************************************************)

   Lambda(STSkipSpaces,STTerm,AccSpace);

   Transitions[STSkipSpaces,CHSpace].NextState:=STSkipSpaces;
   Transitions[STSkipSpaces,CHSpace].Action   :=Nothing;

   Transitions[STSkipSpaces,CHEOLN].NextState :=STStart;
   Transitions[STSkipSpaces,CHEOLN].Action    :=LineEcho;

   Transitions[STSkipSpaces,CHEOF].NextState  :=STTerm;
   Transitions[STSkipSpaces,CHEOF].Action     :=AccEOF;

(************************************************************************)
(*               DOUBLE-QUOTED STRING LITERAL BEGINNING                 *)
(************************************************************************)

   Lambda(STString,STString,Emit);

   Transitions[STString,CHEOLN].NextState     :=STString;
   Transitions[STString,CHEOLN].Action        :=Error;

   Transitions[STString,CHEOF].NextState      :=STString;
   Transitions[STString,CHEOF].Action         :=Error;

   Transitions[STString,CHDQuote].NextState   :=STTerm;
   Transitions[STString,CHDQuote].Action      :=AccString;

   Transitions[STString,CHBSlash].NextState   :=STEQuote;
   Transitions[STString,CHBSlash].Action      :=Emit;

(************************************************************************)
(*                 BACKSTROKE IN DOUBLE-QUOTED STRING                   *)
(************************************************************************)

   Lambda(STEQuote,STString,Emit);

   Transitions[STEQuote,CHEOLN].NextState     :=STEQuote;
   Transitions[STEQuote,CHEOLN].Action        :=Error;

   Transitions[STEQuote,CHEOF].NextState      :=STEQuote;
   Transitions[STEQuote,CHEOF].Action         :=Error;

(************************************************************************)
(*               SINGLE-QUOTED STRING LITERAL BEGINNING                 *)
(************************************************************************)

   Lambda(STStr,STStr,Emit);

   Transitions[STStr,CHEOLN].NextState        :=STStr;
   Transitions[STStr,CHEOLN].Action           :=Error;

   Transitions[STStr,CHEOF].NextState         :=STStr;
   Transitions[STStr,CHEOF].Action            :=Error;

   Transitions[STStr,CHSQuote].NextState      :=STTerm;
   Transitions[STStr,CHSQuote].Action         :=AccStr;

   Transitions[STStr,CHBSlash].NextState      :=STSQuote;
   Transitions[STStr,CHBSlash].Action         :=Emit;

(************************************************************************)
(*                 BACKSTROKE IN SINGLE-QUOTED STRING                   *)
(************************************************************************)

   Lambda(STSQuote,STStr,Emit);

   Transitions[STSQuote,CHEOLN].NextState     :=STSQuote;
   Transitions[STSQuote,CHEOLN].Action        :=Error;

   Transitions[STSQuote,CHEOF].NextState      :=STSQuote;
   Transitions[STSQuote,CHEOF].Action         :=Error;

(************************************************************************)
(*                      LEFT PARENTHESIS                                *)
(************************************************************************)

   Lambda(STLParen,STTerm,AccLParen);

   Transitions[STLParen,CHStar].NextState     :=STCommBeg;
   Transitions[STLParen,CHStar].Action        :=UnEmit;

(************************************************************************)
(*                      COMMENT BEGINING                                *)
(************************************************************************)

   Lambda(STCommBeg,STCommSkip,InComment);

   Transitions[STCommBeg,CHLParen].NextState  :=STCommNest;
   Transitions[STCommBeg,CHLParen].Action     :=InComment;

   Transitions[STCommBeg,CHDollar].NextState  :=STTerm;
   Transitions[STCommBeg,CHDollar].Action     :=AccDir;

   Transitions[STCommBeg,CHEOLN].NextState    :=STCommLine;
   Transitions[STCommBeg,CHEOLN].Action       :=LineEcho;

   Transitions[STCommBeg,CHStar].NextState    :=STCommEnd;
   Transitions[STCommBeg,CHStar].Action       :=InComment;

(************************************************************************)
(*                 EOLN AT BEGINNING OF COMMENT                         *)
(************************************************************************)

   Lambda(STCommLine,STCommSkip,InComment);

   Transitions[STCommLine,CHLParen].NextState :=STCommNest;
   Transitions[STCommLine,CHLParen].Action    :=InComment;

   Transitions[STCommLine,CHEOLN].NextState   :=STCommLine;
   Transitions[STCommLine,CHEOLN].Action      :=LineEcho;

   Transitions[STCommLine,CHStar].NextState   :=STCommEnd;
   Transitions[STCommLine,CHStar].Action      :=InComment;

(************************************************************************)
(*                      COMMENT BEING SKIPPED                           *)
(************************************************************************)

   Lambda(STCommSkip,STCommSkip,EchoComment);

   Transitions[STCommSkip,CHEOF].NextState    :=STCommSkip;
   Transitions[STCommSkip,CHEOF].Action       :=Error;

   Transitions[STCommSkip,CHEOLN].NextState   :=STCommSkip;
   Transitions[STCommSkip,CHEOLN].Action      :=LineEcho;

   Transitions[STCommSkip,CHStar].NextState   :=STCommEnd;
   Transitions[STCommSkip,CHStar].Action      :=EchoComment;

   Transitions[STCommSkip,CHLParen].NextState :=STCommNest;
   Transitions[STCommSkip,CHLParen].Action    :=EchoComment;

(************************************************************************)
(*                      NESTED COMMENT POSSIBLY?                        *)
(************************************************************************)

   Lambda(STCommNest,STCommSkip,EchoComment);

   Transitions[STCommNest,CHEOF].NextState    :=STCommNest;
   Transitions[STCommNest,CHEOF].Action       :=Error;

   Transitions[STCommNest,CHStar].NextState   :=STCommBeg;
   Transitions[STCommNest,CHStar].Action      :=EchoComment;

   Transitions[STCommNest,CHLParen].NextState :=STCommNest;
   Transitions[STCommNest,CHLParen].Action    :=EchoComment;

   Transitions[STCommNest,CHEOLN].NextState   :=STCommSkip;
   Transitions[STCommNest,CHEOLN].Action      :=LineEcho;

(************************************************************************)
(*                      COMMENT ENDING (just read * )                   *)
(************************************************************************)

   Lambda(STCommEnd,STCommSkip,EchoComment);

   Transitions[STCommEnd,CHEOF].NextState     :=STCommEnd;
   Transitions[STCommEnd,CHEOF].Action        :=Error;

   Transitions[STCommEnd,CHEOLN].NextState    :=STCommSkip;
   Transitions[STCommEnd,CHEOLN].Action       :=LineEcho;

   Transitions[STCommEnd,CHRParen].NextState  :=STCommSkip;
   Transitions[STCommEnd,CHRParen].Action     :=OutComment;

   Transitions[STCommEnd,CHStar].NextState    :=STCommEnd;
   Transitions[STCommEnd,CHStar].Action       :=EchoComment;

(************************************************************************)
(*                      TERMINATION STATE                               *)
(************************************************************************)

   Lambda(STTerm,STTerm,Error);

END FSM.