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

+ Change of the way global variables, with multiple entrypoints,

Browse Source 
are referenced, fixes a lot of failed tests
This commit is contained in:
olle 2004-10-31 15:32:13 +00:00
parent f8c9ad629c
commit 8763a9166a
1 changed files with 122 additions and 140 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

262
compiler/powerpc/agppcmpw.pas
View File

@ -48,7 +48,9 @@ interface
private private
procedure WriteInstruction(hp : tai); procedure WriteInstruction(hp : tai);
procedure WriteProcedureHeader(var hp:tai); procedure WriteProcedureHeader(var hp:tai);
procedure WriteDataExportHeader(var s:string; isGlobal, isConst:boolean); procedure WriteDataHeader(var s:string; isExported, isConst:boolean);
cur_CSECT_name: String;
cur_CSECT_class: String;
end; end;
@ -67,11 +69,16 @@ interface
{Whether internal procedure references should be xxx[PR]: } {Whether internal procedure references should be xxx[PR]: }
use_PR = false; use_PR = false;
const_storage_class = '[RW]'; const_storage_class = '';
var_storage_class = '';
secnames : array[TAsmSectionType] of string[10] = ('', secnames : array[TAsmSectionType] of string[10] = (
'csect','csect [TC]','csect [TC]', {TODO: Perhaps use other section types.} '', {none}
'','','','','','','','','','','','','' 'csect', {code}
'csect', {data}
'csect', {read only data}
'csect', {bss}
'csect','csect','csect','csect','','','','','','','',''
); );
{$ifdef GDB} {$ifdef GDB}
@ -465,6 +472,24 @@ var
fixline:=Copy(s,j,i-j+1); fixline:=Copy(s,j,i-j+1);
end; end;
Function PadTabs(const p:string;addch:char):string;
var
s : string;
i : longint;
begin
i:=length(p);
if addch<>#0 then
begin
inc(i);
s:=p+addch;
end
else
s:=p;
if i<8 then
PadTabs:=s+#9#9
else
PadTabs:=s+#9;
end;
{**************************************************************************** {****************************************************************************
PowerPC MPW Assembler PowerPC MPW Assembler
@ -605,7 +630,7 @@ var
until not GetAdjacentTaiSymbol(hp); until not GetAdjacentTaiSymbol(hp);
end; end;
procedure TPPCMPWAssembler.WriteDataExportHeader(var s:string; isGlobal, isConst:boolean); procedure TPPCMPWAssembler.WriteDataHeader(var s:string; isExported, isConst:boolean);
// Returns in s the changed string // Returns in s the changed string
var var
sym: string; sym: string;
@ -615,14 +640,14 @@ var
sym:= s; sym:= s;
replaced:= ReplaceForbiddenChars(s); replaced:= ReplaceForbiddenChars(s);
if isGlobal then if isExported then
begin begin
AsmWrite(#9'export'#9); AsmWrite(#9'export'#9);
AsmWrite(s); AsmWrite(s);
if isConst then if isConst then
AsmWrite(const_storage_class) AsmWrite(const_storage_class)
else else
AsmWrite('[RW]'); AsmWrite(var_storage_class);
if replaced then if replaced then
begin begin
AsmWrite(' => '''); AsmWrite(' => ''');
@ -634,6 +659,7 @@ var
if not macos_direct_globals then if not macos_direct_globals then
begin begin
{The actual section is here interrupted, by inserting a "tc" entry}
AsmWriteLn(#9'toc'); AsmWriteLn(#9'toc');
AsmWrite(#9'tc'#9); AsmWrite(#9'tc'#9);
@ -643,15 +669,13 @@ var
if isConst then if isConst then
AsmWrite(const_storage_class) AsmWrite(const_storage_class)
else else
AsmWrite('[RW]'); AsmWrite(var_storage_class);
AsmLn; AsmLn;
{The interrupted section is here continued.}
AsmWrite(#9'csect'#9); AsmWrite(#9'csect'#9);
AsmWrite(s); AsmWriteln(cur_CSECT_name+cur_CSECT_class);
if isConst then AsmWrite(PadTabs(s+':',#0));
AsmWrite(const_storage_class)
else
AsmWrite('[RW]');
end end
else else
begin begin
@ -673,24 +697,6 @@ var
ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]= ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
(#9'dc.l'#9,#9'dc.w'#9,#9'dc.b'#9); (#9'dc.l'#9,#9'dc.w'#9,#9'dc.b'#9);
Function PadTabs(const p:string;addch:char):string;
var
s : string;
i : longint;
begin
i:=length(p);
if addch<>#0 then
begin
inc(i);
s:=p+addch;
end
else
s:=p;
if i<8 then
PadTabs:=s+#9#9
else
PadTabs:=s+#9;
end;
{$ifdef GDB} {$ifdef GDB}
procedure TPPCMPWAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo); procedure TPPCMPWAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
@ -876,12 +882,26 @@ var
begin begin
{if LasTSec<>sec_none then {if LasTSec<>sec_none then
AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');} AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ENDS');}
if tai_section(hp).sectype<>sec_none then if tai_section(hp).sectype<>sec_none then
begin begin
if tai_section(hp).sectype in [sec_data,sec_rodata,sec_bss] then
cur_CSECT_class:= '[RW]'
else if tai_section(hp).sectype in [sec_code] then
cur_CSECT_class:= ''
else
cur_CSECT_class:= '[RO]';
s:= tai_section(hp).name^;
if s = '' then
InternalError(2004101001); {Nameless sections should not occur on MPW}
ReplaceForbiddenChars(s);
cur_CSECT_name:= s;
AsmLn; AsmLn;
AsmWriteLn(#9+secnames[tai_section(hp).sectype]); AsmWriteLn(#9+secnames[tai_section(hp).sectype]+' '+cur_CSECT_name+cur_CSECT_class);
{$ifdef GDB} {$ifdef GDB}
lastfileinfo.line:=-1; lastfileinfo.line:=-1;
{$endif GDB} {$endif GDB}
end; end;
LasTSec:=tai_section(hp).sectype; LasTSec:=tai_section(hp).sectype;
@ -895,12 +915,11 @@ var
otherwise internalerror(2002110302); otherwise internalerror(2002110302);
end; end;
end; end;
ait_datablock: ait_datablock: {Storage for global variables.}
begin begin
s:= tai_datablock(hp).sym.name; s:= tai_datablock(hp).sym.name;
WriteDataExportHeader(s, tai_datablock(hp).is_global, false); WriteDataHeader(s, tai_datablock(hp).is_global, false);
if not macos_direct_globals then if not macos_direct_globals then
begin begin
AsmWriteLn(#9'ds.b '+tostr(tai_datablock(hp).size)); AsmWriteLn(#9'ds.b '+tostr(tai_datablock(hp).size));
@ -950,36 +969,34 @@ var
repeat repeat
if assigned(tai_const(hp).sym) then if assigned(tai_const(hp).sym) then
begin begin
if assigned(tai_const(hp).endsym) then if assigned(tai_const(hp).endsym) then
begin begin
if (tai_const(hp).endsym.typ = AT_FUNCTION) and use_PR then if (tai_const(hp).endsym.typ = AT_FUNCTION) and use_PR then
AsmWrite('.'); AsmWrite('.');
s:=tai_const(hp).endsym.name; s:=tai_const(hp).endsym.name;
ReplaceForbiddenChars(s); ReplaceForbiddenChars(s);
AsmWrite(s); AsmWrite(s);
inc(l,length(s)); inc(l,length(s));
if tai_const(hp).endsym.typ = AT_FUNCTION then if tai_const(hp).endsym.typ = AT_FUNCTION then
begin begin
if use_PR then if use_PR then
AsmWrite('[PR]') AsmWrite('[PR]')
else else
AsmWrite('[DS]'); AsmWrite('[DS]');
end end;
else if not macos_direct_globals then
AsmWrite(const_storage_class);
AsmWrite('-'); AsmWrite('-');
inc(l,5); {Approx 5 extra, no need to be exactly} inc(l,5); {Approx 5 extra, no need to be exactly}
end; end;
if (tai_const(hp).sym.typ = AT_FUNCTION) and use_PR then if (tai_const(hp).sym.typ = AT_FUNCTION) and use_PR then
AsmWrite('.'); AsmWrite('.');
s:= tai_const(hp).sym.name; s:= tai_const(hp).sym.name;
ReplaceForbiddenChars(s); ReplaceForbiddenChars(s);
AsmWrite(s); AsmWrite(s);
inc(l,length(s)); inc(l,length(s));
if tai_const(hp).sym.typ = AT_FUNCTION then if tai_const(hp).sym.typ = AT_FUNCTION then
@ -988,9 +1005,7 @@ var
AsmWrite('[PR]') AsmWrite('[PR]')
else else
AsmWrite('[DS]'); AsmWrite('[DS]');
end end;
else if not macos_direct_globals then
AsmWrite(const_storage_class);
inc(l,5); {Approx 5 extra, no need to be exactly} inc(l,5); {Approx 5 extra, no need to be exactly}
if tai_const(hp).value > 0 then if tai_const(hp).value > 0 then
@ -1021,7 +1036,7 @@ var
until false; until false;
AsmLn; AsmLn;
end; end;
ait_real_64bit : ait_real_64bit :
begin begin
AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value)); AsmWriteLn(target_asm.comment+'value: '+double2str(tai_real_64bit(hp).value));
@ -1107,65 +1122,62 @@ var
end; { end for j:=0 ... } end; { end for j:=0 ... }
{ do last line of lines } { do last line of lines }
if counter < tai_string(hp).len then if counter < tai_string(hp).len then
AsmWrite(#9'dc.b'#9); AsmWrite(#9'dc.b'#9);
quoted:=false; quoted:=false;
for i:=counter to tai_string(hp).len-1 do for i:=counter to tai_string(hp).len-1 do
begin begin
{ it is an ascii character. } { it is an ascii character. }
if (ord(tai_string(hp).str[i])>31) and if (ord(tai_string(hp).str[i])>31) and
(ord(tai_string(hp).str[i])<128) and (ord(tai_string(hp).str[i])<128) and
(tai_string(hp).str[i]<>'''') and (tai_string(hp).str[i]<>'''') and
(tai_string(hp).str[i]<>'\') then (tai_string(hp).str[i]<>'\') then
begin begin
if not(quoted) then if not(quoted) then
begin begin
if i>counter then if i>counter then
AsmWrite(','); AsmWrite(',');
AsmWrite(''''); AsmWrite('''');
end; end;
AsmWrite(tai_string(hp).str[i]); AsmWrite(tai_string(hp).str[i]);
quoted:=true; quoted:=true;
end { if > 31 and < 128 and " } end { if > 31 and < 128 and " }
else else
begin begin
if quoted then if quoted then
AsmWrite(''''); AsmWrite('''');
if i>counter then if i>counter then
AsmWrite(','); AsmWrite(',');
quoted:=false; quoted:=false;
AsmWrite(tostr(ord(tai_string(hp).str[i]))); AsmWrite(tostr(ord(tai_string(hp).str[i])));
end; end;
end; { end for i:=0 to... } end; { end for i:=0 to... }
if quoted then if quoted then
AsmWrite(''''); AsmWrite('''');
end; end;
AsmLn; AsmLn;
end; end;
ait_label: ait_label:
begin begin
if tai_label(hp).l.is_used then if tai_label(hp).l.is_used then
begin begin
s:= tai_label(hp).l.name; s:= tai_label(hp).l.name;
ReplaceForbiddenChars(s);
if s[1] = '@' then if s[1] = '@' then
//Local labels: begin
AsmWriteLn(s+':') ReplaceForbiddenChars(s);
//Local labels:
AsmWriteLn(s+':')
end
else else
begin begin
//Procedure entry points: //Procedure entry points:
if not macos_direct_globals then if not macos_direct_globals then
begin begin
AsmWriteLn(#9'toc'); WriteDataHeader(s, tai_label(hp).is_global, true);
AsmWrite(#9'tc'#9); AsmWrite(s);
AsmWrite('[TC], '); AsmWrite(s);
AsmWriteLn(const_storage_class);
AsmWrite(#9'csect'#9); AsmWrite(s);
AsmWriteLn(const_storage_class);
end end
else else
begin begin
ReplaceForbiddenChars(s);
AsmWrite(#9'csect'#9); AsmWrite(s); AsmWrite(#9'csect'#9); AsmWrite(s);
AsmWriteLn('[TC]'); AsmWriteLn('[TC]');
@ -1186,9 +1198,7 @@ var
else if tai_symbol(hp).sym.typ=AT_DATA then else if tai_symbol(hp).sym.typ=AT_DATA then
begin begin
s:= tai_symbol(hp).sym.name; s:= tai_symbol(hp).sym.name;
WriteDataHeader(s, tai_symbol(hp).is_global, true);
WriteDataExportHeader(s, tai_symbol(hp).is_global, true);
if macos_direct_globals then if macos_direct_globals then
begin begin
AsmWrite(s); AsmWrite(s);
@ -1223,41 +1233,9 @@ var
{$endif GDB} {$endif GDB}
ait_cutobject : ait_cutobject :
begin begin
{ only reset buffer if nothing has changed } InternalError(2004101101); {Smart linking is done transparently by the MPW linker.}
if AsmSize=AsmStartSize then end;
AsmClear ait_marker :
else
begin
{
if LasTSec<>sec_none then
AsmWriteLn('_'+target_asm.secnames[LasTSec]+#9#9'ends');
AsmLn;
}
AsmWriteLn(#9'end');
AsmClose;
DoAssemble;
AsmCreate(tai_cutobject(hp).place);
end;
{ avoid empty files }
while assigned(hp.next) and (tai(hp.next).typ in [ait_cutobject,ait_section,ait_comment]) do
begin
if tai(hp.next).typ=ait_section then
begin
lasTSec:=tai_section(hp.next).sectype;
end;
hp:=tai(hp.next);
end;
WriteAsmFileHeader;
if lasTSec<>sec_none then
AsmWriteLn(#9+secnames[lasTSec]);
{ AsmWriteLn('_'+target_asm.secnames[lasTSec]+#9#9+
'SEGMENT'#9'PARA PUBLIC USE32 '''+
target_asm.secnames[lasTSec]+'''');
}
AsmStartSize:=AsmSize;
end;
ait_marker :
begin begin
if tai_marker(hp).kind=InlineStart then if tai_marker(hp).kind=InlineStart then
inc(InlineLevel) inc(InlineLevel)
@ -1330,7 +1308,7 @@ var
begin begin
AsmWrite(#9'import'#9); AsmWrite(#9'import'#9);
AsmWrite(s); AsmWrite(s);
AsmWrite('[RW]'); AsmWrite(var_storage_class);
if replaced then if replaced then
begin begin
AsmWrite(' <= '''); AsmWrite(' <= ''');
@ -1344,7 +1322,7 @@ var
AsmWrite(s); AsmWrite(s);
AsmWrite('[TC],'); AsmWrite('[TC],');
AsmWrite(s); AsmWrite(s);
AsmWriteLn('[RW]'); AsmWriteLn(var_storage_class);
end end
else else
InternalError(2003090901); InternalError(2003090901);
@ -1484,7 +1462,11 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.40 2004-10-15 09:30:13 mazen Revision 1.41 2004-10-31 15:32:13 olle
+ Change of the way global variables, with multiple entrypoints,
are referenced, fixes a lot of failed tests
Revision 1.40 2004/10/15 09:30:13 mazen
- remove $IFDEF DELPHI and related code - remove $IFDEF DELPHI and related code
- remove $IFDEF FPCPROCVAR and related code - remove $IFDEF FPCPROCVAR and related code