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

* even more m68k mess

Browse Source 
a tiny fix, and some code from ppc cg, to serve as base

git-svn-id: trunk@2391 -
This commit is contained in:
Károly Balogh 2006-02-01 15:19:58 +00:00
parent e9a6b3dc10
commit 9a879981ed
2 changed files with 78 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

80
compiler/m68k/cgcpu.pas
View File

@ -31,7 +31,7 @@ unit cgcpu;
aasmbase,aasmtai,aasmcpu,
cpubase,cpuinfo,
parabase,cpupara,
node,symconst,symtype,
node,symconst,symtype,symdef,
cgutils,cg64f32;
type
@ -76,6 +76,9 @@ unit cgcpu;
// procedure g_save_all_registers(list : taasmoutput);override;
// procedure g_restore_all_registers(list : taasmoutput;const funcretparaloc:TCGPara);override;
procedure g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);override;
protected
function fixref(list: taasmoutput; var ref: treference): boolean;
private
@ -113,8 +116,8 @@ unit cgcpu;
uses
globals,verbose,systems,cutils,
symdef,symsym,defutil,paramgr,procinfo,
rgobj,tgobj,rgcpu;
symsym,defutil,paramgr,procinfo,
rgobj,tgobj,rgcpu,fmodule;
const
@ -1185,6 +1188,77 @@ unit cgcpu;
list.concat(ai);
end;
procedure tcg68k.g_intf_wrapper(list: TAAsmoutput; procdef: tprocdef; const labelname: string; ioffset: longint);
{
procedure loadvmttor11;
var
href : treference;
begin
reference_reset_base(href,NR_R3,0);
cg.a_load_ref_reg(list,OS_ADDR,OS_ADDR,href,NR_R11);
end;
procedure op_onr11methodaddr;
var
href : treference;
begin
if (procdef.extnumber=$ffff) then
Internalerror(200006139);
{ call/jmp vmtoffs(%eax) ; method offs }
reference_reset_base(href,NR_R11,procdef._class.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));
end;
}
var
make_global : boolean;
begin
if not(procdef.proctypeoption in [potype_function,potype_procedure]) then
Internalerror(200006137);
if not assigned(procdef._class) or
(procdef.procoptions*[po_classmethod, po_staticmethod,
po_methodpointer, po_interrupt, po_iocheck]<>[]) then
Internalerror(200006138);
if procdef.owner.symtabletype<>objectsymtable then
Internalerror(200109191);
make_global:=false;
if (not current_module.is_unit) or
(cs_create_smart in aktmoduleswitches) or
(procdef.owner.defowner.owner.symtabletype=globalsymtable) then
make_global:=true;
if make_global then
List.concat(Tai_symbol.Createname_global(labelname,AT_FUNCTION,0))
else
List.concat(Tai_symbol.Createname(labelname,AT_FUNCTION,0));
{ set param1 interface to self }
// g_adjust_self_value(list,procdef,ioffset);
{ case 4 }
if po_virtualmethod in procdef.procoptions then
begin
// loadvmttor11;
// op_onr11methodaddr;
end
{ case 0 }
else
// list.concat(taicpu.op_sym(A_B,objectlibrary.newasmsymbol(procdef.mangledname,AB_EXTERNAL,AT_FUNCTION)));
List.concat(Tai_symbol_end.Createname(labelname));
end;
{****************************************************************************}
{ TCG64F68K }
{****************************************************************************}

2
compiler/m68k/n68kcnv.pas
View File

@ -56,7 +56,7 @@ implementation
function tm68ktypeconvnode.first_int_to_real: tnode;
var
fname: string[19];
fname: string[32];
begin
{ In case we are in emulation mode, we must
always call the helpers