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

Text File | 1994-09-03 | 4.9 KB | 203 lines

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

     $RCSfile: OD.mod $
  Description: The Oberon-A module definition utility.

   Created by: fjc (Frank Copeland)
    $Revision: 1.5 $
      $Author: fjc $
        $Date: 1994/09/03 16:29:42 $

  Copyright © 1994, Frank Copeland.
  This file is part of Oberon-A.
  See Oberon-A.doc for conditions of use and distribution.

  Log entries are at the end of the file.

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

MODULE OD;

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

IMPORT
  SYS := SYSTEM,
  ODRev,
  Errors,
  e := Exec,
  u := Utility,
  d := Dos,
  str := Strings,
  ODT;

CONST

  CopyrightStr = "Copyright © 1994 Frank Copeland\n";
  UsageStr     = "See OD.doc for conditions of use\n";

CONST

  template = "FROM/A/M,TO/K,VERBOSE/S";
  optFrom = 0;
  optTo = 1;
  optVerbose = 2;
  optCount = 3;

TYPE

  StringArray = CPOINTER TO ARRAY 32767 OF e.STRPTR;

VAR

  rdArgs    : d.RDArgsPtr;
  fromArray : StringArray;
  toDir     : e.STRPTR;


(* -------------------------------------
**
** Writes a string to the standard output stream.
** This is OS 1.3 compatible, because it will be used
** to tell people they can't use OD on that version of
** the OS :-)
*)

PROCEDURE PutStr ( str : ARRAY OF CHAR );
(* $D- Don't copy open arrays *)
BEGIN (* PutStr *)
  SYS.SETREG (0, d.base.Write (d.base.Output(), str, SYS.STRLEN (str)))
END PutStr;

(*------------------------------------*)
PROCEDURE* Cleanup ();

BEGIN (* Cleanup *)
  IF rdArgs # NIL THEN d.base.FreeArgs (rdArgs) END
END Cleanup;

(*------------------------------------*)
PROCEDURE Init ();

BEGIN (* Init *)
  IF d.base.version >= 37 THEN
    rdArgs := NIL; fromArray := NIL; toDir := NIL;
    SYS.SETCLEANUP (Cleanup)
  ELSE
    PutStr (" !! OD requires OS release 2.04 or greater\n");
    HALT (d.returnWarn)
  END
END Init;

(*------------------------------------*)
PROCEDURE GetArgs ();

  VAR
    argArray  : ARRAY optCount OF SYS.LONGWORD;
    i : INTEGER;

BEGIN (* GetArgs *)
  FOR i := 0 TO optCount - 1 DO argArray [i] := NIL END;
  rdArgs := d.base.ReadArgs (template, argArray, NIL);
  IF rdArgs # NIL THEN
    (*
    ** fromArray is guaranteed to contain something, because of the /A
    ** toDir can be NIL
    *)
    fromArray := SYS.VAL (StringArray, argArray [optFrom]);
    toDir := SYS.VAL (e.STRPTR, argArray [optTo]);
    ODT.verbose := (SYS.VAL (LONGINT, argArray [optVerbose]) # 0)
  ELSE
    IF d.base.PrintFault (d.base.IoErr(), " !! ") THEN END;
    HALT (d.returnError)
  END
END GetArgs;

(*------------------------------------*)
PROCEDURE Main ();

  VAR
    i : INTEGER;
    pat : e.STRPTR; modName : ARRAY 32 OF CHAR;
    myAnchor : d.AnchorPathPtr; result : LONGINT;
    fileName : ARRAY 256 OF CHAR;

BEGIN (* Main *)
  (* myAnchor is allocated because it must be longword aligned *)
  (* $Z+ make sure it is zeroed *)NEW (myAnchor);(* $Z= *)
  myAnchor.strlen := SHORT (LEN (myAnchor.buf));
  i := 0;
  LOOP
    (*
    ** fromArray is an array of pointers to strings, each string
    ** being a file name or an AmigaDOS pattern. The last entry
    ** NIL.
    *)
    pat := fromArray [i];
    IF pat = NIL THEN EXIT END;
    (* Find the first file matching the pattern *)
    result := d.base.MatchFirst (pat^, myAnchor^);
    WHILE result = 0 DO
      (* Process the symbol file *)
      ODT.Init ();
      IF ODT.Import (myAnchor.buf, modName) THEN
        IF toDir # NIL THEN COPY (toDir^, fileName)
        ELSE fileName := ""
        END;
        IF d.base.AddPart (fileName, modName, LEN (fileName)) THEN
          str.Append (fileName, ".Def");
          ODT.Export (fileName, modName)
        ELSE
          PutStr (" !! Could not construct file name\n");
          HALT (d.returnError)
        END;
      ELSE
        (* The cause of the error is already reported by Import() *)
        HALT (d.returnError)
      END;
      ODT.Close ();
      SYS.GC;
      (* Get the next matching file *)
      result := d.base.MatchNext (myAnchor^)
    END;
    d.base.MatchEnd (myAnchor^); (* Clean up anchor data *)
    INC (i)
  END;
END Main;

BEGIN (* OD *)
  PutStr (ODRev.vString);
  PutStr (CopyrightStr);
  PutStr (UsageStr);
  PutStr ("\n");
  Init ();
  GetArgs ();
  Main ();
  PutStr ("\x9B\x4B !! All done\n")
END OD.

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

  $Log: OD.mod $
  Revision 1.5  1994/09/03  16:29:42  fjc
  - Uses version string from ODRev.

  Revision 1.4  1994/08/08  16:36:15  fjc
  Release 1.4

  Revision 1.3  1994/07/22  13:56:21  fjc
  - Bumped version number.

  Revision 1.2  1994/07/10  12:34:21  fjc
  - Added check for dos.library V37+
  - General tidy up

  Revision 1.1  1994/07/09  21:55:50  fjc
  Initial revision

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