Browse Source

* moved de2regtyp() from defutil to hlcgobj, so it can be overridden
(and override for the JVM, making the register type for records
R_ADDRESSREGISTER instead of R_INTREGISTER there)

git-svn-id: branches/jvmbackend@18448 -

Jonas Maebe 14 years ago
parent
commit
88df6573a0
3 changed files with 50 additions and 37 deletions
  1. 0 37
      compiler/defutil.pas
  2. 37 0
      compiler/hlcgobj.pas
  3. 13 0
      compiler/jvm/hlcgcpu.pas

+ 0 - 37
compiler/defutil.pas

@@ -101,12 +101,6 @@ interface
     {# Returns whether def is reference counted }
     {# Returns whether def is reference counted }
     function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
     function is_managed_type(def: tdef) : boolean;{$ifdef USEINLINE}inline;{$endif}
 
 
-    {# Returns the kind of register this type should be loaded in (it does not
-       check whether this is actually possible, but if it's loaded in a register
-       by the compiler for any purpose other than parameter passing/function
-       result loading, this is the register type used }
-    function def2regtyp(def: tdef): tregistertype;
-
 {    function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;}
 {    function is_in_limit_value(val_from:TConstExprInt;def_from,def_to : tdef) : boolean;}
 
 
 {*****************************************************************************
 {*****************************************************************************
@@ -546,37 +540,6 @@ implementation
         result:=def.needs_inittable;
         result:=def.needs_inittable;
       end;
       end;
 
 
-    function def2regtyp(def: tdef): tregistertype;
-      begin
-        case def.typ of
-          enumdef,
-          orddef,
-          recorddef,
-          setdef:
-            result:=R_INTREGISTER;
-          stringdef,
-          pointerdef,
-          classrefdef,
-          objectdef,
-          procvardef,
-          procdef,
-          arraydef :
-            result:=R_ADDRESSREGISTER;
-          floatdef:
-            if use_vectorfpu(def) then
-              result:=R_MMREGISTER
-            else if cs_fp_emulation in current_settings.moduleswitches then
-              result:=R_INTREGISTER
-            else
-              result:=R_FPUREGISTER;
-          filedef,
-          variantdef:
-            internalerror(2010120507);
-        else
-          internalerror(2010120506);
-        end;
-      end;
-
 
 
     { true, if p points to an open array def }
     { true, if p points to an open array def }
     function is_open_string(p : tdef) : boolean;
     function is_open_string(p : tdef) : boolean;

+ 37 - 0
compiler/hlcgobj.pas

@@ -80,6 +80,12 @@ unit hlcgobj;
           procedure do_register_allocation(list:TAsmList;headertai:tai); inline;
           procedure do_register_allocation(list:TAsmList;headertai:tai); inline;
           procedure translate_register(var reg : tregister); inline;
           procedure translate_register(var reg : tregister); inline;
 
 
+          {# Returns the kind of register this type should be loaded in (it does not
+             check whether this is actually possible, but if it's loaded in a register
+             by the compiler for any purpose other than parameter passing/function
+             result loading, this is the register type used }
+          function def2regtyp(def: tdef): tregistertype; virtual;
+
           {# Emit a label to the instruction stream. }
           {# Emit a label to the instruction stream. }
           procedure a_label(list : TAsmList;l : tasmlabel); inline;
           procedure a_label(list : TAsmList;l : tasmlabel); inline;
 
 
@@ -572,6 +578,37 @@ implementation
       cg.translate_register(reg);
       cg.translate_register(reg);
     end;
     end;
 
 
+  function thlcgobj.def2regtyp(def: tdef): tregistertype;
+    begin
+        case def.typ of
+          enumdef,
+          orddef,
+          recorddef,
+          setdef:
+            result:=R_INTREGISTER;
+          stringdef,
+          pointerdef,
+          classrefdef,
+          objectdef,
+          procvardef,
+          procdef,
+          arraydef :
+            result:=R_ADDRESSREGISTER;
+          floatdef:
+            if use_vectorfpu(def) then
+              result:=R_MMREGISTER
+            else if cs_fp_emulation in current_settings.moduleswitches then
+              result:=R_INTREGISTER
+            else
+              result:=R_FPUREGISTER;
+          filedef,
+          variantdef:
+            internalerror(2010120507);
+        else
+          internalerror(2010120506);
+        end;
+    end;
+
   procedure thlcgobj.a_label(list: TAsmList; l: tasmlabel); inline;
   procedure thlcgobj.a_label(list: TAsmList; l: tasmlabel); inline;
     begin
     begin
       cg.a_label(list,l);
       cg.a_label(list,l);

+ 13 - 0
compiler/jvm/hlcgcpu.pas

@@ -46,6 +46,8 @@ uses
       procedure incstack(list : TAsmList;slots: longint);
       procedure incstack(list : TAsmList;slots: longint);
       procedure decstack(list : TAsmList;slots: longint);
       procedure decstack(list : TAsmList;slots: longint);
 
 
+      function def2regtyp(def: tdef): tregistertype; override;
+
       procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);override;
       procedure a_call_name(list : TAsmList;pd : tprocdef;const s : string; weak: boolean);override;
       procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : string);override;
       procedure a_call_name_inherited(list : TAsmList;pd : tprocdef;const s : string);override;
 
 
@@ -231,6 +233,17 @@ implementation
         list.concat(tai_comment.Create(strpnew('    freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
         list.concat(tai_comment.Create(strpnew('    freed '+tostr(slots)+', stack height = '+tostr(fevalstackheight))));
     end;
     end;
 
 
+  function thlcgjvm.def2regtyp(def: tdef): tregistertype;
+    begin
+      case def.typ of
+        { records are implemented via classes }
+        recorddef:
+          result:=R_ADDRESSREGISTER;
+        else
+          result:=inherited;
+      end;
+    end;
+
   procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: string; weak: boolean);
   procedure thlcgjvm.a_call_name(list: TAsmList; pd: tprocdef; const s: string; weak: boolean);
     begin
     begin
       a_call_name_intern(list,pd,s,false);
       a_call_name_intern(list,pd,s,false);