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

Correctly implement g_intf_wrapper. Fixes nearly 200 tests and now the cross compiled compiler is at least able to print the help (compiling a simple program does not work yet though).

Browse Source 
m68k/cgcpu.pas, tcg68k:
  + override g_adjust_self_value as we don't do register allocation for the wrapper we need to adjust the Self value using the scratch registers (could be improved however) and we also can not use the offset that the original procedure in tcg uses
  * fix g_intf_wrapper by using the correct operations and loading the correct (virtual) method offset

git-svn-id: trunk@25728 -
This commit is contained in:
svenbarth 2013-10-09 19:56:17 +00:00
parent 327a15488e
commit 6fef9a2c80
1 changed files with 71 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

95
compiler/m68k/cgcpu.pas
View File

@ -67,7 +67,7 @@ unit cgcpu;
procedure a_loadmm_reg_cgpara(list: TAsmList; size: tcgsize; reg: tregister;const locpara : TCGPara;shuffle : pmmshuffle); override;
procedure a_op_const_reg(list : TAsmList; Op: TOpCG; size: tcgsize; a: tcgint; reg: TRegister); override;
// procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
//procedure a_op_const_ref(list : TAsmList; Op: TOpCG; size: TCGSize; a: tcgint; const ref: TReference); override;
procedure a_op_reg_reg(list : TAsmList; Op: TOpCG; size: TCGSize; reg1, reg2: TRegister); override;
procedure a_cmp_const_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;a : tcgint;reg : tregister;
@ -88,6 +88,7 @@ unit cgcpu;
// procedure g_restore_frame_pointer(list : TAsmList);override;
// procedure g_return_from_proc(list : TAsmList;parasize : tcgint);override;
procedure g_adjust_self_value(list:TAsmList;procdef:tprocdef;ioffset:tcgint);override;
procedure g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);override;
protected
@ -1773,37 +1774,82 @@ unit cgcpu;
end;
procedure tcg68k.g_adjust_self_value(list:TAsmList;procdef: tprocdef;ioffset: tcgint);
var
hsym : tsym;
href : treference;
paraloc : Pcgparalocation;
begin
{ calculate the parameter info for the procdef }
procdef.init_paraloc_info(callerside);
hsym:=tsym(procdef.parast.Find('self'));
if not(assigned(hsym) and
(hsym.typ=paravarsym)) then
internalerror(2013100702);
paraloc:=tparavarsym(hsym).paraloc[callerside].location;
while paraloc<>nil do
with paraloc^ do
begin
case loc of
LOC_REGISTER:
a_op_const_reg(list,OP_SUB,size,ioffset,register);
LOC_REFERENCE:
begin
{ offset in the wrapper needs to be adjusted for the stored
return address }
reference_reset_base(href,reference.index,reference.offset-sizeof(pint),sizeof(pint));
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,NR_D0));
list.concat(taicpu.op_const_reg(A_SUB,S_L,ioffset,NR_D0));
list.concat(taicpu.op_reg_ref(A_MOVE,S_L,NR_D0,href));
end
else
internalerror(2013100703);
end;
paraloc:=next;
end;
end;
procedure tcg68k.g_intf_wrapper(list: TAsmList; procdef: tprocdef; const labelname: string; ioffset: longint);
{
procedure loadvmttor11;
procedure getselftoa0(offs:longint);
var
href : treference;
selfoffsetfromsp : longint;
begin
{ move.l offset(%sp),%a0 }
{ framepointer is pushed for nested procs }
if procdef.parast.symtablelevel>normal_function_level then
selfoffsetfromsp:=sizeof(aint)
else
selfoffsetfromsp:=0;
reference_reset_base(href,NR_SP,selfoffsetfromsp+offs,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
end;
procedure loadvmttoa0;
var
href : treference;
begin
reference_reset_base(href,NR_R3,0);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
{ move.l (%a0),%a0 ; load vmt}
reference_reset_base(href,NR_A0,0,4);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_A0);
end;
procedure op_onr11methodaddr;
procedure op_ona0methodaddr;
var
href : treference;
offs : longint;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ call/jmp vmtoffs(%eax) ; method offs }
reference_reset_base(href,NR_R11,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber));
if not((longint(href.offset) >= low(smallint)) and
(longint(href.offset) <= high(smallint))) then
begin
list.concat(taicpu.op_reg_reg_const(A_ADDIS,NR_R11,NR_R11,
smallint((href.offset shr 16)+ord(smallint(href.offset and $ffff) < 0))));
href.offset := smallint(href.offset and $ffff);
end;
list.concat(taicpu.op_reg_ref(A_LWZ,NR_R11,href));
list.concat(taicpu.op_reg(A_MTCTR,NR_R11));
list.concat(taicpu.op_none(A_BCTR));
Internalerror(2013100701);
reference_reset_base(href,NR_A0,tobjectdef(procdef.struct).vmtmethodoffset(procdef.extnumber),4);
list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,NR_A0));
reference_reset_base(href,NR_A0,0,4);
list.concat(taicpu.op_ref(A_JMP,S_L,href));
end;
}
var
make_global : boolean;
begin
@ -1828,18 +1874,19 @@ unit cgcpu;
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
// g_adjust_self_value(list,procdef,ioffset);
g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if (po_virtualmethod in procdef.procoptions) and
not is_objectpascal_helper(procdef.struct) then
begin
// loadvmttor11;
// op_onr11methodaddr;
getselftoa0(4);
loadvmttoa0;
op_ona0methodaddr;
end
{ case 0 }
else
// list.concat(taicpu.op_sym(A_B,current_asmdata.RefAsmSymbol(procdef.mangledname)));
list.concat(taicpu.op_sym(A_JMP,S_L,current_asmdata.RefAsmSymbol(procdef.mangledname)));
List.concat(Tai_symbol_end.Createname(labelname));
end;