gpcp/n2state.cp

   1
   2 (* ================================================================ *)
   3 (*                                                                  *)
   4 (*  Module of the V1.4+ gpcp tool to create symbol files from       *)
   5 (*  the metadata of .NET assemblies, using the PERWAPI interface.   *)
   6 (*                                                                  *)
   7 (*  Copyright QUT 2004 - 2005.                                      *)
   8 (*                                                                  *)
   9 (*  This code released under the terms of the GPCP licence.         *)
  10 (*                                                                  *)
  11 (*  This Module:   <N2State>                                        *)
  12 (*       Holds global state for the process, plus utilities.        *)
  13 (*       Original module, kjg December 2004                         *)
  14 (*                                                                  *)
  15 (* ================================================================ *)
  16
  17 MODULE N2State;
  18   IMPORT GPCPcopyright,
  19          CompState,
  20          LitValue,
  21          ProgArgs,
  22          Console,
  23          Error,
  24          GPText,
  25          ForeignName,
  26          RW := NewSymFileRW,
  27          Id := IdDesc,
  28          Ty := TypeDesc,
  29          Sy := Symbols,
  30          Nh := NameHash,
  31          Sys := "[mscorlib]System",
  32          RTS;
  33
  34  (* ---------------------------------------------------------- *)
  35
  36   CONST prefix = "PeToCps: ";
  37         abtMsg = " ... Aborting";
  38         usgMsg = 'Usage: "PeToCps [options] filenames"';
  39
  40  (* ---------------------------------------------------------- *)
  41
  42   TYPE  CharOpen* = POINTER TO ARRAY OF CHAR;
  43
  44  (* ---------------------------------------------------------- *)
  45
  46   TYPE  CleanDump = POINTER TO RECORD (Sy.SymForAll) END;
  47
  48  (* ---------------------------------------------------------- *)
  49
  50   VAR   netDflt-  : BOOLEAN;
  51         verbose-  : BOOLEAN;
  52         Verbose-  : BOOLEAN;
  53         superVb-  : BOOLEAN;
  54         generics- : BOOLEAN;
  55         legacy-   : BOOLEAN;
  56         cpCmpld-  : BOOLEAN;
  57
  58  (* ---------------------------------------------------------- *)
  59
  60   VAR   thisMod-  : Id.BlkId;
  61         isCorLib- : BOOLEAN;
  62         hashSize- : INTEGER;
  63         ctorBkt-  : INTEGER;
  64         initBkt-  : INTEGER;
  65         srcNam-   : CharOpen;
  66         basNam-   : CharOpen;
  67         impSeq*   : Sy.ScpSeq;
  68         typSeq-   : Sy.TypeSeq;
  69
  70  (* ---------------------------------------------------------- *)
  71
  72   PROCEDURE^ AbortMsg*(IN str : ARRAY OF CHAR);
  73   PROCEDURE^ Message*(IN str : ARRAY OF CHAR);
  74
  75  (* ---------------------------------------------------------- *)
  76
  77   PROCEDURE ListTy*(ty : Sy.Type);
  78   BEGIN
  79     Sy.AppendType(typSeq, ty);
  80   END ListTy;
  81
  82  (* ---------------------------------------------------------- *)
  83
  84   PROCEDURE AddMangledNames(mod : Id.BlkId; asm, nms : CharOpen);
  85   BEGIN
  86     mod.hash    := Nh.enterStr(ForeignName.MangledName(asm, nms));
  87     mod.scopeNm := ForeignName.QuotedName(asm, nms);
  88   END AddMangledNames;
  89
  90  (* ---------------------------------------------------------- *)
  91
  92   PROCEDURE GlobInit*(IN src, bas : ARRAY OF CHAR);
  93   BEGIN
  94     Nh.InitNameHash(hashSize);
  95     srcNam := BOX(src$);
  96     basNam := BOX(bas$);
  97     isCorLib := (bas = "mscorlib");
  98
  99     CompState.CreateThisMod;
 100     thisMod := CompState.thisMod;
 101
 102     Sy.ResetScpSeq(impSeq);
 103     ctorBkt := Nh.enterStr(".ctor");
 104     initBkt := Nh.enterStr("init");
 105   END GlobInit;
 106
 107  (* ------------------------------------- *)
 108
 109   PROCEDURE BlkIdInit*(blk : Id.BlkId; asm, nms : CharOpen);
 110   BEGIN
 111     blk.SetKind(Id.impId);
 112     AddMangledNames(blk, asm, nms);
 113     IF Sy.refused(blk, thisMod) THEN
 114       AbortMsg("BlkId insert failure -- " + Nh.charOpenOfHash(blk.hash)^);
 115     END;
 116     Sy.AppendScope(impSeq, blk)
 117   END BlkIdInit;
 118
 119  (* ------------------------------------- *)
 120
 121   PROCEDURE InsertImport*(blk : Id.BlkId);
 122   BEGIN
 123     IF Sy.refused(blk, thisMod) THEN
 124       AbortMsg("BlkId insert failure in <thisMod>");
 125     END;
 126     Sy.AppendScope(impSeq, blk)
 127   END InsertImport;
 128
 129  (* ------------------------------------- *)
 130
 131   PROCEDURE (dmpr : CleanDump)Op*(id : Sy.Idnt);
 132   BEGIN
 133     WITH id : Id.TypId DO
 134       IF id.type.dump >= Sy.tOffset THEN id.type.dump := 0 END;
 135     ELSE
 136     END;
 137   END Op;
 138
 139  (* ------------------------------------- *)
 140
 141   PROCEDURE ResetBlkIdFlags*(mod : Id.BlkId);
 142     VAR indx : INTEGER;
 143         impB : Sy.Scope;
 144         dmpr : CleanDump;
 145         typI : Sy.Type;
 146   BEGIN
 147    (*
 148     *   Clear the "dump" marker from non built-in types
 149     *)
 150     FOR indx := 0 TO typSeq.tide - 1 DO
 151       typI := typSeq.a[indx];
 152       IF typI.dump >= Sy.tOffset THEN
 153         typI.dump := 0;
 154         typI.force := Sy.noEmit;
 155       END;
 156     END;
 157     mod.SetKind(Id.modId);
 158
 159     IF superVb THEN
 160       Message("Preparing symfile <" + Nh.charOpenOfHash(mod.hash)^ + ">");
 161     END;
 162     FOR indx := 0 TO impSeq.tide - 1 DO
 163       impB := impSeq.a[indx];
 164       IF impB # mod THEN
 165         impB.SetKind(Id.impId);
 166       END;
 167     END;
 168   END ResetBlkIdFlags;
 169
 170  (* ---------------------------------------------------------- *)
 171
 172   PROCEDURE WLn(IN str : ARRAY OF CHAR);
 173   BEGIN
 174     Console.WriteString(str); Console.WriteLn;
 175   END WLn;
 176
 177   PROCEDURE Message*(IN str : ARRAY OF CHAR);
 178   BEGIN
 179     Console.WriteString(prefix);
 180     Console.WriteString(str);
 181     Console.WriteLn;
 182   END Message;
 183
 184   PROCEDURE CondMsg*(IN str : ARRAY OF CHAR);
 185   BEGIN
 186     IF verbose THEN Message(str) END;
 187   END CondMsg;
 188
 189   PROCEDURE AbortMsg*(IN str : ARRAY OF CHAR);
 190   BEGIN
 191     Error.WriteString(prefix);
 192     Error.WriteString(str);
 193     Error.WriteLn;
 194     HALT(1);
 195   END AbortMsg;
 196
 197   PROCEDURE Usage();
 198   BEGIN
 199     Message(usgMsg);
 200     Message("filenames should have explicit .EXE or .DLL extension");
 201     IF netDflt THEN
 202       WLn("Options: /big       ==> allocate huge hash table");
 203       WLn("         /copyright ==> display copyright notice");
 204       WLn("         /generics  ==> enable CLI v2.0 generics");
 205       WLn("         /help      ==> display this message");
 206       WLn("         /legacy    ==> produce compatible symbol file");
 207       WLn("         /verbose   ==> chatter on about progress");
 208       WLn("         /Verbose   ==> go on and on and on about progress");
 209     ELSE
 210       WLn("Options: -big       ==> allocate huge hash table");
 211       WLn("         -copyright ==> display copyright notice");
 212       WLn("         -generics  ==> enable CLI v2.0 generics");
 213       WLn("         -help      ==> display this message");
 214       WLn("         -legacy    ==> produce compatible symbol file");
 215       WLn("         -verbose   ==> chatter on about progress");
 216       WLn("         -Verbose   ==> go on and on and on about progress");
 217     END;
 218   END Usage;
 219
 220  (* ---------------------------------------------------------- *)
 221
 222   PROCEDURE ReportTim(tim : LONGINT);
 223     CONST millis = " mSec";
 224   BEGIN
 225     Console.WriteInt(SHORT(tim), 0);
 226     Console.WriteString(millis);
 227   END ReportTim;
 228
 229   PROCEDURE Report*(IN nam, res : ARRAY OF CHAR; tim : LONGINT);
 230   BEGIN
 231     Console.WriteString(prefix);
 232     Console.WriteString(" Input file <");
 233     Console.WriteString(nam);
 234     Console.WriteString("> ");
 235     Console.WriteString(res);
 236     IF verbose THEN
 237       Console.WriteString(", time: ");
 238       ReportTim(tim);
 239     END;
 240     Console.WriteLn;
 241   END Report;
 242
 243   PROCEDURE Summary*(flNm, okNm : INTEGER; tim : LONGINT);
 244     CONST sumPre = " Summary: ";
 245   BEGIN
 246     Console.WriteString(prefix);
 247     Console.WriteString(sumPre);
 248     IF flNm = 0 THEN
 249       Console.WriteString(" No input files specified");
 250     ELSE
 251       Console.WriteInt(flNm,1);
 252       Console.WriteString(" input files");
 253       IF okNm < flNm THEN
 254         Console.WriteInt(flNm - okNm, 0);
 255         Console.WriteString(" failed");
 256       END;
 257       IF verbose THEN
 258         Console.WriteLn;
 259         Console.WriteString(prefix);
 260         Console.WriteString(sumPre);
 261         Console.WriteString("Total elapsed time: ");
 262         ReportTim(tim);
 263       END;
 264     END;
 265     Console.WriteLn;
 266   END Summary;
 267
 268  (* ---------------------------------------------------------- *)
 269
 270   PROCEDURE ParseOption*(IN arg : ARRAY OF CHAR);
 271   BEGIN
 272     IF    arg = "-big" THEN
 273         hashSize := 40000;
 274     ELSIF arg = "-verbose" THEN
 275         verbose := TRUE;
 276         Verbose := FALSE;
 277         superVb := FALSE;
 278     ELSIF arg = "-Verbose" THEN
 279         verbose := TRUE;
 280         Verbose := TRUE;
 281         superVb := FALSE;
 282     ELSIF arg = "-generics" THEN
 283         generics := TRUE;
 284     ELSIF arg = "-legacy" THEN
 285         legacy := TRUE;
 286         CompState.legacy := TRUE;
 287     ELSIF arg = "-VERBOSE" THEN
 288         verbose := TRUE;
 289         Verbose := TRUE;
 290         superVb := TRUE;
 291     ELSIF arg = "-help" THEN
 292         Usage();
 293     ELSIF arg = "-copyright" THEN
 294         GPCPcopyright.Write();
 295     ELSE
 296         Message("Bad Option " + arg); Usage;
 297     END;
 298   END ParseOption;
 299
 300  (* ---------------------------------------------------------- *)
 301
 302   PROCEDURE EmitSymbolfile*(blk : Id.BlkId);
 303   BEGIN
 304     RW.EmitSymfile(blk);
 305     Message(" Output file <" +
 306             Nh.charOpenOfHash(blk.hash)^ +
 307             ".cps> created");
 308   END EmitSymbolfile;
 309
 310  (* ---------------------------------------------------------- *)
 311
 312 BEGIN
 313   netDflt  := (RTS.defaultTarget = "net");
 314   generics := FALSE;
 315   verbose  := FALSE;
 316   Verbose  := FALSE;
 317   superVb  := FALSE;
 318   legacy   := FALSE;
 319   cpCmpld  := FALSE; (* pending the custom attribute *)
 320   hashSize := 5000;
 321   Sy.InitScpSeq(impSeq, 10);
 322   Sy.InitTypeSeq(typSeq, 10);
 323   CompState.ParseOption("/special");
 324 END N2State.