paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-13 23:09:09 +02:00
Code Issues Packages Projects Releases Wiki Activity

* moved de2regtyp() from defutil to hlcgobj, so it can be overridden

Browse Source 
(and override for the JVM, making the register type for records
     R_ADDRESSREGISTER instead of R_INTREGISTER there)

git-svn-id: branches/jvmbackend@18448 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:00:31 +00:00
parent 921b54f9fb
commit 88df6573a0
3 changed files with 50 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
compiler/defutil.pas
View File

@ -101,12 +101,6 @@ interface
{# Returns whether def is reference counted }
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;}
{*****************************************************************************
@ -546,37 +540,6 @@ implementation
result:=def.needs_inittable;
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 }
function is_open_string(p : tdef) : boolean;

37
compiler/hlcgobj.pas
View File

@ -80,6 +80,12 @@ unit hlcgobj;
procedure do_register_allocation(list:TAsmList;headertai:tai); 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. }
procedure a_label(list : TAsmList;l : tasmlabel); inline;
@ -572,6 +578,37 @@ implementation
cg.translate_register(reg);
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;
begin
cg.a_label(list,l);

13
compiler/jvm/hlcgcpu.pas
View File

@ -46,6 +46,8 @@ uses
procedure incstack(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_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))));
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);
begin
a_call_name_intern(list,pd,s,false);