(******************************************************************************
*                                                                             *
*    Programmname:  DefMaker                                                  *
*                                                                             *
*    Stand:         22.10.89                            Uhrzeit:  11:36:37    *
*                                                                             *
*    Bearbeitet mit dem MODULETool V1.0         (©) by  Thomas Stolze 1989    *
*                                                                             *
******************************************************************************)

(* $R- *) (* $V- *) (* $S- *) (* $N- *) (* $F- *)
IMPLEMENTATION MODULE DefMaker;

FROM Arts          IMPORT Assert,BreakPoint;
FROM SYSTEM        IMPORT ADDRESS,ADR;
FROM Storage       IMPORT ALLOCATE,Available,DEALLOCATE;
FROM Str           IMPORT CapString,Concat,Copy,LastPos,Length;
FROM FileSystem    IMPORT Close,File,Lookup,Response,ReadChar,WriteBytes,
                          WriteChar;
FROM Graphics      IMPORT jam2;
FROM Intuition     IMPORT IntuiText,PrintIText,WindowPtr;
FROM StringSupport IMPORT DeleteStr,LeftStr,LEQ,LLT,ProduceStr,StringStr;
FROM TimerSupport  IMPORT MakeDateString,MakeTimeString;
FROM ToolRoutines  IMPORT SicherheitsKopie;

CONST lineFeed = 12C;
      EOL      = lineFeed;
      NUL      = 00C;
      SP       = " ";
      HT       = 11C;
      
      MaxChars           = 80;
      maxZeilen          = 2500;
      maxDefZeilen       = 1000;
      maxElemente        = 10000;
      maxModule          = 64;
      maxImportElemente  = 500;
      maxZeilenChars     = 99;
     
TYPE BefehlsZustand = (wechsel,unveraendert);              
                   
     ImportedFilePtr = POINTER TO ImportedFile;
     ImportedFile    = RECORD
                         zeile: ARRAY [0..maxZeilenChars] OF CHAR;
                       END;
     
    erstelleImport = RECORD
                       fromFlag,
                       importFlag,
                       merkZeile,
                       nobeginorproc : BOOLEAN;
                       zeile         : CARDINAL;
                     END;
                     
   DefImpInfoPtr = POINTER TO DefImpInfo;
   DefImpInfo    = RECORD
                     Zeile  : CARDINAL;
                     Befehl : Befehle;
                   END;  
                       
VAR SourcePtr      : ARRAY [0..maxZeilen] OF ImportedFilePtr;
    OrderPtr       : ARRAY [0..maxElemente] OF KeyFeldPtr;
    ImportElemente : ARRAY [0..maxModule],[0..maxImportElemente] OF KeyFeldPtr;
    LaengenZaehler : ARRAY [0..maxModule] OF CARDINAL;
    DefinitionPtr  : ARRAY [0..maxDefZeilen] OF DefImpInfoPtr;
    KeyWords       : ARRAY [0..73],[0..15] OF CHAR;
    ZeilenString   : ARRAY [0..maxZeilenChars] OF CHAR;
    LetzterBefehl,
    lastOrder,
    merkBefehl     : Befehle;
    Liste          : erstelleImport;
    status         : ImportStatus;
    InfoTabPtr     : InfoTabellenPtr;
    windptr        : WindowPtr;
    Input,
    Output1,Output2: File;
    ZeichenZaehler,
    ZeilenZaehler,
    importSpalte,
    importZeile,
    defCounter,
    Pass,
    test1,test2     : CARDINAL;
    klammerCounter  : INTEGER;
    firstPass       : BOOLEAN;

PROCEDURE PrintString(String : ADDRESS; window : WindowPtr;
                      xpos,ypos : INTEGER; loeschen : BOOLEAN);
VAR Text : IntuiText;
    space: ARRAY [0..40] OF CHAR;
BEGIN
   WITH Text DO
     frontPen:=1; backPen:=0; drawMode:=jam2;
     leftEdge:=0; topEdge:=0; iText:=String;
     nextText:=NIL; iTextFont:=NIL;
   END;
   IF loeschen THEN
      space:=(""); ProduceStr(space," ",35); Text.iText:=ADR(space);
      PrintIText(window^.rPort,ADR(Text),xpos,ypos);
   END;
   Text.iText:=String;
   PrintIText(window^.rPort,ADR(Text),xpos,ypos); 
END PrintString;

PROCEDURE InitKeyWords;
BEGIN
  KeyWords[01]:="ABS";            KeyWords[02]:="AND";
  KeyWords[03]:="ARRAY";          KeyWords[04]:="BEGIN";
  KeyWords[05]:="BOOLEAN";        KeyWords[06]:="BPOINTER";
  KeyWords[07]:="BY";             KeyWords[08]:="CAP";
  KeyWords[09]:="CARDINAL";       KeyWords[10]:="CASE";
  KeyWords[11]:="CHAR";           KeyWords[12]:="CHR";
  KeyWords[13]:="CODE";           KeyWords[14]:="CONST";
  KeyWords[15]:="DEC";            KeyWords[16]:="DEFINITION";
  KeyWords[17]:="DIV";            KeyWords[18]:="DO";
  KeyWords[19]:="ELSE";           KeyWords[20]:="ELSIF";
  KeyWords[21]:="END";            KeyWords[22]:="EXCL";
  KeyWords[23]:="EXIT";           KeyWords[24]:="EXPORT"; 
  KeyWords[25]:="FALSE";          KeyWords[26]:="FLOAT";
  KeyWords[27]:="FOR";            KeyWords[28]:="FORWARD";
  KeyWords[29]:="FROM";           KeyWords[30]:="HALT";
  KeyWords[31]:="HIGH";           KeyWords[32]:="IF";
  KeyWords[33]:="IMPLEMENTATION"; KeyWords[34]:="IMPORT";
  KeyWords[35]:="IN";             KeyWords[36]:="INC";
  KeyWords[37]:="INCL";           KeyWords[38]:="INTEGER";
  KeyWords[39]:="LONGCARD";       KeyWords[40]:="LONGINT";
  KeyWords[41]:="LONGREAL";       KeyWords[42]:="LOOP";
  KeyWords[43]:="MAX";            KeyWords[44]:="MIN";
  KeyWords[45]:="MOD";            KeyWords[46]:="MODULE";
  KeyWords[47]:="NIL";            KeyWords[48]:="NOT";
  KeyWords[49]:="ODD";            KeyWords[50]:="OF";
  KeyWords[51]:="OR";             KeyWords[52]:="ORD";
  KeyWords[53]:="POINTER";        KeyWords[54]:="PROC";
  KeyWords[55]:="PROCEDURE";      KeyWords[56]:="QUALIFIED";
  KeyWords[57]:="REAL";           KeyWords[58]:="RECORD";
  KeyWords[59]:="REM";            KeyWords[60]:="REPEAT";
  KeyWords[61]:="RETURN";         KeyWords[62]:="SET";
  KeyWords[63]:="SIZE";           KeyWords[64]:="THEN";
  KeyWords[65]:="TO";             KeyWords[66]:="TRUE";
  KeyWords[67]:="TRUNC";          KeyWords[68]:="TYPE";
  KeyWords[69]:="UNTIL";          KeyWords[70]:="VAL";
  KeyWords[71]:="VAR";            KeyWords[72]:="WHILE";
  KeyWords[73]:="WITH";
END InitKeyWords;

PROCEDURE AllocDatenFeld(VAR datenPtr : ADDRESS; size : INTEGER): BOOLEAN;
VAR adr,sou : ADDRESS;
    null    : CHAR;
    i       : CARDINAL;
BEGIN
  IF datenPtr = NIL THEN
     IF Available(size) THEN
        ALLOCATE(datenPtr,size);
        RETURN TRUE;
     END;
     datenPtr:=NIL; InfoTabPtr^.Fehler:=OutofMemory;
     PrintString(ADR("Nicht genug Speicher vorhanden"),windptr,130,59,TRUE);
     RETURN FALSE;
  END;
  RETURN TRUE;   
END AllocDatenFeld;

PROCEDURE DeallocDatenFeld(VAR datenPtr : ADDRESS; size : INTEGER);
BEGIN 
  DEALLOCATE(datenPtr,size); datenPtr:=NIL;
END DeallocDatenFeld;
  
PROCEDURE MerkeProgramm(): BOOLEAN;
BEGIN
  IF InfoTabPtr^.eineLeerzeile THEN
     IF (Length(ZeilenString) = 0) THEN
        INC(InfoTabPtr^.leerzeilenZaehler);
     ELSE
        InfoTabPtr^.leerzeilenZaehler:=0; 
     END;
  ELSE
    InfoTabPtr^.leerzeilenZaehler:=0;
  END;      
  IF (InfoTabPtr^.leerzeilenZaehler < 2) THEN 
     IF AllocDatenFeld(SourcePtr[ZeilenZaehler],SIZE(ImportedFile)) THEN
        Copy(SourcePtr[ZeilenZaehler]^.zeile,ZeilenString);
        ZeilenString:=("");
        RETURN TRUE;
     ELSE
        RETURN FALSE;   
     END;   
  END;
  DEC(ZeilenZaehler);
  RETURN TRUE;
END MerkeProgramm;

PROCEDURE QSort(spalte,start,end : CARDINAL);
  PROCEDURE FirstHigher(unten,oben : ARRAY OF CHAR): BOOLEAN;
  VAR i : CARDINAL;
  BEGIN
    CapString(unten); CapString(oben);
    IF LLT(unten,oben) THEN
       RETURN TRUE;
    END;  
    RETURN FALSE;
  END FirstHigher;
  PROCEDURE Sort(unten,oben : CARDINAL);
  VAR i,j : CARDINAL;
      x,w : KeyFeldPtr;
  BEGIN
    i := unten; j := oben;
    x := ImportElemente[spalte,(unten + oben) DIV 2];
    REPEAT
      WHILE FirstHigher(x^.name,ImportElemente[spalte,i]^.name) DO INC(i) END;
      WHILE FirstHigher(ImportElemente[spalte,j]^.name,x^.name) DO DEC(j) END;
      IF (i <= j) THEN
        w := ImportElemente[spalte,i];
        ImportElemente[spalte,i] := ImportElemente[spalte,j];
        ImportElemente[spalte,j] := w;
        INC(i);
        DEC(j);
      END;
    UNTIL (i > j);
    IF (unten < j) THEN Sort(unten,j) END;
    IF (i < oben)  THEN Sort(i,oben) END;
  END Sort;
BEGIN
  Sort(start,end);
END QSort;
  
PROCEDURE merkeDefinition;
BEGIN
  IF (DefinitionPtr[defCounter-1]^.Zeile < ZeilenZaehler) THEN
     IF AllocDatenFeld(DefinitionPtr[defCounter],SIZE(DefImpInfo)) THEN
        DefinitionPtr[defCounter]^.Zeile:=ZeilenZaehler;
        DefinitionPtr[defCounter]^.Befehl:=merkBefehl;
        INC(defCounter);
     ELSE
        InfoTabPtr^.Fehler:=OutofMemory;
     END;
  END;
END merkeDefinition;

PROCEDURE ImplementationAnfang;
BEGIN
  IF InfoTabPtr^.defMod THEN
     IF Liste.nobeginorproc THEN
        IF (InfoTabPtr^.endeImportListe <= ZeilenZaehler) THEN
           InfoTabPtr^.endeImportListe:=ZeilenZaehler;
        END;
     END;
  END;
END ImplementationAnfang;

PROCEDURE MerkNichtSchluesselWort(string : ARRAY OF CHAR);
VAR index : CARDINAL;
  PROCEDURE BinaeresSuchen(): BOOLEAN;
  VAR pos,
      anfang,
      ende    : INTEGER;
  BEGIN
    anfang:=0; ende:=73;
    IF (LetzterBefehl # keinBefehl) THEN
       lastOrder:=LetzterBefehl;
    END;   
    REPEAT
      pos:=((anfang+ende) DIV 2);
      IF LLT(string,KeyWords[pos]) THEN
         anfang:=pos+1;
      ELSE
         ende:=pos-1;
      END;
    UNTIL (LEQ(string,KeyWords[pos]) OR (anfang > ende));
    
    IF LEQ(string,KeyWords[pos]) THEN
       CASE pos OF
          4: LetzterBefehl:=begin;
       | 14: LetzterBefehl:=const;
       | 16: LetzterBefehl:=definition;
       | 29: LetzterBefehl:=from;
       | 33: LetzterBefehl:=implementation;
       | 34: LetzterBefehl:=import;
       | 46: LetzterBefehl:=module;
       | 55: LetzterBefehl:=procedure;
       | 68: LetzterBefehl:=type;
       | 71: LetzterBefehl:=var;
       ELSE
         LetzterBefehl:=sonstiger;
       END;
       RETURN FALSE;
    ELSE
       LetzterBefehl:=keinBefehl;
    END;
    RETURN TRUE;
  END BinaeresSuchen;
  
  PROCEDURE Zuweisen(element : CARDINAL): BOOLEAN;
  BEGIN
    IF AllocDatenFeld(OrderPtr[element],SIZE(KeyFeld)) THEN
       Copy(OrderPtr[element]^.name,string);
       OrderPtr[element]^.order:=LetzterBefehl;
       OrderPtr[element]^.zeile:=ZeilenZaehler;
       OrderPtr[element]^.vorkommen:=0;
       OrderPtr[element]^.importname:=FALSE;
       OrderPtr[element]^.status:=status;
       OrderPtr[element]^.pass:=Pass;
       RETURN TRUE;
    END;
    RETURN FALSE;
  END Zuweisen;
  
  PROCEDURE HashSort(VAR i : CARDINAL): BOOLEAN;
  VAR hashw,val,len : CARDINAL;
  BEGIN
    hashw:=0; i:=0; len:=Length(string);
    WHILE (i < len) DO
      val:=ORD(string[i]);
      hashw:=hashw+val * (len-i);
      INC(i);
    END;
    hashw:=(hashw MOD maxElemente);
    i:=hashw;
    WHILE (i <= maxElemente) DO
      IF (OrderPtr[i] = NIL) THEN
         IF Zuweisen(i) THEN
            RETURN TRUE;
         END;
         RETURN FALSE;   
      ELSE
         INC(i);
      END;
    END;
    i:=0;
    WHILE (i < hashw) DO
      IF (OrderPtr[i] = NIL) THEN
         IF Zuweisen(i) THEN
            RETURN TRUE;
         END; 
         RETURN FALSE;
      ELSE
         INC(i);
      END;
    END;
    RETURN FALSE;              
  END HashSort;
  
  PROCEDURE HashSuchen(VAR i : CARDINAL): BOOLEAN;
  VAR hashw,val,len : CARDINAL;
  BEGIN
    hashw:=0; i:=0; len:=Length(string);
    WHILE (i <= len) DO
      val:=ORD(string[i]);
      hashw:=hashw+val * (len-i);
      INC(i);
    END;
    hashw:=(hashw MOD maxElemente);
    i:=hashw;
    WHILE (i <= maxElemente) DO
      IF LEQ(OrderPtr[i]^.name,string) THEN
         IF (OrderPtr[i]^.pass = Pass) THEN
            IF (OrderPtr[i]^.status = status) THEN
               RETURN TRUE;
            END;    
         END;
         RETURN FALSE;
      ELSE
         IF (OrderPtr[i] = NIL) THEN
            i:=maxElemente
         END;
         INC(i);
      END;
    END;
    i:=0;
    WHILE (i <= hashw) DO
      IF LEQ(OrderPtr[i]^.name,string) THEN
         IF (OrderPtr[i]^.pass = Pass) THEN
            IF (OrderPtr[i]^.status = status) THEN
               RETURN TRUE;
            END;      
         END;
         RETURN FALSE;   
      ELSE
         IF (OrderPtr[i] = NIL) THEN
            i:=hashw+i;
         END;
         INC(i);
      END;
    END;  
  RETURN FALSE;         
  END HashSuchen;

  PROCEDURE ListenOrganisation;
  BEGIN
    IF Liste.importFlag THEN
       ImportElemente[importSpalte-1,importZeile]:=OrderPtr[index];
       INC(LaengenZaehler[importSpalte-1]); INC(importZeile);
       IF (ZeilenZaehler # InfoTabPtr^.endeImportListe) THEN
          InfoTabPtr^.endeImportListe:=ZeilenZaehler;
       END;
    ELSIF Liste.fromFlag THEN
       IF (importSpalte <= maxModule) THEN
          ImportElemente[importSpalte,0]:=OrderPtr[index];
          ImportElemente[importSpalte,0]^.importname:=TRUE;
          INC(LaengenZaehler[importSpalte]); INC(importSpalte);
          importZeile:=1; Liste.fromFlag:=FALSE;
          IF (ZeilenZaehler # InfoTabPtr^.endeImportListe) THEN
             InfoTabPtr^.endeImportListe:=ZeilenZaehler;
          END;
          IF (Length(string) > InfoTabPtr^.maxlenImportName) THEN
             InfoTabPtr^.maxlenImportName:=Length(string);
          END;
       ELSE
          InfoTabPtr^.Fehler:=zuvieleModule;
       END;        
    END;
    IF (lastOrder = module) THEN InfoTabPtr^.moduleName:=OrderPtr[index] END;
  END ListenOrganisation;
    
BEGIN
  IF BinaeresSuchen() THEN
     IF NOT HashSuchen(index) THEN
        IF ((OrderPtr[index]^.pass < Pass) AND NOT firstPass) THEN
           IF Zuweisen(index) THEN
              ListenOrganisation;
           END;   
        ELSE
           IF HashSort(index) THEN
              ListenOrganisation;
           ELSE
              InfoTabPtr^.Fehler:=zuvieleElemente;
           END;
        END;   
     ELSE
        INC(OrderPtr[index]^.vorkommen);
     END;
  ELSE
   WITH Liste DO
    status:=qualifiziert;  
    CASE LetzterBefehl OF
      from:
          fromFlag:=TRUE; importFlag:=FALSE;
          status:=qualifiziert;
    | import:
          IF (lastOrder # from) THEN
             fromFlag:=TRUE; importFlag:=FALSE;
             status:=unqualifiziert;
          ELSE
             importFlag:=TRUE; status:=qualifiziert;
          END;
    | implementation:
          InfoTabPtr^.module:=imp;
    | definition:
          InfoTabPtr^.module:=def;
    | module:
          IF (InfoTabPtr^.module = nichtdefiniert) THEN
             IF InfoTabPtr^.defMod THEN
                InfoTabPtr^.module:=imp;
             ELSE 
                InfoTabPtr^.module:=mod;
             END;   
          END;
    | procedure:
          IF InfoTabPtr^.defMod THEN
             merkZeile:=TRUE; merkBefehl:=LetzterBefehl;
             nobeginorproc:=FALSE;
          END; 
          importFlag:=FALSE;      
    | type,const:
          importFlag:=FALSE; merkZeile:=FALSE; status:=qualifiziert;
          IF InfoTabPtr^.defMod THEN
             IF nobeginorproc THEN
                merkZeile:=TRUE; merkBefehl:=LetzterBefehl;
             END;      
          END;
    | begin:
          merkZeile:=FALSE; importFlag:=FALSE;
          nobeginorproc:=FALSE;
    | var:
          nobeginorproc:=FALSE;
          merkZeile:=FALSE; importFlag:=FALSE;
          IF (klammerCounter # 0) THEN merkZeile:=TRUE END;
    ELSE
      fromFlag:=FALSE; importFlag:=FALSE;
    END; 
   END;                  
  END;
END MerkNichtSchluesselWort;

PROCEDURE AlphaNumerisch(ch : CHAR): BOOLEAN;
VAR  Resultat : BOOLEAN;
BEGIN
  CASE ch OF
   "A".."Z","a".."z","0".."9" :
    Resultat := TRUE;
  ELSE
    Resultat := FALSE;
  END;
  RETURN Resultat;        
END AlphaNumerisch;

PROCEDURE Numerisch(ch : CHAR): BOOLEAN;
BEGIN
  IF (ch >= "0") AND (ch <= "9") THEN
     RETURN TRUE;
  END;
  RETURN FALSE;   
END Numerisch;

PROCEDURE FuehrendNumerisch(ch : CHAR): BOOLEAN;
BEGIN
  CASE ch OF
   "0".."9","A".."F","H" :
    RETURN TRUE;
  ELSE
    RETURN FALSE;
  END;    
END FuehrendNumerisch;

PROCEDURE CheckDatei;
TYPE
  ZustandArt = (inVerarbeitung,Abgeschlossen);
  BausteinOderSeparator = (Baustein,Separator);
VAR
  Zustand        : ZustandArt;
  NaechstesZch,
  LetztesZch     : CHAR;
  WelcheSorte    : BausteinOderSeparator;
  sort,
  spaceCounter   : CARDINAL;
  
  PROCEDURE LiesNaechstesZeichen;
  BEGIN
    LetztesZch := NaechstesZch;
    IF (Input.eof) THEN
       Zustand:=Abgeschlossen;
       NaechstesZch:=NUL;
    ELSE
        ReadChar(Input,NaechstesZch);
    END;
  END LiesNaechstesZeichen;
  
  PROCEDURE ZaehleKlammern;
  BEGIN
    CASE NaechstesZch OF
      ")": DEC(klammerCounter);
    | "(": INC(klammerCounter);
    ELSE
    END; 
  END ZaehleKlammern;
  
PROCEDURE KopiereSymbol(VAR Art: BausteinOderSeparator);
    PROCEDURE SendeZeichen(ch : CHAR);
    VAR zahl : ARRAY [0..6] OF CHAR;
    BEGIN
    IF (ZeichenZaehler-1 <= maxZeilenChars) THEN
       ZeilenString[ZeichenZaehler-1]:=ch;
       IF (ch = SP)  THEN INC(spaceCounter) ELSE spaceCounter:=0 END;      
       IF (ch = EOL) THEN
           IF (ZeichenZaehler-spaceCounter-1 > MaxChars) THEN
              PrintString(ADR("Zeile mit Überlänge !"),windptr,130,59,TRUE); 
           END;
           ZeilenString[ZeichenZaehler-1]:=NUL;
           DeleteStr(ZeilenString,ZeichenZaehler-1-spaceCounter,spaceCounter); 
           ZeichenZaehler:=1;
           IF (ZeilenZaehler <= maxZeilen) THEN
              IF (NOT MerkeProgramm()) THEN
                  InfoTabPtr^.Fehler:=OutofMemory;
              END;
              IF InfoTabPtr^.defMod THEN
                 IF Liste.merkZeile THEN merkeDefinition END;
                 ImplementationAnfang;
              END;
              INC(ZeilenZaehler);
              StringStr(zahl,ZeilenZaehler,5);
              PrintString(ADR(zahl),windptr,230,49,FALSE);
           ELSE
              InfoTabPtr^.Fehler:=zuvieleZeilen;
              PrintString(ADR("Datei ist zu lang !!!"),windptr,130,59,TRUE);
           END;      
        ELSE
           INC(ZeichenZaehler);
        END;
    ELSE
       InfoTabPtr^.Fehler:=zuvieleZeicheninZeile;
       PrintString(ADR("Datei enthält zu lange Zeilen !!!"),
                   windptr,130,59,TRUE);
    END;       
    END SendeZeichen;
    
    PROCEDURE SendeZeichenkette(A : ARRAY OF CHAR);
    VAR i : CARDINAL;
    BEGIN
      FOR i:=0 TO HIGH(A) DO
        SendeZeichen(A[i]);
      END;
    END SendeZeichenkette;
    
    PROCEDURE UeberspringeZeichenkette(ErstesZch : CHAR);
    BEGIN
      LiesNaechstesZeichen;
      WHILE ((NaechstesZch # ErstesZch) AND (NaechstesZch # NUL)) DO
        SendeZeichen(NaechstesZch);
        LiesNaechstesZeichen;
      END;
      SendeZeichen(NaechstesZch);
      LiesNaechstesZeichen;
    END UeberspringeZeichenkette;
    
    PROCEDURE UeberspringeKommentarRest;
    VAR Letztes : (Uninteressant,Stern,KlammerZu);
    BEGIN
      LiesNaechstesZeichen;
      Letztes:= Uninteressant;
      WHILE ((Letztes # KlammerZu) AND (NaechstesZch # NUL)) DO
        CASE Letztes OF
          Uninteressant:
            IF NaechstesZch="*" THEN Letztes:=Stern END;
        | Stern:
           CASE NaechstesZch OF
             "*": Letztes:=Stern;
           | ")": Letztes:=KlammerZu;
             ELSE Letztes:=Uninteressant;
           END;
        END;
        SendeZeichen(NaechstesZch);
        LiesNaechstesZeichen;
      END; 
      DEC(klammerCounter); 
    END UeberspringeKommentarRest;
    
    PROCEDURE UeberspringeZchKette;
    VAR ch : CHAR;
    BEGIN
      ch:=NaechstesZch;
      SendeZeichen(NaechstesZch);
      LiesNaechstesZeichen; 
      WHILE ((NaechstesZch # ch) AND (NaechstesZch # NUL)) DO
        SendeZeichen(NaechstesZch);
        LiesNaechstesZeichen;
      END;
      SendeZeichen(NaechstesZch);
      LiesNaechstesZeichen;
    END UeberspringeZchKette;
       
    PROCEDURE UeberspringeZahl;
    TYPE
      TestProzTyp=PROCEDURE(CHAR):BOOLEAN;
      
      PROCEDURE UeberspringeSequenz(Einschliesslich: TestProzTyp);
      BEGIN
        WHILE (Einschliesslich(NaechstesZch) AND (NaechstesZch # NUL)) DO
          SendeZeichen(NaechstesZch);
          LiesNaechstesZeichen;
        END;
      END UeberspringeSequenz;
      
    BEGIN
      UeberspringeSequenz(FuehrendNumerisch);
      IF NaechstesZch = "." THEN
        SendeZeichen(NaechstesZch);
        LiesNaechstesZeichen;
        UeberspringeSequenz(Numerisch);
        IF NaechstesZch = "E" THEN
           SendeZeichen(NaechstesZch);
           LiesNaechstesZeichen;
           IF (NaechstesZch = "+") OR (NaechstesZch = "-") THEN
              SendeZeichen(NaechstesZch);
              LiesNaechstesZeichen;
           END;
           UeberspringeSequenz(Numerisch);
        END;
      END;
    END UeberspringeZahl;
    
    PROCEDURE FindeSchluesselWort;
    VAR string : ARRAY [0..maxElementeChars] OF CHAR;
        count  : CARDINAL;
    BEGIN
      count:=0;
      WHILE AlphaNumerisch(NaechstesZch) DO
        string[count]:=NaechstesZch; INC(count);
          SendeZeichen(NaechstesZch);
        LiesNaechstesZeichen;
      END;
      ZaehleKlammern; string[count]:=NUL;
      MerkNichtSchluesselWort(string);
      
      SendeZeichen(NaechstesZch);  
      LiesNaechstesZeichen;
    END FindeSchluesselWort;
      
BEGIN
  Assert((InfoTabPtr^.Fehler = ok),ADR("Fehler aufgetreten !"));
  Art := Baustein;
  CASE NaechstesZch OF
    SP,HT,EOL:
      Art := Separator;
      SendeZeichen(NaechstesZch);
      LiesNaechstesZeichen;
  | "+","-","*","/","=",",",";","|","^","[","]","{","}":
      SendeZeichen(NaechstesZch);
      LiesNaechstesZeichen;
  | "&":
      IF InfoTabPtr^.And THEN
         IF AlphaNumerisch(LetztesZch) THEN
            SendeZeichen(SP);
         END;
         SendeZeichenkette("AND");
         LiesNaechstesZeichen;
         IF AlphaNumerisch(NaechstesZch) THEN
            SendeZeichen(SP);
         END;
      ELSE
         SendeZeichen("&");
         LiesNaechstesZeichen;
      END;      
  | "~":
      IF InfoTabPtr^.Tilde THEN
         IF AlphaNumerisch(LetztesZch) THEN
            SendeZeichen(SP);
         END;
         SendeZeichenkette("NOT");
         LiesNaechstesZeichen;
         IF AlphaNumerisch(NaechstesZch) THEN
            SendeZeichen(SP);
         END;
      ELSE
         SendeZeichen("~");
         LiesNaechstesZeichen;
      END;      
  | "#":
      IF InfoTabPtr^.Doppelkreuz THEN
         SendeZeichenkette("<>");
         LiesNaechstesZeichen;
      ELSE
         SendeZeichen("#");
         LiesNaechstesZeichen;
      END;      
  | "(":
       INC(klammerCounter);
       LiesNaechstesZeichen;
       CASE NaechstesZch OF
         "*":
           Art := Separator;
           SendeZeichenkette("(*");
           UeberspringeKommentarRest;
       ELSE
           SendeZeichen("(");
       END;
  | ")":
       DEC(klammerCounter);
       SendeZeichen(")");
       LiesNaechstesZeichen;     
  | ":":
      LiesNaechstesZeichen;
      CASE NaechstesZch OF
       "=":
          SendeZeichenkette(":=");
          LiesNaechstesZeichen;
       ELSE
          SendeZeichen(":");
       END;
  | "<":
       LiesNaechstesZeichen;
       CASE NaechstesZch OF
         "=":
            SendeZeichenkette("<=");
            LiesNaechstesZeichen;
       | ">":
            IF InfoTabPtr^.Doppelkreuz THEN
               SendeZeichenkette("<>");
            ELSE
               SendeZeichen("#");
            END;      
            LiesNaechstesZeichen;
       ELSE
            SendeZeichen("<");
       END;
  | ">":
       LiesNaechstesZeichen;
       CASE NaechstesZch OF
         "=":
            SendeZeichenkette(">=");
            LiesNaechstesZeichen;
       ELSE
            SendeZeichen(">");
       END;
  | ".":
       LiesNaechstesZeichen;
       CASE NaechstesZch OF
         ".":
            SendeZeichenkette("..");
            LiesNaechstesZeichen;
       ELSE
            SendeZeichen(".");
       END;
  | "0".."9":
       UeberspringeZahl;
  |  "a".."z","A".."Z":
       FindeSchluesselWort;
  |  '"',"'":
      UeberspringeZchKette;
  ELSE
     IF (NaechstesZch # NUL) THEN
        SendeZeichen(NaechstesZch);
     END;   
     LiesNaechstesZeichen;
  END;
END KopiereSymbol;
BEGIN
  ZeilenZaehler:=0; ZeichenZaehler:=1;
  Zustand:=inVerarbeitung; status:=undefiniert;
  NaechstesZch:=SP; importSpalte:=0; importZeile:=0;
  defCounter:=1; InfoTabPtr^.Fehler:=ok;
  
  WITH Liste DO
    merkZeile:=FALSE; nobeginorproc:=TRUE;
    fromFlag:=FALSE; importFlag:=FALSE; zeile:=0;
  END;  
  klammerCounter:=0; 
  LiesNaechstesZeichen;
  
    KopiereSymbol(WelcheSorte);
  WHILE (Zustand # Abgeschlossen) DO
    KopiereSymbol(WelcheSorte);
  END;
  
  FOR sort:=0 TO importSpalte-1 DO
    IF (LaengenZaehler[sort]-1 > 1) THEN
       QSort(sort,1,LaengenZaehler[sort]-1);
    END;
  END;
  INC(Pass);
END CheckDatei;  

PROCEDURE SchreibeModule;
VAR string          : ARRAY [0..maxZeilenChars] OF CHAR;
    spaceStr        : ARRAY [0..maxElementeChars] OF CHAR;
    i,j,pos,
    counter,len     : CARDINAL;
    anzahl          : LONGINT;
    
  PROCEDURE SchreibeZeile(str : ARRAY OF CHAR; VAR out : File);
  BEGIN
     pos:=Length(str);
     WriteBytes(out,ADR(str),pos,anzahl);
     WriteChar (out,lineFeed);
  END SchreibeZeile;
  
  PROCEDURE Zeichenanhaengen(zeichen : ARRAY OF CHAR);
  BEGIN
    Concat(string,zeichen);
  END Zeichenanhaengen;
  
  PROCEDURE SchreibeImportListe(VAR out : File);
  VAR check   : ARRAY [0..40] OF CHAR;
      newline : BOOLEAN;
      
     PROCEDURE Zuweisen;
     BEGIN
       IF InfoTabPtr^.Block THEN
          IF newline THEN
             SchreibeZeile(string,out); string:=("  "); newline:=FALSE;
          END;   
       END;
       
       INC(counter);
       len:=Length(ImportElemente[i,j]^.name);
       IF ((Length(string) + len + 1) <= MaxChars) THEN
          Concat(string,ImportElemente[i,j]^.name); Zeichenanhaengen(",");
       ELSE
          SchreibeZeile(string,out); string:=("");
          IF InfoTabPtr^.Block THEN
             string:=("  ");
          ELSE   
             ProduceStr(string," ",InfoTabPtr^.maxlenImportName+13);
          END;   
          Concat(string,ImportElemente[i,j]^.name);
          Zeichenanhaengen(",");
       END;
     END Zuweisen;
     
     PROCEDURE Suchen(k : CARDINAL): BOOLEAN;
     BEGIN 
       WHILE (k <= LaengenZaehler[i]-1) DO
         IF LEQ(check,ImportElemente[i,k]^.name) THEN
            IF (ImportElemente[i,k]^.vorkommen > 0) OR
                                       NOT InfoTabPtr^.aussortieren THEN
               RETURN TRUE;
            ELSE
               RETURN FALSE;
            END;      
         END;
         INC(k);
       END;
       RETURN FALSE;
     END Suchen;
           
  BEGIN
    IF (InfoTabPtr^.module # def) THEN
       FOR i:=0 TO importSpalte-1 DO 
           IF (ImportElemente[i,0]^.status = unqualifiziert) THEN
              string:=("IMPORT "); Concat(string,ImportElemente[i,0]^.name);
              Zeichenanhaengen(";"); SchreibeZeile(string,out);
           END;
       END;
       WriteChar(out,lineFeed);
    END; 
           
    FOR i:=0 TO importSpalte-1 DO
     spaceStr:=(""); string:=(""); counter:=0;
     IF (ImportElemente[i,0]^.status = qualifiziert) THEN
       IF InfoTabPtr^.Block AND (i > 0) THEN WriteChar(out,lineFeed) END;
          Copy(string,"FROM "); Concat(string,ImportElemente[i,0]^.name);
          IF NOT InfoTabPtr^.Block THEN
             ProduceStr(spaceStr," ",InfoTabPtr^.maxlenImportName -
                                    Length(ImportElemente[i,0]^.name));
             Concat(string,spaceStr);
          END;   
          Concat(string," IMPORT ");

          j:=0; newline:=TRUE;
          IF (ImportElemente[i,0]^.vorkommen > 1) THEN
             Zuweisen; newline:=FALSE;
          END;
          FOR j:=1 TO LaengenZaehler[i]-1 DO
            IF (ImportElemente[i,j]^.vorkommen > 0) OR
                                            NOT InfoTabPtr^.aussortieren THEN
              Zuweisen;
            ELSE
              Copy(check,ImportElemente[i,j]^.name); len:=Length(check); 
              LeftStr(check,check,len-1); Concat(check,"Set");
              IF Suchen(j) THEN
                 Zuweisen;
              END;             
            END;
       END;
       IF (counter # 0) THEN
          string[Length(string)-1]:=CHR(ORD(";")); SchreibeZeile(string,out);
       END;   
     END;
    END;
    WriteChar(out,lineFeed);
  END SchreibeImportListe;
  
  PROCEDURE SchreibeModulNamen(VAR out : File);
  BEGIN
    CASE InfoTabPtr^.module OF
      mod: string:=("MODULE ");
    | def: string:=("DEFINITION MODULE ");
    | imp: string:=("IMPLEMENTATION MODULE ");
    END;
    Concat(string,InfoTabPtr^.moduleName^.name); Zeichenanhaengen(";");
    SchreibeZeile(string,out); WriteChar(out,lineFeed);
  END SchreibeModulNamen;
  
  PROCEDURE ProgrammKopf;
  VAR   text   : ARRAY [0..15] OF CHAR; 
      
      PROCEDURE LeerZeile;
      BEGIN
        ProduceStr(string," ",79); string[0]:=("*"); string[78]:=("*");
      END LeerZeile;
      
      PROCEDURE InsertString(VAR string : ARRAY OF CHAR; token : ARRAY OF CHAR;
                              at : INTEGER);
      VAR i,j : INTEGER;
      BEGIN
        i:=0; j:=Length(token);
        WHILE (i < j) DO
          string[at+i]:=token[i]; INC(i);
        END;  
      END InsertString;
   BEGIN
    ProduceStr(string,"*",79); string[0]:=("(");
      SchreibeZeile(string,Output1); LeerZeile; SchreibeZeile(string,Output1);
    text:=("Programmname:"); InsertString(string,text,5); 
      Copy(text,InfoTabPtr^.moduleName^.name); InsertString(string,text,20);
      SchreibeZeile(string,Output1);
    LeerZeile; SchreibeZeile(string,Output1); text:=("Stand:");
      InsertString(string,text,5); MakeDateString(text); 
      InsertString(string,text,20);
      text:=("Uhrzeit:"); InsertString(string,text,56);
    MakeTimeString(text);InsertString(string,text,66);
    SchreibeZeile(string,Output1); LeerZeile; SchreibeZeile(string,Output1);
      string:=("*    Bearbeitet mit dem MODULETool V1.1         (©) by  ");
      Concat(string,"Thomas Stolze 1989    *");
      SchreibeZeile(string,Output1); LeerZeile; SchreibeZeile(string,Output1);
      ProduceStr(string,"*",79); string[78]:=(")");
    SchreibeZeile(string,Output1);
    WriteChar(Output1,lineFeed);
  END ProgrammKopf;
BEGIN
  IF InfoTabPtr^.Head THEN
     ProgrammKopf;
  ELSE
    FOR i:=1 TO InfoTabPtr^.moduleName^.zeile DO
      SchreibeZeile(SourcePtr[i-1]^.zeile,Output1);
    END;
  END;  
  IF InfoTabPtr^.Speed THEN
     IF (InfoTabPtr^.module # def) THEN
        string:=("(* $R- *) (* $V- *) (* $S- *) (* $N- *) (* $F- *)");
        SchreibeZeile(string,Output1);
     ELSIF (InfoTabPtr^.module = def) THEN
        string:=("(* $N- *)");
        SchreibeZeile(string,Output1);
     END;
  END;
        
  SchreibeModulNamen(Output1);
  SchreibeImportListe(Output1);
  
  IF InfoTabPtr^.defMod THEN 
     InfoTabPtr^.module:=def; SchreibeModulNamen(Output2);
     SchreibeImportListe(Output2); WriteChar(Output2,lineFeed);
     
     FOR i:=1 TO defCounter-1 DO
       SchreibeZeile(SourcePtr[DefinitionPtr[i]^.Zeile]^.zeile,Output2);
     END;
     WriteChar(Output2,lineFeed);
     
     string:=("END "); Concat(string,InfoTabPtr^.moduleName^.name);
     Concat(string,"."); SchreibeZeile(string,Output2);
     InfoTabPtr^.endeImportListe:=InfoTabPtr^.endeImportListe-2;
  END;
  
  FOR i:=InfoTabPtr^.endeImportListe+2 TO ZeilenZaehler-1 DO
      SchreibeZeile(SourcePtr[i]^.zeile,Output1);
  END;

END SchreibeModule;

PROCEDURE MakeModule(name : ARRAY OF CHAR; optionen : InfoTabellenPtr;
                     window : WindowPtr): BOOLEAN;
VAR newName: ARRAY [0..140] OF CHAR;
    pos    : INTEGER;
    anzahl : LONGINT;
    PROCEDURE CloseAll;
    BEGIN
      Close(Input); Close(Output1); Close(Output2);
    END CloseAll;
BEGIN
  InfoTabPtr:=optionen; InitKeyWords; windptr:=window;
  Copy(newName,name); firstPass:=TRUE; Pass:=0;
  
  IF InfoTabPtr^.backup THEN
     PrintString(ADR("erstelle Sicherheitskopie"),windptr,130,59,TRUE);
     SicherheitsKopie(name);
  END;   
  
  Lookup(Input,name,1024,FALSE);
  IF (Input.res = done) THEN
     PrintString(ADR("Zeilenzahl:"),windptr,130,49,TRUE);
     PrintString(ADR("Bearbeite Datei"),windptr,130,59,TRUE);
     CheckDatei;
  ELSE
     Close(Input);
     RETURN FALSE;   
  END;
  Close(Input);
  PrintString(ADR("Schreibe Datei zurück"),windptr,130,59,TRUE);
  
  Lookup(Output1,newName,1024,TRUE);
  IF (Output1.res = done) THEN
     IF InfoTabPtr^.defMod THEN
        pos:=LastPos(newName,Length(newName),".");
        IF (pos # -1) THEN LeftStr(newName,newName,pos) END;
        Concat(newName,".def");
        
        Lookup(Output2,newName,1024,TRUE);
        IF (Output2.res # done) THEN
           InfoTabPtr^.Fehler:=dosError;
           CloseAll;
           RETURN FALSE;
        END;
     END;      
     SchreibeModule;
     CloseAll;
     IF InfoTabPtr^.defMod THEN
        PrintString(ADR("Erzeuge DEFINITION MODULE"),windptr,130,59,TRUE);
        Lookup(Input,newName,1024,FALSE);
        IF (Input.res = done) THEN
           WITH InfoTabPtr^ DO
             module:=nichtdefiniert;
             defMod:=FALSE;
             Block:=FALSE;
             endeImportListe:=0;
             maxlenImportName:=0;
             leerzeilenZaehler:=0;
             aussortieren:=TRUE;
           END;
           FOR test1:=0 TO importSpalte-1 DO
               LaengenZaehler[test1]:=0;
           END;    
           LetzterBefehl:=keinBefehl;
           lastOrder:=keinBefehl;
           merkBefehl:=keinBefehl;
           status:=undefiniert;
           firstPass:=FALSE;
           CheckDatei;
           PrintString(ADR("Bearbeitung abgeschlossen"),windptr,130,59,TRUE);
             CloseAll;
             Lookup(Output1,newName,1024,TRUE);
             IF (Output1.res # done) THEN
                InfoTabPtr^.Fehler:=dosError;
                RETURN FALSE;
             END;
           SchreibeModule;
        END;
       CloseAll;
       RETURN TRUE;
     END;  
     RETURN TRUE; 
  ELSE
     CloseAll;
     RETURN FALSE;
  END;      
END MakeModule;

BEGIN
END DefMaker.