Gold Fish 3/goldfish_volume_3.bin/files/dev/obero/oberon-a/source/misc/stripcomments.mod

Text File | 1995-07-02 | 10.4 KB | 449 lines

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

     $RCSfile: StripComments.mod $
  Description: A utility to strip comments from Oberon source files.

   Created by: fjc (Frank Copeland)
    $Revision: 1.7 $
      $Author: fjc $
        $Date: 1995/01/26 01:05:15 $

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

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

<*STANDARD-*>

MODULE StripComments;

IMPORT
  SYS := SYSTEM,
  Kernel,
  Errors,
  rev := StripCommentsRev,
  e := Exec,
  d := Dos,
  f := Files,
  IO := StdIO,
  Str := Strings;

CONST

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

TYPE

  StringArray = POINTER [2] TO ARRAY 32767 OF e.LSTRPTR;

VAR

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

CONST
  CopyrightStr = "Copyright © 1994, Frank Copeland\n";
  UsageStr     = "see Oberon-A.doc for conditions of use\n\n";
  FileTag      = "\n\n(* Comments stripped by StripComments 1.5 *)\n";

CONST

  PathLen = 255;

TYPE

  Path = ARRAY PathLen + 1 OF CHAR;

VAR

  (*
    These variables are global so that they may be found by the Cleanup()
    procedure in the event of an abnormal exit
  *)

  input,      (* The current input file. *)
  output      (* The current output file. *)
    : f.File;

  r, w : f.Rider;
  ch : CHAR;

CONST

  CR = 0DX; LF = 0AX; TAB = 09X; SP = " ";

VAR

  state, line, spaces, blanklines : INTEGER;
  blankline : BOOLEAN;
  quoteChar : CHAR;

CONST

  STARTLINE = 0;
  WHITESPACE = 1;
  COPYCHAR = 2;
  LEFTBRACKET = 3;
  STARTCOMMENT = 4;
  COPYCOMMENT = 5;
  SKIPCOMMENT = 6;
  STAR = 7;
  ENDCOMMENT = 8;
  INSTRING = 9;


(*------------------------------------*)
PROCEDURE* Cleanup (VAR rc : LONGINT);

BEGIN (* Cleanup *)
  IF input # NIL THEN f.Close (input) END;
  IF output # NIL THEN f.Purge (output) END;
  IF rdArgs # NIL THEN d.FreeArgs (rdArgs) END
END Cleanup;

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

BEGIN (* Init *)
  IF d.base.lib.version >= 37 THEN
    rdArgs := NIL; fromArray := NIL; toDir := NIL;
    Kernel.SetCleanup (Cleanup)
  ELSE
    IO.WriteStr (" !! StripComments requires OS release 2.04 or greater\n");
    HALT (d.warn)
  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.OldReadArgs (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.LSTRPTR, argArray [optTo]);
  ELSE
    IF d.PrintFault (d.IoErr(), "ReadArgs") THEN END;
    HALT (d.error)
  END
END GetArgs;

(*------------------------------------*)
PROCEDURE MakeOutputName
  (inputName : ARRAY OF CHAR; VAR outputName : ARRAY OF CHAR);

  VAR filePart : e.LSTRPTR;

<*$CopyArrays-*>
BEGIN (* MakeOutputName *)
  filePart := d.FilePart (inputName);
  IF toDir = NIL THEN COPY ("", outputName)
  ELSE COPY (toDir^, outputName)
  END;
  Errors.Assert
    ( d.AddPart (outputName, filePart^, PathLen),
      "Output file name too big" )
END MakeOutputName;

(*------------------------------------*)
PROCEDURE WriteSpaces ();

BEGIN (* WriteSpaces *)
  WHILE spaces > 0 DO f.Write (w, SP); DEC (spaces) END
END WriteSpaces;

(*------------------------------------*)
PROCEDURE WriteString (s : ARRAY OF CHAR);

  VAR i : INTEGER; ch : CHAR;

<*$CopyArrays-*>
BEGIN (* WriteString *)
  i := 0; ch := s [0];
  WHILE ch # 0X DO f.Write (w, ch); INC (i); ch := s [i] END
END WriteString;

(*------------------------------------*)
PROCEDURE CopyComment ();

BEGIN (* CopyComment *)
  state := COPYCOMMENT;
  LOOP
    f.Read (r, ch);
    IF r.eof THEN
      IO.WriteStr (" !! End of file encountered in CopyComment()\n"); EXIT
    END;
    f.Write (w, ch);
    CASE ch OF
      LF :
        INC (line);
        IF (line MOD 10) = 0 THEN IO.WriteInt (line); IO.Write (CR) END;
        state := COPYCOMMENT
      |
      "(" : state := LEFTBRACKET
      |
      "*" :
        IF state = LEFTBRACKET THEN CopyComment (); state := COPYCOMMENT
        ELSE state := STAR
        END
      |
      ")" : IF state = STAR THEN EXIT ELSE state := COPYCOMMENT END
      |
    ELSE state := COPYCOMMENT
    END
  END
END CopyComment;

(*------------------------------------*)
PROCEDURE SkipComment ();

BEGIN (* SkipComment *)
  state := SKIPCOMMENT;
  LOOP
    CASE ch OF
      LF :
        INC (line); INC (blanklines);
        IF (line MOD 10) = 0 THEN IO.WriteInt (line); IO.Write (CR) END;
        state := SKIPCOMMENT
      |
      "(" : state := LEFTBRACKET
      |
      "*" :
        IF state = LEFTBRACKET THEN SkipComment (); state := SKIPCOMMENT
        ELSE state := STAR
        END
      |
      ")" : IF state = STAR THEN EXIT ELSE state := SKIPCOMMENT END
      |
    ELSE state := SKIPCOMMENT
    END;
    f.Read (r, ch);
    IF r.eof THEN
      IO.WriteStr (" !! End of file encountered in SkipComment()\n"); EXIT
    END;
  END
END SkipComment;

(*------------------------------------*)
PROCEDURE ChangeState ();

BEGIN (* ChangeState *)
  CASE state OF
    STARTLINE :
      INC (line);
      IF (line MOD 10) = 0 THEN IO.WriteInt (line); IO.Write (CR) END;
      IF blankline THEN INC (blanklines)
      ELSE blanklines := 0; blankline := TRUE
      END;
      IF blanklines < 2 THEN f.Write (w, LF) END;
      spaces := 0;
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
        "'", '"' :
          f.Write (w, ch); state := INSTRING; quoteChar := ch
        |
      ELSE
        f.Write (w, ch); state := COPYCHAR
      END;
    |
    WHITESPACE :
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
        "'", '"' :
          WriteSpaces(); f.Write (w, ch); state := INSTRING;
          quoteChar := ch
        |
      ELSE
        WriteSpaces(); f.Write (w, ch); state := COPYCHAR
      END;
    |
    COPYCHAR :
      blankline := FALSE;
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
        "'", '"' :
          f.Write (w, ch); state := INSTRING; quoteChar := ch
        |
      ELSE
        f.Write (w, ch); state := COPYCHAR
      END;
    |
    LEFTBRACKET :
      CASE ch OF
        "*" : state := STARTCOMMENT
        |
        LF :
          WriteSpaces (); f.Write (w, "("); state := STARTLINE
        |
        SP :
          WriteSpaces (); f.Write (w, "("); spaces := 1;
          blankline := FALSE; state := WHITESPACE
        |
        TAB :
          WriteSpaces (); f.Write (w, "("); spaces := 8;
          blankline := FALSE; state := WHITESPACE
        |
        "(" :
          WriteSpaces (); f.Write (w, "("); blankline := FALSE;
          state := LEFTBRACKET
        |
        "'", '"' :
          WriteSpaces (); f.Write (w, "("); f.Write (w, ch);
          state := INSTRING; quoteChar := ch
        |
      ELSE
        WriteSpaces (); f.Write (w, "("); f.Write (w, ch);
        state := COPYCHAR
      END;
    |
    STARTCOMMENT :
      IF ch = "!" THEN
        WriteSpaces(); WriteString ("(*"); CopyComment ();
        blankline := FALSE
      ELSE
        SkipComment ()
      END;
      state := ENDCOMMENT
    |
    ENDCOMMENT :
      CASE ch OF
        LF : state := STARTLINE
        |
        SP : INC (spaces); state := WHITESPACE
        |
        TAB : INC (spaces, 8); state := WHITESPACE
        |
        "(" : state := LEFTBRACKET
        |
        "'", '"' :
          f.Write (w, ch); state := INSTRING; quoteChar := ch
        |
      ELSE
        f.Write (w, ch); state := COPYCHAR
      END;
    |
    INSTRING :
      f.Write (w, ch); IF ch = quoteChar THEN state := COPYCHAR END
    |
  END
END ChangeState;

(*------------------------------------*)
PROCEDURE Strip (inputName : ARRAY OF CHAR);

  VAR outputName : Path;

<*$CopyArrays-*>
BEGIN (* Strip *)
  input := f.Old (inputName);
  IF input # NIL THEN
    MakeOutputName (inputName, outputName);
    output := f.New (outputName);
    IF output # NIL THEN
      IO.WriteF2
        (" !! %s -> %s\n", SYS.ADR (inputName), SYS.ADR (outputName));
      f.Set (r, input, 0);
      f.Set (w, output, 0);
      spaces := 0; state := WHITESPACE; line := 1; blankline := FALSE;
      WHILE ~r.eof DO
        f.Read (r, ch);
        ChangeState ()
      END;
      WriteString (FileTag);
      f.Close (input);
      f.Register (output)
    ELSE
      f.Close (input);
      IO.WriteF1 (" !! Could not open %s\n", SYS.ADR (outputName))
    END
  ELSE
    IO.WriteF1 (" !! Could not open %s\n", SYS.ADR (inputName))
  END;

  input := NIL; output := NIL;
  f.Set (r, NIL, 0); f.Set (w, NIL, 0);
  Kernel.GC
END Strip;

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

  VAR
    i : INTEGER;
    pat : e.LSTRPTR; 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 *)
  <*$ < ClearVars+ *> NEW (myAnchor); <*$ > *>
  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.MatchFirst (pat^, myAnchor^);
    WHILE result = 0 DO
      (* Strip the file and get the next name. *)
      Strip (myAnchor.buf);
      (* Get the next matching file *)
      result := d.MatchNext (myAnchor^)
    END;
    d.MatchEnd (myAnchor^); (* Clean up anchor data *)
    INC (i)
  END;
END Main;

(*------------------------------------*)
BEGIN (* StripComments *)
  IO.WriteStr (rev.vString);
  IO.WriteStr (CopyrightStr);
  IO.WriteStr (UsageStr);
  Init ();
  GetArgs ();
  Main ();
  IO.WriteStr ("\x9B\x4B !! All done\n")
END StripComments.