gpcp/PeToCps.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:   <PeToCps>                                        *)
  12 (*       Base module. Command line processing etcetera.             *)
  13 (*       Original module, kjg December 2004                         *)
  14 (*                                                                  *)
  15 (* ================================================================ *)
  16
  17 MODULE PeToCps;
  18   IMPORT CPmain, RTS, GPCPcopyright, ProgArgs,
  19      GPFiles,
  20      FileNames,
  21      Glb := N2State,
  22      C2T := ClsToType,
  23      Per := "[QUT.PERWAPI]QUT.PERWAPI",
  24      Sys := "[mscorlib]System",
  25      IdDesc;
  26
  27   TYPE
  28     ArgS = ARRAY 256 OF CHAR;
  29
  30   VAR
  31     chr0 : CHAR;
  32     argN : INTEGER;
  33     filN : INTEGER;
  34     okNm : INTEGER;
  35     errs : INTEGER;
  36     tim0 : LONGINT;
  37     timS : LONGINT;
  38     timE : LONGINT;
  39     argS : ArgS;
  40     resS : Glb.CharOpen;
  41
  42 (* ==================================================================== *)
  43
  44   PROCEDURE resStr(res : INTEGER) : Glb.CharOpen;
  45     VAR tmp : Glb.CharOpen;
  46   BEGIN
  47     CASE res OF
  48     | 0 : tmp := BOX("succeeded");
  49     | 1 : tmp := BOX("input not found");
  50     | 2 : tmp := BOX("output not created");
  51     | 3 : tmp := BOX("failed");
  52     | 4 : tmp := BOX("error <" + resS^ + ">");
  53     END;
  54     RETURN tmp;
  55   END resStr;
  56
  57 (* ------------------------------------------------------- *)
  58
  59   PROCEDURE ExceptionName(x : RTS.NativeException) : Glb.CharOpen;
  60     VAR ptr : Glb.CharOpen;
  61         idx : INTEGER;
  62   BEGIN
  63     ptr := RTS.getStr(x);
  64     FOR idx := 0 TO LEN(ptr^) - 1 DO
  65       IF ptr[idx] <= " " THEN ptr[idx] := 0X; RETURN ptr END;
  66     END;
  67     RETURN ptr;
  68   END ExceptionName;
  69
  70 (* ------------------------------------------------------- *)
  71
  72   PROCEDURE GetVersionInfo(pef : Per.PEFile;
  73                        OUT inf : POINTER TO ARRAY OF INTEGER);
  74     CONST tag = "PublicKeyToken=";
  75     VAR   asm : Per.Assembly;
  76           str : Sys.String;
  77           arr : Glb.CharOpen;
  78           idx : INTEGER;
  79           tok : LONGINT;
  80   BEGIN
  81     asm := pef.GetThisAssembly();
  82     IF (asm.MajorVersion() # 0) & (LEN(asm.Key()) > 0) THEN
  83       NEW(inf, 6);
  84       tok := asm.KeyTokenAsLong();
  85       inf[4] := RTS.hiInt(tok);
  86       inf[5] := RTS.loInt(tok);
  87
  88       inf[0] := asm.MajorVersion();
  89       inf[1] := asm.MinorVersion();
  90       inf[2] := asm.BuildNumber();
  91       inf[3] := asm.RevisionNumber();
  92
  93     ELSE
  94       inf := NIL;
  95     END;
  96   END GetVersionInfo;
  97
  98 (* ------------------------------------------------------- *)
  99
 100   PROCEDURE CopyVersionInfo(inf : POINTER TO ARRAY OF INTEGER;
 101                             blk : IdDesc.BlkId);
 102     VAR ix : INTEGER;
 103   BEGIN
 104     IF inf # NIL THEN
 105       NEW(blk.verNm);
 106       FOR ix := 0 TO 5 DO
 107         blk.verNm[ix] := inf[ix];
 108       END;
 109     END;
 110   END CopyVersionInfo;
 111
 112 (* ==================================================================== *)
 113
 114   PROCEDURE Process(IN  nam : ARRAY OF CHAR;
 115                     OUT rVl : INTEGER);       (* return value *)
 116     VAR peFl : Per.PEFile;
 117         clss : POINTER TO ARRAY OF Per.ClassDef;
 118         indx : INTEGER;
 119         nSpc : VECTOR OF C2T.DefNamespace;
 120         basS : ArgS;
 121         vrsn : POINTER TO ARRAY OF INTEGER;
 122   BEGIN
 123     rVl := 0;
 124     FileNames.StripExt(nam, basS);
 125
 126     Glb.CondMsg(" Reading PE file");
 127     peFl := Per.PEFile.ReadPublicClasses(MKSTR(nam));
 128
 129     Glb.GlobInit(nam, basS);
 130
 131     IF ~Glb.isCorLib THEN C2T.InitCorLibTypes() END;
 132
 133     Glb.CondMsg(" Processing PE file");
 134     clss := peFl.GetClasses();
 135     C2T.Classify(clss, nSpc);
 136    (*
 137     *  Define BlkId for every namespace
 138     *)
 139     GetVersionInfo(peFl, vrsn);
 140     FOR indx := 0 TO LEN(nSpc) - 1 DO
 141       C2T.MakeBlkId(nSpc[indx], Glb.basNam);
 142       CopyVersionInfo(vrsn, nSpc[indx].bloc);
 143     END;
 144
 145    (*
 146     *  Define TypIds in every namespace
 147     *)
 148     FOR indx := 0 TO LEN(nSpc) - 1 DO
 149       IF ~Glb.isCorLib THEN C2T.ImportCorlib(nSpc[indx]) END;
 150       C2T.MakeTypIds(nSpc[indx]);
 151     END;
 152     IF Glb.isCorLib THEN C2T.BindSystemTypes() END;
 153    (*
 154     *  Define structure of every class
 155     *)
 156     FOR indx := 0 TO LEN(nSpc) - 1 DO
 157       C2T.DefineClss(nSpc[indx]);
 158     END;
 159    (*
 160     *  Write out symbol file(s)
 161     *)
 162     FOR indx := 0 TO LEN(nSpc) - 1 DO
 163       Glb.ResetBlkIdFlags(nSpc[indx].bloc);
 164       Glb.EmitSymbolfile(nSpc[indx].bloc);
 165     END;
 166     Glb.CondMsg(" Completing normally");
 167   RESCUE (sysX)
 168     resS := ExceptionName(sysX);
 169     Glb.Message(" " + resS^);
 170     Glb.Message(" " + RTS.getStr(sysX)^);
 171     rVl := 4;
 172   END Process;
 173
 174 (* ==================================================================== *)
 175 (*                            Main Argument Loop                        *)
 176 (* ==================================================================== *)
 177
 178 BEGIN
 179   filN := 0;
 180   tim0 := RTS.GetMillis();
 181   Glb.Message(GPCPcopyright.verStr);
 182   FOR argN := 0 TO ProgArgs.ArgNumber()-1 DO
 183     ProgArgs.GetArg(argN, argS);
 184     chr0 := argS[0];
 185     IF (chr0 = '-') OR (chr0 = GPFiles.optChar) THEN (* option string *)
 186       argS[0] := "-";
 187       Glb.ParseOption(argS$);
 188     ELSE
 189       timS := RTS.GetMillis();
 190       Process(argS$, errs);
 191       INC(filN);
 192       IF errs = 0 THEN INC(okNm) END;
 193       timE := RTS.GetMillis();
 194
 195       Glb.Report(argS$, resStr(errs), timE - timS);
 196     END;
 197   END;
 198   Glb.Summary(filN, okNm, timE - tim0);
 199  (*
 200   *  Return the result code of the final compilation
 201   *)
 202   IF errs # 0 THEN HALT(1) END;
 203 END PeToCps.