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

* improve function imports

Browse Source
This commit is contained in:
florian 2002-10-02 22:14:15 +00:00
parent 654d313c73
commit 4cb3d9b498
1 changed files with 242 additions and 690 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

686
compiler/powerpc/agppcmpw.pas
View File

@ -30,7 +30,7 @@ unit agppcmpw;
interface interface
uses uses
globals,aasmbase,aasmtai,aasmcpu,assemble, aasmbase,aasmtai,aasmcpu,assemble,
cpubase; cpubase;
const const
@ -52,13 +52,7 @@ interface
procedure WriteAsmList;override; procedure WriteAsmList;override;
Function DoAssemble:boolean;override; Function DoAssemble:boolean;override;
procedure WriteExternals; procedure WriteExternals;
{$ifdef GDB}
procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
procedure WriteFileEndInfo;
{$endif}
procedure WriteAsmFileHeader; procedure WriteAsmFileHeader;
private
procedure GenProcedureHeader(var hp:tai);
end; end;
@ -68,30 +62,14 @@ interface
{$ifdef delphi} {$ifdef delphi}
sysutils, sysutils,
{$endif} {$endif}
cutils,globtype,systems,cclasses, cutils,globtype,globals,systems,cclasses,
verbose,finput,fmodule,script,cpuinfo verbose,finput,fmodule,script,cpuinfo
; ;
const const
line_length = 70; line_length = 70;
{Whether internal procedure references should be xxx[PR]: }
use_PR = false;
const_storage_class = '[RW]';
{$ifdef GDB}
var
n_line : byte; { different types of source lines }
linecount,
includecount : longint;
funcname : pchar;
stabslastfileinfo : tfileposinfo;
isInFunction: Boolean;
firstLineInFunction: longint;
{$endif}
function ReplaceForbiddenChars(var s: string):Boolean; function ReplaceForbiddenChars(var s: string):Boolean;
{Returns wheater a replacement has occured.} {Returns wheater a replacement has occured.}
@ -163,33 +141,29 @@ var
'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','mr.','not', 'mtcr', 'mtlr', 'mflr', 'crnot', 'mt', 'mf','nop', 'li', 'lis', 'la', 'mr','mr.','not', 'mtcr', 'mtlr', 'mflr',
'mtctr', 'mfctr'); 'mtctr', 'mfctr');
symaddr2str: array[trefsymaddr] of string[3] = ('','@ha','@l');
function getreferencestring(var ref : treference) : string; function getreferencestring(var ref : treference) : string;
var var
s : string; s : string;
begin begin
with ref do with ref do
begin begin
inc(offset,offsetfixup); inc(offset,offsetfixup);
if ((offset < -32768) or (offset > 32767)) and
if (symaddr <> refs_full) then (symaddr = refs_full) then
InternalError(2002110301) internalerror(19991);
else if ((offset < -32768) or (offset > 32767)) then if (symaddr = refs_full) then
InternalError(19991); s := ''
else if not assigned(symbol) then
s := '('
if assigned(symbol) then else
begin begin
{s:='('+symbol.name; CHANGED from this to: }
s:= symbol.name; s:= symbol.name;
ReplaceForbiddenChars(s); ReplaceForbiddenChars(s);
{if symbol.typ = AT_FUNCTION then s:='('+s;
;} end;
s:= s+'[TC]' {ref to TOC entry }
end
else
s:= '';
if offset<0 then if offset<0 then
s:=s+tostr(offset) s:=s+tostr(offset)
@ -202,16 +176,23 @@ function getreferencestring(var ref : treference) : string;
s:=s+tostr(offset); s:=s+tostr(offset);
end; end;
if (index.enum=R_NO) and (base.enum<>R_NO) then if (symaddr <> refs_full) then
s := s+')'+symaddr2str[symaddr];
if (index=R_NO) and (base<>R_NO) then
begin begin
if offset=0 then if offset=0 then
if not assigned(symbol) then begin
if assigned(symbol) then
s:=s+'+0'
else
s:=s+'0'; s:=s+'0';
s:=s+'('+mpw_reg2str[base.enum]+')' end;
s:=s+'('+mpw_reg2str[base]+')'
end end
else if (index.enum<>R_NO) and (base.enum<>R_NO) and (offset=0) then else if (index<>R_NO) and (base<>R_NO) and (offset=0) then
s:=s+mpw_reg2str[base.enum]+','+mpw_reg2str[index.enum] s:=s+mpw_reg2str[base]+','+mpw_reg2str[index]
else if ((index.enum<>R_NO) or (base.enum<>R_NO)) then else if ((index<>R_NO) or (base<>R_NO)) then
internalerror(19992); internalerror(19992);
end; end;
getreferencestring:=s; getreferencestring:=s;
@ -223,7 +204,7 @@ function getreferencestring(var ref : treference) : string;
begin begin
case o.typ of case o.typ of
top_reg : top_reg :
getopstr_jmp:=mpw_reg2str[o.reg.enum]; getopstr_jmp:=mpw_reg2str[o.reg];
{ no top_ref jumping for powerpc } { no top_ref jumping for powerpc }
top_const : top_const :
getopstr_jmp:=tostr(o.val); getopstr_jmp:=tostr(o.val);
@ -258,7 +239,7 @@ function getreferencestring(var ref : treference) : string;
begin begin
case o.typ of case o.typ of
top_reg: top_reg:
getopstr:=mpw_reg2str[o.reg.enum]; getopstr:=mpw_reg2str[o.reg];
{ no top_ref jumping for powerpc } { no top_ref jumping for powerpc }
top_const: top_const:
getopstr:=tostr(longint(o.val)); getopstr:=tostr(longint(o.val));
@ -342,7 +323,7 @@ function getreferencestring(var ref : treference) : string;
end; end;
end; end;
Function GetInstruction(hp : tai):string; {CHANGED from method to proc} Function GetInstruction(hp : tai):string; {CHANGED from methot to proc}
var op: TAsmOp; var op: TAsmOp;
s: string; s: string;
i: byte; i: byte;
@ -355,54 +336,18 @@ function getreferencestring(var ref : treference) : string;
case op of case op of
A_B,A_BA,A_BLA: A_B,A_BA,A_BLA:
s:=#9+op2str[op]+#9; s:=#9+op2str[op]+#9;
A_BCTR,A_BCTRL,A_BLR,A_BLRL:
s:=#9+op2str[op];
A_BL: A_BL:
s:=#9+op2str[op]+#9'.'; s:=#9+op2str[op]+#9'.';
else else
s:=cond2str(op,taicpu(hp).condition)+','; s:=cond2str(op,taicpu(hp).condition)+',';
end; end;
if (taicpu(hp).oper[0].typ <> top_none) then
s:=s+getopstr_jmp(taicpu(hp).oper[0]); s:=s+getopstr_jmp(taicpu(hp).oper[0]);
if use_PR then
if op=A_BL then if op=A_BL then
s:=s+'[PR]'; s:=s+'[PR]';
end end
else else
{ process operands } { process operands }
begin begin
case op of
A_MFSPR:
case taicpu(hp).oper[1].reg.enum of
R_CR:
begin
op:=A_MFCR;
taicpu(hp).ops:=1;
end;
R_LR:
begin
op:=A_MFLR;
taicpu(hp).ops:=1;
end;
else
internalerror(2002100701);
end;
A_MTSPR:
case taicpu(hp).oper[1].reg.enum of
R_CR:
begin
op:=A_MTCR;
taicpu(hp).ops:=1;
end;
R_LR:
begin
op:=A_MTLR;
taicpu(hp).ops:=1;
end;
else
internalerror(2002100701);
end;
end;
s:=#9+op2str[op]; s:=#9+op2str[op];
if taicpu(hp).ops<>0 then if taicpu(hp).ops<>0 then
begin begin
@ -475,143 +420,6 @@ function getreferencestring(var ref : treference) : string;
{**************************************************************************** {****************************************************************************
PowerPC MPW Assembler PowerPC MPW Assembler
****************************************************************************} ****************************************************************************}
procedure TPPCMPWAssembler.GenProcedureHeader(var hp:tai);
{Returns the current hp where the caller should continue from}
{For multiple entry procedures, only the last is exported as xxx[PR]
(if use_PR is set) }
procedure WriteExportHeader(hp:tai);
var
s: string;
replaced: boolean;
begin
s:= tai_symbol(hp).sym.name;
replaced:= ReplaceForbiddenChars(s);
if replaced then
begin
if not use_PR then
AsmWriteLn(#9'export'#9'.'+s+' => ''.'+tai_symbol(hp).sym.name+'''');
AsmWriteLn(#9'export'#9+s+'[DS] => '''+tai_symbol(hp).sym.name+'[DS]''');
end
else
begin
if not use_PR then
AsmWriteLn(#9'export'#9'.'+s);
AsmWriteLn(#9'export'#9+s+'[DS]');
end;
{Entry in transition vector: }
AsmWriteLn(#9'csect'#9+s+'[DS]');
AsmWriteLn(#9'dc.l'#9'.'+s);
AsmWriteln(#9'dc.l'#9'TOC[tc0]');
{Entry in TOC: }
AsmWriteLn(#9'toc');
AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[DS]');
end;
function GetAdjacentTaiSymbol(var hp:tai):Boolean;
begin
GetAdjacentTaiSymbol:= false;
while assigned(hp.next) do
case tai(hp.next).typ of
ait_symbol:
begin
hp:=tai(hp.next);
GetAdjacentTaiSymbol:= true;
Break;
end;
ait_stab_function_name:
hp:=tai(hp.next);
else
begin
//AsmWriteln(' ;#*#*# ' + tostr(Ord(tai(hp.next).typ)));
Break;
end;
end;
end;
var
first,last: tai;
s: string;
replaced: boolean;
begin
s:= tai_symbol(hp).sym.name;
{Write all headers}
first:= hp;
repeat
WriteExportHeader(hp);
last:= hp;
until not GetAdjacentTaiSymbol(hp);
{Start the section of the body of the proc: }
s:= tai_symbol(last).sym.name;
replaced:= ReplaceForbiddenChars(s);
if use_PR then
if replaced then
AsmWriteLn(#9'export'#9'.'+s+'[PR] => ''.'+tai_symbol(last).sym.name+'[PR]''')
else
AsmWriteLn(#9'export'#9'.'+s+'[PR]');
AsmWriteLn(#9'csect'#9'.'+s+'[PR]'); //starts the section
AsmWriteLn(#9'function'#9'.'+s+'[PR]'); //info for debugger
{$ifdef GDB}
if ((cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches)) then
begin
//info for debuggers:
firstLineInFunction:= stabslastfileinfo.line;
AsmWriteLn(#9'beginf ' + tostr(firstLineInFunction));
isInFunction:= true;
end;
{$endif}
{Write all labels: }
hp:= first;
repeat
s:= tai_symbol(hp).sym.name;
ReplaceForbiddenChars(s);
AsmWriteLn('.'+s+':');
until not GetAdjacentTaiSymbol(hp);
end;
(*
procedure TPPCMPWAssembler.GenProcedureHeader(hp:tai);
var
s: string;
replaced: boolean;
begin
s:= tai_symbol(hp).sym.name;
replaced:= ReplaceForbiddenChars(s);
if replaced then
begin
AsmWriteLn(#9'export'#9'.'+s+'[PR] => ''.'+tai_symbol(hp).sym.name+'[PR]''');
AsmWriteLn(#9'export'#9+s+'[DS] => '''+tai_symbol(hp).sym.name+'[DS]''');
end
else
begin
AsmWriteLn(#9'export'#9'.'+s+'[PR]');
AsmWriteLn(#9'export'#9+s+'[DS]');
end;
{Entry in transition vector: }
AsmWriteLn(#9'csect'#9+s+'[DS]');
AsmWriteLn(#9'dc.l'#9'.'+s);
AsmWriteln(#9'dc.l'#9'TOC[tc0]');
{Entry in TOC: }
AsmWriteLn(#9'toc');
AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[DS]');
{Start the section of the body of the proc: }
AsmWriteLn(#9'csect'#9'.'+s+'[PR]');
AsmWriteLn('.'+s+':');
end;
*)
var var
LasTSec : TSection; LasTSec : TSection;
@ -621,7 +429,7 @@ function getreferencestring(var ref : treference) : string;
const const
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; Function PadTabs(const p:string;addch:char):string;
var var
@ -642,92 +450,23 @@ function getreferencestring(var ref : treference) : string;
PadTabs:=s+#9; PadTabs:=s+#9;
end; end;
{$ifdef GDB}
procedure TPPCMPWAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
var
curr_n : byte;
begin
if not ((cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches)) then
exit;
{ file changed ? (must be before line info) }
if (fileinfo.fileindex<>0) and
(stabslastfileinfo.fileindex<>fileinfo.fileindex) then
begin
infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
if assigned(infile) then
begin
(*
if includecount=0 then
curr_n:=n_sourcefile
else
curr_n:=n_includefile;
if (infile.path^<>'') then
begin
AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+
tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount));
end;
AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile.name^))+'",'+
tostr(curr_n)+',0,0,'+target_asm.labelprefix+'text'+ToStr(IncludeCount));
*)
AsmWriteLn(#9'file '''+lower(FixFileName(infile.name^))+'''');
(*
AsmWriteLn(target_asm.labelprefix+'text'+ToStr(IncludeCount)+':');
*)
inc(includecount);
{ force new line info }
stabslastfileinfo.line:=-1;
end;
end;
{ line changed ? }
if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
begin
(*
if (n_line=n_textline) and assigned(funcname) and
(target_info.use_function_relative_addresses) then
begin
AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(fileinfo.line)+','+
target_asm.labelprefix+'l'+tostr(linecount)+' - ');
AsmWritePChar(FuncName);
AsmLn;
inc(linecount);
end
else
AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(fileinfo.line));
*)
if isInFunction then
AsmWriteln(#9'line '+ tostr(fileinfo.line - firstLineInFunction - 1));
end;
stabslastfileinfo:=fileinfo;
end;
procedure TPPCMPWAssembler.WriteFileEndInfo;
begin
if not ((cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches)) then
exit;
AsmLn;
(*
AsmWriteLn(ait_section2str(sec_code));
AsmWriteLn(#9'.stabs "",'+tostr(n_sourcefile)+',0,0,'+target_asm.labelprefix+'etext');
AsmWriteLn(target_asm.labelprefix+'etext:');
*)
end;
{$endif}
procedure TPPCMPWAssembler.WriteTree(p:TAAsmoutput); procedure TPPCMPWAssembler.WriteTree(p:TAAsmoutput);
const
nolinetai =[ait_label,
ait_regalloc,ait_tempalloc,
{$ifdef GDB}
ait_stabn,ait_stabs,ait_stab_function_name,
{$endif GDB}
ait_cut,ait_marker,ait_align,ait_section];
{TODO: Perhaps replace internalerror(10000) with something else}
var var
s, s,
prefix, prefix,
suffix : string; suffix : string;
hp : tai; hp : tai;
hp1 : tailineinfo;
counter, counter,
lines, lines,
InlineLevel : longint; InlineLevel : longint;
@ -742,33 +481,22 @@ function getreferencestring(var ref : treference) : string;
begin begin
if not assigned(p) then if not assigned(p) then
exit; exit;
InlineLevel:=0;
{ lineinfo is only needed for codesegment (PFV) } { lineinfo is only needed for codesegment (PFV) }
do_line:=((cs_asm_source in aktglobalswitches) or do_line:=((cs_asm_source in aktglobalswitches) or
(cs_lineinfo in aktmoduleswitches)) (cs_lineinfo in aktmoduleswitches))
and (p=codesegment); and (p=codesegment);
InlineLevel:=0;
DoNotSplitLine:=false; DoNotSplitLine:=false;
hp:=tai(p.first); hp:=tai(p.first);
while assigned(hp) do while assigned(hp) do
begin begin
if not(hp.typ in SkipLineInfo) and if do_line and not(hp.typ in nolinetai) and
not DoNotSplitLine then not DoNotSplitLine then
begin begin
hp1 := hp as tailineinfo;
{$ifdef GDB}
{ write debug info }
if (cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches) then
WriteFileLineInfo(hp1.fileinfo);
{$endif GDB}
if do_line then
begin
{ load infile } { load infile }
if lastfileinfo.fileindex<>hp1.fileinfo.fileindex then if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
begin begin
infile:=current_module.sourcefiles.get_file(hp1.fileinfo.fileindex); infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
if assigned(infile) then if assigned(infile) then
begin begin
{ open only if needed !! } { open only if needed !! }
@ -776,7 +504,7 @@ function getreferencestring(var ref : treference) : string;
infile.open; infile.open;
end; end;
{ avoid unnecessary reopens of the same file !! } { avoid unnecessary reopens of the same file !! }
lastfileinfo.fileindex:=hp1.fileinfo.fileindex; lastfileinfo.fileindex:=hp.fileinfo.fileindex;
{ be sure to change line !! } { be sure to change line !! }
lastfileinfo.line:=-1; lastfileinfo.line:=-1;
end; end;
@ -790,26 +518,23 @@ function getreferencestring(var ref : treference) : string;
if assigned(lastinfile) then if assigned(lastinfile) then
lastinfile.close; lastinfile.close;
end; end;
if (hp1.fileinfo.line<>lastfileinfo.line) and if (hp.fileinfo.line<>lastfileinfo.line) and
((hp1.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then ((hp.fileinfo.line<infile.maxlinebuf) or (InlineLevel>0)) then
begin begin
if (hp1.fileinfo.line<>0) and if (hp.fileinfo.line<>0) and
((infile.linebuf^[hp1.fileinfo.line]>=0) or (InlineLevel>0)) then ((infile.linebuf^[hp.fileinfo.line]>=0) or (InlineLevel>0)) then
AsmWriteLn(target_asm.comment+'['+tostr(hp1.fileinfo.line)+'] '+ AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
fixline(infile.GetLineStr(hp1.fileinfo.line))); fixline(infile.GetLineStr(hp.fileinfo.line)));
{ set it to a negative value ! { set it to a negative value !
to make that is has been read already !! PM } to make that is has been read already !! PM }
if (infile.linebuf^[hp1.fileinfo.line]>=0) then if (infile.linebuf^[hp.fileinfo.line]>=0) then
infile.linebuf^[hp1.fileinfo.line]:=-infile.linebuf^[hp1.fileinfo.line]-1; infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
end; end;
end; end;
lastfileinfo:=hp1.fileinfo; lastfileinfo:=hp.fileinfo;
lastinfile:=infile; lastinfile:=infile;
end; end;
end;
DoNotSplitLine:=false; DoNotSplitLine:=false;
case hp.typ of case hp.typ of
ait_comment: ait_comment:
begin begin
@ -827,20 +552,19 @@ function getreferencestring(var ref : treference) : string;
if tai_section(hp).sec<>sec_none then if tai_section(hp).sec<>sec_none then
begin begin
AsmLn; AsmLn;
AsmWriteLn(#9+target_asm.secnames[tai_section(hp).sec]); AsmWriteLn(#9+target_asm.secnames[tai_section(hp).sec]){+#9#9+
{$ifdef GDB} 'SEGMENT'#9'PARA PUBLIC USE32 '''+
lastfileinfo.line:=-1; target_asm.secnames[tai_section(hp).sec]+'''');}
{$endif GDB}
end; end;
LasTSec:=tai_section(hp).sec; LasTSec:=tai_section(hp).sec;
end; end;
ait_align: ait_align:
begin begin
case tai_align(hp).aligntype of case tai_align(hp).aligntype of
1:AsmWriteLn(#9'align 0'); 1:AsmWriteLn(#9'ALIGN 0');
2:AsmWriteLn(#9'align 1'); 2:AsmWriteLn(#9'ALIGN 1');
4:AsmWriteLn(#9'align 2'); 4:AsmWriteLn(#9'ALIGN 2');
otherwise internalerror(2002110302); otherwise internalerror(10000);
end; end;
end; end;
ait_datablock: ait_datablock:
@ -849,25 +573,12 @@ function getreferencestring(var ref : treference) : string;
replaced:= ReplaceForbiddenChars(s); replaced:= ReplaceForbiddenChars(s);
if tai_datablock(hp).is_global then if tai_datablock(hp).is_global then
if replaced then if replaced then
AsmWriteLn(#9'export'#9+s+'[RW] => '''+tai_datablock(hp).sym.name+'''') AsmWriteLn(#9'EXPORT'#9+s+' => '''+tai_datablock(hp).sym.name+'''')
else else
AsmWriteLn(#9'export'#9+s+'[RW]'); AsmWriteLn(#9'EXPORT'#9+s);
AsmWriteLn(PadTabs(s,#0)+'DS.B '+tostr(tai_datablock(hp).size));
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) } {TODO: ? PadTabs(s,#0) }
end; end;
end;
ait_const_32bit, ait_const_32bit,
ait_const_8bit, ait_const_8bit,
ait_const_16bit : ait_const_16bit :
@ -887,56 +598,17 @@ function getreferencestring(var ref : treference) : string;
until (not found) or (l>line_length); until (not found) or (l>line_length);
AsmLn; AsmLn;
end; end;
ait_const_symbol: ait_const_symbol : begin
begin AsmWriteLn(#9#9'DD'#9'offset '+tai_const_symbol(hp).sym.name);
(*
AsmWriteLn(#9#9'dd'#9'offset '+tai_const_symbol(hp).sym.name);
if tai_const_symbol(hp).offset>0 then if tai_const_symbol(hp).offset>0 then
AsmWrite('+'+tostr(tai_const_symbol(hp).offset)) AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
else if tai_const_symbol(hp).offset<0 then else if tai_const_symbol(hp).offset<0 then
AsmWrite(tostr(tai_const_symbol(hp).offset)); AsmWrite(tostr(tai_const_symbol(hp).offset));
AsmLn; AsmLn;
*)
s:= tai_const_symbol(hp).sym.name;
ReplaceForbiddenChars(s);
if tai_const_symbol(hp).sym.typ = AT_FUNCTION then
begin
if use_PR then
AsmWriteLn(#9'dc.l'#9'.'+ s +'[PR]')
else
AsmWriteLn(#9'dc.l'#9 + s + '[DS]')
end
else
begin
if macos_direct_globals then
AsmWriteLn(#9'dc.l'#9+s)
else
AsmWriteLn(#9'dc.l'#9+s+const_storage_class);
end; end;
ait_real_32bit : AsmWriteLn(#9'DC.L'#9'"'+single2str(tai_real_32bit(hp).value)+'"');
(* TODO: the following might need to be included. Temporaily we ait_real_64bit : AsmWriteLn(#9'DC.D'#9'"'+double2str(tai_real_64bit(hp).value)+'"');
generate an error ait_string : begin
if tai_const_symbol(hp).offset>0 then
AsmWrite('+'+tostr(tai_const_symbol(hp).offset))
else if tai_const_symbol(hp).offset<0 then
AsmWrite(tostr(tai_const_symbol(hp).offset));
*)
if tai_const_symbol(hp).offset <> 0 then
InternalError(2002110101);
AsmLn;
end;
ait_real_32bit:
AsmWriteLn(#9'dc.l'#9'"'+single2str(tai_real_32bit(hp).value)+'"');
ait_real_64bit:
AsmWriteLn(#9'dc.d'#9'"'+double2str(tai_real_64bit(hp).value)+'"');
ait_string:
begin
{NOTE When a single quote char is encountered, it is {NOTE When a single quote char is encountered, it is
replaced with a numeric ascii value. It could also replaced with a numeric ascii value. It could also
have been replaced with the escape seq of double quotes.} have been replaced with the escape seq of double quotes.}
@ -947,7 +619,7 @@ function getreferencestring(var ref : treference) : string;
Begin Begin
for j := 0 to lines-1 do for j := 0 to lines-1 do
begin begin
AsmWrite(#9'dc.b'#9); AsmWrite(#9'DC.B'#9);
quoted:=false; quoted:=false;
for i:=counter to counter+line_length do for i:=counter to counter+line_length do
begin begin
@ -980,7 +652,7 @@ function getreferencestring(var ref : treference) : string;
counter := counter+line_length; counter := counter+line_length;
end; { end for j:=0 ... } end; { end for j:=0 ... }
{ do last line of lines } { do last line of lines }
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
@ -1013,90 +685,53 @@ function getreferencestring(var ref : treference) : string;
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); ReplaceForbiddenChars(s);
if s[1] = '@' then AsmWrite(s);
AsmWriteLn(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(':')
else else
begin DoNotSplitLine:=true;}
if not macos_direct_globals then AsmWriteLn(':');
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;
end; ait_direct : begin
end;
ait_direct:
begin
AsmWritePChar(tai_direct(hp).str); AsmWritePChar(tai_direct(hp).str);
AsmLn; AsmLn;
end; end;
ait_symbol: ait_symbol : begin
begin s:= tai_label(hp).l.name;
if tai_symbol(hp).sym.typ=AT_FUNCTION then
GenProcedureHeader(hp)
else if tai_symbol(hp).sym.typ=AT_DATA then
begin
s:= tai_symbol(hp).sym.name;
replaced:= ReplaceForbiddenChars(s); replaced:= ReplaceForbiddenChars(s);
if tai_symbol(hp).is_global then if tai_symbol(hp).is_global then
if replaced then if replaced then
AsmWriteLn(#9'export'#9+s+'[RW] => '''+tai_symbol(hp).sym.name+'''') AsmWriteLn(#9'EXPORT'#9+s+' => '''+tai_symbol(hp).sym.name+'''')
else else
AsmWriteLn(#9'export'#9+s+'[RW]'); AsmWriteLn(#9'EXPORT'#9+s);
AsmWrite(s);
{if assigned(hp.next) and not(tai(hp.next).typ in
if not macos_direct_globals then [ait_const_32bit,ait_const_16bit,ait_const_8bit,
begin ait_const_symbol,ait_const_rva,
AsmWriteLn(#9'toc'); ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then}
AsmWriteLn(#9'tc'#9+s+'[TC], '+s+ const_storage_class); AsmWriteLn(':')
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 : begin
else
InternalError(2003071301);
end; end;
ait_symbol_end: ait_instruction : begin
{$ifdef GDB}
if isInFunction then
if ((cs_debuginfo in aktmoduleswitches) or
(cs_gdb_lineinfo in aktglobalswitches)) then
begin
//info for debuggers:
AsmWriteLn(#9'endf ' + tostr(stabslastfileinfo.line));
isInFunction:= false;
end
{$endif GDB}
;
ait_instruction:
AsmWriteLn(GetInstruction(hp)); AsmWriteLn(GetInstruction(hp));
end;
{$ifdef GDB} {$ifdef GDB}
ait_stabn: ; ait_stabn,
ait_stabs: ; ait_stabs,
ait_force_line,
ait_force_line : ait_stab_function_name : ;
stabslastfileinfo.line:=0;
ait_stab_function_name: ;
{$endif GDB} {$endif GDB}
ait_cut : ait_cut : begin
begin
{ only reset buffer if nothing has changed } { only reset buffer if nothing has changed }
if AsmSize=AsmStartSize then if AsmSize=AsmStartSize then
AsmClear AsmClear
@ -1104,10 +739,10 @@ function getreferencestring(var ref : treference) : string;
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');
AsmLn; AsmLn;
} }
AsmWriteLn(#9'end'); AsmWriteLn(#9'END');
AsmClose; AsmClose;
DoAssemble; DoAssemble;
AsmCreate(tai_cut(hp).place); AsmCreate(tai_cut(hp).place);
@ -1139,7 +774,7 @@ function getreferencestring(var ref : treference) : string;
dec(InlineLevel); dec(InlineLevel);
end; end;
else else
internalerror(2002110303); internalerror(10000);
end; end;
hp:=tai(hp.next); hp:=tai(hp.next);
end; end;
@ -1156,38 +791,30 @@ function getreferencestring(var ref : treference) : string;
begin begin
if tasmsymbol(p).defbind=AB_EXTERNAL then if tasmsymbol(p).defbind=AB_EXTERNAL then
begin begin
//Writeln('ZZZ ',p.name,' ',p.classname,' ',Ord(tasmsymbol(p).typ)); {currentasmlist.AsmWriteln(#9'IMPORT'#9+p.name);}
s:= p.name; s:= p.name;
case tasmsymbol(p).typ of case tasmsymbol(p).typ of
AT_FUNCTION: AT_FUNCTION:
begin begin
if ReplaceForbiddenChars(s) then if ReplaceForbiddenChars(s) then
begin begin
if not use_PR then currentasmlist.AsmWriteLn(#9'IMPORT'#9'.'+s+' <= ''.'+p.name+'[PR]''');
currentasmlist.AsmWriteLn(#9'import'#9'.'+s+' <= ''.'+p.name+'''') currentasmlist.AsmWriteLn(#9'IMPORT'#9+s+' <= '''+p.name+'[DS]''');
else
currentasmlist.AsmWriteLn(#9'import'#9'.'+s+'[PR] <= ''.'+p.name+'[PR]''');
currentasmlist.AsmWriteLn(#9'import'#9+s+'[DS] <= '''+p.name+'[DS]''');
end end
else else
begin begin
if not use_PR then currentasmlist.AsmWriteLn(#9'IMPORT'#9'.'+s+'[PR]');
currentasmlist.AsmWriteLn(#9'import'#9'.'+s) currentasmlist.AsmWriteLn(#9'IMPORT'#9+s+'[DS]');
else
currentasmlist.AsmWriteLn(#9'import'#9'.'+s+'[PR]');
currentasmlist.AsmWriteLn(#9'import'#9+s+'[DS]');
end; end;
currentasmlist.AsmWriteLn(#9'toc'); currentasmlist.AsmWriteLn(#9'TOC');
currentasmlist.AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[DS]'); currentasmlist.AsmWriteLn(#9'TC'#9+s+'[TC],'+s+'[DS]');
end end
else else
begin begin
if ReplaceForbiddenChars(s) then if ReplaceForbiddenChars(s) then
currentasmlist.AsmWriteLn(#9'import'#9+s+'[RW] <= '''+p.name+'''') currentasmlist.AsmWriteLn(#9'IMPORT'#9+s+' <= '''+p.name+'''')
else else
currentasmlist.AsmWriteLn(#9'import'#9+s+'[RW]'); currentasmlist.AsmWriteLn(#9'IMPORT'#9+s);
currentasmlist.AsmWriteLn(#9'toc');
currentasmlist.AsmWriteLn(#9'tc'#9+s+'[TC],'+s+'[RW]');
end; end;
end; end;
end; end;
@ -1238,42 +865,17 @@ function getreferencestring(var ref : treference) : string;
AsmLn; 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; AsmLn;
end; end;
procedure TPPCMPWAssembler.WriteAsmList; procedure TPPCMPWAssembler.WriteAsmList;
{$ifdef GDB}
var
fileinfo : tfileposinfo;
{$endif GDB}
begin begin
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
if assigned(current_module.mainsource) then if assigned(current_module.mainsource) then
comment(v_info,'Start writing MPW-styled assembler output for '+current_module.mainsource^); comment(v_info,'Start writing MPW-styled assembler output for '+current_module.mainsource^);
{$endif} {$endif}
LasTSec:=sec_none; LasTSec:=sec_none;
{$ifdef GDB}
FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
{$endif GDB}
{$ifdef GDB}
//n_line:=n_bssline;
funcname:=nil;
linecount:=1;
includecount:=0;
fileinfo.fileindex:=1;
fileinfo.line:=1;
isInFunction:= false;
firstLineInFunction:= 0;
{ Write main file }
WriteFileLineInfo(fileinfo);
{$endif GDB}
WriteAsmFileHeader; WriteAsmFileHeader;
WriteExternals; WriteExternals;
@ -1287,11 +889,8 @@ function getreferencestring(var ref : treference) : string;
WriteTree(rttilist); WriteTree(rttilist);
WriteTree(resourcestringlist); WriteTree(resourcestringlist);
WriteTree(bsssegment); WriteTree(bsssegment);
{$ifdef GDB}
WriteFileEndInfo;
{$ENDIF}
AsmWriteLn(#9'end'); AsmWriteLn(#9'END');
AsmLn; AsmLn;
{$ifdef EXTDEBUG} {$ifdef EXTDEBUG}
@ -1316,10 +915,10 @@ function getreferencestring(var ref : treference) : string;
allowdirect : true; allowdirect : true;
needar : true; needar : true;
labelprefix_only_inside_procedure : true; labelprefix_only_inside_procedure : true;
labelprefix : '@'; labelprefix : '@@';
comment : '; '; comment : '; ';
secnames : ('', secnames : ('',
'csect','csect [TC]','csect [TC]', {TODO: Perhaps use other section types.} 'CSECT','CSECT','CSECT', {TODO: Perhaps use other section types.}
'','','','','','', '','','','','','',
'','','') '','','')
); );
@ -1329,55 +928,7 @@ initialization
end. end.
{ {
$Log$ $Log$
Revision 1.20 2002-10-01 05:17:27 olle Revision 1.7 2002-10-02 22:14:15 florian
* minor fix
Revision 1.19 2003/04/06 21:01:40 olle
+ line numbers are now emitted in the assembler code
* bug in export and import directive fixed
* made code more in sync with aggas.pas
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
* changed proc ref from .xxx[PR] (refering to its section)
to .xxx (refering to its label) to allow for multiple ref to a proc.
Revision 1.15 2002/11/17 16:31:59 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k
Revision 1.14 2002/11/07 15:50:23 jonas
* fixed bctr(l) problems
Revision 1.13 2002/11/04 18:24:53 olle
* globals are located in TOC and relative r2, instead of absolute
* symbols which only differs in case are treated as a single symbol
+ tai_const_symbol supported
* only refs_full accepted
Revision 1.12 2002/10/23 15:31:01 olle
* branch b does not jump to dotted symbol now
Revision 1.11 2002/10/19 23:52:40 olle
* import directive changed
Revision 1.10 2002/10/10 19:39:37 florian
* changes from Olle to get simple programs compiled and assembled
Revision 1.9 2002/10/07 21:19:53 florian
* more mpw fixes
Revision 1.8 2002/10/06 22:46:20 florian
* fixed function exporting
Revision 1.7 2002/10/02 22:14:15 florian
* improve function imports * improve function imports
Revision 1.6 2002/09/27 21:09:49 florian Revision 1.6 2002/09/27 21:09:49 florian
@ -1390,3 +941,4 @@ end.
+ target macos for ppc added + target macos for ppc added
+ frame work for mpw assembler output + frame work for mpw assembler output
} }