paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-19 19:19:32 +01:00
Code Issues Packages Projects Releases Wiki Activity

* changed global var access, TOC now contain pointers to globals

Browse Source 
* fixed handling of function pointers
This commit is contained in:
olle 2003-01-13 17:17:50 +00:00
parent 60431e6794
commit a02a1adee1
3 changed files with 229 additions and 68 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
compiler/powerpc/agppcmpw.pas
View File

@ -70,7 +70,11 @@ interface
const
line_length = 70;
use_PR = false; {Whether internal references should be xxx[PR] }
{Whether internal procedure references should be xxx[PR]: }
use_PR = false;
const_storage_class = '[RW]';
function ReplaceForbiddenChars(var s: string):Boolean;
@ -721,10 +725,20 @@ function getreferencestring(var ref : treference) : string;
else
AsmWriteLn(#9'export'#9+s);
AsmWriteLn(#9'csect'#9+s+'[TC]');
AsmWriteLn(PadTabs(s+':',#0)+'ds.b '+tostr(tai_datablock(hp).size));
{TODO: ? PadTabs(s,#0) }
if not macos_direct_globals then
begin
AsmWriteLn(#9'toc');
AsmWriteLn(#9'tc'#9+s+'[TC], '+s+'[RW]');
AsmWriteLn(#9'csect'#9+s+'[RW]');
AsmWriteLn(#9'ds.b '+tostr(tai_datablock(hp).size));
end
else
begin
AsmWriteLn(#9'csect'#9+s+'[TC]');
AsmWriteLn(PadTabs(s+':',#0)+'ds.b '+tostr(tai_datablock(hp).size));
{TODO: ? PadTabs(s,#0) }
end;
end;
ait_const_32bit,
ait_const_8bit,
@ -765,10 +779,15 @@ function getreferencestring(var ref : treference) : string;
if use_PR then
AsmWriteLn(#9'dc.l'#9'.'+ s +'[PR]')
else
AsmWriteLn(#9'dc.l'#9'.'+ s)
AsmWriteLn(#9'dc.l'#9 + s + '[DS]')
end
else
AsmWriteLn(#9'dc.l'#9+ s);
begin
if macos_direct_globals then
AsmWriteLn(#9'dc.l'#9+s)
else
AsmWriteLn(#9'dc.l'#9+s+const_storage_class);
end;
(* TODO: the following might need to be included. Temporaily we
generate an error
@ -872,18 +891,22 @@ function getreferencestring(var ref : treference) : string;
begin
s:= tai_label(hp).l.name;
ReplaceForbiddenChars(s);
if s[1] <> '@' then
AsmWriteLn(#9'csect'#9+s+'[TC]');
AsmWrite(s);
{if assigned(hp.next) and not(tai(hp.next).typ in
[ait_const_32bit,ait_const_16bit,ait_const_8bit,
ait_const_symbol,ait_const_rva,
ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
AsmWriteLn(':')
if s[1] = '@' then
AsmWriteLn(s+':')
else
DoNotSplitLine:=true;}
AsmWriteLn(':');
begin
if not macos_direct_globals then
begin
AsmWriteLn(#9'toc');
AsmWriteLn(#9'tc'#9+s+'[TC], '+s+const_storage_class);
AsmWriteLn(#9'csect'#9+s+const_storage_class);
end
else
begin
AsmWriteLn(#9'csect'#9+s+'[TC]');
AsmWriteLn(PadTabs(s+':',#0));
end;
end;
end;
end;
ait_direct:
@ -903,10 +926,20 @@ function getreferencestring(var ref : treference) : string;
if replaced then
AsmWriteLn(#9'export'#9+s+' => '''+tai_symbol(hp).sym.name+'''')
else
AsmWriteLn(#9'export'#9+s);
AsmWriteLn(#9'csect'#9+s+'[TC]');
AsmWrite(s);
AsmWriteLn(':');
AsmWriteLn(#9'export'#9+s+'[RW]');
if not macos_direct_globals then
begin
AsmWriteLn(#9'toc');
AsmWriteLn(#9'tc'#9+s+'[TC], '+s+ const_storage_class);
AsmWriteLn(#9'csect'#9+s+ const_storage_class);
end
else
begin
AsmWriteLn(#9'csect'#9+s+'[TC]');
AsmWriteLn(s+':');
end;
end;
end;
ait_symbol_end:
@ -1008,7 +1041,11 @@ ait_stab_function_name : ;
if ReplaceForbiddenChars(s) then
currentasmlist.AsmWriteLn(#9'import'#9+s+' <= '''+p.name+'''')
else
currentasmlist.AsmWriteLn(#9'import'#9+s);
begin
currentasmlist.AsmWriteLn(#9'import'#9+s+'[RW]');
currentasmlist.AsmWriteLn(#9'toc');
currentasmlist.AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[RW]');
end;
end;
end;
end;
@ -1059,7 +1096,7 @@ ait_stab_function_name : ;
AsmLn;
*)
AsmWriteLn(#9'STRING ASIS'); {Interpret strings just to be the content between the quotes.}
AsmWriteLn(#9'string asis'); {Interpret strings just to be the content between the quotes.}
AsmLn;
end;
@ -1122,7 +1159,11 @@ initialization
end.
{
$Log$
Revision 1.17 2003-01-08 18:43:57 daniel
Revision 1.18 2003-01-13 17:17:50 olle
* changed global var access, TOC now contain pointers to globals
* fixed handling of function pointers
Revision 1.17 2003/01/08 18:43:57 daniel
* Tregister changed into a record
Revision 1.16 2002/11/28 10:56:07 olle

195
compiler/powerpc/cgcpu.pas
View File

@ -242,41 +242,82 @@ const
end;
{ calling a code fragment by name }
{ calling a procedure by name }
procedure tcgppc.a_call_name(list : taasmoutput;const s : string);
var
href : treference;
begin
{MacOS: The linker on MacOS (PPCLink) inserts a call to glue code,
if it is a cross-TOC call. If so, it also replaces the NOP
with some restore code.}
list.concat(taicpu.op_sym(A_BL,objectlibrary.newasmsymbol(s)));
if target_info.system=system_powerpc_macos then
list.concat(taicpu.op_none(A_NOP));
procinfo.flags:=procinfo.flags or pi_do_call;
end;
{ calling a procedure by address }
procedure tcgppc.a_call_reg(list : taasmoutput;reg: tregister);
var
tmpreg : tregister;
tmpref : treference;
begin
list.concat(taicpu.op_reg(A_MTCTR,reg));
list.concat(taicpu.op_none(A_BCTRL));
if target_info.system=system_powerpc_macos then
list.concat(taicpu.op_none(A_NOP));
begin
{Generate instruction to load the procedure address from
the transition vector.}
//TODO: Support cross-TOC calls.
tmpreg := get_scratch_reg_int(list);
reference_reset(tmpref);
tmpref.offset := 0;
//tmpref.symaddr := refs_full;
tmpref.base:= reg;
list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
list.concat(taicpu.op_reg(A_MTCTR,tmpreg));
free_scratch_reg(list,tmpreg);
end
else
list.concat(taicpu.op_reg(A_MTCTR,reg));
list.concat(taicpu.op_none(A_BCTRL));
//if target_info.system=system_powerpc_macos then
// //NOP is not needed here.
// list.concat(taicpu.op_none(A_NOP));
procinfo.flags:=procinfo.flags or pi_do_call;
//list.concat(tai_comment.create(strpnew('***** a_call_reg')));
end;
{ calling a code fragment through a reference }
{ calling a procedure by address }
procedure tcgppc.a_call_ref(list : taasmoutput;const ref : treference);
var
tmpreg : tregister;
tmpref : treference;
begin
tmpreg := get_scratch_reg_int(list);
a_load_ref_reg(list,OS_ADDR,ref,tmpreg);
if target_info.system=system_powerpc_macos then
begin
{Generate instruction to load the procedure address from
the transition vector.}
//TODO: Support cross-TOC calls.
reference_reset(tmpref);
tmpref.offset := 0;
//tmpref.symaddr := refs_full;
tmpref.base:= tmpreg;
list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
end;
list.concat(taicpu.op_reg(A_MTCTR,tmpreg));
free_scratch_reg(list,tmpreg);
list.concat(taicpu.op_none(A_BCTRL));
if target_info.system=system_powerpc_macos then
list.concat(taicpu.op_none(A_NOP));
//if target_info.system=system_powerpc_macos then
// //NOP is not needed here.
// list.concat(taicpu.op_none(A_NOP));
procinfo.flags:=procinfo.flags or pi_do_call;
//list.concat(tai_comment.create(strpnew('***** a_call_ref')));
end;
{********************** load instructions ********************}
@ -1428,7 +1469,7 @@ const
var
ref2, tmpref: treference;
freereg: boolean;
r2:Tregister;
r2,tmpreg:Tregister;
begin
ref2 := ref;
@ -1440,14 +1481,35 @@ const
if ref2.base.enum <> R_NO then
internalerror(2002103102); //TODO: Implement this if needed
reference_reset(tmpref);
tmpref.offset := ref2.offset;
tmpref.symbol := ref2.symbol;
tmpref.symaddr := refs_full;
tmpref.base.enum := R_NO;
r2.enum:=R_TOC;
list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r2,tmpref));
end
if macos_direct_globals then
begin
reference_reset(tmpref);
tmpref.offset := ref2.offset;
tmpref.symbol := ref2.symbol;
tmpref.symaddr := refs_full;
tmpref.base.enum := R_NO;
r2.enum:=R_TOC;
list.concat(taicpu.op_reg_reg_ref(A_ADDI,r,r2,tmpref));
end
else
begin
tmpreg := get_scratch_reg_address(list);
reference_reset(tmpref);
tmpref.symbol := ref2.symbol;
tmpref.offset := ref2.offset;
tmpref.symaddr := refs_full;
tmpref.base.enum:= R_TOC;
list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
reference_reset(tmpref);
tmpref.offset := 0;
tmpref.symaddr := refs_full;
tmpref.base:= tmpreg;
list.concat(taicpu.op_reg_ref(A_LA,r,tmpref));
free_scratch_reg(list,tmpreg);
end;
//list.concat(tai_comment.create(strpnew('*** a_loadaddr_ref_reg')));
end
else
begin
@ -1826,35 +1888,80 @@ const
begin
if ref.base.enum <> R_NO then
begin
{Generates
add tempreg, ref.base, RTOC
op reg, symbolplusoffset, tempreg
which is eqvivalent to the more comprehensive
addi tempreg, RTOC, symbolplusoffset
add tempreg, ref.base, RTOC
op reg, tempreg
but which saves one instruction.}
if macos_direct_globals then
begin
{Generates
add tempreg, ref.base, RTOC
op reg, symbolplusoffset, tempreg
which is eqvivalent to the more comprehensive
addi tempreg, RTOC, symbolplusoffset
add tempreg, ref.base, tempreg
op reg, tempreg
but which saves one instruction.}
tmpreg := get_scratch_reg_address(list);
reference_reset(tmpref);
tmpref.symbol := ref.symbol;
tmpref.offset := ref.offset;
tmpref.symaddr := refs_full;
tmpref.base:= tmpreg;
tmpreg := get_scratch_reg_address(list);
reference_reset(tmpref);
tmpref.symbol := ref.symbol;
tmpref.offset := ref.offset;
tmpref.symaddr := refs_full;
tmpref.base:= tmpreg;
r.enum:=R_TOC;
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
ref.base,r));
list.concat(taicpu.op_reg_ref(op,reg,tmpref));
r.enum:=R_TOC;
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
ref.base,r));
list.concat(taicpu.op_reg_ref(op,reg,tmpref));
end
else
begin
tmpreg := get_scratch_reg_address(list);
reference_reset(tmpref);
tmpref.symbol := ref.symbol;
tmpref.offset := ref.offset;
tmpref.symaddr := refs_full;
tmpref.base.enum:= R_TOC;
list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
list.concat(taicpu.op_reg_reg_reg(A_ADD,tmpreg,
ref.base,tmpreg));
reference_reset(tmpref);
tmpref.offset := 0;
tmpref.symaddr := refs_full;
tmpref.base:= tmpreg;
list.concat(taicpu.op_reg_ref(op,reg,tmpref));
end;
//list.concat(tai_comment.create(strpnew('**** a_load_store 1')));
end
else
begin
reference_reset(tmpref);
tmpref.symbol := ref.symbol;
tmpref.offset := ref.offset;
tmpref.symaddr := refs_full;
tmpref.base.enum:= R_TOC;
list.concat(taicpu.op_reg_ref(op,reg,tmpref));
if macos_direct_globals then
begin
reference_reset(tmpref);
tmpref.symbol := ref.symbol;
tmpref.offset := ref.offset;
tmpref.symaddr := refs_full;
tmpref.base.enum:= R_TOC;
list.concat(taicpu.op_reg_ref(op,reg,tmpref));
end
else
begin
tmpreg := get_scratch_reg_address(list);
reference_reset(tmpref);
tmpref.symbol := ref.symbol;
tmpref.offset := ref.offset;
tmpref.symaddr := refs_full;
tmpref.base.enum:= R_TOC;
list.concat(taicpu.op_reg_ref(A_LWZ,tmpreg,tmpref));
reference_reset(tmpref);
tmpref.offset := 0;
tmpref.symaddr := refs_full;
tmpref.base:= tmpreg;
list.concat(taicpu.op_reg_ref(op,reg,tmpref));
end;
//list.concat(tai_comment.create(strpnew('*** a_load_store 2')));
end;
end
else
@ -2000,7 +2107,11 @@ begin
end.
{
$Log$
Revision 1.69 2003-01-09 22:00:53 florian
Revision 1.70 2003-01-13 17:17:50 olle
* changed global var access, TOC now contain pointers to globals
* fixed handling of function pointers
Revision 1.69 2003/01/09 22:00:53 florian
* fixed some PowerPC issues
Revision 1.68 2003/01/08 18:43:58 daniel

13
compiler/powerpc/cpubase.pas
View File

@ -112,7 +112,7 @@ uses
R_CR,R_CR0,R_CR1,R_CR2,R_CR3,R_CR4,R_CR5,R_CR6,R_CR7,
R_XER,R_LR,R_CTR,R_FPSCR
);
Tregister=record
enum:Toldregister;
number:word;
@ -309,6 +309,11 @@ uses
const
symaddr2str: array[trefsymaddr] of string[3] = ('','@ha','@l');
const
{ MacOS only. Whether the direct data area (TOC) directly contain
global variables. Otherwise it contains pointers to global variables. }
macos_direct_globals = false;
{*****************************************************************************
Operand
*****************************************************************************}
@ -755,7 +760,11 @@ implementation
end.
{
$Log$
Revision 1.40 2003-01-09 15:49:56 daniel
Revision 1.41 2003-01-13 17:17:50 olle
* changed global var access, TOC now contain pointers to globals
* fixed handling of function pointers
Revision 1.40 2003/01/09 15:49:56 daniel
* Added register conversion
Revision 1.39 2003/01/08 18:43:58 daniel