IMPLEMENTATION MODULE MetaClass;          

FROM List IMPORT List;
FROM Streams IMPORT OutputStream, StdOut;
IMPORT String;
IMPORT SYSTEM;
IMPORT Stack;
                                     
INLINE
  %#include <assert.h>
  END;
  ------------------------------
  -- The MetaClass class describes a class
  -- which is given to it as formal class.
  ------------------------------

  CLASS MetaClass(Class); 
                
    VAR          
      TheInst: Class;
      TheInstArray: ARRAY OF Class;
      TheName, TheModName: ARRAY OF CHAR;
      TheSize, TheDualSize: INTEGER;
      TheSignature, 
      TheLastSignature, 
      TheDual,
      TheOrgMethods,
      TheInhMethods: INTEGER;
      TheInherits: MetaClass;
      TheInstanceStack: Stack(Class);

    METHOD InstanceStack: Stack(Class);
      BEGIN
      IF TheInstanceStack = VOID THEN
        TheInstanceStack.CREATE;
        END;
      RESULT := TheInstanceStack;
      END InstanceStack;

    METHOD PushInstance(Inst: Class);
      BEGIN
      InstanceStack.Push(TheInst);
-- ??? patched by bernard
--      UseInstance(Inst);
--      TheInstArray := VOID;
      DoUseInstance(Inst);
      END PushInstance;

    METHOD PopInstance: Class;
      BEGIN
      RESULT := TheInst;
-- ??? patched by bernard
--      UseInstance(InstanceStack.Pop);
--      TheInstArray := VOID;
      DoUseInstance(InstanceStack.Pop);
      END PopInstance;

    METHOD DupInstance;
      BEGIN
      InstanceStack.Push(TheInst);
      END DupInstance;

    METHOD DropInstance;
      BEGIN
-- ??? patched by bernard
--      UseInstance(InstanceStack.Pop);
      DoUseInstance(InstanceStack.Pop);
      END DropInstance;
                                         
    REDEFINE METHOD CREATE;
      VAR
        Other: MetaClass(Class);
        Sig, ADual: INTEGER;
      BEGIN
      IF NOT DataDictionary.Critical THEN
        INLINE         
          %{
          % minimal_dual *d;
          %
          % d = THIS->Y_Class;
          % Y_Sig = d->first_sig;
          % Y_ADual = (yint) d;
          %}
          END;
        TheSignature := Sig;
        TheDual := ADual;
        ASSERT TheDual <> 0;
        WHAT DataDictionary.GetDescription(Sig) OF
          IN MetaClass(Class):
            Other := TAG;
            END;
          END;
        TheInst := Other.TheInst;
        TheName := Other.TheName;
        TheSize := Other.TheSize;
        TheModName := Other.TheModName;
        TheLastSignature := Other.TheLastSignature;
        TheInherits := Other.TheInherits;
        AttrListAsked := Other.AttrListAsked;
        TheAttrList := Other.TheAttrList;
        DataDictionary.Register (THIS);
        END;
      END CREATE;
      
    -----------------------
    -- Setting the object's internal state happens through
    -- private methods called Set and SetModName. 
    -- External classes cannot change
    -- a class descriptor, even by inheritance.
    -----------------------
    METHOD SetModName (ModName: ARRAY OF CHAR);
      BEGIN
      TheModName := ModName;
      END SetModName;
      
    METHOD Set (Name: ARRAY OF CHAR;
                Size, DualSize: INTEGER;
                Signature, LastSig, Dual, OrgMethods, InhMethods: INTEGER;
                Inherits: MetaClass);
      BEGIN   
      TheName := Name; 
      TheSize := Size;
      TheDualSize := DualSize;
      TheSignature := Signature;
      TheLastSignature := LastSig;
      TheDual := Dual;
      TheOrgMethods := OrgMethods;
      TheInhMethods := InhMethods;
      TheInherits := Inherits;
      END Set;
   
    METHOD Name: ARRAY OF CHAR;
      BEGIN           
      RESULT := TheName;
      END Name;
      
    METHOD Module: ARRAY OF CHAR;
      BEGIN           
      RESULT := TheModName;
      END Module;
      
    METHOD Signature: INTEGER;
      BEGIN             
      RESULT := TheSignature;
      END Signature;
      
    METHOD LastSignature: INTEGER;
      BEGIN                  
      RESULT := TheLastSignature;
      END LastSignature;
      
    METHOD Size: INTEGER;
      BEGIN                 
      RESULT := TheSize;
      ASSERT RESULT > 0;  
      END Size;
      
    METHOD DualSize: INTEGER;
      BEGIN                 
      RESULT := TheDualSize;  
----      ASSERT RESULT > 0;
      END DualSize;
      
    METHOD Inherits: MetaClass;
      BEGIN             
      RESULT := TheInherits;
      END Inherits;         
      
    VAR
      TheAttrList: List(Attribute);           
      AttrListAsked: BOOLEAN;
      TheMethList: List(Method);
      MethListAsked: BOOLEAN;

-----------------------------------------------------------
-- patched by bernard
-- we now have the possibility to hide some of the fields of a given
-- class; that is, they will not appear in the attribute list (but they
-- are still present in the system and can be accessed in C, by the
-- debugger for example)
-- we can ask for the complete list or for the list minus the hidden
-- fields
------------------------------------------------------------------             
    METHOD AttributeList: List(Attribute);
      VAR
        Visible: BOOLEAN;
        TDu, Level, Offset, Sig: INTEGER;
        Name: ARRAY OF CHAR;
        CharAttr: CharAttribute;
        StrAttr: StringAttribute;
        IntAttr: IntegerAttribute;
        RealAttr: RealAttribute;
        BoolAttr: BooleanAttribute;
        ArrAttr: ArrayAttribute;
        ClassAttr: ClassAttribute(ClassAttribute); 
                                              -- Must be constrained
                                              -- so that it can be CREATEd
      BEGIN
      Sig := 0;
      Level := 0;
      IF NOT AttrListAsked THEN
        AttrListAsked := TRUE;     
        TheAttrList.CREATE;
        TDu := TheDual;
        INLINE
          %{
          %  minimal_dual *d;
          %  FIELD_INFO *f;
          %  obj_ptr *v_s = v_stack;
          %
          %  d = (minimal_dual *) Y_TDu;
          %  assertp(d);
          %  f = (FIELD_INFO *) d->first_field;
          %  while(f)
          %    {
          %      v_stack = v_s;
          %      Y_Name = new_string(f->name); 
          %      Y_Offset = f->offset;
          %      Y_Level = f->level;
          %      d = (minimal_dual *) f->field_dual;
          %      assertp(d);
          %      Y_Sig = d->first_sig; 
          %      Y_TDu = (yint) d;
          %      if ((Y_Level == 1) && (d == &YD_CHAR)) /* String ! */
          %        {                                                 
          END;
        StrAttr.CREATE (Name, Offset, THIS);
        TheAttrList.Append (StrAttr);
        INLINE
          %        }
          %       else if (Y_Level > 0)
          %        {
          END; 
        ArrAttr.CREATE (Name, Offset, THIS);
        ArrAttr.Set (Level, Sig);
        TheAttrList.Append (ArrAttr);
        INLINE
          %        }
          %       else if (d == &YD_CHAR)
          %        {
          END;
        CharAttr.CREATE (Name, Offset, THIS);
        TheAttrList.Append (CharAttr); 
        INLINE
          %        }
          %       else if (d == &YD_INT)
          %        {
          END;     
        IntAttr.CREATE (Name, Offset, THIS);
        TheAttrList.Append (IntAttr);
        INLINE
          %        }
          %       else if (d == &YD_REAL)
          %        {
          END;     
        RealAttr.CREATE (Name, Offset, THIS);
        TheAttrList.Append (RealAttr);
        INLINE
          %        }
          %       else if (d == &YD_BOOL)
          %        {
          END;     
        BoolAttr.CREATE (Name, Offset, THIS);
        TheAttrList.Append (BoolAttr);
        INLINE
          %        }
          %       else    /* No predefined class */
          %        {
          END;     
        ClassAttr.CREATE (Name, Offset, THIS);
        ClassAttr.SetDual (TDu);
        TheAttrList.Append (ClassAttr);
        INLINE
          %        }
          %      Y_Visible = (f->visible ? TRUE : FALSE);
          %      f = (FIELD_INFO*) f -> next;
          END;
        TheAttrList.Get(TheAttrList.Size-1).SetVisible (Visible);
        INLINE
          %    } /* while f */
          %}
          END;
        END;
      RESULT := TheAttrList;  
      END AttributeList;        
      
    METHOD MethodList: List(Method);
      VAR
        TDu, Level, Sig, Offset: INTEGER;
        Name: ARRAY OF CHAR;
        VoidMeth: VoidMethod;
        CharMeth: CharMethod;
        StrMeth: StringMethod;
        IntMeth: IntegerMethod;
        RealMeth: RealMethod;
        BoolMeth: BooleanMethod;
        ClassMeth: ClassMethod(ClassMethod); 
                                              -- Must be constrained
                                              -- so that it can be CREATEd
      BEGIN
      Level := 0;
      Sig := 0;
      IF NOT MethListAsked THEN
        MethListAsked := TRUE;     
        TheMethList.CREATE;
        TDu := TheDual;
        INLINE
          %{
          %  minimal_dual *d;
          %  METHOD_INFO *m;
          %  obj_ptr *v_s = v_stack;
          %
          %  d = (minimal_dual *) Y_TDu;
          %  assertp(d);
          %  m = (METHOD_INFO *) d->first_method;
          %  while(m)
          %    {
          %      v_stack = v_s;
          %      Y_Name = new_string(m->name); 
          %      Y_Offset = m->offset;
--          %      if (Y_Offset == 0)
--          %        printf ("Null offset is: %s\n", Y_Name);
          %      Y_Level = m->return_array_level;
          %      d = (minimal_dual *) m->return_dual;
          %      if (d)
          %        Y_Sig = d->first_sig; 
          %       else
          %        Y_Sig = 0; 
          %      Y_TDu = (yint) d;
          %      if ((Y_Level == 1) && (d == &YD_CHAR)) /* String ! */
          %        {                                                 
          END;
        StrMeth.CREATE (Name, Offset, THIS);
        TheMethList.Append (StrMeth);
        INLINE
          %        }
          %       else if (Y_Level > 0)
          %        {
          END; 
-- not supported yet
--        ArrMeth.CREATE (Name, Offset, THIS);
--        ArrMeth.Set (Level, Sig);
--        TheMethList.Append (ArrMeth);
        INLINE
          %        }
          %       else if (d == NULL)
          %        {
          END;
        VoidMeth.CREATE (Name, Offset, THIS);
        TheMethList.Append (VoidMeth); 
        INLINE
          %        }
          %       else if (d == &YD_CHAR)
          %        {
          END;
        CharMeth.CREATE (Name, Offset, THIS);
        TheMethList.Append (CharMeth); 
        INLINE
          %        }
          %       else if (d == &YD_INT)
          %        {
          END;     
        IntMeth.CREATE (Name, Offset, THIS);
        TheMethList.Append (IntMeth);
        INLINE
          %        }
          %       else if (d == &YD_REAL)
          %        {
          END;     
        RealMeth.CREATE (Name, Offset, THIS);
        TheMethList.Append (RealMeth);
        INLINE
          %        }
          %       else if (d == &YD_BOOL)
          %        {
          END;     
        BoolMeth.CREATE (Name, Offset, THIS);
        TheMethList.Append (BoolMeth);
        INLINE
          %        }
          %       else    /* No predefined class */
          %        {
          END;     
        ClassMeth.CREATE (Name, Offset, THIS);
        ClassMeth.SetDual (TDu);
        TheMethList.Append (ClassMeth);
        INLINE
          %        }
          %      m = (METHOD_INFO*) m -> next;
          %    } /* while m */
          %}
          END;
        END;
      RESULT := TheMethList;  
      END MethodList;        
      
    --------------------------------
    -- The UseInstance method attaches a given instance
    -- to the MetaClass, in such a way that the 
    -- attributes listed in the AttributeList method
    -- refer to a valid instance.
    --------------------------------
    METHOD DoUseInstance (Inst: Class);
      BEGIN 
      IF (Inst <> TheInst) THEN                
        TheInst := Inst;
        FOR Attr IN THIS.AttributeList DO
          IF Inst = VOID THEN
            Attr.SetPtr (0);
           ELSE
            Attr.SetPtr (Ptr (Attr.Offset));
            END; -- IF
          END; -- FOR
        IF MethListAsked THEN
          FOR Meth IN THIS.MethodList DO
-- to make sure we don't accidentaly call a method when instance = VOID
-- we set all the method pointers to 0
-- this should get an exception immediately
            IF Inst = VOID THEN
              Meth.SetPtr (0);
             ELSE
              Meth.SetPtr (MethodPtr (Meth.Offset));
              END; -- IF
            END; -- FOR
          END; -- IF
        END; -- IF
      END DoUseInstance;

    METHOD UseInstance (Inst: Class);
      BEGIN 
      DoUseInstance (Inst);
      TheInstArray := VOID;
      END UseInstance;

    METHOD UseInstances (Arr: ARRAY OF Class);
      BEGIN
      TheInstArray := Arr;
      UseInstanceIndex (Index := 0);
      END UseInstances;

    METHOD UseInstanceIndex(Index: INTEGER);
      BEGIN
      IF (TheInstArray <> VOID) AND (Index >= 0) AND 
         (Index < TheInstArray.SIZE) THEN
        DoUseInstance (TheInstArray[Index]);
        END;
      END UseInstanceIndex;
    
    METHOD InstanceCount: INTEGER;
      BEGIN
      IF TheInstArray <> VOID THEN
        RESULT := TheInstArray.SIZE;
       ELSE
        RESULT := 1;
        END;
      END InstanceCount;

    METHOD Instance: Class;
      BEGIN                 
      RESULT := TheInst;
      END Instance;
      
    METHOD Ptr (Offset: INTEGER): INTEGER; 
      VAR
        Base: Class;
      BEGIN         
      Base := TheInst;
      INLINE
        % if (Y_Base)
        %   Y_RESULT = Y_Offset + (yint) Y_Base;
        END;
      END Ptr;
      
-- CAUTION: method pointers are stored in the dual, not in the object

    METHOD MethodPtr (Offset: INTEGER): INTEGER; 
      VAR
        Base: INTEGER;
      BEGIN         
      ASSERT (TheDual <> 0);
      Base := TheDual;
-- check with Darius
-- is offset ok to add with an int ???
      INLINE
        % assert (Y_Base);
        %   Y_RESULT = Y_Offset + Y_Base;
        END;
      END MethodPtr;

    METHOD InstancePtr: INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = (yint)THIS->Y_TheInst;
        END;
      END InstancePtr;
      
    METHOD FindAttribute (TheName : ARRAY OF CHAR) : Attribute;
    VAR
      Att : Attribute;
      AttList: List(Attribute);
    BEGIN  
    AttList := THIS.AttributeList;
    FOR i := 0 TO AttList.Size - 1 WHILE RESULT = VOID DO
      Att := AttList.Get (i);
      IF String.Equals (Att.Name, TheName) THEN
        RESULT := Att;
        END;
      END;
    END FindAttribute;

  METHOD FindVisibleAttribute (TheName : ARRAY OF CHAR) : Attribute;
    BEGIN
    RESULT := FindAttribute (TheName);
    IF (RESULT <> VOID) AND NOT RESULT.Visible THEN
      RESULT := VOID;
      END;
    END FindVisibleAttribute;

  METHOD FindAttributePos(Attr: Attribute): INTEGER;
    BEGIN
    ASSERT Attr <> VOID;
    RESULT := -1;
    FOR i := 0 TO AttributeList.Size - 1 WHILE RESULT = -1 DO
      IF AttributeList.Get(i) = Attr THEN
        RESULT := i;
        END; -- IF
      END; -- FOR
    END FindAttributePos;

    METHOD FindMethod (TheName : ARRAY OF CHAR) : Method;
    BEGIN  
    RESULT := FIRST m IN THIS.MethodList :- String.Equals (m.Name, TheName);
    END FindMethod;

  METHOD FindMethodPos(Meth: Method): INTEGER;
    BEGIN
    RESULT := MethodList.Index (Meth);
    END FindMethodPos;

    METHOD OriginalMethods: INTEGER;
      BEGIN   
      RESULT := TheOrgMethods;      
      END OriginalMethods;
      
    METHOD InheritedMethods: INTEGER;
      BEGIN
      RESULT := TheInhMethods;
      END InheritedMethods;
      
  END MetaClass; 
  
  -----------------------------
  -- The DataDictionary class gives access
  -- to the MetaClass's without having to
  -- refer to an actual class as formal. It also
  -- gives access to a centralized pool of these
  -- MetaClass's. 
  -----------------------------
  ONCE CLASS DataDictionary; 

    VAR
      DescTable: ARRAY OF MetaClass;
      CriticalFlag: BOOLEAN;
      TheClassCreator: ClassCreator;
      
    METHOD TotalDualSize: INTEGER;
      BEGIN             
      INLINE
        % {
        % extern yint total_dual_size();
        %  Y_RESULT = total_dual_size();
        % }
        END;
----      FOR i := 0 TO DescTable.SIZE - 1 DO
----        IF DescTable[i] <> VOID THEN
----          RESULT := RESULT + DescTable[i].DualSize;
----          END;
----        END;      
----      ASSERT RESULT > 0;
      END TotalDualSize;
    
    METHOD Register (ClassDes: MetaClass);
      BEGIN
      ASSERT NOT Critical;
      DescTable [ClassDes.Signature] := ClassDes;
      ClassDes.UseInstance (ClassDes.Instance); 
                            -- Set the field pointer to the right instance
                            -- and to the right descriptor.
      END Register;
      
    METHOD Critical: BOOLEAN;
      BEGIN
      RESULT := CriticalFlag;
      END Critical;
     
    METHOD LastSig: INTEGER;
      BEGIN
      INLINE
        % Y_RESULT = last_class_sig();
        END;
      END LastSig;
      
    METHOD GetDescription (Sig: INTEGER): MetaClass;
      VAR
-----------------------------------------------------------------
-- patched by bernard      
-----------------------------------------------------------------      
--        Temp: MetaClass(MetaClass); -- Need a constrained
--                                                  -- instance to CREATE
-------------------------------------------------------------------
        Temp: MetaClass;
        ModName, Name: ARRAY OF CHAR;
        DSize, Size, FirstSig, TheLastSig, InhSig, Dual: INTEGER;
        DoesInherit: BOOLEAN;      
        OMeth, IMeth: INTEGER;
      BEGIN
      ASSERT Sig >= FirstSig;
      ASSERT Sig < LastSig;
      IF DescTable [Sig] = VOID THEN
        CriticalFlag := TRUE;
-----------------------------------------------------------------------
-- patched by bernard
----------------------------------------------------------------------
--        Temp.CREATE;
-----------------------------------------------------------------------
        Temp := TheClassCreator.CreateClass;
        CriticalFlag := FALSE;
        INLINE
          %{ 
          %  minimal_dual *d;
          %  d = get_class_dual (Y_Sig);
          %  assertp(d);
          %  ((YC_MetaClassMetaClass*)Y_Temp)->Y_Class = d;
          %  Y_Size = d->elem_size;
          %  Y_DSize = d->dual_size;
          %  Y_FirstSig = d->first_sig;
          %  Y_TheLastSig = d->last_sig;
          %  Y_Name = new_string (d->class_name);
          %  Y_ModName = new_string (d->module_name);
          %  Y_OMeth = d->orig_meth_count;
          %  Y_IMeth = d->inh_meth_count;
          %  if (d->inherited)
          %    {
          %      Y_InhSig = ((minimal_dual *)d->inherited)->first_sig;
          %      Y_DoesInherit = 1;
          %    }
          %  Y_Dual = (yint) d;
          %} 
          END;
        IF DoesInherit THEN
          Temp.Set (Name, Size, DSize, FirstSig, TheLastSig, Dual, OMeth, 
                    IMeth, GetDescription(InhSig));
         ELSE
          Temp.Set (Name, Size, DSize, FirstSig, TheLastSig, Dual, OMeth,
                    IMeth, VOID);
          END;
        Temp.SetModName (ModName);
        DescTable [Sig] := Temp;
        END;
      RESULT := DescTable [Sig];
      END GetDescription;

    METHOD SetDescription(Class: MetaClass);
      BEGIN
      ASSERT Class <> VOID;
      DescTable[Class.Signature] := Class;
      END SetDescription;
      
      METHOD FindMetaClass (ModuleName, ClassName : ARRAY OF CHAR) 
                                              : MetaClass;
      VAR
        ADesc   : MetaClass;
      BEGIN
      FOR i := FirstSig TO LastSig - 1 WHILE RESULT = VOID DO
        ADesc := GetDescription (i);
        IF ADesc = VOID THEN
          StdOut.WriteLine ("Error !");
         ELSE
          IF ((ModuleName = VOID) OR String.Equals (ModuleName, ADesc.Module)) AND
             String.Equals (ClassName,  ADesc.Name) THEN
            RESULT := ADesc;
            END;
          END;
        END;
      END FindMetaClass;    
      
    REDEFINE METHOD CREATE;
      BEGIN
      DescTable.CREATE (LastSig);
-- added by bernard      
      TheClassCreator.CREATE;
      END CREATE;

    METHOD SetClassCreator(Creator: ClassCreator);
      BEGIN
      ASSERT Creator <> VOID;
      TheClassCreator := Creator;
      END SetClassCreator;

    METHOD GetClassCreator: ClassCreator;
      BEGIN
      RESULT := TheClassCreator;
      ASSERT RESULT <> VOID;
      END GetClassCreator;      
      
    METHOD Dump(Output: OutputStream);
      VAR
        CDesc: MetaClass;
        AList: List(Attribute);
        Attr: Attribute;
        MList: List(Method);
        Meth: Method;

        METHOD Tab;
          BEGIN
          Output.WriteChar (SYSTEM.CHR(9));
          END Tab;

      BEGIN
      FOR i := 0 TO LastSig - 1 DO
        CDesc := GetDescription (i);
        ASSERT CDesc <> VOID;
        Output.WriteString (CDesc.Name);
        Tab;
        Output.WriteInt (CDesc.Size, 0);
        Tab;
        Output.WriteInt (CDesc.Signature, 0);
        Tab;
        Output.WriteInt (CDesc.LastSignature, 0);
        Tab;
        IF CDesc.Inherits = VOID THEN
          Output.WriteChar ('*');
         ELSE
          Output.WriteString (CDesc.Inherits.Name);
          END; -- IF
        AList := CDesc.AttributeList;  
        IF (AList <> VOID) AND (AList.Size > 0) THEN
          Output.WriteLn;
          Tab;                 
          Output.WriteInt (AList.Size, 0);
          FOR j := 0 TO AList.Size - 1 DO
            Attr := AList.Get(j);
            Tab;
            Output.WriteString (Attr.Name);
            Tab;
            Output.WriteInt (Attr.Offset, 0);
            Output.WriteLn;
            END; -- FOR
          END; -- IF
        MList := CDesc.MethodList;  
        IF (MList <> VOID) AND (MList.Size > 0) THEN
          Output.WriteLn;
          Tab;                 
          Output.WriteInt (MList.Size, 0);
          FOR j := 0 TO MList.Size - 1 DO
            Meth := MList.Get(j);
            Tab;
            Output.WriteString (Meth.Name);
            Tab;
            Output.WriteInt (Meth.Offset, 0);
            Output.WriteLn;
            END;
          END;
        Output.WriteLn;
        END; -- FOR
      END Dump;
  END DataDictionary;                     
-----------------------------------------------------------------------
  CLASS ClassCreator;
  
    METHOD CreateClass: MetaClass;
      VAR
        TheClass: MetaClass(MetaClass);
      BEGIN
      TheClass.CREATE;
      RESULT := TheClass;
      END CreateClass;
    
    END ClassCreator;
    
  
  ----------------------------------
  -- The Attribute class describes individual attributes
  -- of a class. It is meant to be used through one of its 
  -- derived classes (IntegerAttribute, RealAttribute, etc...)
  ----------------------------------
  CLASS Attribute;      
    VAR
      TheInfo: AttributeInformation;
      TheName: ARRAY OF CHAR;
      TheOffset, ThePtr: INTEGER; 
      TheClass: MetaClass;
      TheVisible: BOOLEAN;
      
    METHOD Visible: BOOLEAN;
      BEGIN
      RESULT := TheVisible;
      END Visible;
      
    METHOD SetVisible(Flag: BOOLEAN);
      BEGIN
      TheVisible := Flag;
      END SetVisible;
      
    METHOD GetMetaClass: MetaClass;
      BEGIN     
      RESULT := TheClass;
      END GetMetaClass;
      
    REDEFINE METHOD CREATE (Name: ARRAY OF CHAR;
                            Offset: INTEGER;
                            Class: MetaClass);
      BEGIN 
      TheName := Name;
      TheOffset := Offset;
      TheClass := Class;
      END CREATE;
      
    METHOD Name: ARRAY OF CHAR;
      BEGIN 
      RESULT := TheName;
      END Name;
      
    METHOD Offset: INTEGER;
      BEGIN             
      RESULT := TheOffset;
      END Offset;

    METHOD SetPtr (Ptr: INTEGER);
      BEGIN
      ThePtr := Ptr;
      END SetPtr;
      
    METHOD Ptr: INTEGER;
      BEGIN
      RESULT := ThePtr;
      END Ptr;  
            
    METHOD AttachInfo (Info: AttributeInformation); 
      BEGIN                      
      TheInfo := Info;
      END AttachInfo;
      
    METHOD GetInfo: AttributeInformation; 
      BEGIN           
      RESULT := TheInfo;
      END GetInfo;
  END Attribute;                         
                            
  --------------------------
  CLASS IntegerAttribute;
    INHERITS Attribute;

    REDEFINE METHOD Reset;
      BEGIN
      Set(0); 
      END Reset;
    
    METHOD Set(Value: INTEGER);
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % *((yint *) Y_i) = Y_Value;
        END;
      END Set;
      
    METHOD Get: INTEGER;            
      VAR
        i: INTEGER;
      BEGIN 
      i := Ptr;
      ASSERT i <> 0;
      INLINE
        % Y_RESULT = *((yint *) Y_i);
        END;
      END Get;
  END IntegerAttribute;
                            
  --------------------------
  CLASS RealAttribute;
    INHERITS Attribute;
    
    REDEFINE METHOD Reset;
      BEGIN
      Set(0.0); 
      END Reset;
    
    METHOD Set(Value: REAL);      
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % *((double *) Y_i) = Y_Value;
        END;
      END Set;
      
    METHOD Get: REAL;
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % Y_RESULT = *((double *) Y_i);
        END;
      END Get;
      
  END RealAttribute;
                            
  --------------------------
  CLASS CharAttribute;
    INHERITS Attribute;
    
    REDEFINE METHOD Reset;
      VAR
        Ch: CHAR;
      BEGIN
      Set(Ch); 
      END Reset;
    
    METHOD Set(Value: CHAR);
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % *((char *) Y_i) = Y_Value;
        END;
      END Set;
      
    METHOD Get: CHAR;              
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % Y_RESULT = *((char *) Y_i);
        END;
      END Get;
  END CharAttribute;
                            
  --------------------------
  CLASS BooleanAttribute;
    INHERITS Attribute;
    
    REDEFINE METHOD Reset;
      BEGIN
      Set(FALSE); 
      END Reset;
    
    METHOD Set(Value: BOOLEAN);
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % *((int *) Y_i) = Y_Value;
        END;
      END Set;
      
    METHOD Get: BOOLEAN;  
      VAR
        i: INTEGER;
      BEGIN 
      i := Ptr;
      ASSERT i <> 0;
      INLINE
        % Y_RESULT = *((int *) Y_i);
        END;
      END Get;

  END BooleanAttribute;
                           
  --------------------------
  CLASS StringAttribute;
    INHERITS Attribute;
    
    REDEFINE METHOD Reset;
      BEGIN
      Set(VOID); 
      END Reset;
    
    METHOD Set (Value: ARRAY OF CHAR);    
      VAR
        i: INTEGER;
      BEGIN 
      i := Ptr;
      ASSERT i <> 0;
      INLINE
        % *((obj_ptr *) Y_i) = Y_Value;
        END;
      END Set;
      
    METHOD Get: ARRAY OF CHAR;      
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % Y_RESULT =  *((obj_ptr *) Y_i);
        END;
      END Get;
  END StringAttribute;                  
                           
  -------------------------
  CLASS ClassAttribute(Class);
    INHERITS Attribute;
    
    REDEFINE METHOD Reset;
      BEGIN
      Set(VOID); 
      END Reset;
    
    METHOD SetDual (i: INTEGER);
      BEGIN       
      INLINE
        % THIS->Y_Class = (minimal_dual *)Y_i;
        END;
      END SetDual;
    
    METHOD Set (Value: Class);
      VAR
        i: INTEGER;
      BEGIN 
      i := Ptr;
      ASSERT i <> 0;
      INLINE
        % *((obj_ptr *) Y_i) = Y_Value;
        END;
      END Set;
      
    METHOD Get: Class;
      VAR
        i: INTEGER;        
      BEGIN        
      i := Ptr;          
      ASSERT i <> 0;
      INLINE 
        % Y_RESULT =  *((obj_ptr *) Y_i);
        END;
      DEBUG
        IF RESULT <> VOID THEN
          WHAT RESULT OF
            IN Class:
              END;
            END;
          END;
        END;
      END Get;

    METHOD ValueClass: MetaClass;
      VAR
        i: INTEGER;
      BEGIN
      INLINE
        % Y_i = (THIS->Y_Class) -> first_sig;
        END;
      RESULT := DataDictionary.GetDescription (i);
      END ValueClass;

  END ClassAttribute;  
  
  -------------------------
  CLASS ArrayAttribute;            
    INHERITS Attribute;
    VAR
      TheSig, TheArrayLevel: INTEGER;
  
    METHOD ArrayLevel: INTEGER;
      BEGIN
      RESULT := TheArrayLevel;
      END ArrayLevel;
        
    METHOD Size: INTEGER;
      BEGIN
      ASSERT FALSE; -- NIY
      END Size;
       
    METHOD PutAttribute (Index: INTEGER): Attribute;
      BEGIN
      ASSERT FALSE; -- NIY
      END PutAttribute;
      
    METHOD Set (ArrayLevel: INTEGER;
                Sig: INTEGER);
      BEGIN
      TheSig := Sig;
      TheArrayLevel := ArrayLevel;
      END Set;                 
  END ArrayAttribute;
                           
  -------------------------------
  -- The AttributeInformation class serves as base
  -- class to attach information to attributes.
  -------------------------------
  CLASS AttributeInformation;
  END AttributeInformation;

  ----------------------------------
  -- The Method class describes individual method
  -- of a class. 
  ----------------------------------
  CLASS Method;      
    VAR
      TheName: ARRAY OF CHAR;
      TheOffset, ThePtr: INTEGER; 
      TheClass: MetaClass;
      
    METHOD GetMetaClass: MetaClass;
      BEGIN     
      RESULT := TheClass;
      END GetMetaClass;
      
    REDEFINE METHOD CREATE (Name: ARRAY OF CHAR;
                            Offset: INTEGER;
                            Class: MetaClass);
      BEGIN 
      TheName := Name;
      TheOffset := Offset;
      TheClass := Class;
      END CREATE;
      
    METHOD Name: ARRAY OF CHAR;
      BEGIN 
      RESULT := TheName;
      END Name;
      
    METHOD Offset: INTEGER;
      BEGIN             
      RESULT := TheOffset;
      END Offset;

    METHOD SetPtr (Ptr: INTEGER);
      BEGIN
      ThePtr := Ptr;
      END SetPtr;
      
    METHOD Ptr: INTEGER;
      BEGIN
      RESULT := ThePtr;
      END Ptr;  

    METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "Method";
      END WhatAmI;

  END Method;                         
  --------------------------
  CLASS VoidMethod;
    INHERITS Method;

    METHOD Call;
      VAR
        ThisPtr: INTEGER;
        MethodPtr: INTEGER;
      BEGIN
      ASSERT GetMetaClass <> VOID;
      ThisPtr := GetMetaClass.InstancePtr;
      MethodPtr := Ptr;
      ASSERT MethodPtr <> 0;
      ASSERT ThisPtr <> 0;
      INLINE
        %{
        %  method_ref *p;
        %  VOID (*f)();
        %  obj_ptr this;
        %
        %  p = (method_ref *)Y_MethodPtr;
        %  assert(p != NULL);
        %  f = p->current.void_func;
        %  this = (obj_ptr)Y_ThisPtr;
        %  assertp(this);
        %  f(this);
        %}
        END;
      END Call;
            
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "VoidMethod";
      END WhatAmI;

    END VoidMethod;
  --------------------------
  CLASS IntegerMethod;
    INHERITS Method;

    METHOD Call: INTEGER;
      VAR
        ThisPtr: INTEGER;
        MethodPtr: INTEGER;
      BEGIN
      ASSERT GetMetaClass <> VOID;
      ThisPtr := GetMetaClass.InstancePtr;
      MethodPtr := Ptr;
      ASSERT ThisPtr <> 0;
      ASSERT MethodPtr <> 0;
      INLINE
        %{
        %  method_ref *p;
        %  yint (*f)();
        %  obj_ptr this;
        %
        %  p = (method_ref *)Y_MethodPtr;
        %  assertp(p);
        %  f = p->current.int_func;
        %  assertp(f);
        %  this = (obj_ptr)Y_ThisPtr;
        %  assertp(this);
        %  Y_RESULT = f(this);
        %}
        END;
      END Call;
            
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "IntegerMethod";
      END WhatAmI;

  END IntegerMethod;

  --------------------------
  CLASS RealMethod;
    INHERITS Method;

    METHOD Call: REAL;
      VAR
        ThisPtr: INTEGER;
        MethodPtr: INTEGER;
      BEGIN
      ASSERT GetMetaClass <> VOID;
      ThisPtr := GetMetaClass.InstancePtr;
      MethodPtr := Ptr;
      INLINE
        %{
        %  method_ref *p;
        %  method_ref m;
        %  double (*f)();
        %  obj_ptr this;
        %
        %  p = (method_ref *)Y_MethodPtr;
        %  assertp(p);
        %  m = *p;
        %  f = m.current.double_func;
        %  this = (obj_ptr)Y_ThisPtr;
        %  assertp(this);
        %  Y_RESULT = f(this);
        %}
        END;
      END Call;
            
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "RealMethod";
      END WhatAmI;

  END RealMethod;

  --------------------------
  CLASS CharMethod;
    INHERITS Method;

    METHOD Call: CHAR;
      VAR
        ThisPtr: INTEGER;
        MethodPtr: INTEGER;
      BEGIN
      ASSERT GetMetaClass <> VOID;
      ThisPtr := GetMetaClass.InstancePtr;
      MethodPtr := Ptr;
      INLINE
        %{
        %  method_ref *p;
        %  method_ref m;
        %  ychar (*f)();
        %  obj_ptr this;
        %
        %  p = (method_ref *)Y_MethodPtr;
        %  assertp(p);
        %  m = *p;
        %  f = m.current.char_func;
        %  this = (obj_ptr)Y_ThisPtr;
        %  assertp(this);
        %  Y_RESULT = f(this);
        %}
        END;
      END Call;
            
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "CharMethod";
      END WhatAmI;

  END CharMethod;

  --------------------------
  CLASS BooleanMethod;
    INHERITS Method;

    METHOD Call: BOOLEAN;
      VAR
        ThisPtr: INTEGER;
        MethodPtr: INTEGER;
      BEGIN
      ASSERT GetMetaClass <> VOID;
      ThisPtr := GetMetaClass.InstancePtr;
      MethodPtr := Ptr;
      INLINE
        %{
        %  method_ref *p;
        %  method_ref m;
        %  int (*f)();
        %  obj_ptr this;
        %
        %  p = (method_ref *)Y_MethodPtr;
        %  assertp(p);
        %  m = *p;
        %  /* ??? what can I do if not a VOID function */
        %  f = m.current.boolean_func;
        %  this = (obj_ptr)Y_ThisPtr;
        %  assertp(this);
        %  Y_RESULT = f(this);
        %}
        END;
      END Call;
            
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "BooleanMethod";
      END WhatAmI;

  END BooleanMethod;


  --------------------------
  CLASS StringMethod;
    INHERITS Method;

    METHOD Call: ARRAY OF CHAR;
      VAR
        ThisPtr: INTEGER;
        MethodPtr: INTEGER;
      BEGIN
      ASSERT GetMetaClass <> VOID;
      ThisPtr := GetMetaClass.InstancePtr;
      MethodPtr := Ptr;
      INLINE
        %{
        %  method_ref *p;
        %  method_ref m;
        %  obj_ptr (*f)();
        %  obj_ptr this;
        %
        %  p = (method_ref *)Y_MethodPtr;
        %  assertp(p);
        %  m = *p;
        %  f = m.current.obj_ptr_func;
        %  this = (obj_ptr)Y_ThisPtr;
        %  assertp(this);
        %  Y_RESULT = f(this);
        %}
        END;
      END Call;
            
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "StringMethod";
      END WhatAmI;

  END StringMethod;

  -------------------------
  CLASS ClassMethod(Class);
    INHERITS Method;

    METHOD SetDual (i: INTEGER);
      BEGIN       
      INLINE
        % THIS->Y_Class = (minimal_dual *)Y_i;
        END;
      END SetDual;
    
    METHOD Call: Class;
      VAR
        ThisPtr: INTEGER;
        MethodPtr: INTEGER;
      BEGIN
      ASSERT GetMetaClass <> VOID;
      ThisPtr := GetMetaClass.InstancePtr;
      MethodPtr := Ptr;
      INLINE
        %{
        %  method_ref *p;
        %  method_ref m;
        %  obj_ptr (*f)();
        %  obj_ptr this;
        %
        %  p = (method_ref *)Y_MethodPtr;
        %  assertp(p);
        %  m = *p;
        %  f = m.current.obj_ptr_func;
        %  this = (obj_ptr)Y_ThisPtr;
        %  assertp(this);
        %  Y_RESULT = f(this);
        %}
        END;
      END Call;
            
    REDEFINE METHOD WhatAmI: ARRAY OF CHAR;
      BEGIN
      RESULT := "ClassMethod";
      END WhatAmI;

    METHOD RefCall: Ref;
      VAR
        TheRef: Ref(Class);
      BEGIN
      TheRef.CREATE(Call);
      RESULT := TheRef;
      END RefCall;

  END ClassMethod;

                            

END MetaClass;
