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

    :Program.    ModToPas.mod
    :Version.    17.2.90
    :Contents.   Modula II nach Turbo Pascal Konverter
    :Author.     Markus Uhlendahl
    :Address.    Vorm Burgtor 16, D-4408 Dülmen
    :Phone.      02594/81540
    :Copyright.  Public Domain
    :Language.   Modula-2
    :Translator. M2Amiga AMSoft V3.3d

**********************************************************************)
MODULE ModToPas;


FROM SYSTEM     IMPORT ADR,ADDRESS;

FROM Arts       IMPORT Assert,AllLevelTermProc;

FROM Exec       IMPORT AllocMem,MemReqSet,MemReqs,FreeMem;

IMPORT Dos;

FROM Arguments  IMPORT GetArg,NumArgs;

FROM FileSystem IMPORT Lookup,Close,Length,File,Response;

FROM Terminal   IMPORT WriteString,WriteLn,Write;

IMPORT Str;
(*
FROM InOut IMPORT WriteInt;
*)

VAR memory,memory2,mem2 : ADDRESS;


PROCEDURE ReadString (VAR s : ARRAY OF CHAR);

  VAR read : LONGINT;

  BEGIN
    read:=Dos.Read (Dos.Input(),ADR(s),HIGH(s)+1);
    s[read-1]:=0C;
  END ReadString;


PROCEDURE Schreibe (s : ARRAY OF CHAR;VAR mem : ADDRESS);

  VAR i : INTEGER;

  BEGIN
    i:=0;
    WHILE (i<=HIGH(s)) AND (s[i]#0C) AND (mem<memory2+30000) DO
      IF s[i]=CHAR(10) THEN
        mem^:=CHAR(13);
        INC (mem);
      END;
      mem^:=s[i];
      INC (mem);
      INC (i);
    END;
  END Schreibe;


PROCEDURE Schreib (c : CHAR;VAR mem : ADDRESS);

  BEGIN
    IF c=CHAR(10) THEN
      mem^:=CHAR(13);
      INC (mem);
    END;
    mem^:=c;
    INC (mem);
  END Schreib;


PROCEDURE FileNamen (VAR FileName,AusgabeFile : ARRAY OF CHAR);

  VAR err : BOOLEAN;

  BEGIN
    err:=FALSE;
    IF FileName[Str.Length(FileName)-1]#"d" THEN
      err:=TRUE;
    ELSIF FileName[Str.Length(FileName)-2]#"o" THEN
      err:=TRUE;
    ELSIF FileName[Str.Length(FileName)-3]#"m" THEN
      err:=TRUE;
    ELSIF FileName[Str.Length(FileName)-4]#"." THEN
      err:=TRUE;
    END;
    IF err THEN
      Str.CopyPos (FileName,".mod",Str.Length(FileName));
    END;
    Str.Copy (AusgabeFile,FileName);
    Str.CopyPos (AusgabeFile,".pas",Str.Length(FileName)-4);
  END FileNamen;


PROCEDURE leseFile (    FileName : ARRAY OF CHAR;
                    VAR laenge   : LONGINT;
                    VAR mem      : ADDRESS);

  VAR anz,i  : LONGINT;
      file   : File;
      handle : Dos.FileHandlePtr;

  BEGIN
    Lookup (file,FileName,1024,FALSE);
    Assert (file.res#notFound,ADR("DATEI NICHT ZU ÖFFNEN"));
    Length (file,laenge);
    Close (file);
    memory:=AllocMem (laenge,MemReqSet{chip});
    Assert (memory#NIL,ADR("NICHT GENUG CHIPMEMORY"));
    mem:=memory;
    handle:=Dos.Open (ADR(FileName),Dos.readOnly);
    anz:=Dos.Read (handle,mem,laenge);
    Assert (anz=laenge,ADR("FEHLER BEIM LESEN"));
    Dos.Close (handle);
  END leseFile;


PROCEDURE schreibeFile (ausgabe : ARRAY OF CHAR;
                        laenge  : LONGINT;
                        mem     : ADDRESS);

  VAR file : File;
      anz  : LONGINT;

  BEGIN
    Lookup (file,ausgabe,1024,TRUE);
    Assert (file.res#notFound,ADR("DATEI NICHT ZU SCHREIBEN"));
    anz:=Dos.Write (file.file,mem,laenge);
    Close (file);
    Assert (anz=laenge,ADR("FEHLER BEIM SCHREIBEN?"));
  END schreibeFile;


PROCEDURE Wortholen (VAR wort : ARRAY OF CHAR;
                     VAR mem  : ADDRESS;
                     VAR ende : LONGCARD);

  VAR i : INTEGER;

  BEGIN
    i:=0;
    WHILE NOT(((CHAR(mem^)>="a") AND (CHAR(mem^)<="z")) OR
          ((CHAR(mem^)>="A") AND (CHAR(mem^)<="Z")) OR
          ((CHAR(mem^)<="9") AND (CHAR(mem^)>="0"))) AND
          (LONGCARD(mem)<=ende) DO
      Schreib (CHAR(mem^),mem2);
      INC (mem);
    END;
    WHILE ((CHAR(mem^)>="a") AND (CHAR(mem^)<="z")) OR
          ((CHAR(mem^)>="A") AND (CHAR(mem^)<="Z")) OR
          ((CHAR(mem^)<="9") AND (CHAR(mem^)>="0")) DO
      wort[i]:=CHAR(mem^);
      INC (mem);
      INC (i);
    END;
    wort[i]:=0C;
  END Wortholen;


PROCEDURE bisSemikolon (VAR mem : ADDRESS);

  BEGIN
    WHILE CHAR(mem^)#";" DO
      INC (mem);
    END;
    INC (mem,2);
  END bisSemikolon;


PROCEDURE funktion (akt : ADDRESS) : BOOLEAN;

  VAR access : INTEGER;

  BEGIN
    access:=0;
    WHILE (CHAR(akt^)#";") DO
      IF (CHAR(akt^)="(") THEN
        INC (access);
      ELSIF (CHAR(akt^)=")") THEN
        DEC (access);
      END;
      IF (access=0) AND (CHAR(akt^)=":") THEN
        RETURN (TRUE);
      END;
      INC (akt);
    END;
    RETURN (FALSE);
  END funktion;


PROCEDURE ModulaNachPascal (FileName,AusgabeFile : ARRAY OF CHAR);

  VAR laenge : LONGINT;
      mem    : ADDRESS;
      wort   : ARRAY[0..80] OF CHAR;
      ende   : LONGCARD;
      stack  : INTEGER;
      hilf   : ADDRESS;
      fstack : INTEGER;
      fkt    : ARRAY[1..10],[1..80] OF CHAR;
      last   : ARRAY[1..50] OF BOOLEAN;
      pstack : INTEGER;


  BEGIN
    fstack:=0;
    stack:=0;
    pstack:=0;
    leseFile (FileName,laenge,mem);
    ende:=LONGCARD(mem)+LONGCARD(laenge)-1;
    memory2:=AllocMem (30000,MemReqSet{chip});
    Assert (memory2#NIL,ADR("NICHT GENUG CHIPMEMORY"));
    mem2:=memory2;
    WHILE ende>=LONGCARD(mem) DO
      Wortholen (wort,mem,ende);
      IF Str.Compare (wort,"MODULE")=0 THEN
        Schreibe ("PROGRAM",mem2);
      ELSIF Str.Compare (wort,"PROCEDURE")=0 THEN
        INC (pstack);
        last[pstack]:=FALSE;
        IF funktion(mem) THEN
          INC (fstack);
          last[pstack]:=TRUE;
          hilf:=mem+1;
          Wortholen (fkt[fstack],hilf,ende);
          Schreibe ("FUNCTION",mem2);
        ELSE
          Schreibe ("PROCEDURE",mem2);
        END;
      ELSIF Str.Compare (wort,"RETURN")=0 THEN
        Schreibe (fkt[fstack],mem2);
        Schreibe (":=",mem2);
        REPEAT
          Schreib (CHAR(mem^),mem2);
          INC (mem);
        UNTIL (CHAR(mem^)=";");
        Schreibe ("; EXIT;",mem2);
        INC (mem);
      ELSIF Str.Compare (wort,"IMPORT")=0 THEN
        bisSemikolon (mem);
      ELSIF Str.Compare (wort,"FROM")=0 THEN
        bisSemikolon (mem);
      ELSIF Str.Compare (wort,"THEN")=0 THEN
        Schreibe ("THEN BEGIN",mem2);
        INC (stack);
      ELSIF Str.Compare (wort,"ELSIF")=0 THEN
        DEC (stack);
      ELSIF Str.Compare (wort,"DO")=0 THEN
        Schreibe ("DO BEGIN",mem2);
        INC (stack);
      ELSIF Str.Compare (wort,"ELSE")=0 THEN
        Schreibe ("END ELSE BEGIN",mem2);
      ELSIF Str.Compare (wort,"POINTER")=0 THEN
        Wortholen (wort,mem,ende);
        Schreibe ("^",mem2);
        INC (mem);
      ELSIF Str.Compare (wort,"RECORD")=0 THEN
        Schreibe ("RECORD",mem2);
        INC (stack);
      ELSIF Str.Compare (wort,"WriteString")=0 THEN
        Schreibe ("Write",mem2);
        WHILE CHAR(mem^)#";" DO
          IF (CHAR(mem^)=CHAR(34)) THEN
            Schreib ("'",mem2);
          ELSE
            Schreib (CHAR(mem^),mem2);
          END;
          INC (mem);
        END;
      ELSIF Str.Compare (wort,"Write")=0 THEN
        Schreibe ("Write",mem2);
        WHILE CHAR(mem^)#";" DO
          IF (CHAR(mem^)=CHAR(34)) THEN
            Schreib ("'",mem2);
          ELSE
            Schreib (CHAR(mem^),mem2);
          END;
          INC (mem);
        END;
      ELSIF Str.Compare (wort,"WriteInt")=0 THEN
        Schreibe ("Write",mem2);
        WHILE CHAR(mem^)#";" DO
          IF CHAR(mem^)="," THEN
            Schreib (":",mem2);
          ELSE
            Schreib (CHAR(mem^),mem2);
          END;
          INC (mem);
        END;
      ELSIF Str.Compare (wort,"WriteReal")=0 THEN
        Schreibe ("Write",mem2);
        WHILE CHAR(mem^)#";" DO
          IF CHAR(mem^)="," THEN
            Schreib (":",mem2);
          ELSE
            Schreib (CHAR(mem^),mem2);
          END;
          INC (mem);
        END;
      ELSIF Str.Compare (wort,"ReadReal")=0 THEN
        Schreibe ("Read",mem2);
      ELSIF Str.Compare (wort,"ReadInt")=0 THEN
        Schreibe ("Read",mem2);
      ELSIF Str.Compare (wort,"ReadString")=0 THEN
        Schreibe ("Read",mem2);
      ELSIF Str.Compare (wort,"ReadF")=0 THEN
        Schreibe ("Read",mem2);
      ELSIF Str.Compare (wort,"ReadFInt")=0 THEN
        Schreibe ("Read",mem2);
      ELSIF Str.Compare (wort,"ReadFString")=0 THEN
        Schreibe ("Read",mem2);
      ELSIF Str.Compare (wort,"ReadFReal")=0 THEN
        Schreibe ("Read",mem2);
      ELSIF Str.Compare (wort,"WriteF")=0 THEN
        Schreibe ("Write",mem2);
      ELSIF Str.Compare (wort,"WriteFInt")=0 THEN
        Schreibe ("Write",mem2);
      ELSIF Str.Compare (wort,"WriteFString")=0 THEN
        Schreibe ("Write",mem2);
        WHILE CHAR(mem^)#";" DO
          IF (CHAR(mem^)=CHAR(34)) THEN
            Schreib ("´",mem2);
          ELSE
            Schreib (CHAR(mem^),mem2);
          END;
          INC (mem);
        END;
      ELSIF Str.Compare (wort,"WriteFReal")=0 THEN
        Schreibe ("Write",mem2);
      ELSIF Str.Compare (wort,"END")=0 THEN
        Schreibe ("END",mem2);
        IF stack=0 THEN
          INC (mem);
          IF (pstack>0) AND (last[pstack]) THEN
            DEC (fstack);
          END;
          DEC (pstack);
          Wortholen (wort,mem,ende);
        ELSE
          DEC (stack);
        END;
      ELSE
        Schreibe (wort,mem2);
      END;
    END;
    schreibeFile (AusgabeFile,LONGINT(mem2-memory2),memory2);
  END ModulaNachPascal;


VAR laenge               : LONGINT;
    FileName,AusgabeFile : ARRAY[0..107] OF CHAR;
    hilf,i               : INTEGER;


PROCEDURE Cleanup;

  BEGIN
    IF memory#NIL THEN
      FreeMem (memory,laenge);
    END;
    IF memory2#NIL THEN
      FreeMem (memory2,30000);
    END;
  END Cleanup;


BEGIN
  memory:=NIL;
  AllLevelTermProc (Cleanup);
  WriteString ("Modula II nach Turbo Pascal Konverter, 9.2.90,");
  WriteString (" ©  Markus Uhlendahl");WriteLn;
  IF NumArgs()>0 THEN
    FOR i:=1 TO NumArgs() DO
      GetArg (i,FileName,hilf);
      IF FileName[0]="?" THEN
        WriteString ("Aufruf: ModToPas {prgname{.mod}}");WriteLn;
        FileName[0]:=0C;
      END;
      IF FileName[0]#0C THEN
        FileNamen (FileName,AusgabeFile);
        ModulaNachPascal (FileName,AusgabeFile);
      END;
    END;
  ELSE
    WriteString ("Bitte Filename:");ReadString (FileName);
    IF FileName[0]#0C THEN
      FileNamen (FileName,AusgabeFile);
      ModulaNachPascal (FileName,AusgabeFile);
    END;
  END;
END ModToPas.