Fresh Fish 8/FreshFishVol8-CD1.bin/useful/dev/obero/oberon-a/source/ol/ol.mod

Text File | 1994-09-03 | 16.9 KB | 564 lines

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

     $RCSfile: OL.mod $
  Description: Recursively scans the symbol files referenced by a module and
               creates a WITH file to be input to a linker.

   Created by: fjc (Frank Copeland)
    $Revision: 2.3 $
      $Author: fjc $
        $Date: 1994/09/03 16:30:49 $

  Copyright © 1993-1994, Frank Copeland
  This module forms part of the OL program
  See OL.doc for conditions of use and distribution

  Log entries are at the end of the file.

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

MODULE OL;

(*
** $C= CaseChk       $I= IndexChk  $L= LongAdr   $N= NilChk
** $P- PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
** $V= OvflChk       $Z= ZeroVars
*)

IMPORT
  OLRev, Errors, E := Exec, D := Dos, DU := DosUtil, Str := Strings,
  F := Files, IO := StdIO, Args, SYS := SYSTEM, L := Lists;

CONST
  CopyrightStr = "Copyright © 1993-1994 Frank Copeland\n";
  UsageStr = "See OL.doc for conditions of use\n";

  maxPaths = 32;
  maxName  = 255;
  maxPath  = 255;

  SymTag = 53594D07H; (* Symbol file tag : "SYM" + version # *)

  (* terminal symbols for symbol file elements *)
  eUndef = 0; eCon = 1; eTypE = 2; eTyp = 3; eVar = 4; eXProc = 5;
  eLibCall = 6; ePointer = 7; eProcTyp = 8; eArray = 9; eDynArr = 10;
  eRecord = 11; eParList = 12; eValPar = 13; eVarPar = 14; eValRegPar = 15;
  eVarRegPar = 16; eFldList = 17; eFld = 18; eHPtr = 19; eHProc = 20;
  eFixup = 21; eMod = 22; eBPointer = 23; eCPointer = 24; eMod0 = 25;

  noLinker = 0;
  aLink = 1;
  bLink = 2;
  dLink = 3;

TYPE
  NameStr = ARRAY maxName + 1 OF CHAR;
  PathStr = ARRAY maxPath + 1 OF CHAR;

  ModulePtr = POINTER TO Module;
  Module = RECORD (L.ExtNode)
    path : PathStr;
  END; (* Module *)

VAR
  searchPath : ARRAY maxPaths OF E.STRPTR;
  pathx      : INTEGER;
  moduleName : NameStr;
  moduleList : L.List;
  linker : SHORTINT;
  doLink : BOOLEAN;
  outputPath, linkerPath, linkOptions : ARRAY 256 OF CHAR;
  withName : PathStr;

(*------------------------------------*)
PROCEDURE Greetings ();

BEGIN (* Greetings *)
  IO.WriteStr (OLRev.vString);
  IO.WriteStr (CopyrightStr);
  IO.WriteStr (UsageStr);
  IO.WriteLn ();
END Greetings;

PROCEDURE Init ();

  (*------------------------------------*)
  PROCEDURE WbInit ();

  BEGIN (* WbInit *)
    IO.WriteStr ("Sorry, no support for Workbench yet :-(\n");
    HALT (10);
  END WbInit;

  (*------------------------------------*)
  PROCEDURE Usage ();

  BEGIN (* Usage *)
    IO.WriteStr ("Usage   : OL {option} <module>\n");
    IO.WriteStr ("Options : SRC | SOURCE <directory>\n");
    IO.WriteStr ("          DST | DESTINATION <directory>\n");
    IO.WriteStr ("          ALINK | BLINK | DLINK\n");
    IO.WriteStr ("          LINK\n");
    IO.WriteStr ("          LINKER <path>\n");
    IO.WriteStr ("          OPT | OPTIONS <linker options>\n");
    IO.WriteStr ("see OL.doc for details\n\n");
    HALT (20)
  END Usage;

  (*------------------------------------*)
  PROCEDURE CliInit ();

    CONST
      OnlyOneLinker = " !! More than one linker specified\n\n";
      RepeatArg = " !! Argument given more than once\n\n";

    VAR arg : INTEGER; argStr : ARRAY 256 OF CHAR;

  BEGIN (* CliInit *)
    arg := 1; moduleName := ""; linker := noLinker; doLink := FALSE;
    linkerPath := ""; linkOptions := "";
    LOOP
      IF arg >= Args.argc THEN
        IF moduleName = "" THEN Usage () ELSE EXIT END;
      END;
      COPY (Args.argv [arg]^, argStr); Str.ToUpper (argStr);
      IF (argStr = "SRC") OR (argStr = "SOURCE") THEN
        INC (arg); IF arg >= Args.argc THEN Usage () END;
        IF pathx >= maxPaths THEN
          IO.WriteStr (" !! Too many search paths\n\n"); HALT (20)
        ELSE
          searchPath [pathx] := Args.argv [arg];
          INC (pathx); searchPath [pathx] := NIL
        END
      ELSIF (argStr = "DST") OR (argStr = "DESTINATION") THEN
        IF outputPath = "" THEN
          INC (arg); IF arg >= Args.argc THEN Usage () END;
          COPY (Args.argv [arg]^, outputPath )
        ELSE
          IO.WriteStr (RepeatArg); Usage ()
        END;
      ELSIF argStr = "ALINK" THEN
        IF linker = noLinker THEN linker := aLink
        ELSE
          IO.WriteStr (OnlyOneLinker); Usage ()
        END;
      ELSIF argStr = "BLINK" THEN
        IF linker = noLinker THEN linker := bLink
        ELSE
          IO.WriteStr (OnlyOneLinker); Usage ()
        END;
      ELSIF argStr = "DLINK" THEN
        IF linker = noLinker THEN linker := dLink
        ELSE
          IO.WriteStr (OnlyOneLinker); Usage ()
        END;
      ELSIF argStr = "LINK" THEN
        IF ~doLink THEN doLink := TRUE
        ELSE IO.WriteStr (RepeatArg); Usage ()
        END
      ELSIF argStr = "LINKER" THEN
        IF linkerPath = "" THEN
          INC (arg); IF arg >= Args.argc THEN Usage () END;
          COPY (Args.argv [arg]^, linkerPath)
        ELSE
          IO.WriteStr (RepeatArg); Usage ()
        END
      ELSIF (argStr = "OPT") OR (argStr = "OPTIONS") THEN
        IF linkOptions = "" THEN
          INC (arg); IF arg >= Args.argc THEN Usage () END;
          COPY (Args.argv [arg]^, linkOptions)
        ELSE
          IO.WriteStr (RepeatArg); Usage ()
        END
      ELSIF moduleName = "" THEN
        COPY (Args.argv [arg]^, moduleName)
      ELSE
        Usage ()
      END;
      INC (arg);
    END; (* LOOP *)
    IF linker = noLinker THEN linker := bLink END;
    IF pathx >= maxPaths THEN
      IO.WriteStr (" !! Too many search paths\n\n"); HALT (20)
    ELSIF linker # dLink THEN
      searchPath [pathx] := SYS.ADR ("OLIB:");
      INC (pathx); searchPath [pathx] := NIL
    END;

    IO.WriteF1 ("Program : %s\n", SYS.ADR (moduleName));
    IO.WriteStr ("Linker  : ");
    IF linkerPath # "" THEN IO.WriteStr (linkerPath); IO.Write (" ")
    ELSIF linker = aLink THEN IO.WriteStr ("ALink ")
    ELSIF linker = bLink THEN IO.WriteStr ("BLink ")
    ELSE IO.WriteStr ("dlink ")
    END;
    IF doLink THEN IO.WriteStr (linkOptions) END;
    IO.WriteLn (); IO.WriteLn ()
  END CliInit;

BEGIN (* Init *)
  searchPath [0] := NIL; pathx := 0; outputPath := "";
  L.NewList (moduleList);
  IF Args.argc = 0 THEN   (* Program run from Workbench *)
    WbInit ()
  ELSE                      (* Program run from CLI *)
    CliInit ()
  END; (* ELSE *)
END Init;

PROCEDURE Main ();

  VAR error : BOOLEAN;

  (*------------------------------------*)
  PROCEDURE Process (modName : ARRAY OF CHAR; key : LONGINT);

    VAR
      fileName, name : NameStr; symPath, objPath : PathStr;
      node : L.NodePtr; module : ModulePtr; symFile : F.File; r : F.Rider;
      s : SHORTINT; i : INTEGER; l, modKey : LONGINT; ch : CHAR;

    (*------------------------------------*)
    PROCEDURE ReadModAnchor (
      VAR k : LONGINT; VAR n : ARRAY OF CHAR)
      : BOOLEAN;

      VAR s : SHORTINT; ch : CHAR;

    BEGIN (* ReadModAnchor *)
      F.Read (r, s); (* modAnchor *)
      IF (s = eMod) OR (s = eMod0) THEN
        F.ReadBytes (r, k, 4); (* key *)
        s := 0;
        LOOP
          F.Read (r, ch); n [s] := ch;
          IF ch = 0X THEN EXIT END;
          INC (s);
          IF s > maxName THEN
            n [maxName] := 0X;
            IO.WriteF1
              ( "\x9B\x4B !! Module name too long in symbol file %s\n\n",
                SYS.ADR (symPath));
            RETURN FALSE
          END; (* IF *)
        END; (* LOOP *)
        RETURN TRUE
      END; (* IF *)
      RETURN FALSE
    END ReadModAnchor;

  (* $D- disable copying of open arrays *)
  BEGIN (* Process *)
    node := L.FindName (moduleList, modName);
    IF node = NIL THEN
      COPY (modName, fileName); Str.Append (fileName, ".Sym");
      IF DU.Search (searchPath, fileName, symPath) THEN
        COPY (modName, fileName); Str.Append (fileName, ".Obj");
        IF DU.Search (searchPath, fileName, objPath) THEN
          NEW (module);
          IF module # NIL THEN
            L.AttachName (module^, modName);
            module.path := objPath; module.key := key;
            L.AddTail (moduleList, module);
            symFile := F.Old (symPath);
            IF symFile # NIL THEN
              IO.WriteF1 ("\x9B\x4B << %s\r", SYS.ADR (symPath));
              F.Set (r, symFile, 0);
              F.ReadBytes (r, l, 4); (* Symbol file tag *)
              IF l = SymTag THEN
                IF ReadModAnchor (modKey, name) THEN
                  IF (key = 0) OR (key = modKey) THEN
                    IF Str.CompareCAP (modName, name) = 0 THEN
                      WHILE ~error & ReadModAnchor (modKey, name) DO
                        Process (name, modKey)
                      END
                    ELSE
                      IO.WriteF1 (
                        "\x9B\x4B !! Bad name in symbol file %s\n\n",
                        SYS.ADR (symPath));
                      error := TRUE
                    END; (* ELSE *)
                  ELSE
                    IO.WriteF1 (
                      "\x9B\x4B !! Bad key in symbol file %s\n\n",
                      SYS.ADR (symPath));
                    error := TRUE
                  END; (* ELSE *)
                ELSE
                  IO.WriteF1 (
                    "\x9B\x4B !! Bad modAnchor in symbol file %s\n\n",
                    SYS.ADR (symPath));
                  error := TRUE
                END; (* ELSE *)
              ELSE
                IO.WriteF1 (
                  "\x9B\x4B !! Bad tag in symbol file %s\n\n",
                  SYS.ADR (symPath));
                error := TRUE
              END; (* ELSE *)
              F.Close (symFile)
            ELSE
              IO.WriteF1 (
                "\x9B\x4B !! Could not open %s\n\n", SYS.ADR (symPath));
              error := TRUE
            END; (* IF *)
          ELSE
            IO.WriteStr ("\x9B\x4B !! Out of memory\n\n");
            error := TRUE
          END; (* ELSE *)
        ELSIF linker # dLink THEN
          IO.WriteF1 (
            "\x9B\x4B !! Could not find object file %s\n\n", SYS.ADR (fileName));
          error := TRUE
        END
      ELSIF linker # dLink THEN
        IO.WriteF1 (
          "\x9B\x4B !! Could not find symbol file %s\n\n", SYS.ADR (fileName));
        error := TRUE
      END; (* IF *)
    ELSE
      IF node (ModulePtr).key # key THEN
        IO.WriteF1 (
          "\x9B\x4B !! Bad key in module %s\n\n", SYS.ADR (modName));
        error := TRUE
      (*
      ELSE
        IO.WriteF1 (
          "\x9B\x4B    Module %s already processed\r", SYS.ADR (modName));
      *)
      END; (* IF *)
    END; (* IF *)
  END Process;

  (*------------------------------------*)
  PROCEDURE OberonLib ();

    VAR libPath : PathStr; module : ModulePtr;

  BEGIN (* OberonLib *)
    IF linker = dLink THEN
      IF pathx >= maxPaths THEN
        IO.WriteStr (" !! Too many search paths\n\n"); HALT (20)
      ELSE
        searchPath [pathx] := SYS.ADR ("OLIB:");
        INC (pathx); searchPath [pathx] := NIL
      END;
      IF DU.Search (searchPath, "OLib.lib", libPath) THEN
        NEW (module);
        IF module # NIL THEN
          module.path := libPath; L.AddTail (moduleList, module);
        ELSE
          IO.WriteStr ("\x9B\x4B !! Out of memory\n\n");
          error := TRUE
        END
      ELSE
        IO.WriteStr ("\x9B\x4B !! Could not find OLib.lib\n\n");
        error := TRUE
      END
    END;
    IF DU.Search (searchPath, "OberonSys.lib", libPath) THEN
      NEW (module);
      IF module # NIL THEN
        module.path := libPath; L.AddTail (moduleList, module);
      ELSE
        IO.WriteStr ("\x9B\x4B !! Out of memory\n\n");
        error := TRUE
      END; (* ELSE *)
    ELSE
      IO.WriteStr ("\x9B\x4B !! Could not find OberonSys.lib\n\n");
      error := TRUE
    END; (* IF *)
  END OberonLib;

  (*------------------------------------*)
  (*
    Produces a .with file with the format:

    FROM <moduleName>.obj
    LIBRARY <first imported module>*
      <other imported modules>*
      ...
      OberonSys.lib
    TO <moduleName>

  *)
  PROCEDURE Output ();

    VAR
      withFile : F.File; w : F.Rider; module : L.NodePtr; ch : CHAR;

    (*------------------------------------*)
    PROCEDURE Indent ();
    BEGIN (* Indent *)
      F.Write (w, " "); F.Write (w, " ")
    END Indent;

    (*------------------------------------*)
    PROCEDURE WriteStr (str : ARRAY OF CHAR);
    (* $D- disable copying of open arrays *)
    BEGIN (* WriteStr *)
      F.WriteBytes (w, str, Str.Length (str))
    END WriteStr;

    (*------------------------------------*)
    PROCEDURE OutputALink ();

    BEGIN (* OutputALink *)
      F.Set (w, withFile, 0);
      module := moduleList.head;
      WriteStr ("FROM ");
      WriteStr (module (ModulePtr).path); F.Write (w, "\n");
      module := module.succ;
      WriteStr ("LIBRARY "); WriteStr (module (ModulePtr).path);
      module := module.succ;
      WHILE module # NIL DO
        F.Write (w, "*"); F.Write (w, "\n");
        Indent (); WriteStr (module (ModulePtr).path);
        module := module.succ
      END;
      F.Write (w, "\n"); WriteStr ("TO ");
      WriteStr (moduleName); F.Write (w, "\n");
    END OutputALink;

    (*------------------------------------*)
    PROCEDURE OutputBLink ();

    BEGIN (* OutputBLink *)
      F.Set (w, withFile, 0);
      module := moduleList.head;
      WriteStr ("FROM\n");
      Indent (); WriteStr (module (ModulePtr).path); F.Write (w, "\n");
      module := module.succ;
      WriteStr ("LIBRARY\n");
      WHILE module # NIL DO
        Indent (); WriteStr (module (ModulePtr).path); F.Write (w, "\n");
        module := module.succ
      END;
      WriteStr ("TO\n");
      Indent (); WriteStr (moduleName); F.Write (w, "\n");
    END OutputBLink;

    (*------------------------------------*)
    PROCEDURE OutputDLink ();

    BEGIN (* OutputDLink *)
      F.Set (w, withFile, 0);
      module := moduleList.head;
      WHILE module # NIL DO
        WriteStr (module (ModulePtr).path); F.Write (w, "\n");
        module := module.succ
      END;
    END OutputDLink;

  BEGIN (* Output *)
    IF outputPath # "" THEN
      COPY (outputPath, withName);
      ch := withName [Str.Length(withName)-1];
      IF (ch # ":") & (ch # "/") THEN Str.Append (withName, "/") END
    ELSE
      withName [0] := 0X
    END;
    Str.Append (withName, moduleName); Str.Append (withName, ".with");
    withFile := F.New (withName);
    IF withFile # NIL THEN
      IF linker = aLink THEN OutputALink ()
      ELSIF linker = bLink THEN OutputBLink ()
      ELSE OutputDLink ()
      END;
      F.Register (withFile);
      IF withFile.dosError # 0 THEN
        IO.WriteF1 ("\x9B\x4B !! Error closing %s\n", SYS.ADR (withName))
      ELSE
        IO.WriteF1 ("\x9B\x4B >> %s\n\n", SYS.ADR (withName))
      END;
    ELSE
      IO.WriteF1 (
        "\x9B\x4B !! Could not create %s\n", SYS.ADR (withName));
    END; (* ELSE *)
  END Output;

  (*------------------------------------*)
  PROCEDURE DoLink ();

    VAR
      command : ARRAY 256 OF CHAR; success : BOOLEAN;

  BEGIN (* DoLink *)
    IF linkerPath # "" THEN COPY (linkerPath, command)
    ELSIF linker = aLink THEN command := "ALink"
    ELSIF linker = bLink THEN command := "BLink"
    ELSE (* linker = dLink *) command := "dlink"
    END;
    IF linker = dLink THEN Str.Append (command, " @")
    ELSE Str.Append (command, " WITH ")
    END;
    Str.Append (command, withName);
    IF linkOptions # "" THEN
      Str.Append (command, " "); Str.Append (command, linkOptions)
    END;
    IF D.base.version >= 37 THEN
      success := (D.base.SystemTags (command, 0) # -1)
    ELSE
      success := D.base.Execute (command, NIL, NIL)
    END;
    IF ~success THEN
      IO.WriteF1 (" !! Error calling '%s'\n", SYS.ADR (command))
    END
  END DoLink;

BEGIN (* Main *)
  error := FALSE;
  Process (moduleName, 0);
  IF ~error THEN OberonLib () END;
  IF ~error THEN Output () END;
  IF ~error & doLink THEN DoLink () END
END Main;

BEGIN (* OL *)
  Greetings ();
  Init ();
  Main ()
END OL.

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

  $Log: OL.mod $
  Revision 2.3  1994/09/03  16:30:49  fjc
  - Gets version string from OLRev.

  Revision 2.2  1994/08/08  16:37:42  fjc
  Release 1.4

  Revision 2.1  1994/07/03  14:59:27  fjc
  - Added option to call linker direct from OL.

  Revision 1.6  1994/06/17  18:07:52  fjc
  - Added specific support for ALink and dlink.

  Revision 1.5  1994/06/05  00:02:02  fjc
  - Changed to use new Amiga interface

  Revision 1.4  1994/05/19  23:26:57  fjc
  - Fixed case-sensitivity of module parameter.
  - Command line arguments slightly changed.
  - Changed format of .with file to suit Commodore's ALink.
  - OLIB: is now the default symbol file search path.

  Revision 1.3  1994/05/11  23:42:09  fjc
  - Added copyright notice to file header
  - Changed greeting

  Revision 1.2  1994/01/25  09:58:30  fjc
  - Updated greeting

  Revision 1.1  1994/01/15  19:00:05  fjc
  - Start of revision control

  v0.3  (02-01-94)  Recognises new symbol file tags.
  v0.2  (06-09-93)  First public release.
  v0.1  (23-07-93)  Initial conversion from Modula 2 to Oberon.
  v0.0  (28-05-93)  Initial version, written in Modula 2.

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