Browse Source

+ support of explicit type case <any ordinal type>->pointer
(delphi mode only)

florian 23 years ago
parent
commit
589c742efe
3 changed files with 63 additions and 5 deletions
  1. 24 1
      compiler/ncnv.pas
  2. 30 2
      compiler/psystem.pas
  3. 9 2
      compiler/symdef.pas

+ 24 - 1
compiler/ncnv.pas

@@ -1166,6 +1166,25 @@ implementation
                     end;
                     end;
                  end
                  end
 
 
+              { ordinal to pointer }
+              else
+                if (m_delphi in aktmodeswitches) and
+                   is_ordinal(left.resulttype.def) and
+                   (resulttype.def.deftype=pointerdef) then
+                 begin
+                   if left.nodetype=pointerconstn then
+                    begin
+                      hp:=cordconstnode.create(tpointerconstnode(left).value,resulttype);
+                      result:=hp;
+                      exit;
+                    end
+                   else
+                    begin
+                      if IsConvertable(left.resulttype.def,ordpointertype.def,convtype,ordconstn,false)=0 then
+                        CGMessage2(type_e_incompatible_types,left.resulttype.def.typename,resulttype.def.typename);
+                    end;
+                 end
+
                { only if the same size or formal def }
                { only if the same size or formal def }
                { why do we allow typecasting of voiddef ?? (PM) }
                { why do we allow typecasting of voiddef ?? (PM) }
                else
                else
@@ -1893,7 +1912,11 @@ begin
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.66  2002-08-09 07:33:01  florian
+  Revision 1.67  2002-08-11 15:28:00  florian
+    + support of explicit type case <any ordinal type>->pointer
+      (delphi mode only)
+
+  Revision 1.66  2002/08/09 07:33:01  florian
     * a couple of interface related fixes
     * a couple of interface related fixes
 
 
   Revision 1.65  2002/07/29 21:23:42  florian
   Revision 1.65  2002/07/29 21:23:42  florian

+ 30 - 2
compiler/psystem.pas

@@ -217,6 +217,21 @@ begin
   globaldef('file',cfiletype);
   globaldef('file',cfiletype);
   globaldef('pvmt',pvmttype);
   globaldef('pvmt',pvmttype);
   globaldef('variant',cvarianttype);
   globaldef('variant',cvarianttype);
+{$ifdef i386}
+  ordpointertype:=u32bittype;
+{$endif i386}
+{$ifdef x86_64}
+  ordpointertype:=cu64bittype;
+{$endif x86_64}
+{$ifdef powerpc}
+  ordpointertype:=u32bittype;
+{$endif powerpc}
+{$ifdef sparc}
+  ordpointertype:=u32bittype;
+{$endif sparc}
+{$ifdef m68k}
+  ordpointertype:=u32bittype;
+{$endif}
 end;
 end;
 
 
 
 
@@ -251,21 +266,30 @@ begin
   openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
   openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
   tarraydef(openchararraytype.def).elementtype:=cchartype;
   tarraydef(openchararraytype.def).elementtype:=cchartype;
 {$ifdef x86}
 {$ifdef x86}
+{$ifdef i386}
+  ordpointertype:=u32bittype;
+{$endif i386}
+{$ifdef x86_64}
+  ordpointertype:=cu64bittype;
+{$endif x86_64}
   s32floattype.setdef(tfloatdef.create(s32real));
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s80floattype.setdef(tfloatdef.create(s80real));
   s80floattype.setdef(tfloatdef.create(s80real));
 {$endif x86}
 {$endif x86}
 {$ifdef powerpc}
 {$ifdef powerpc}
+  ordpointertype:=u32bittype;
   s32floattype.setdef(tfloatdef.create(s32real));
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s80floattype.setdef(tfloatdef.create(s80real));
   s80floattype.setdef(tfloatdef.create(s80real));
 {$endif powerpc}
 {$endif powerpc}
 {$ifdef sparc}
 {$ifdef sparc}
+  ordpointertype:=u32bittype;
   s32floattype.setdef(tfloatdef.create(s32real));
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s64floattype.setdef(tfloatdef.create(s64real));
 {$endif sparc}
 {$endif sparc}
   s64currencytype.setdef(tfloatdef.create(s64currency));
   s64currencytype.setdef(tfloatdef.create(s64currency));
 {$ifdef m68k}
 {$ifdef m68k}
+  ordpointertype:=u32bittype;
   s32floattype.setdef(tfloatdef.create(s32real));
   s32floattype.setdef(tfloatdef.create(s32real));
   if (cs_fp_emulation in aktmoduleswitches) then
   if (cs_fp_emulation in aktmoduleswitches) then
    begin
    begin
@@ -291,7 +315,11 @@ end;
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.32  2002-07-25 17:54:24  carl
+  Revision 1.33  2002-08-11 15:28:00  florian
+    + support of explicit type case <any ordinal type>->pointer
+      (delphi mode only)
+
+  Revision 1.32  2002/07/25 17:54:24  carl
    + Extended is now CPU dependant (equal to bestrealtype)
    + Extended is now CPU dependant (equal to bestrealtype)
 
 
   Revision 1.30  2002/07/07 09:52:32  florian
   Revision 1.30  2002/07/07 09:52:32  florian
@@ -350,4 +378,4 @@ end.
       instead of direct comparisons of low/high values of orddefs because
       instead of direct comparisons of low/high values of orddefs because
       qword is a special case
       qword is a special case
 
 
-}
+}

+ 9 - 2
compiler/symdef.pas

@@ -664,7 +664,10 @@ interface
                                     needed for readln() }
                                     needed for readln() }
        cfiletype,                 { get the same definition for all file }
        cfiletype,                 { get the same definition for all file }
                                   { used for stabs }
                                   { used for stabs }
-       cvarianttype,              { we use only one variant def }
+       { we use only one variant def }
+       cvarianttype,
+       { unsigned ord type with the same size as a pointer }
+       ordpointertype,
        pvmttype      : ttype;     { type of classrefs, used for stabs }
        pvmttype      : ttype;     { type of classrefs, used for stabs }
 
 
 
 
@@ -5501,7 +5504,11 @@ implementation
 end.
 end.
 {
 {
   $Log$
   $Log$
-  Revision 1.88  2002-08-11 14:32:28  peter
+  Revision 1.89  2002-08-11 15:28:00  florian
+    + support of explicit type case <any ordinal type>->pointer
+      (delphi mode only)
+
+  Revision 1.88  2002/08/11 14:32:28  peter
     * renamed current_library to objectlibrary
     * renamed current_library to objectlibrary
 
 
   Revision 1.87  2002/08/11 13:24:13  peter
   Revision 1.87  2002/08/11 13:24:13  peter