From 589c742efe2aab91df03c1a608330d3b75214d4b Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sun, 11 Aug 2002 15:28:00 +0000
Subject: [PATCH]   + support of explicit type case <any ordinal type>->pointer
     (delphi mode only)

---
 compiler/ncnv.pas    | 25 ++++++++++++++++++++++++-
 compiler/psystem.pas | 32 ++++++++++++++++++++++++++++++--
 compiler/symdef.pas  | 11 +++++++++--
 3 files changed, 63 insertions(+), 5 deletions(-)

diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index f16a47162b..e19bab8b82 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -1166,6 +1166,25 @@ implementation
                     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 }
                { why do we allow typecasting of voiddef ?? (PM) }
                else
@@ -1893,7 +1912,11 @@ begin
 end.
 {
   $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
 
   Revision 1.65  2002/07/29 21:23:42  florian
diff --git a/compiler/psystem.pas b/compiler/psystem.pas
index c3d50472be..b2ab2249d0 100644
--- a/compiler/psystem.pas
+++ b/compiler/psystem.pas
@@ -217,6 +217,21 @@ begin
   globaldef('file',cfiletype);
   globaldef('pvmt',pvmttype);
   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;
 
 
@@ -251,21 +266,30 @@ begin
   openchararraytype.setdef(tarraydef.create(0,-1,s32bittype));
   tarraydef(openchararraytype.def).elementtype:=cchartype;
 {$ifdef x86}
+{$ifdef i386}
+  ordpointertype:=u32bittype;
+{$endif i386}
+{$ifdef x86_64}
+  ordpointertype:=cu64bittype;
+{$endif x86_64}
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s80floattype.setdef(tfloatdef.create(s80real));
 {$endif x86}
 {$ifdef powerpc}
+  ordpointertype:=u32bittype;
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
   s80floattype.setdef(tfloatdef.create(s80real));
 {$endif powerpc}
 {$ifdef sparc}
+  ordpointertype:=u32bittype;
   s32floattype.setdef(tfloatdef.create(s32real));
   s64floattype.setdef(tfloatdef.create(s64real));
 {$endif sparc}
   s64currencytype.setdef(tfloatdef.create(s64currency));
 {$ifdef m68k}
+  ordpointertype:=u32bittype;
   s32floattype.setdef(tfloatdef.create(s32real));
   if (cs_fp_emulation in aktmoduleswitches) then
    begin
@@ -291,7 +315,11 @@ end;
 end.
 {
   $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)
 
   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
       qword is a special case
 
-}
\ No newline at end of file
+}
diff --git a/compiler/symdef.pas b/compiler/symdef.pas
index fb0bcc7dae..58567bc96a 100644
--- a/compiler/symdef.pas
+++ b/compiler/symdef.pas
@@ -664,7 +664,10 @@ interface
                                     needed for readln() }
        cfiletype,                 { get the same definition for all file }
                                   { 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 }
 
 
@@ -5501,7 +5504,11 @@ implementation
 end.
 {
   $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
 
   Revision 1.87  2002/08/11 13:24:13  peter