(**********************************************************************

:Program.    SourceScanner.mod
:Contens.    Ein Modul für M2m, das SourceFiles nach Import-Listen
:Contens.    analysiert.
:Author.     Bernd Braun
:Address.    Lippestr. 11, D-3300 Braunschweig
:Phone.      0531/845498
:Copyright.  Public Domain
:Language.   Modula-2
:Translator. M2Amiga A+L V4.096d
:Imports.    DynStr, NewInOut
:History.    V1.0 21.Jun.1991
:History.    V1.1 19.Jul.1991 SyncRun aus ARP eingebaut.
:History.    V1.2 26.Jul.1991 Programm läßt sich jetzt unterbrechen,
:History.                     allerdings nicht Compiler oder Linker.
:History.    V1.3 27.Jul.1991 Härtetest mit A+L Sourcen überstanden.

***********************************************************************)

IMPLEMENTATION MODULE SourceScanner;

   FROM Arts IMPORT
      Assert;
   FROM ASCII IMPORT
      nul, eof, sp, eol, ht;
   FROM DosD IMPORT
      Date;
   FROM DynStr IMPORT
      DynString, StatString, MakeStatString, MakeDynString, ForgetDynString;
   FROM Graph IMPORT
      EckenPtr, SucheEcke, NeueEcke, NeueKante;
   FROM Header IMPORT
      Typen, PfadPtr, PfadElem, PfadListe, optionen, option, NullDate,
      PathandProg, NameandExt, latestDate, MaxDate, GetDatefromFile;
   FROM Storage IMPORT
      ALLOCATE, DEALLOCATE;
   FROM NewInOut IMPORT
      FILE, ReadFile, done, Open, ModeOld, Close, WriteString,
      WriteLn;
   FROM String IMPORT
      Copy, Concat, Compare;
   FROM SYSTEM IMPORT
      ADR;

   CONST
      fileerr  = 'Kann File nicht öffnen!';
      parerr   = 'Parser Error!';

   TYPE
      Token    = ( implement, definit, module, from, import, ident,
                   semicolon, colon, comma, end, const, var, type,
                   procedure, endoffile, weissnich );

   VAR
      lastch   : CHAR;        (* Letztes eingegegebes Zeichen. *)

   (*
      Prüft ein Zeichen auf Buchstabe.
   *)
   PROCEDURE isletter ( ch : CHAR ) : BOOLEAN;
   BEGIN
      RETURN ( 'A' <= CAP ( ch ) ) AND ( CAP ( ch ) <= 'Z' );
   END isletter;

   (*
      Prüft ein Zeichen auf Zahl.
   *)
   PROCEDURE isdigit  ( ch : CHAR ) : BOOLEAN;
   BEGIN
      RETURN ( '0' <= ch ) AND ( ch <= '9' );
   END isdigit;

   (*
      Liest ein Token aus file ein, gibt es in Str zurück, war es
      ein Word wird word TRUE. Rückgabe TRUE, wenn Dateiende erreicht.
   *)
   PROCEDURE ReadToken (     file : FILE;
                         VAR Str  : ARRAY OF CHAR;
                         VAR word : BOOLEAN       ) : BOOLEAN;
      VAR
         ch : CHAR;     (* Aktuelles Zeichen. *)
         i  : INTEGER;  (* Index in Str. *)
   BEGIN
      i := 0;
      IF lastch # nul THEN
         (* Zeichen im Einagbepuffer lastch zurückgeben. *)
         ch     := lastch;
         lastch := nul;
      ELSE
         (* Neues Zeichen aus Datei lesen. *)
         ReadFile ( file, ch );
      END;
      IF isletter ( ch ) THEN
         (* Wörter beginnen mit einem Buchstaben. *)
         word := TRUE;
         REPEAT
            Str [ i ] := ch;
            INC ( i );
            ReadFile ( file, ch );
         UNTIL NOT ( isletter ( ch ) OR isdigit ( ch ) ) OR NOT done;
         (* Letztes Zeichen, das nicht zum Wort gehört zurückschreiben. *)
         lastch := ch;
         Str [ i ] := nul;
         RETURN TRUE;
      ELSE
         (* Kein Wort. Nur ein Zeichen zurückgeben. *)
         word := FALSE;
         Str [ 0 ] := ch;
         Str [ 1 ] := nul;
         RETURN ch # eof;
      END;
   END ReadToken;

   (*
      Sucht das Programm ModulName in den Pfaden, die in PfadListe
      angegeben sind. Danach wird das Programm nach IMPORT-Listen
      durchsucht, die in der ImportListe zurückgegeben werden.
      Zurückgegeben wird dazu noch der Typ des Programms und das
      Erstellungsdatum.
      Gibt in inDir das Directory zurück in dem ModulName gefunden wurde.
      Wurde ProgrName in keinem Pfad endeckt wird in gefunden
      FALSE zurückgegeben.
   *)
   PROCEDURE ScanSource (     ModulName   : DynString;
                              PfadList    : PfadPtr;
                          VAR Typ         : Typen;
                          VAR Datum       : Date;
                          VAR gefunden    : BOOLEAN;
                          VAR inDir       : DynString;
                          VAR ImportListe : PfadPtr   );
      VAR
         Path,
         Prog,
         Pfad,
         Pfad2       : StatString;
         pos         : INTEGER;

      (*
         Überließt Kommentare.
      *)
      PROCEDURE Kommentar ( file : FILE );
         VAR
            Str  : StatString;
            word : BOOLEAN;
      BEGIN
         WHILE ReadToken ( file, Str, word ) DO
            IF NOT word THEN
               CASE Str [ 0 ] OF
                  '*' :
                     IF ReadToken ( file, Str, word ) THEN
                        IF ( NOT word ) AND ( Str [ 0 ] = ')' ) THEN
                           RETURN;
                        ELSIF ( NOT word ) AND ( Str [ 0 ] = '*' ) THEN
                           lastch := '*';
                           (* Nächstes ReadToken liefert '*' zurück. *)
                        END;
                     ELSE
                        RETURN;
                     END;
               |  '(' :
                     IF ReadToken ( file, Str, word ) THEN
                        IF ( NOT word ) AND ( Str [ 0 ] = '*' ) THEN
                           (* geschachtelter Kommentar. *)
                           Kommentar ( file );
                        ELSIF ( NOT word ) AND ( Str [ 0 ] = '(' ) THEN
                           lastch := '(';
                           (* Nächstes ReadToken liefert '(' zurück. *)
                        END;
                     ELSE
                        RETURN;
                     END;
               ELSE
                  (* Überlesen. *)
               END;
            END;
         END;
      END Kommentar;

      (*
         Ließt ein Token aus file und gibt einen Ident in Str zurück.
      *)
      PROCEDURE GetToken (     file : FILE;
                           VAR Str  : ARRAY OF CHAR ) : Token;
         VAR
            word : BOOLEAN;
      BEGIN
         LOOP
            (* Führende Spaces überlesen. *)
            IF NOT ReadToken ( file, Str, word ) THEN
               RETURN endoffile;
            END;
            IF word THEN
               EXIT;
            ELSIF ( Str [ 0 ] # sp ) AND ( Str [ 0 ] # eol ) AND
                  ( Str [ 0 ] # ht ) THEN
               EXIT;
            END;
         END;
         IF word THEN
            IF Compare ( Str, 'DEFINITION' ) = 0 THEN
               RETURN definit;
            ELSIF Compare ( Str, 'IMPLEMENTATION' ) = 0 THEN
               RETURN implement;
            ELSIF Compare ( Str, 'IMPORT' ) = 0 THEN
               RETURN import;
            ELSIF Compare ( Str, 'FROM' ) = 0 THEN
               RETURN from;
            ELSIF Compare ( Str, 'MODULE' ) = 0 THEN
               RETURN module;
            ELSIF Compare ( Str, 'END' ) = 0 THEN
               RETURN end;
            ELSIF Compare ( Str, 'CONST' ) = 0 THEN
               RETURN const;
            ELSIF Compare ( Str, 'VAR' ) = 0 THEN
               RETURN var;
            ELSIF Compare ( Str, 'TYPE' ) = 0 THEN
               RETURN type;
            ELSIF Compare ( Str, 'PROCEDURE' ) = 0 THEN
               RETURN procedure;
            ELSE
               RETURN ident;
            END;
         ELSE
            CASE Str [ 0 ] OF
               ':'   :  RETURN colon;
            |  ';'   :  RETURN semicolon;
            |  ','   :  RETURN comma;
            |  '('   :  IF ReadToken ( file, Str, word ) THEN
                           IF Str [ 0 ] = '*' THEN
                              Kommentar ( file );
                              RETURN GetToken ( file, Str );
                           END;
                        ELSE
                           RETURN endoffile;
                        END;
            ELSE
               RETURN weissnich;
            END;
         END;
      END GetToken;

      (*
         Fügt Name in die ImportListe ein.
      *)
      PROCEDURE Insert ( Name : ARRAY OF CHAR );
         VAR
            p : PfadPtr;
      BEGIN
         (* SYSTEM nicht eintragen. *)
         IF Compare ( Name, 'SYSTEM' ) # 0 THEN
            ALLOCATE ( p, SIZE ( PfadElem ) );
            WITH p^ DO
               next := ImportListe;
               MakeDynString ( Name, ProgName );
               PfadName := NIL;
            END;
            ImportListe := p;
         END;
      END Insert;

      (*
         Scannt Prog nach IMPORT Listen durch.
      *)
      PROCEDURE Scan ( Prog : ARRAY OF CHAR );
         VAR
            file : FILE;
            Tok  : Token;
            word : BOOLEAN;
            Str,
            Str1 : StatString;
      BEGIN
         file := Open ( Prog, ModeOld );
         Assert ( done, ADR ( fileerr ) );
         CASE GetToken ( file, Str ) OF
            definit :
               Typ := definition;
         |  implement :
               Typ := implementation;
         |  module :
               Typ := modul;
         ELSE
            Assert ( FALSE, ADR ( parerr ) );
         END;
         Tok := GetToken ( file, Str );
         WHILE Tok # endoffile DO
            CASE Tok OF
               end, var, type, const, procedure :
                  Close ( file );
                  RETURN;
            |  from :
                  Tok := GetToken ( file, Str );
                  Assert ( Tok = ident, ADR ( parerr ) );
                  Insert ( Str );
                  LOOP
                     Tok := GetToken ( file, Str );
                     IF Tok = endoffile THEN
                        Close ( file );
                        RETURN;
                     END;
                     IF Tok = semicolon THEN
                        EXIT;
                     END;
                  END;                  
            |  import :
                  LOOP
                     (* Liste von Modulnamen verarbeiten. *)
                     Tok := GetToken ( file, Str );
                     Assert ( Tok = ident, ADR ( parerr ) );
                     Tok := GetToken ( file, Str1 );
                     IF Tok = comma THEN
                        Insert ( Str );
                     ELSIF Tok = semicolon THEN
                        Insert ( Str );
                        EXIT;
                     ELSE
                        Assert ( Tok = colon, ADR ( parerr ) );
                        Tok := GetToken ( file, Str );
                        Assert ( Tok = ident, ADR ( parerr ) );
                        Insert ( Str );
                        Tok := GetToken ( file, Str );
                        IF Tok = semicolon THEN
                           EXIT;
                        END;
                     END;
                  END;
            ELSE
               (* Schwamm drüber! *)
            END; (* OF CASE *)
            Tok := GetToken ( file, Str );
         END;
         Close ( file );
      END Scan;

   BEGIN
      (* Voreinstellungen. *)
      gefunden := FALSE;
      Datum := NullDate;
      ImportListe := NIL;
      inDir := NIL;

      (* ModulName suchen. *)
      WHILE NOT gefunden AND ( PfadList # NIL ) DO
         MakeStatString ( Path, PfadList^.PfadName );
         Copy ( Pfad, Path );
         Concat ( Pfad, ModulName^ );
         Copy ( Pfad2, Path );
         Concat ( Pfad2, 'txt/' );
         Concat ( Pfad2, ModulName^ );
         (* In Pfad steht jetzt der vollständige Pfad von ModulName,
            in Pfad2 noch der um txt erweiterte. *)

         GetDatefromFile ( Pfad2, Datum, gefunden );
         IF NOT gefunden THEN
            GetDatefromFile ( Pfad, Datum, gefunden );
            IF gefunden AND ( verbose IN option ) THEN
               WriteString ( ' - ' );
               WriteString ( Pfad );
               WriteLn;
            END;
            IF gefunden THEN
               Scan ( Pfad );
            END;
         ELSE
            IF verbose IN option THEN
               WriteString ( ' - ' );
               WriteString ( Pfad2 );
               WriteLn;
            END;
            Scan ( Pfad2 );
         END;
         IF gefunden THEN
            PathandProg ( Path, Prog, Pfad );
            MakeDynString ( Path, inDir );
            MaxDate ( latestDate, Datum, latestDate );
         END;
         PfadList := PfadList^.next;
      END; (* OF WHILE *)
   END ScanSource;

   (*
      Trägt rekursiv ProgName und alle von ihm importierten Module
      in den Grphen ein.
   *)
   PROCEDURE Eintragen ( Name : DynString );
      VAR
         ImportListe,
         ImpList,
         ImpList2    : PfadPtr;
         Type        : Typen;
         Datum       : Date;
         found       : BOOLEAN;
         Dir,
         DynStr      : DynString;
         Vor,
         Nach,
         Str         : StatString;
         EckPtr      : EckenPtr;
   BEGIN
      ImportListe := NIL;
      EckPtr := SucheEcke ( Name );
      IF EckPtr = NIL THEN
         (* Name in Graph einfügen. *)
         EckPtr := NeueEcke ( Name );
         (* Importliste von Name durchsuchen. *)
         ScanSource ( Name, PfadListe, Type, Datum, found,
                      Dir, ImportListe );
         WITH EckPtr^ DO
            ErstellungsDatum := Datum;
            gefunden := found;
            ModulPfad := Dir;
            Typ := Type;
         END;
         (* Rekursiv alle importierten Module eintragen. *)
         NameandExt ( Vor, Nach, Name^ );
         IF Compare ( Nach, 'mod' ) = 0 THEN
            (* Eine Implementation ist von ihrer Definition abhängig. *)
            Concat ( Vor, '.def' );
            MakeDynString ( Vor, DynStr );
            Eintragen ( DynStr );
         END;
         ImpList := ImportListe;
         WHILE ImpList # NIL DO
            MakeStatString ( Str, ImpList^.ProgName );
            Concat ( Str, '.def' );
            MakeDynString ( Str, DynStr );
            Eintragen ( DynStr );

            MakeStatString ( Str, ImpList^.ProgName );
            Concat ( Str, '.mod' );
            MakeDynString ( Str, DynStr );
            Eintragen ( DynStr );

            ImpList := ImpList^.next;
         END;
         (* Alle Kanten eintragen. *)
         NameandExt ( Vor, Nach, Name^ );
         IF Compare ( Nach, 'mod' ) = 0 THEN
            (* Eine Implementation ist von ihrer Definition abhängig. *)
            Concat ( Vor, '.def' );
            MakeDynString ( Vor, DynStr );
            NeueKante ( EckPtr, SucheEcke ( DynStr ) );
            ForgetDynString ( DynStr );
         END;
         ImpList := ImportListe;
         WHILE ImpList # NIL DO
            MakeStatString ( Str, ImpList^.ProgName );
            Concat ( Str, '.mod' );
            MakeDynString ( Str, DynStr );
            NeueKante ( EckPtr, SucheEcke ( DynStr ) );
            ForgetDynString ( DynStr );

            MakeStatString ( Str, ImpList^.ProgName );
            Concat ( Str, '.def' );
            MakeDynString ( Str, DynStr );
            NeueKante ( EckPtr, SucheEcke ( DynStr ) );
            ForgetDynString ( DynStr );
            ImpList := ImpList^.next;
         END;
         (* PfadListe löschen *)
         ImpList  := ImportListe;
         WHILE ImpList # NIL DO
            ImpList2 := ImpList^.next;
            ForgetDynString ( ImpList^.ProgName );
            DEALLOCATE ( ImpList, SIZE ( PfadElem ) );
            ImpList := ImpList2;
         END;
      END;
   END Eintragen;

BEGIN
   (* Eingabepuffer lastch löschen. *)
   lastch := nul;
END SourceScanner.