home *** CD-ROM | disk | FTP | other *** search
/ Amiga ISO Collection / AmigaUtilCD2.iso / Programming / Misc / OB3.2D2.DMS / in.adf / Module / Objects.mod < prev    next >
Encoding:
Text File  |  1994-08-05  |  2.9 KB  |  129 lines
  1.  
  2. (*
  3.  * This modules is really implementation dependand! It will not work
  4.  * with any compiler but Amiga Oberon. It does a lot of assumptions
  5.  * on how records are represented and how type information and
  6.  * Garbage-Collector information is stored!
  7.  *
  8.  * To use this modules, inform Objects about your types in all
  9.  * modules via
  10.  *
  11.  * ...
  12.  *   MyObject = POINTER TO MyObjectDesc;
  13.  *   MyObjectDesc = RECORD ... END;
  14.  * ...
  15.  *   x: MyObject;
  16.  * ...
  17.  *   NEW(x); Objects.AddObject(x,"MyModule.MyObject"); x := NIL;
  18.  * ...
  19.  *
  20.  * Future versions of Amiga Oberon will probalby do this initialisations
  21.  * automatically.
  22.  *
  23.  *)
  24.  
  25. MODULE Objects;
  26.  
  27. IMPORT B  * := BasicTypes,
  28.        F  * := FileSystem,
  29.        A    := AVLTrees,
  30.        BI   := BinaryTrees,
  31.        GC   := GarbageCollector,
  32.        ol   := OberonLib,
  33.                SYSTEM;
  34.  
  35. TYPE
  36.   Object * = POINTER TO ObjectDesc;
  37.  
  38.   ObjectDesc * = RECORD (B.ANYDesc) END;
  39.  
  40.   TypDesc = STRUCT
  41. (* $IF GarbageCollector *)
  42.     gctype: GC.InternalObjectTypePtr;
  43. (* $ELSE *)
  44.     size  : LONGINT;
  45. (* $END *)
  46.     typedesc: LONGINT;
  47.   END;
  48.  
  49.   Name = POINTER TO NameDesc;
  50.   NameDesc = RECORD (A.SNodeDesc)
  51.     typ: TypDesc;
  52.   END;
  53.  
  54.   Obj = POINTER TO ObjDesc;
  55.   ObjDesc = RECORD (A.NodeDesc)
  56.     name : Name;
  57.   END;
  58.  
  59.   ObjRoot = POINTER TO ObjRootDesc;
  60.   ObjRootDesc = RECORD (A.RootDesc)
  61.     findtypedesc: LONGINT;
  62.   END;
  63.  
  64. VAR
  65.   names: A.SRoot;
  66.   objects: ObjRoot;
  67.  
  68. PROCEDURE (x: Object) Load  * (VAR f: F.File); (* is deferred *) END Load;
  69. PROCEDURE (x: Object) Store * (VAR f: F.File); (* is deferred *) END Store;
  70.  
  71. PROCEDURE GetTyp(x: B.ANY): TypDesc;
  72. (* low-level routine to get ptr to typedesc and gctype *)
  73. TYPE Typ = UNTRACED POINTER TO TypDesc;
  74. BEGIN
  75.   RETURN SYSTEM.VAL(Typ,SYSTEM.VAL(LONGINT,SYSTEM.ADR(x^))-4)^;
  76. END GetTyp;
  77.  
  78. PROCEDURE ObjToName * (x: B.ANY; VAR name: ARRAY OF CHAR);
  79. BEGIN
  80.   objects.findtypedesc := GetTyp(x).typedesc;
  81.   COPY(objects.Find()(Obj).name.name,name);
  82. END ObjToName;
  83.  
  84. PROCEDURE NameToObj * (name: ARRAY OF CHAR; VAR x: B.ANY);
  85. VAR
  86.   adrPtr: UNTRACED POINTER TO SYSTEM.ADDRESS;
  87.   namestr: A.String;
  88.   n: Name;
  89. BEGIN
  90.   adrPtr := SYSTEM.ADR(x);
  91.   COPY(name,namestr);
  92.   n := names.SFind(namestr)(Name);
  93. (* $IF GarbageCollector *)
  94.   GC.New(adrPtr^,n.typ.gctype);
  95. (* $ELSE *)
  96.   ol.New(adrPtr^,n.typ.size);
  97. (* $END *)
  98.   adrPtr := SYSTEM.ADR(x^);
  99.   adrPtr^ := n.typ.typedesc;
  100. END NameToObj;
  101.  
  102. PROCEDURE AddObject * (x: B.ANY; name: ARRAY OF CHAR);
  103. VAR
  104.   n: Name;
  105.   o: Obj;
  106. BEGIN
  107.   NEW(n); NEW(o);
  108.   o.name := n;
  109.   n.typ := GetTyp(x);
  110.   COPY(name,n.name);
  111.   names  .Add(n); IF ~ names  .addOk THEN HALT(20) END;
  112.   objects.Add(o); IF ~ objects.addOk THEN HALT(20) END;
  113. END AddObject;
  114.  
  115. PROCEDURE (obj: Obj) Compare * (b: B.COMPAREABLE): LONGINT;
  116. BEGIN
  117.   RETURN obj.name.typ.typedesc - b(Obj).name.typ.typedesc;
  118. END Compare;
  119.  
  120. PROCEDURE (obj: Obj) Find * (r: BI.Root): LONGINT;
  121. BEGIN
  122.   RETURN obj.name.typ.typedesc - r(ObjRoot).findtypedesc;
  123. END Find;
  124.  
  125. BEGIN
  126.   NEW(names);
  127.   NEW(objects);
  128. END Objects.
  129.