+ added basic olevariant support

compiler/psub.pas

@@ -986,7 +986,6 @@ implementation
          { reset to normal non static function }
          if (current_procinfo.procdef.parast.symtablelevel=normal_function_level) then
            allow_only_static:=false;
-
          current_procinfo:=oldprocinfo;
       end;
 
@@ -1291,7 +1290,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.157  2003-10-03 14:45:09  peter
+  Revision 1.158  2003-10-06 22:23:41  florian
+    + added basic olevariant support
+
+  Revision 1.157  2003/10/03 14:45:09  peter
     * more proc directive for procvar fixes
 
   Revision 1.156  2003/10/02 21:20:32  peter

compiler/psystem.pas

@@ -167,6 +167,7 @@ implementation
         addtype('Int64',cs64bittype);
         adddef('TypedFile',tfiledef.createtyped(voidtype));
         addtype('Variant',cvarianttype);
+        addtype('OleVariant',colevarianttype);
         { Internal types }
         addtype('$formal',cformaltype);
         addtype('$void',voidtype);
@@ -190,6 +191,7 @@ implementation
         addtype('$openchararray',openchararraytype);
         addtype('$file',cfiletype);
         addtype('$variant',cvarianttype);
+        addtype('$olevariant',cvarianttype);
         addtype('$s32real',s32floattype);
         addtype('$s64real',s64floattype);
         addtype('$s80real',s80floattype);
@@ -252,6 +254,7 @@ implementation
         globaldef('file',cfiletype);
         globaldef('pvmt',pvmttype);
         globaldef('variant',cvarianttype);
+        globaldef('olevariant',colevarianttype);
         globaldef('methodpointer',methodpointertype);
 {$ifdef i386}
         ordpointertype:=u32bittype;
@@ -361,7 +364,8 @@ implementation
         charpointertype.setdef(tpointerdef.create(cchartype));
         voidfarpointertype.setdef(tpointerdef.createfar(voidtype));
         cfiletype.setdef(tfiledef.createuntyped);
-        cvarianttype.setdef(tvariantdef.create);
+        cvarianttype.setdef(tvariantdef.create(vt_normalvariant));
+        colevarianttype.setdef(tvariantdef.create(vt_olevariant));
         registerdef:=oldregisterdef;
       end;
 
@@ -505,7 +509,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.56  2003-09-28 17:55:04  peter
+  Revision 1.57  2003-10-06 22:23:41  florian
+    + added basic olevariant support
+
+  Revision 1.56  2003/09/28 17:55:04  peter
     * parent framepointer changed to hidden parameter
     * tloadparentfpnode added
 

compiler/symconst.pas

@@ -168,6 +168,10 @@ type
     normset,smallset,varset
   );
 
+  tvarianttype = (
+    vt_normalvariant,vt_olevariant
+  );
+
   tcallercallee = (callerside,calleeside);
 
   { basic type for tprocdef and tprocvardef }
@@ -375,7 +379,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.65  2003-09-28 17:55:04  peter
+  Revision 1.66  2003-10-06 22:23:41  florian
+    + added basic olevariant support
+
+  Revision 1.65  2003/09/28 17:55:04  peter
     * parent framepointer changed to hidden parameter
     * tloadparentfpnode added
 

compiler/symdef.pas

@@ -138,7 +138,8 @@ interface
        end;
 
        tvariantdef = class(tstoreddef)
-          constructor create;
+          varianttype : tvarianttype;
+          constructor create(v : tvarianttype);
           constructor ppuload(ppufile:tcompilerppufile);
           function gettypename:string;override;
           procedure ppuwrite(ppufile:tcompilerppufile);override;
@@ -696,8 +697,9 @@ interface
        cfiletype,                 { get the same definition for all file }
                                   { used for stabs }
        methodpointertype,         { typecasting of methodpointers to extract self }
-       { we use only one variant def }
+       { we use only one variant def for every variant class }
        cvarianttype,
+       colevarianttype,
        { unsigned ord type with the same size as a pointer }
        ordpointertype,
        defaultordconsttype,       { pointer to type of ordinal constants }
@@ -2192,9 +2194,10 @@ implementation
                                TVARIANTDEF
 ****************************************************************************}
 
-    constructor tvariantdef.create;
+    constructor tvariantdef.create(v : tvarianttype);
       begin
          inherited create;
+         varianttype:=v;
          deftype:=variantdef;
          setsize;
       end;
@@ -2203,6 +2206,7 @@ implementation
     constructor tvariantdef.ppuload(ppufile:tcompilerppufile);
       begin
          inherited ppuloaddef(ppufile);
+         varianttype:=tvarianttype(ppufile.getbyte);
          deftype:=variantdef;
          setsize;
       end;
@@ -2211,6 +2215,7 @@ implementation
     procedure tvariantdef.ppuwrite(ppufile:tcompilerppufile);
       begin
          inherited ppuwritedef(ppufile);
+         ppufile.putbyte(byte(varianttype));
          ppufile.writeentry(ibvariantdef);
       end;
 
@@ -2223,7 +2228,12 @@ implementation
 
     function tvariantdef.gettypename : string;
       begin
-         gettypename:='Variant';
+         case varianttype of
+           vt_normalvariant:
+             gettypename:='Variant';
+           vt_olevariant:
+             gettypename:='OleVariant';
+         end;
       end;
 
 
@@ -5903,7 +5913,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.172  2003-10-05 21:21:52  peter
+  Revision 1.173  2003-10-06 22:23:41  florian
+    + added basic olevariant support
+
+  Revision 1.172  2003/10/05 21:21:52  peter
     * c style array of const generates callparanodes
     * varargs paraloc fixes