gpcp/ClsToType.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:   <ClsToType>                                      *)
  12 (*       Transforms PERWAPI classes to GPCP TypeDesc structures.    *)
  13 (*       Original module, kjg December 2004                         *)
  14 (*                                                                  *)
  15 (* ================================================================ *)
  16
  17 MODULE ClsToType;
  18   IMPORT
  19 (*
  20  *  Rfl := mscorlib_System_Reflection,  (* temporary *)
  21  *  Sio := mscorlib_System_IO,          (* temporary *)
  22  *)
  23     FNm := FileNames,
  24     Mng := ForeignName,
  25     Per := "[QUT.PERWAPI]QUT.PERWAPI",
  26     Glb := N2State,
  27     Ltv := LitValue,
  28     Cst := CompState,
  29     Nh  := NameHash,
  30     Id  := IdDesc,
  31     Ty  := TypeDesc,
  32     Xp  := ExprDesc,
  33     Sy  := Symbols,
  34     Bi  := Builtin,
  35     Console,
  36     ASCII,
  37     RTS;
  38
  39  (* ------------------------------------------------------------ *)
  40
  41   CONST anon*      = 0; (* The anonymous hash index *)
  42
  43   CONST (* class kind enumeration *)
  44         default* =  0; refCls*  =  1; valCls*  =  2;
  45         enuCls*  =  3; evtCls*  =  4; dlgCls*  =  5;
  46         primTyp* =  6; arrTyp*  =  7; voidTyp* =  8;
  47         strTyp*  =  9; objTyp*  = 10; sysValT* = 11;
  48         sysEnuT* = 12; sysDelT* = 13; sysExcT* = 14; voidStar* = 15;
  49
  50   CONST (* type attribute enumeration bits   *)
  51         absTp = 7; intTp = 5; sldTp = 8;
  52
  53         (* field attribute enumeration bits  *)
  54         stFld = 4; ltFld = 6;
  55
  56         (* method attribute enumeration bits *)
  57         stMth = 4; fnMth = 5; vrMth = 6; nwMth = 8; abMth = 10;
  58
  59  (* ------------------------------------------------------------ *)
  60
  61   TYPE  Namespace*    = POINTER TO ABSTRACT RECORD
  62                           hash  : INTEGER;
  63                           bloc* : Id.BlkId;
  64                           tIds  : VECTOR OF Id.TypId;
  65                         END;
  66
  67         DefNamespace* = POINTER TO RECORD (Namespace)
  68                           clss  : VECTOR OF Per.ClassDef;
  69                         END;
  70
  71         RefNamespace* = POINTER TO RECORD (Namespace)
  72                           clss  : VECTOR OF Per.ClassRef;
  73                         END;
  74
  75  (* ------------------------------------------------------------ *)
  76
  77   VAR   ntvObj : Sy.Type;
  78         ntvStr : Sy.Type;
  79         ntvExc : Sy.Type;
  80         ntvTyp : Sy.Type;
  81         ntvEnu : Sy.Type;
  82         ntvEvt : Sy.Type;
  83         ntvVal : Sy.Type;
  84         sysU16 : Sy.Type;
  85         sysU32 : Sy.Type;
  86         sysU64 : Sy.Type;
  87         voidSt : Sy.Type;
  88
  89         intPtr : Sy.Type;
  90         uIntPt : Sy.Type;
  91         tpdRef : Sy.Type;
  92
  93         corLib : Id.BlkId;
  94
  95         baseArrs : ARRAY 18 OF Sy.Type;
  96
  97  (* ------------------------------------------------------------ *)
  98  (*                   Utilities and Predicates                   *)
  99  (* ------------------------------------------------------------ *)
 100
 101   PROCEDURE^ cpTypeFromCTS(peT : Per.Type; spc : DefNamespace) : Sy.Type;
 102
 103  (* ------------------------------------------------ *)
 104
 105   PROCEDURE isExportedType(attr : Per.TypeAttr) : BOOLEAN;
 106     VAR bits : SET;
 107   BEGIN
 108     bits := BITS(attr) * {0..2};
 109     CASE ORD(bits) OF
 110     | 1, 2, 4, 7 : RETURN TRUE;
 111     ELSE RETURN FALSE;
 112     END;
 113   END isExportedType;
 114
 115  (* ------------------------------------------------ *)
 116
 117   PROCEDURE isProtectedType(attr : Per.TypeAttr) : BOOLEAN;
 118     VAR bits : SET;
 119   BEGIN
 120     bits := BITS(attr) * {0..2};
 121     CASE ORD(bits) OF
 122     | 4, 7 : RETURN TRUE;
 123     ELSE RETURN FALSE;
 124     END;
 125   END isProtectedType;
 126
 127  (* ------------------------------------------------ *)
 128
 129   PROCEDURE isGenericClass(cls : Per.ClassDesc) : BOOLEAN;
 130   BEGIN
 131     RETURN LEN(cls.GetGenericParams()) > 0;
 132   END isGenericClass;
 133
 134  (* ------------------------------------------------ *)
 135
 136   PROCEDURE isGenericType(typ : Per.Type) : BOOLEAN;
 137   BEGIN
 138     WITH typ : Per.ClassSpec DO RETURN TRUE;
 139        | typ : Per.ClassDesc DO RETURN isGenericClass(typ);
 140        | typ : Per.Array     DO RETURN isGenericType(typ.ElemType());
 141     ELSE RETURN FALSE;
 142     END;
 143   END isGenericType;
 144
 145  (* ------------------------------------------------ *)
 146
 147   PROCEDURE isPublicClass(cls : Per.Class) : BOOLEAN;
 148   BEGIN
 149     WITH cls : Per.NestedClassDef DO
 150       RETURN isExportedType(cls.GetAttributes()) &
 151              ~isGenericType(cls) &
 152              isPublicClass(cls.GetParentClass());
 153     |    cls : Per.ClassDef DO
 154       RETURN isExportedType(cls.GetAttributes()) &
 155              ~isGenericType(cls);
 156     ELSE (* cls : Per.ClassRef ==> exported *)
 157       RETURN TRUE;
 158     END;
 159   END isPublicClass;
 160
 161  (* ------------------------------------------------ *)
 162
 163   PROCEDURE hasGenericArg(mth : Per.Method) : BOOLEAN;
 164     VAR idx : INTEGER;
 165         par : Per.Type;
 166         prs : POINTER TO ARRAY OF Per.Type;
 167   BEGIN
 168     prs := mth.GetParTypes();
 169     FOR idx := 0 TO LEN(prs) - 1 DO
 170       par := prs[idx];
 171       IF isGenericType(par) THEN RETURN TRUE END;
 172     END;
 173     RETURN FALSE;
 174   END hasGenericArg;
 175
 176  (* ------------------------------------------------ *)
 177
 178   PROCEDURE isGenericMethod(mth : Per.Method) : BOOLEAN;
 179   BEGIN
 180     RETURN (mth.GetGenericParam(0) # NIL) OR hasGenericArg(mth);
 181   END isGenericMethod;
 182
 183  (* ------------------------------------------------ *)
 184
 185   PROCEDURE isVarargMethod(mth : Per.Method) : BOOLEAN;
 186   BEGIN
 187     RETURN mth.GetCallConv() = Per.CallConv.Vararg;
 188   END isVarargMethod;
 189
 190  (* ------------------------------------------------ *)
 191  (*
 192   PROCEDURE isNestedType(attr : Per.TypeAttr) : BOOLEAN;
 193     VAR bits : INTEGER;
 194   BEGIN
 195     bits := ORD(BITS(attr) * {0..2});
 196     RETURN (bits >= 2) & (bits <= 7);
 197   END isNestedType;
 198   *)
 199  (* ------------------------------------------------ *)
 200
 201   PROCEDURE gpName(typ : Per.Class) : RTS.NativeString;
 202   BEGIN
 203     WITH typ : Per.NestedClassDef DO
 204         RETURN gpName(typ.GetParentClass()) + "$" + typ.Name();
 205     | typ : Per.NestedClassRef DO
 206         RETURN gpName(typ.GetParentClass()) + "$" + typ.Name();
 207     ELSE
 208       RETURN typ.Name();
 209     END;
 210   END gpName;
 211
 212  (* ------------------------------------------------ *)
 213
 214   PROCEDURE gpSpce(typ : Per.Class) : RTS.NativeString;
 215   BEGIN
 216     WITH typ : Per.NestedClassDef DO
 217         RETURN gpSpce(typ.GetParentClass());
 218     | typ : Per.NestedClassRef DO
 219         RETURN gpSpce(typ.GetParentClass());
 220     ELSE
 221       RETURN typ.NameSpace();
 222     END;
 223   END gpSpce;
 224
 225  (* ------------------------------------------------ *)
 226
 227   PROCEDURE ilName(mth : Per.Method) : RTS.NativeString;
 228     VAR cls : Per.Class;
 229   BEGIN
 230     cls := mth.GetParent()(Per.Class);
 231     RETURN gpSpce(cls) + "." + gpName(cls) + "::'" + mth.Name() + "'";
 232   END ilName;
 233
 234  (* ------------------------------------------------ *)
 235
 236   PROCEDURE isCorLibRef(res : Per.ResolutionScope) : BOOLEAN;
 237     VAR str : RTS.NativeString;
 238   BEGIN
 239     IF Glb.isCorLib THEN
 240       RETURN FALSE; (* ==> this is corlib DEFINITION! *)
 241     ELSIF res = NIL THEN
 242       RETURN FALSE;
 243     ELSE
 244       str := res.Name();
 245       RETURN ((str = "mscorlib") OR (str = "CommonLanguageRuntimeLibrary"));
 246     END;
 247   END isCorLibRef;
 248
 249  (* ------------------------------------------------ *)
 250
 251   PROCEDURE SayWhy(cls : Per.Class);
 252     VAR str : Glb.CharOpen;
 253   BEGIN
 254     WITH cls : Per.ClassSpec DO
 255       str := BOX(" Hiding generic class -- ");
 256     |   cls : Per.NestedClassDef DO
 257       IF ~isExportedType(cls.GetAttributes()) THEN RETURN; (* just private! *)
 258       ELSIF isGenericType(cls) THEN
 259         str := BOX(" Hiding generic class -- ");
 260       ELSE (* ~isPublicClass(cls.GetParentClass()); *)
 261         str := BOX(" Hiding public child of private class -- ");
 262       END;
 263     |   cls : Per.ClassDef DO
 264       IF ~isExportedType(cls.GetAttributes()) THEN RETURN; (* just private! *)
 265       ELSE (* isGenericType(cls) *)
 266         str := BOX(" Hiding generic class -- ");
 267       END;
 268     END;
 269     Glb.Message(str^ + gpSpce(cls) + "." + gpName(cls));
 270   END SayWhy;
 271
 272  (* ------------------------------------------------ *)
 273
 274   PROCEDURE getKind(typ : Per.Type) : INTEGER;
 275     VAR pEnu : INTEGER;
 276         pTyp : Per.Class;
 277         name : RTS.NativeString;
 278         rScp : Per.ResolutionScope;
 279   BEGIN
 280     WITH typ : Per.Array DO (* --------------- *) RETURN arrTyp;
 281     | typ : Per.UnmanagedPointer DO (* ------- *) RETURN voidStar;
 282     | typ : Per.PrimitiveType DO
 283         IF    typ = Per.PrimitiveType.Object THEN RETURN objTyp;
 284         ELSIF typ = Per.PrimitiveType.String THEN RETURN strTyp;
 285         ELSIF typ = Per.PrimitiveType.Void   THEN RETURN voidTyp;
 286         ELSE                                      RETURN primTyp;
 287         END;
 288     | typ : Per.ClassDef DO
 289         rScp := typ.GetScope();
 290         pTyp := typ.get_SuperType();
 291        (*
 292         *  If this is *not* mscorlib, then check the kind of the parent.
 293         *)
 294         IF ~Glb.isCorLib THEN
 295           pEnu := getKind(pTyp);
 296           name := gpName(typ);
 297        (*
 298         *  If it has no parent, then it must be Object, or some ref class.
 299         *)
 300         ELSIF pTyp = NIL THEN                     RETURN refCls;
 301        (*
 302         *  Since "ntvObj" and the others have not been initialized
 303         *  for the special case of processing mscorlib, we must look
 304         *  at the names of the parents.
 305         *)
 306         ELSE
 307           name := gpName(pTyp);
 308           IF    name = "ValueType"               THEN RETURN valCls;
 309           ELSIF name = "Enum"                    THEN RETURN enuCls;
 310           ELSIF name = "MulticastDelegate"       THEN RETURN dlgCls;
 311           ELSE (* -------------------------------- *) RETURN refCls;
 312           END;
 313         END;
 314     | typ : Per.ClassRef DO
 315         rScp := typ.GetScope();
 316         name := gpName(typ);
 317         pEnu := default;
 318     ELSE (* ---------------------------------- *) RETURN default;
 319     END;
 320
 321     IF isCorLibRef(rScp) THEN
 322       IF    name = "Object"                  THEN RETURN objTyp;
 323       ELSIF name = "ValueType"               THEN RETURN sysValT;
 324       ELSIF name = "Enum"                    THEN RETURN sysEnuT;
 325       ELSIF name = "MulticastDelegate"       THEN RETURN sysDelT;
 326       ELSIF name = "Exception"               THEN RETURN sysExcT;
 327       END;
 328     END;
 329
 330     IF    pEnu = sysValT                     THEN RETURN valCls;
 331     ELSIF pEnu = sysDelT                     THEN RETURN dlgCls;
 332     ELSIF pEnu = sysEnuT                     THEN RETURN enuCls;
 333     ELSE (* ---------------------------------- *) RETURN refCls;
 334     END;
 335   END getKind;
 336
 337  (* ------------------------------------------------ *)
 338
 339   PROCEDURE kindStr(kind : INTEGER) : Glb.CharOpen;
 340   BEGIN
 341     CASE kind OF
 342     | default  : RETURN BOX("opaque               ");
 343     | refCls   : RETURN BOX("reference class      ");
 344     | valCls   : RETURN BOX("value class          ");
 345     | enuCls   : RETURN BOX("enumeration class    ");
 346     | evtCls   : RETURN BOX("event class          ");
 347     | dlgCls   : RETURN BOX("delegate             ");
 348     | primTyp  : RETURN BOX("primitive            ");
 349     | arrTyp   : RETURN BOX("array type           ");
 350     | voidTyp  : RETURN BOX("void type            ");
 351     | strTyp   : RETURN BOX("Sys.String           ");
 352     | objTyp   : RETURN BOX("Sys.Object           ");
 353     | sysValT  : RETURN BOX("Sys.ValueType        ");
 354     | sysEnuT  : RETURN BOX("Sys.Enum Type        ");
 355     | sysDelT  : RETURN BOX("Sys.MulticastDelegate");
 356     | sysExcT  : RETURN BOX("Sys.Exception        ");
 357     | voidStar : RETURN BOX("Sys.Void*            ");
 358     ELSE         RETURN BOX("unknown              ");
 359     END;
 360   END kindStr;
 361
 362  (* ------------------------------------------------ *)
 363
 364   PROCEDURE mapPrimitive(peT : Per.Type) : Sy.Type;
 365   BEGIN
 366     IF    peT = Per.PrimitiveType.Int32    THEN RETURN Bi.intTp;
 367     ELSIF peT = Per.PrimitiveType.Char     THEN RETURN Bi.charTp;
 368     ELSIF peT = Per.PrimitiveType.Boolean  THEN RETURN Bi.boolTp;
 369     ELSIF peT = Per.PrimitiveType.Int16    THEN RETURN Bi.sIntTp;
 370     ELSIF peT = Per.PrimitiveType.Float64  THEN RETURN Bi.realTp;
 371     ELSIF peT = Per.PrimitiveType.Int64    THEN RETURN Bi.lIntTp;
 372     ELSIF peT = Per.PrimitiveType.Float32  THEN RETURN Bi.sReaTp;
 373     ELSIF peT = Per.PrimitiveType.Int8     THEN RETURN Bi.byteTp;
 374     ELSIF peT = Per.PrimitiveType.UInt8    THEN RETURN Bi.uBytTp;
 375     ELSIF peT = Per.PrimitiveType.UInt16   THEN RETURN sysU16;
 376     ELSIF peT = Per.PrimitiveType.UInt32   THEN RETURN sysU32;
 377     ELSIF peT = Per.PrimitiveType.UInt64   THEN RETURN sysU64;
 378     ELSIF peT = Per.PrimitiveType.IntPtr   THEN RETURN intPtr;
 379     ELSIF peT = Per.PrimitiveType.UIntPtr  THEN RETURN uIntPt;
 380     ELSIF peT = Per.PrimitiveType.TypedRef THEN RETURN tpdRef;
 381     ELSE (* ------------------------------- *) RETURN NIL;
 382     END;
 383   END mapPrimitive;
 384
 385  (* ------------------------------------------------ *)
 386
 387   PROCEDURE makeNameType(blk : Id.BlkId; hsh : INTEGER) : Id.TypId;
 388     VAR tId : Id.TypId;
 389   BEGIN
 390     tId := Id.newTypId(Ty.newNamTp());
 391     tId.hash := hsh;
 392     tId.dfScp := blk;
 393     tId.type.idnt := tId;
 394     tId.SetMode(Sy.pubMode);
 395     Glb.ListTy(tId.type);
 396     IF Sy.refused(tId, blk) THEN Glb.AbortMsg("bad TypId insert") END;
 397     RETURN tId;
 398   END makeNameType;
 399
 400  (* ------------------------------------------------ *)
 401
 402   PROCEDURE lookup(peT : Per.Class; nSp : DefNamespace) : Sy.Type;
 403     VAR asm : Glb.CharOpen;  (* assembly file name *)
 404         spc : Glb.CharOpen;  (* namespace name str *)
 405         mNm : Glb.CharOpen;  (* CP module name     *)
 406         cNm : Glb.CharOpen;  (* PE file class name *)
 407         blk : Sy.Idnt;       (* The Blk descriptor *)
 408         bId : Id.BlkId;      (* The Blk descriptor *)
 409         tId : Sy.Idnt;       (* TypId descriptor   *)
 410         hsh : INTEGER;       (* Class name hash    *)
 411    (* -------------------------------------------- *)
 412     PROCEDURE NoteImport(spc : DefNamespace; imp : Id.BlkId);
 413     BEGIN
 414       IF (spc # NIL) & (spc.bloc # imp) THEN
 415         IF ~Sy.refused(imp, spc.bloc) THEN
 416           IF Glb.superVb THEN
 417             Console.WriteString("Inserting import <");
 418             Console.WriteString(Nh.charOpenOfHash(imp.hash));
 419             Console.WriteString("> in Namespace ");
 420             Console.WriteString(Nh.charOpenOfHash(spc.bloc.hash));
 421             Console.WriteLn;
 422           END;
 423         END;
 424       END;
 425     END NoteImport;
 426    (* -------------------------------------------- *)
 427   BEGIN
 428     bId := NIL;
 429    (*
 430     *  First we establish the (mangled) name of the defining scope.
 431     *)
 432     WITH peT : Per.ClassDef DO
 433         asm := BOX(Glb.basNam^); (* Must do a value copy *)
 434     | peT : Per.ClassRef DO
 435         asm := BOX(peT.GetScope().Name());
 436     ELSE
 437         RETURN NIL;
 438     END;
 439 (*
 440  *  FNm.StripExt(asm, asm);
 441  *  spc := BOX(peT.NameSpace());
 442  *)
 443     spc := BOX(gpSpce(peT));
 444     mNm := Mng.MangledName(asm, spc);
 445    (*
 446     *  Check if this name is already known to PeToCps
 447     *)
 448     blk := Glb.thisMod.symTb.lookup(Nh.enterStr(mNm));
 449     cNm := BOX(gpName(peT));
 450     hsh := Nh.enterStr(cNm);
 451     WITH blk : Id.BlkId DO
 452        (*
 453         *  The module name is known to PeToCps.
 454         *  However, it may not have been listed as an import
 455         *  into the current namespace, in the case of multiple
 456         *  namespaces defined in the same source PEFile.
 457         *)
 458         NoteImport(nSp, blk);
 459
 460         tId := blk.symTb.lookup(hsh);
 461         IF (tId # NIL) & (tId IS Id.TypId) THEN
 462           RETURN tId.type;
 463         ELSE
 464           bId := blk;
 465         END;
 466     ELSE
 467     END;
 468    (*
 469     *  Could not find the type identifier descriptor.
 470     *)
 471     IF bId = NIL THEN
 472      (*
 473       *  Create a BlkId for the namespace.
 474       *)
 475       NEW(bId);
 476       INCL(bId.xAttr, Sy.need);
 477       Glb.BlkIdInit(bId, asm, spc);
 478      (*
 479       *  ... and in any case, this new BlkId is an
 480       *  import into the current namespace scope.
 481       *)
 482       NoteImport(nSp, bId);
 483     END;
 484    (*
 485     *  Now create a TypId, and insert in block symTab.
 486     *)
 487     tId := makeNameType(bId, hsh);
 488     RETURN tId.type;
 489   END lookup;
 490
 491  (* ------------------------------------------------ *)
 492
 493   PROCEDURE ptrToArrayOf(elTp : Sy.Type) : Sy.Type;
 494     VAR ptrT : Sy.Type;
 495    (* -------------------------------------------- *)
 496     PROCEDURE getPtr(elT : Sy.Type) : Sy.Type;
 497       VAR arT, ptT : Sy.Type;
 498     BEGIN
 499       arT := Ty.mkArrayOf(elT); Glb.ListTy(arT);
 500       ptT := Ty.mkPtrTo(arT);   Glb.ListTy(ptT); RETURN ptT;
 501     END getPtr;
 502    (* -------------------------------------------- *)
 503   BEGIN
 504     WITH elTp : Ty.Base DO
 505       ptrT := baseArrs[elTp.tpOrd];
 506       IF ptrT = NIL THEN
 507         ptrT := getPtr(elTp);
 508         baseArrs[elTp.tpOrd] := ptrT;
 509       END;
 510     ELSE
 511       ptrT := getPtr(elTp);
 512     END;
 513     RETURN ptrT;
 514   END ptrToArrayOf;
 515
 516  (* ------------------------------------------------ *)
 517
 518   PROCEDURE cpTypeFromCTS(peT : Per.Type; spc : DefNamespace) : Sy.Type;
 519     VAR kind : INTEGER;
 520   BEGIN
 521     kind := getKind(peT);
 522     CASE kind OF
 523     | voidTyp  : RETURN NIL;
 524     | arrTyp   : RETURN ptrToArrayOf(
 525                              cpTypeFromCTS(peT(Per.Array).ElemType(), spc));
 526     | primTyp  : RETURN mapPrimitive(peT);
 527     | strTyp   : RETURN ntvStr;
 528     | objTyp   : RETURN ntvObj;
 529     | sysValT  : RETURN ntvVal;
 530     | sysEnuT  : RETURN ntvEnu;
 531     | sysDelT  : RETURN ntvEvt;
 532     | voidStar : RETURN voidSt;
 533
 534     ELSE (* default, refCls, valCls, enuCls, evtCls, dlgCls *)
 535       WITH peT : Per.Class DO
 536         RETURN lookup(peT, spc);
 537       ELSE
 538         IF peT # NIL THEN
 539           Console.WriteString("Not a class -- ");
 540           Console.WriteLn;
 541         END;
 542         RETURN NIL;
 543       END;
 544     END;
 545   END cpTypeFromCTS;
 546
 547  (* ------------------------------------------------ *)
 548
 549   PROCEDURE modeFromMbrAtt(att : SET) : INTEGER;
 550   BEGIN
 551     CASE ORD(att * {0,1,2}) OF
 552     | 4, 5 : RETURN Sy.protect;
 553     | 6    : RETURN Sy.pubMode;
 554     ELSE     RETURN Sy.prvMode;
 555     END;
 556   END modeFromMbrAtt;
 557
 558  (* ------------------------------------------------ *)
 559
 560   PROCEDURE mkParam(IN nam : ARRAY OF CHAR;
 561                        mod : INTEGER;
 562                        typ : Sy.Type;
 563                        rcv : BOOLEAN) : Id.ParId;
 564     VAR par : Id.ParId;
 565   BEGIN
 566     par := Id.newParId();
 567     par.parMod := mod;
 568     par.type   := typ;
 569     par.hash   := Nh.enterStr(nam);
 570     par.isRcv  := rcv;
 571     RETURN par;
 572   END mkParam;
 573
 574  (* ------------------------------------------------------------ *)
 575
 576   PROCEDURE isValClass(cls : Per.Type) : BOOLEAN;
 577   BEGIN
 578     RETURN getKind(cls) = valCls;
 579   END isValClass;
 580
 581  (* ------------------------------------------------------------ *)
 582  (*                   Main processing code                       *)
 583  (* ------------------------------------------------------------ *)
 584
 585   PROCEDURE (spc : DefNamespace)AddRecFld(rec : Ty.Record;
 586                                           fld : Per.FieldDef), NEW;
 587     VAR   mod : INTEGER;
 588           hsh : INTEGER;
 589           bts : SET;
 590           res : BOOLEAN;
 591           fId : Id.FldId;
 592           vId : Id.VarId;
 593           cId : Id.ConId;
 594    (* ------------------------------------ *)
 595     PROCEDURE conExp(val : Per.Constant) : Sy.Expr;
 596       VAR byts : POINTER TO ARRAY OF UBYTE;
 597           chrs : POINTER TO ARRAY OF CHAR;
 598           indx : INTEGER;
 599     BEGIN
 600       WITH val : Per.DoubleConst DO
 601           RETURN Xp.mkRealLt(val.GetDouble());
 602       | val : Per.FloatConst DO
 603           RETURN Xp.mkRealLt(val.GetDouble());
 604       | val : Per.CharConst DO
 605           RETURN Xp.mkCharLt(val.GetChar());
 606       | val : Per.IntConst DO
 607           RETURN Xp.mkNumLt(val.GetLong());
 608       | val : Per.UIntConst DO
 609           RETURN Xp.mkNumLt(val.GetULongAsLong());
 610       | val : Per.StringConst DO
 611           byts := val.GetStringBytes();
 612           NEW(chrs, LEN(byts) DIV 2 + 1);
 613           FOR indx := 0 TO (LEN(byts) DIV 2)-1 DO
 614             chrs[indx] := CHR(byts[indx*2] + byts[indx*2 + 1] * 256);
 615           END;
 616           (* RETURN Xp.mkStrLt(chrs); *)
 617           RETURN Xp.mkStrLenLt(chrs, LEN(chrs) - 1); (* CHECK THIS! *)
 618       END;
 619     END conExp;
 620    (* ------------------------------------ *)
 621   BEGIN
 622     bts := BITS(fld.GetFieldAttr());
 623     mod := modeFromMbrAtt(bts);
 624     IF mod > Sy.prvMode THEN
 625       hsh := Nh.enterStr(fld.Name());
 626       IF ltFld IN bts THEN                 (* literal field  *)
 627         cId := Id.newConId();
 628         cId.hash := hsh;
 629         cId.SetMode(mod);
 630         cId.recTyp := rec;
 631         cId.type := cpTypeFromCTS(fld.GetFieldType(), spc);
 632         cId.conExp := conExp(fld.GetValue());
 633         res := rec.symTb.enter(hsh, cId);
 634         Sy.AppendIdnt(rec.statics, cId);
 635       ELSIF stFld IN bts THEN              (* static field   *)
 636         vId := Id.newVarId();
 637         vId.hash := hsh;
 638         vId.SetMode(mod);
 639         vId.recTyp := rec;
 640         vId.type := cpTypeFromCTS(fld.GetFieldType(), spc);
 641         res := rec.symTb.enter(hsh, vId);
 642         Sy.AppendIdnt(rec.statics, vId);
 643       ELSE                                 (* instance field *)
 644         fId := Id.newFldId();
 645         fId.hash := hsh;
 646         fId.SetMode(mod);
 647         fId.recTyp := rec;
 648         fId.type := cpTypeFromCTS(fld.GetFieldType(), spc);
 649         res := rec.symTb.enter(hsh, fId);
 650         Sy.AppendIdnt(rec.fields, fId);
 651       END;
 652     END;
 653   END AddRecFld;
 654
 655  (* ------------------------------------------------------------ *)
 656
 657   PROCEDURE (spc : DefNamespace)AddFormals(typ : Ty.Procedure;
 658                                            mth : Per.MethodDef), NEW;
 659     VAR indx : INTEGER;
 660         pMod : INTEGER;
 661         thsP : Per.Param;
 662         thsT : Per.Type;
 663         pPar : Id.ParId;
 664         pars : POINTER TO ARRAY OF Per.Param;
 665
 666   BEGIN
 667     typ.retType := cpTypeFromCTS(mth.GetRetType(), spc);
 668     pars := mth.GetParams();
 669     FOR indx := 0 TO LEN(pars) - 1 DO
 670       pMod := Sy.val;
 671       thsP := pars[indx];
 672       thsT := thsP.GetParType();
 673       IF thsT IS Per.ManagedPointer THEN
 674         thsT := thsT(Per.PtrType).GetBaseType(); pMod := Sy.var;
 675       END;
 676       pPar := mkParam(thsP.GetName(), pMod, cpTypeFromCTS(thsT, spc), FALSE);
 677       Id.AppendParam(typ.formals, pPar);
 678     END;
 679   END AddFormals;
 680
 681  (* ------------------------------------------------------------ *)
 682
 683   PROCEDURE (spc : DefNamespace)AddRecMth(rec : Ty.Record;
 684                                           mth : Per.MethodDef), NEW;
 685     VAR   mod : INTEGER;
 686           hsh : INTEGER;
 687           pMd : INTEGER;
 688           bts : SET;
 689           res : BOOLEAN;
 690           pId : Id.PrcId;
 691           mId : Id.MthId;
 692           rcv : Per.Type;        (* Receiver type *)
 693           pTp : Ty.Procedure;
 694   BEGIN
 695    (* SPECIAL FOR PRE 1.4 VERSION *)
 696     IF isGenericMethod(mth) THEN
 697       Glb.CondMsg(" Hiding generic method -- " + ilName(mth));
 698       RETURN;
 699     ELSIF isVarargMethod(mth) THEN
 700       Glb.CondMsg(" Hiding Vararg call method -- " + ilName(mth));
 701       RETURN;
 702     END;
 703     bts := BITS(mth.GetMethAttributes());
 704     mod := modeFromMbrAtt(bts);
 705     IF mod > Sy.prvMode THEN
 706       hsh := Nh.enterStr(mth.Name());
 707
 708       IF stMth IN bts THEN                (* static method *)
 709         pId := Id.newPrcId();
 710         pId.SetKind(Id.conPrc);
 711         pId.hash := hsh;
 712         pId.SetMode(mod);
 713         pTp := Ty.newPrcTp();
 714         pTp.idnt := pId;
 715         pId.type := pTp;
 716         spc.AddFormals(pTp, mth);
 717         res := rec.symTb.enter(hsh, pId);
 718         Sy.AppendIdnt(rec.statics, pId);
 719         Glb.ListTy(pTp);
 720
 721       ELSIF hsh = Glb.ctorBkt THEN        (* constructor method *)
 722         pId := Id.newPrcId();
 723         pId.SetKind(Id.ctorP);
 724         pId.hash := Glb.initBkt;
 725         pId.prcNm := BOX(".ctor");
 726         pId.SetMode(mod);
 727         pTp := Ty.newPrcTp();
 728         pTp.idnt := pId;
 729         pId.type := pTp;
 730         spc.AddFormals(pTp, mth);
 731         rcv := mth.GetParent()(Per.Type);
 732         pTp.retType := cpTypeFromCTS(rcv, spc);
 733         res := rec.symTb.enter(Glb.initBkt, pId);
 734         Sy.AppendIdnt(rec.statics, pId);
 735         Glb.ListTy(pTp);
 736
 737       ELSE                                (* instance method *)
 738         mId := Id.newMthId();
 739         mId.SetKind(Id.conMth);
 740         mId.hash := hsh;
 741         mId.SetMode(mod);
 742
 743         pMd := Sy.val;
 744         rcv := mth.GetParent()(Per.Type);
 745         IF isValClass(rcv) THEN pMd := Sy.var END;
 746
 747         mId.rcvFrm := mkParam("this", pMd, cpTypeFromCTS(rcv, spc), TRUE);
 748         pTp := Ty.newPrcTp();
 749         pTp.idnt := mId;
 750         mId.type := pTp;
 751         pTp.receiver := rec;
 752         spc.AddFormals(pTp, mth);
 753
 754         IF    abMth IN bts    THEN
 755           mId.mthAtt := Id.isAbs;
 756         ELSIF (vrMth IN bts) & ~(fnMth IN bts) THEN
 757           mId.mthAtt := Id.extns;
 758         END;
 759         IF ~(vrMth IN bts) OR (nwMth IN bts) THEN
 760           INCL(mId.mthAtt, Id.newBit);
 761         END;
 762
 763 (* FIXME -- boxRcv flag needs to be set ... *)
 764
 765         res := rec.symTb.enter(hsh, mId);
 766         Sy.AppendIdnt(rec.methods, mId);
 767       END;
 768     END;
 769   END AddRecMth;
 770
 771  (* ------------------------------------------------------------ *)
 772
 773   PROCEDURE (spc : DefNamespace)AddRecEvt(rec : Ty.Record;
 774                                           evt : Per.Event), NEW;
 775     VAR   eTp : Per.Type;
 776           nam : RTS.NativeString;
 777           hsh : INTEGER;
 778           fId : Id.FldId;
 779           res : BOOLEAN;
 780   BEGIN
 781     eTp := evt.GetEventType();
 782     nam := evt.Name();
 783     hsh := Nh.enterStr(nam);
 784     fId := Id.newFldId();
 785     fId.hash := hsh;
 786     fId.SetMode(Sy.pubMode);
 787     fId.recTyp := rec;
 788     fId.type := cpTypeFromCTS(eTp, spc);
 789     res := rec.symTb.enter(hsh, fId);
 790     Sy.AppendIdnt(rec.fields, fId);
 791   END AddRecEvt;
 792
 793  (* ------------------------------------------------------------ *)
 794
 795   PROCEDURE MakeRefCls(cls : Per.ClassDef;
 796                        spc : DefNamespace;
 797                        att : Per.TypeAttr;
 798                    OUT tId : Id.TypId);
 799     VAR ptr  : Ty.Pointer;
 800    (* ------------------------------------------------- *)
 801     PROCEDURE mkRecord(cls : Per.ClassDef;
 802                        spc : DefNamespace;
 803                        att : Per.TypeAttr) : Ty.Record;
 804       VAR rec : Ty.Record;
 805           spr : Per.Class;
 806           knd : INTEGER;
 807           bts : SET;
 808           idx : INTEGER;
 809           ifE : Per.Class;
 810           ifA : POINTER TO ARRAY OF Per.Class;
 811     BEGIN
 812       bts := BITS(att);
 813       rec := Ty.newRecTp();
 814       spr := cls.get_SuperType();
 815
 816       ifA := cls.GetInterfaces();
 817       IF ifA # NIL THEN
 818         FOR idx := 0 TO LEN(ifA) - 1 DO
 819           ifE := ifA[idx];
 820           IF ~(ifE IS Per.ClassSpec) & isPublicClass(ifE) THEN
 821             Sy.AppendType(rec.interfaces, cpTypeFromCTS(ifE, spc));
 822           ELSIF Glb.verbose THEN
 823             SayWhy(ifE);
 824           END;
 825         END;
 826       END;
 827
 828       IF spr = NIL THEN knd := objTyp ELSE knd := getKind(spr) END;
 829       IF knd # objTyp THEN rec.baseTp := cpTypeFromCTS(spr, spc) END;
 830      (*
 831       *  The INTERFACE test must come first, since
 832       *  these have the ABSTRACT bit set as well.
 833       *)
 834       IF    intTp IN bts THEN rec.recAtt := Ty.iFace;
 835      (*
 836       *  Now the ABSTRACT but not interface case.
 837       *)
 838       ELSIF absTp IN bts THEN rec.recAtt := Ty.isAbs;
 839      (*
 840       *  If class is sealed, then default for CP.
 841       *)
 842       ELSIF sldTp IN bts THEN rec.recAtt := Ty.noAtt;
 843      (*
 844       *  Else CP default is EXTENSIBLE.
 845       *)
 846       ELSE                    rec.recAtt := Ty.extns;
 847       END;
 848      (*
 849       *  This is effectively the "no __copy__" flag.
 850       *)
 851       IF ~Glb.cpCmpld THEN INCL(rec.xAttr, Sy.isFn) END;
 852       Glb.ListTy(rec);
 853       RETURN rec;
 854     END mkRecord;
 855    (* ------------------------------------------------- *)
 856   BEGIN
 857    (*
 858     *  Create the descriptors.
 859     *)
 860     ptr := Ty.newPtrTp();
 861     tId := Id.newTypId(ptr);
 862     ptr.idnt := tId;
 863     ptr.boundTp := mkRecord(cls, spc, att);
 864     ptr.boundTp(Ty.Record).bindTp := ptr;
 865     tId.hash := Nh.enterStr(gpName(cls));
 866     Glb.ListTy(ptr);
 867   END MakeRefCls;
 868
 869  (* ------------------------------------------------------------ *)
 870
 871   PROCEDURE MakeEnumTp(cls : Per.ClassDef;
 872                    OUT tId : Id.TypId);
 873     VAR enu : Ty.Enum;
 874   BEGIN
 875    (*
 876     *  Create the descriptors.
 877     *)
 878     enu := Ty.newEnuTp();
 879     tId := Id.newTypId(enu);
 880     tId.hash := Nh.enterStr(gpName(cls));
 881     enu.idnt := tId;
 882     Glb.ListTy(enu);
 883   END MakeEnumTp;
 884
 885  (* ------------------------------------------------ *)
 886
 887   PROCEDURE MakeValCls(cls : Per.ClassDef;
 888                    OUT tId : Id.TypId);
 889     VAR rec  : Ty.Record;
 890   BEGIN
 891    (*
 892     *  Create the descriptors.
 893     *)
 894     rec := Ty.newRecTp();
 895     tId := Id.newTypId(rec);
 896     rec.idnt := tId;
 897     tId.hash := Nh.enterStr(gpName(cls));
 898     IF ~Glb.cpCmpld THEN INCL(rec.xAttr, Sy.isFn) END;
 899     Glb.ListTy(rec);
 900   END MakeValCls;
 901
 902  (* ------------------------------------------------ *)
 903
 904   PROCEDURE MakePrcCls(cls : Per.ClassDef;
 905                    OUT tId : Id.TypId);
 906     VAR prc  : Ty.Procedure;
 907   BEGIN
 908    (*
 909     *  Create the descriptors.
 910     *)
 911 (*                          (* We have no way of distinguishing between *)
 912  *   prc := Ty.newPrcTp();  (* CP EVENT and CP PROCEDURE types from the *)
 913  *)                         (* PE-file.  So, default to EVENT meantime. *)
 914     prc := Ty.newEvtTp();
 915     tId := Id.newTypId(prc);
 916     prc.idnt := tId;
 917     tId.hash := Nh.enterStr(gpName(cls));
 918     Glb.ListTy(prc);
 919   END MakePrcCls;
 920
 921  (* ------------------------------------------------------------ *)
 922
 923   PROCEDURE (spc : DefNamespace)DefineRec(cls : Per.ClassDef;
 924                                           rec : Ty.Record), NEW;
 925     VAR indx : INTEGER;
 926         flds : POINTER TO ARRAY OF Per.FieldDef;
 927         evts : POINTER TO ARRAY OF Per.Event;
 928         mths : POINTER TO ARRAY OF Per.MethodDef;
 929   BEGIN
 930    (*
 931     *  Now fill in record fields ...
 932     *)
 933     flds := cls.GetFields();
 934     FOR indx := 0 TO LEN(flds) - 1 DO
 935       spc.AddRecFld(rec, flds[indx]);
 936     END;
 937    (*
 938     *  Now fill in record events ...
 939     *)
 940     evts := cls.GetEvents();
 941     FOR indx := 0 TO LEN(evts) - 1 DO
 942       spc.AddRecEvt(rec, evts[indx]);
 943     END;
 944    (*
 945     *  Now fill in record methods ...
 946     *)
 947     mths := cls.GetMethods();
 948     FOR indx := 0 TO LEN(mths) - 1 DO
 949       spc.AddRecMth(rec, mths[indx]);
 950     END;
 951   END DefineRec;
 952
 953  (* ------------------------------------------------------------ *)
 954
 955   PROCEDURE (spc : DefNamespace)DefineEnu(cls : Per.ClassDef;
 956                                           enu : Ty.Enum), NEW;
 957     CONST litB = 6; (* 40H *)
 958     VAR   indx : INTEGER;
 959           valu : LONGINT;
 960           flds : POINTER TO ARRAY OF Per.FieldDef;
 961           thsF : Per.FieldDef;
 962           thsC : Id.ConId;
 963           mode : INTEGER;
 964           bits : SET;
 965           sCon : Per.SimpleConstant;
 966   BEGIN
 967    (*
 968     *  Now fill in record details ...
 969     *)
 970     flds := cls.GetFields();
 971     FOR indx := 0 TO LEN(flds) - 1 DO
 972       thsF := flds[indx];
 973       bits := BITS(thsF.GetFieldAttr());
 974       mode := modeFromMbrAtt(bits);
 975       IF (mode > Sy.prvMode) & (litB IN bits) THEN
 976         sCon := thsF.GetValue()(Per.SimpleConstant);
 977         WITH sCon : Per.IntConst DO valu := sCon.GetLong();
 978            | sCon : Per.UIntConst DO valu := sCon.GetULongAsLong();
 979         END;
 980         thsC := Id.newConId();
 981         thsC.SetMode(mode);
 982         thsC.hash := Nh.enterStr(thsF.Name());
 983         thsC.conExp := Xp.mkNumLt(valu);
 984         thsC.type := Bi.intTp;
 985         Sy.AppendIdnt(enu.statics, thsC);
 986       END;
 987     END;
 988   END DefineEnu;
 989
 990  (* ------------------------------------------------------------ *)
 991
 992   PROCEDURE (spc : DefNamespace)DefinePrc(cls : Per.ClassDef;
 993                                           prc : Ty.Procedure), NEW;
 994     VAR indx : INTEGER;
 995         valu : INTEGER;
 996         invk : Per.MethodDef;
 997   BEGIN
 998    (*
 999     *  Now fill in parameter details ...
1000     *)
1001     invk := cls.GetMethod(MKSTR("Invoke"));
1002     spc.AddFormals(prc, invk);
1003     RETURN;
1004   END DefinePrc;
1005
1006  (* ------------------------------------------------------------ *)
1007
1008   PROCEDURE MakeTypIds*(thsN : DefNamespace);
1009     VAR indx : INTEGER;
1010         thsC : Per.ClassDef;
1011         attr : Per.TypeAttr;
1012         tEnu : INTEGER;
1013         tpId : Id.TypId;
1014         clsh : Sy.Idnt;
1015   BEGIN
1016    (*
1017     *  For every namespace, define gpcp descriptors
1018     *  for each class, method, field and constant.
1019     *)
1020     Glb.CondMsg(" CP Module name - " + Nh.charOpenOfHash(thsN.bloc.hash)^);
1021     Glb.CondMsg(' Alternative import name - "' + thsN.bloc.scopeNm^ + '"');
1022     FOR indx := 0 TO LEN(thsN.clss) - 1 DO
1023       thsC := thsN.clss[indx];
1024       attr := thsC.GetAttributes();
1025       tEnu := getKind(thsC);
1026
1027       IF Glb.Verbose THEN
1028         Console.WriteString("        ");
1029         Console.WriteString(kindStr(tEnu)); Console.Write(ASCII.HT);
1030         Console.WriteString(gpName(thsC));
1031         Console.WriteLn;
1032       END;
1033
1034       CASE tEnu OF
1035       | refCls  : MakeRefCls(thsC, thsN, attr, tpId);
1036       | valCls  : MakeValCls(thsC, tpId);
1037       | enuCls  : MakeEnumTp(thsC, tpId);
1038 (*
1039  *    | evtCls  : MakeEvtCls(thsC, tpId);
1040  *)
1041       | dlgCls  : MakePrcCls(thsC, tpId);
1042       ELSE tpId := NIL;
1043       END;
1044 (* ---- temporary ---- *)
1045 IF tpId # NIL THEN
1046 (* ---- temporary ---- *)
1047       IF isProtectedType(attr) THEN
1048         tpId.SetMode(Sy.protect);
1049       ELSE
1050         tpId.SetMode(Sy.pubMode);
1051       END;
1052       tpId.dfScp := thsN.bloc;
1053       IF ~thsN.bloc.symTb.enter(tpId.hash, tpId) THEN
1054        (*
1055         *  Just a sanity check!
1056         *)
1057         clsh := thsN.bloc.symTb.lookup(tpId.hash);
1058         ASSERT((clsh IS Id.TypId) & (clsh.type IS Ty.Opaque));
1059
1060         thsN.bloc.symTb.Overwrite(tpId.hash, tpId);
1061       END;
1062 (* ---- temporary ---- *)
1063 END;
1064 (* ---- temporary ---- *)
1065       APPEND(thsN.tIds, tpId);
1066     END;
1067   END MakeTypIds;
1068
1069  (* ------------------------------------------------ *)
1070  (* ------------------------------------------------ *
1071
1072   PROCEDURE MakeRefIds(thsN : RefNamespace);
1073     VAR indx : INTEGER;
1074         thsC : Per.ClassRef;
1075         tEnu : INTEGER;
1076         tpId : Id.TypId;
1077   BEGIN
1078    (*
1079     *  For every namespace, define gpcp TypId descriptors for each class
1080     *)
1081     IF Glb.verbose THEN
1082       Glb.Message(" GPCP-Module name - " + Nh.charOpenOfHash(thsN.bloc.hash)^);
1083     END;
1084     FOR indx := 0 TO LEN(thsN.clss) - 1 DO
1085       thsC := thsN.clss[indx];
1086       IF Glb.Verbose THEN
1087         Console.WriteString("        class rfrnce ");
1088         Console.WriteString(gpName(thsC));
1089         Console.WriteLn;
1090       END;
1091       tpId := makeNameType(thsN.bloc, Nh.enterStr(gpName(thsC)));
1092       APPEND(thsN.tIds, tpId);
1093     END;
1094   END MakeRefIds;
1095
1096   * ------------------------------------------------ *)
1097  (* ------------------------------------------------ *)
1098
1099   PROCEDURE MakeBlkId*(spc : Namespace; aNm : Glb.CharOpen);
1100   BEGIN
1101     NEW(spc.bloc);
1102     INCL(spc.bloc.xAttr, Sy.need);
1103     Glb.BlkIdInit(spc.bloc, aNm, Nh.charOpenOfHash(spc.hash));
1104     IF Glb.superVb THEN Glb.Message("Creating blk - " +
1105                                      Nh.charOpenOfHash(spc.bloc.hash)^) END;
1106   END MakeBlkId;
1107
1108  (* ------------------------------------------------ *)
1109
1110   PROCEDURE DefineClss*(thsN : DefNamespace);
1111     VAR indx : INTEGER;
1112         tEnu : INTEGER;
1113         thsT : Sy.Type;
1114         thsI : Id.TypId;
1115         thsC : Per.ClassDef;
1116   BEGIN
1117    (*
1118     *  For every namespace, define gpcp descriptors
1119     *  for each class, method, field and constant.
1120     *)
1121     FOR indx := 0 TO LEN(thsN.clss) - 1 DO
1122       thsC := thsN.clss[indx];
1123       thsI := thsN.tIds[indx];
1124       tEnu := getKind(thsC);
1125
1126       CASE tEnu OF
1127       | valCls  : thsN.DefineRec(thsC, thsI.type(Ty.Record));
1128       | enuCls  : thsN.DefineEnu(thsC, thsI.type(Ty.Enum));
1129       | dlgCls  : thsN.DefinePrc(thsC, thsI.type(Ty.Procedure));
1130       | refCls  : thsT := thsI.type(Ty.Pointer).boundTp;
1131                   thsN.DefineRec(thsC, thsT(Ty.Record));
1132 (*
1133  *    | evtCls  : thsN.MakeEvtCls(thsC, ); (* Can't distinguish from dlgCls! *)
1134  *)
1135       ELSE (* skip *)
1136       END;
1137     END;
1138   END DefineClss;
1139
1140  (* ------------------------------------------------------------ *)
1141  (*    Separate flat class-list into lists for each namespace    *)
1142  (* ------------------------------------------------------------ *)
1143
1144   PROCEDURE Classify*(IN  clss : ARRAY OF Per.ClassDef;
1145                       OUT nVec : VECTOR OF DefNamespace);
1146     VAR indx : INTEGER;
1147         thsC : Per.ClassDef;
1148         attr : Per.TypeAttr;
1149    (* ======================================= *)
1150     PROCEDURE Insert(nVec : VECTOR OF DefNamespace;
1151                      thsC : Per.ClassDef);
1152       VAR thsH : INTEGER;
1153           jndx : INTEGER;
1154           nSpc : RTS.NativeString;
1155           cNam : RTS.NativeString;
1156           newN : DefNamespace;
1157     BEGIN
1158       nSpc := gpSpce(thsC);
1159       cNam := gpName(thsC);
1160       IF nSpc = "" THEN thsH := anon ELSE thsH := Nh.enterStr(nSpc) END;
1161      (*
1162       *  See if already a Namespace for this hash bucket
1163       *)
1164       FOR jndx := 0 TO LEN(nVec) - 1 DO
1165         IF nVec[jndx].hash = thsH THEN
1166           APPEND(nVec[jndx].clss, thsC); RETURN;    (* FORCED EXIT! *)
1167         END;
1168       END;
1169      (*
1170       *  Else insert in a new Namespace
1171       *)
1172       NEW(newN);                  (* Create new DefNamespace object    *)
1173       NEW(newN.clss, 8);          (* Create new vector of ClassDef     *)
1174       NEW(newN.tIds, 8);          (* Create new vector of Id.TypId     *)
1175       newN.hash := thsH;
1176       APPEND(newN.clss, thsC);    (* Append class to new class vector  *)
1177       APPEND(nVec, newN);         (* Append new DefNamespace to result *)
1178     END Insert;
1179    (* ======================================= *)
1180   BEGIN
1181     NEW(nVec, 8);
1182     FOR indx := 0 TO LEN(clss) - 1 DO
1183       thsC := clss[indx];
1184       IF isPublicClass(thsC) THEN
1185         Insert(nVec, thsC);
1186       ELSIF Glb.verbose THEN
1187         SayWhy(thsC);
1188       END;
1189 (* ------------------------------------- *
1190  *    attr := thsC.GetAttributes();
1191  *    IF isExportedType(attr) THEN
1192  *      IF ~isGenericClass(thsC) THEN (* SPECIAL FOR PRE 1.4 VERSION *)
1193  *        Insert(nVec, thsC);
1194  *      ELSIF Glb.verbose THEN
1195  *        Glb.Message(" Hiding generic class -- " +
1196  *                         gpSpce(thsC) + "." + gpName(thsC));
1197  *      END;
1198  *    END;
1199  * ------------------------------------- *)
1200     END;
1201     IF Glb.verbose THEN
1202       IF LEN(nVec) = 1 THEN
1203         Glb.Message(" Found one def namespace");
1204       ELSE
1205         Glb.Message(" Found "+Ltv.intToCharOpen(LEN(nVec))^+" def namespaces");
1206       END;
1207     END;
1208   END Classify;
1209
1210 (* ------------------------------------------------------------- *)
1211 (* ------------------------------------------------------------- *)
1212
1213   PROCEDURE InitCorLibTypes*();
1214   BEGIN
1215    (*
1216     *  Create import descriptor for [mscorlib]System
1217     *)
1218     Bi.MkDummyImport("mscorlib_System", "[mscorlib]System", corLib);
1219    (*
1220     *  Create various classes.
1221     *)
1222     ntvObj := makeNameType(corLib, Nh.enterStr("Object")).type;
1223     ntvStr := makeNameType(corLib, Nh.enterStr("String")).type;
1224     ntvExc := makeNameType(corLib, Nh.enterStr("Exception")).type;
1225     ntvTyp := makeNameType(corLib, Nh.enterStr("Type")).type;
1226     ntvEvt := makeNameType(corLib, Nh.enterStr("MulticastDelegate")).type;
1227     ntvVal := makeNameType(corLib, Nh.enterStr("ValueType")).type;
1228     ntvEnu := makeNameType(corLib, Nh.enterStr("Enum")).type;
1229    (*
1230     *  Do the unsigned types with no CP equivalent.
1231     *)
1232     sysU16 := makeNameType(corLib, Nh.enterStr("UInt16")).type;
1233     sysU32 := makeNameType(corLib, Nh.enterStr("UInt32")).type;
1234     sysU64 := makeNameType(corLib, Nh.enterStr("UInt64")).type;
1235     voidSt := makeNameType(corLib, Nh.enterStr("VoidStar")).type;
1236     intPtr := makeNameType(corLib, Nh.enterStr("IntPtr")).type;
1237     uIntPt := makeNameType(corLib, Nh.enterStr("UIntPtr")).type;
1238     tpdRef := makeNameType(corLib, Nh.enterStr("TypedReference")).type;
1239   END InitCorLibTypes;
1240
1241 (* ------------------------------------------------------------- *)
1242 (*
1243   PROCEDURE ImportCorlib*();
1244   BEGIN
1245     Glb.InsertImport(corLib);
1246     INCL(corLib.xAttr, Sy.need);
1247   END ImportCorlib;
1248  *)
1249 (* ------------------------------------------------------------- *)
1250
1251   PROCEDURE ImportCorlib*(spc : DefNamespace);
1252   BEGIN
1253     IF (spc # NIL) & (spc.bloc # corLib) THEN
1254       IF ~Sy.refused(corLib, spc.bloc) THEN
1255         IF Glb.superVb THEN
1256           Console.WriteString("Inserting import <");
1257           Console.WriteString(Nh.charOpenOfHash(corLib.hash));
1258           Console.WriteString("> in Namespace ");
1259           Console.WriteString(Nh.charOpenOfHash(spc.bloc.hash));
1260           Console.WriteLn;
1261         END;
1262       END;
1263     END;
1264     INCL(corLib.xAttr, Sy.need);
1265   END ImportCorlib;
1266
1267 (* ------------------------------------------------------------- *)
1268
1269   PROCEDURE BindSystemTypes*();
1270     VAR blk : Id.BlkId;       (* The Blk descriptor *)
1271         tId : Sy.Idnt;
1272    (* -------------------------- *)
1273     PROCEDURE MakeAbstract(blk : Id.BlkId; hsh : INTEGER);
1274     BEGIN
1275       blk.symTb.lookup(hsh).type(Ty.Record).recAtt := Ty.isAbs;
1276     END MakeAbstract;
1277    (* -------------------------- *)
1278   BEGIN
1279    (*
1280     *  Load import descriptor for [mscorlib]System
1281     *)
1282     corLib := Glb.thisMod.symTb.lookup(
1283                         Nh.enterStr("mscorlib_System"))(Id.BlkId);
1284     blk := corLib;
1285
1286    (*
1287     *  THIS IS ONLY EXPERIMENTAL
1288     *  We make the record types that correspond to the
1289     *  primitive types abstract to prevent the declaration
1290     *  of variables of these types.
1291     *
1292     *  The static methods can still be called, of course.
1293     *)
1294     MakeAbstract(blk, Nh.enterStr("Boolean"));
1295     MakeAbstract(blk, Nh.enterStr("Byte"));
1296     MakeAbstract(blk, Nh.enterStr("Char"));
1297     MakeAbstract(blk, Nh.enterStr("SByte"));
1298     MakeAbstract(blk, Nh.enterStr("Int16"));
1299     MakeAbstract(blk, Nh.enterStr("Int32"));
1300     MakeAbstract(blk, Nh.enterStr("Int64"));
1301     MakeAbstract(blk, Nh.enterStr("UInt16"));
1302     MakeAbstract(blk, Nh.enterStr("UInt32"));
1303     MakeAbstract(blk, Nh.enterStr("UInt64"));
1304    (*
1305     *  Create various classes.
1306     *)
1307     tId := blk.symTb.lookup(Nh.enterStr("Object"));
1308     ntvObj := tId.type;
1309
1310     tId := blk.symTb.lookup(Nh.enterStr("String"));
1311     ntvStr := tId.type;
1312
1313     tId := blk.symTb.lookup(Nh.enterStr("Exception"));
1314     ntvExc := tId.type;
1315
1316     tId := blk.symTb.lookup(Nh.enterStr("Type"));
1317     ntvTyp := tId.type;
1318
1319     tId := blk.symTb.lookup(Nh.enterStr("MulticastDelegate"));
1320     ntvEvt := tId.type;
1321
1322     tId := blk.symTb.lookup(Nh.enterStr("ValueType"));
1323     ntvVal := tId.type;
1324
1325     tId := blk.symTb.lookup(Nh.enterStr("Enum"));
1326     ntvEnu := tId.type;
1327    (*
1328     *  Do the unsigned types with no CP equivalent.
1329     *)
1330     tId := blk.symTb.lookup(Nh.enterStr("UInt16"));
1331     sysU16 := tId.type;
1332
1333     tId := blk.symTb.lookup(Nh.enterStr("UInt32"));
1334     sysU32 := tId.type;
1335
1336     tId := blk.symTb.lookup(Nh.enterStr("UInt64"));
1337     sysU64 := tId.type;
1338    (*
1339     *  Do the miscellaneous values
1340     *)
1341     tId := blk.symTb.lookup(Nh.enterStr("IntPtr"));
1342     voidSt := tId.type;
1343     intPtr := tId.type;
1344
1345     tId := blk.symTb.lookup(Nh.enterStr("UIntPtr"));
1346     uIntPt := tId.type;
1347
1348     tId := blk.symTb.lookup(Nh.enterStr("TypedReference"));
1349     tpdRef := tId.type;
1350
1351   END BindSystemTypes;
1352
1353 (* ------------------------------------------------------------- *)
1354 BEGIN
1355   Bi.InitBuiltins;
1356 END ClsToType.
1357 (* ------------------------------------------------------------- *)