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

* Long symbol names support

Browse Source
This commit is contained in:
peter 2002-12-24 18:10:34 +00:00
parent 7e3b2ace2c
commit 2d13cc9d04
3 changed files with 525 additions and 521 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

316
compiler/i386/ag386att.pas
View File

@ -35,6 +35,10 @@ interface
type
T386ATTAssembler=class(TGNUassembler)
private
procedure WriteReference(var ref : treference);
procedure WriteOper(const o:toper);
procedure WriteOper_jmp(const o:toper);
public
procedure WriteInstruction(hp: tai);override;
end;
@ -72,176 +76,161 @@ interface
verbose;
function getreferencestring(var ref : treference) : string;
var
s : string;
begin
with ref do
begin
inc(offset,offsetfixup);
offsetfixup:=0;
{ have we a segment prefix ? }
{ These are probably not correctly handled under GAS }
{ should be replaced by coding the segment override }
{ directly! - DJGPP FAQ }
if segment<>R_NO then
s:=gas_reg2str[segment]+':'
else
s:='';
if assigned(symbol) then
s:=s+symbol.name;
if offset<0 then
s:=s+tostr(offset)
else
if (offset>0) then
begin
if assigned(symbol) then
s:=s+'+'+tostr(offset)
else
s:=s+tostr(offset);
end
else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then
s:=s+'0';
if (index<>R_NO) and (base=R_NO) then
begin
s:=s+'(,'+gas_reg2str[index];
if scalefactor<>0 then
s:=s+','+tostr(scalefactor)+')'
else
s:=s+')';
end
else
if (index=R_NO) and (base<>R_NO) then
s:=s+'('+gas_reg2str[base]+')'
else
if (index<>R_NO) and (base<>R_NO) then
begin
s:=s+'('+gas_reg2str[base]+','+gas_reg2str[index];
if scalefactor<>0 then
s:=s+','+tostr(scalefactor)+')'
else
s := s+')';
end;
end;
getreferencestring:=s;
end;
function getopstr(const o:toper) : string;
var
hs : string;
begin
case o.typ of
top_reg :
getopstr:=gas_reg2str[o.reg];
top_ref :
getopstr:=getreferencestring(o.ref^);
top_const :
getopstr:='$'+tostr(longint(o.val));
top_symbol :
begin
if assigned(o.sym) then
hs:='$'+o.sym.name
else
hs:='$';
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs)
else
if not(assigned(o.sym)) then
hs:=hs+'0';
getopstr:=hs;
end;
else
internalerror(10001);
end;
end;
function getopstr_jmp(const o:toper) : string;
var
hs : string;
begin
case o.typ of
top_reg :
getopstr_jmp:='*'+gas_reg2str[o.reg];
top_ref :
getopstr_jmp:='*'+getreferencestring(o.ref^);
top_const :
getopstr_jmp:=tostr(longint(o.val));
top_symbol :
begin
hs:=o.sym.name;
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs);
getopstr_jmp:=hs;
end;
else
internalerror(10001);
end;
end;
{****************************************************************************
TI386ATTASMOUTPUT
****************************************************************************}
procedure T386AttAssembler. WriteInstruction(hp: tai);
var
op : tasmop;
s : string;
sep : char;
calljmp : boolean;
i : integer;
begin
if hp.typ <> ait_instruction then exit;
taicpu(hp).SetOperandOrder(op_att);
op:=taicpu(hp).opcode;
calljmp:=is_calljmp(op);
{ call maybe not translated to call }
s:=#9+gas_op2str[op]+cond2str[taicpu(hp).condition];
{ suffix needed ? fnstsw,fldcw don't support suffixes
with binutils 2.9.5 under linux }
if (not calljmp) and
(gas_needsuffix[op]<>AttSufNONE) and
(op<>A_FNSTSW) and (op<>A_FSTSW) and
(op<>A_FNSTCW) and (op<>A_FSTCW) and
(op<>A_FLDCW) and not(
(taicpu(hp).oper[0].typ=top_reg) and
(taicpu(hp).oper[0].reg in [R_ST..R_ST7])
) then
s:=s+gas_opsize2str[taicpu(hp).opsize];
{ process operands }
if taicpu(hp).ops<>0 then
procedure T386AttAssembler.WriteReference(var ref : treference);
begin
with ref do
begin
{ call and jmp need an extra handling }
{ this code is only called if jmp isn't a labeled instruction }
{ quick hack to overcome a problem with manglednames=255 chars }
if calljmp then
begin
AsmWrite(s+#9);
s:=getopstr_jmp(taicpu(hp).oper[0]);
end
inc(offset,offsetfixup);
offsetfixup:=0;
{ have we a segment prefix ? }
{ These are probably not correctly handled under GAS }
{ should be replaced by coding the segment override }
{ directly! - DJGPP FAQ }
if segment<>R_NO then
AsmWrite(gas_reg2str[segment]+':');
if assigned(symbol) then
AsmWrite(symbol.name);
if offset<0 then
AsmWrite(tostr(offset))
else
if (offset>0) then
begin
if assigned(symbol) then
AsmWrite('+'+tostr(offset))
else
AsmWrite(tostr(offset));
end
else if (index=R_NO) and (base=R_NO) and not assigned(symbol) then
AsmWrite('0');
if (index<>R_NO) and (base=R_NO) then
begin
AsmWrite('(,'+gas_reg2str[index]);
if scalefactor<>0 then
AsmWrite(','+tostr(scalefactor)+')')
else
AsmWrite(')');
end
else
if (index=R_NO) and (base<>R_NO) then
AsmWrite('('+gas_reg2str[base]+')')
else
if (index<>R_NO) and (base<>R_NO) then
begin
for i:=0 to taicpu(hp).ops-1 do
begin
if i=0 then
sep:=#9
else
sep:=',';
s:=s+sep+getopstr(taicpu(hp).oper[i])
end;
AsmWrite('('+gas_reg2str[base]+','+gas_reg2str[index]);
if scalefactor<>0 then
AsmWrite(','+tostr(scalefactor));
AsmWrite(')');
end;
end;
AsmWriteLn(s);
end;
end;
procedure T386AttAssembler.WriteOper(const o:toper);
begin
case o.typ of
top_reg :
AsmWrite(gas_reg2str[o.reg]);
top_ref :
WriteReference(o.ref^);
top_const :
AsmWrite('$'+tostr(longint(o.val)));
top_symbol :
begin
AsmWrite('$');
if assigned(o.sym) then
AsmWrite(o.sym.name);
if o.symofs>0 then
AsmWrite('+'+tostr(o.symofs))
else
if o.symofs<0 then
AsmWrite(tostr(o.symofs))
else
if not(assigned(o.sym)) then
AsmWrite('0');
end;
else
internalerror(10001);
end;
end;
procedure T386AttAssembler.WriteOper_jmp(const o:toper);
begin
case o.typ of
top_reg :
AsmWrite('*'+gas_reg2str[o.reg]);
top_ref :
begin
AsmWrite('*');
WriteReference(o.ref^);
end;
top_const :
AsmWrite(tostr(longint(o.val)));
top_symbol :
begin
AsmWrite(o.sym.name);
if o.symofs>0 then
AsmWrite('+'+tostr(o.symofs))
else
if o.symofs<0 then
AsmWrite(tostr(o.symofs));
end;
else
internalerror(10001);
end;
end;
procedure T386AttAssembler.WriteInstruction(hp: tai);
var
op : tasmop;
calljmp : boolean;
i : integer;
begin
if hp.typ <> ait_instruction then
exit;
taicpu(hp).SetOperandOrder(op_att);
op:=taicpu(hp).opcode;
calljmp:=is_calljmp(op);
{ call maybe not translated to call }
AsmWrite(#9+gas_op2str[op]+cond2str[taicpu(hp).condition]);
{ suffix needed ? fnstsw,fldcw don't support suffixes
with binutils 2.9.5 under linux }
if (not calljmp) and
(gas_needsuffix[op]<>AttSufNONE) and
(op<>A_FNSTSW) and (op<>A_FSTSW) and
(op<>A_FNSTCW) and (op<>A_FSTCW) and
(op<>A_FLDCW) and not(
(taicpu(hp).oper[0].typ=top_reg) and
(taicpu(hp).oper[0].reg in [R_ST..R_ST7])
) then
AsmWrite(gas_opsize2str[taicpu(hp).opsize]);
{ process operands }
if taicpu(hp).ops<>0 then
begin
if calljmp then
begin
AsmWrite(#9);
WriteOper_jmp(taicpu(hp).oper[0]);
end
else
begin
for i:=0 to taicpu(hp).ops-1 do
begin
if i=0 then
AsmWrite(#9)
else
AsmWrite(',');
WriteOper(taicpu(hp).oper[i]);
end;
end;
end;
AsmLn;
end;
{*****************************************************************************
@ -314,7 +303,10 @@ initialization
end.
{
$Log$
Revision 1.26 2002-08-12 15:08:40 carl
Revision 1.27 2002-12-24 18:10:34 peter
* Long symbol names support
Revision 1.26 2002/08/12 15:08:40 carl
+ stab register indexes for powerpc (moved from gdb to cpubase)
+ tprocessor enumeration moved to cpuinfo
+ linker in target_info is now a class

359
compiler/i386/ag386int.pas
View File

@ -29,10 +29,17 @@ unit ag386int;
interface
uses aasmbase,aasmtai,aasmcpu,assemble;
uses
cpubase,
aasmbase,aasmtai,aasmcpu,assemble;
type
T386IntelAssembler = class(TExternalAssembler)
private
procedure WriteReference(var ref : treference);
procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
procedure WriteOper_jmp(const o:toper;s : topsize);
public
procedure WriteTree(p:TAAsmoutput);override;
procedure WriteAsmList;override;
Function DoAssemble:boolean;override;
@ -49,7 +56,7 @@ interface
sysutils,
{$endif}
cutils,globtype,globals,systems,cclasses,
verbose,cpubase,finput,fmodule,script,cpuinfo
verbose,finput,fmodule,script,cpuinfo
;
const
@ -120,157 +127,6 @@ interface
comp2str:=double2str(dd^);
end;
function getreferencestring(var ref : treference) : string;
var
s : string;
first : boolean;
begin
with ref do
begin
first:=true;
inc(offset,offsetfixup);
offsetfixup:=0;
if ref.segment<>R_NO then
s:=std_reg2str[segment]+':['
else
s:='[';
if assigned(symbol) then
begin
if (aktoutputformat = as_i386_tasm) then
s:=s+'dword ptr ';
s:=s+symbol.name;
first:=false;
end;
if (base<>R_NO) then
begin
if not(first) then
s:=s+'+'
else
first:=false;
s:=s+std_reg2str[base];
end;
if (index<>R_NO) then
begin
if not(first) then
s:=s+'+'
else
first:=false;
s:=s+std_reg2str[index];
if scalefactor<>0 then
s:=s+'*'+tostr(scalefactor);
end;
if offset<0 then
s:=s+tostr(offset)
else if (offset>0) then
s:=s+'+'+tostr(offset);
if s[length(s)]='[' then
s:=s+'0';
s:=s+']';
end;
getreferencestring:=s;
end;
function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
var
hs : string;
begin
case o.typ of
top_reg :
getopstr:=std_reg2str[o.reg];
top_const :
getopstr:=tostr(longint(o.val));
top_symbol :
begin
if assigned(o.sym) then
hs:='offset '+o.sym.name
else
hs:='offset ';
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs)
else
if not(assigned(o.sym)) then
hs:=hs+'0';
getopstr:=hs;
end;
top_ref :
begin
hs:=getreferencestring(o.ref^);
if ((opcode <> A_LGS) and (opcode <> A_LSS) and
(opcode <> A_LFS) and (opcode <> A_LDS) and
(opcode <> A_LES)) then
Begin
case s of
S_B : hs:='byte ptr '+hs;
S_W : hs:='word ptr '+hs;
S_L : hs:='dword ptr '+hs;
S_IS : hs:='word ptr '+hs;
S_IL : hs:='dword ptr '+hs;
S_IQ : hs:='qword ptr '+hs;
S_FS : hs:='dword ptr '+hs;
S_FL : hs:='qword ptr '+hs;
S_FX : hs:='tbyte ptr '+hs;
S_BW : if dest then
hs:='word ptr '+hs
else
hs:='byte ptr '+hs;
S_BL : if dest then
hs:='dword ptr '+hs
else
hs:='byte ptr '+hs;
S_WL : if dest then
hs:='dword ptr '+hs
else
hs:='word ptr '+hs;
end;
end;
getopstr:=hs;
end;
else
internalerror(10001);
end;
end;
function getopstr_jmp(const o:toper;s : topsize) : string;
var
hs : string;
begin
case o.typ of
top_reg :
getopstr_jmp:=std_reg2str[o.reg];
top_const :
getopstr_jmp:=tostr(longint(o.val));
top_symbol :
begin
hs:=o.sym.name;
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs);
getopstr_jmp:=hs;
end;
top_ref :
{ what about lcall or ljmp ??? }
begin
if (aktoutputformat = as_i386_tasm) then
hs:=''
else
begin
if s=S_FAR then
hs:='far ptr '
else
hs:='dword ptr ';
end;
getopstr_jmp:=hs+getreferencestring(o.ref^);
end;
else
internalerror(10001);
end;
end;
function fixline(s:string):string;
{
@ -296,6 +152,154 @@ interface
T386IntelAssembler
****************************************************************************}
procedure T386IntelAssembler.WriteReference(var ref : treference);
var
first : boolean;
begin
with ref do
begin
first:=true;
inc(offset,offsetfixup);
offsetfixup:=0;
if ref.segment<>R_NO then
AsmWrite(std_reg2str[segment]+':[')
else
AsmWrite('[');
if assigned(symbol) then
begin
if (aktoutputformat = as_i386_tasm) then
AsmWrite('dword ptr ');
AsmWrite(symbol.name);
first:=false;
end;
if (base<>R_NO) then
begin
if not(first) then
AsmWrite('+')
else
first:=false;
AsmWrite(std_reg2str[base]);
end;
if (index<>R_NO) then
begin
if not(first) then
AsmWrite('+')
else
first:=false;
AsmWrite(std_reg2str[index]);
if scalefactor<>0 then
AsmWrite('*'+tostr(scalefactor));
end;
if offset<0 then
begin
AsmWrite(tostr(offset));
first:=false;
end
else if (offset>0) then
begin
AsmWrite('+'+tostr(offset));
first:=false;
end;
if first then
AsmWrite('0');
AsmWrite(']');
end;
end;
procedure T386IntelAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;dest : boolean);
begin
case o.typ of
top_reg :
AsmWrite(std_reg2str[o.reg]);
top_const :
AsmWrite(tostr(longint(o.val)));
top_symbol :
begin
AsmWrite('offset ');
if assigned(o.sym) then
AsmWrite(o.sym.name);
if o.symofs>0 then
AsmWrite('+'+tostr(o.symofs))
else
if o.symofs<0 then
AsmWrite(tostr(o.symofs))
else
if not(assigned(o.sym)) then
AsmWrite('0');
end;
top_ref :
begin
if ((opcode <> A_LGS) and (opcode <> A_LSS) and
(opcode <> A_LFS) and (opcode <> A_LDS) and
(opcode <> A_LES)) then
Begin
case s of
S_B : AsmWrite('byte ptr ');
S_W : AsmWrite('word ptr ');
S_L : AsmWrite('dword ptr ');
S_IS : AsmWrite('word ptr ');
S_IL : AsmWrite('dword ptr ');
S_IQ : AsmWrite('qword ptr ');
S_FS : AsmWrite('dword ptr ');
S_FL : AsmWrite('qword ptr ');
S_FX : AsmWrite('tbyte ptr ');
S_BW : if dest then
AsmWrite('word ptr ')
else
AsmWrite('byte ptr ');
S_BL : if dest then
AsmWrite('dword ptr ')
else
AsmWrite('byte ptr ');
S_WL : if dest then
AsmWrite('dword ptr ')
else
AsmWrite('word ptr ');
end;
end;
WriteReference(o.ref^);
end;
else
internalerror(10001);
end;
end;
procedure T386IntelAssembler.WriteOper_jmp(const o:toper;s : topsize);
begin
case o.typ of
top_reg :
AsmWrite(std_reg2str[o.reg]);
top_const :
AsmWrite(tostr(longint(o.val)));
top_symbol :
begin
AsmWrite(o.sym.name);
if o.symofs>0 then
AsmWrite('+'+tostr(o.symofs))
else
if o.symofs<0 then
AsmWrite(tostr(o.symofs));
end;
top_ref :
{ what about lcall or ljmp ??? }
begin
if (aktoutputformat <> as_i386_tasm) then
begin
if s=S_FAR then
AsmWrite('far ptr ')
else
AsmWrite('dword ptr ');
end;
WriteReference(o.ref^);
end;
else
internalerror(10001);
end;
end;
var
LasTSec : TSection;
lastfileinfo : tfileposinfo;
@ -342,7 +346,6 @@ interface
found,
do_line,DoNotSplitLine,
quoted : boolean;
sep : char;
begin
if not assigned(p) then
exit;
@ -591,23 +594,21 @@ interface
end;
ait_instruction : begin
taicpu(hp).CheckNonCommutativeOpcodes;
{ We need intel order, no At&t }
taicpu(hp).SetOperandOrder(op_intel);
{ Reset }
{ Reset }
suffix:='';
prefix:= '';
s:='';
{ We need to explicitely set
word prefix to get selectors
to be pushed in 2 bytes PM }
if (taicpu(hp).opsize=S_W) and
((taicpu(hp).opcode=A_PUSH) or
(taicpu(hp).opcode=A_POP)) and
(taicpu(hp).oper[0].typ=top_reg) and
((taicpu(hp).oper[0].reg>=firstsreg) and
(taicpu(hp).oper[0].reg<=lastsreg)) then
AsmWriteln(#9#9'DB'#9'066h');
{ added prefix instructions, must be on same line as opcode }
{ We need to explicitely set
word prefix to get selectors
to be pushed in 2 bytes PM }
if (taicpu(hp).opsize=S_W) and
((taicpu(hp).opcode=A_PUSH) or
(taicpu(hp).opcode=A_POP)) and
(taicpu(hp).oper[0].typ=top_reg) and
((taicpu(hp).oper[0].reg>=firstsreg) and
(taicpu(hp).oper[0].reg<=lastsreg)) then
AsmWriteln(#9#9'DB'#9'066h');
{ added prefix instructions, must be on same line as opcode }
if (taicpu(hp).ops = 0) and
((taicpu(hp).opcode = A_REP) or
(taicpu(hp).opcode = A_LOCK) or
@ -621,8 +622,7 @@ interface
{ this is theorically impossible... }
if hp=nil then
begin
s:=#9#9+prefix;
AsmWriteLn(s);
AsmWriteLn(#9#9+prefix);
break;
end;
{ nasm prefers prefix on a line alone
@ -636,23 +636,27 @@ interface
end
else
prefix:= '';
AsmWrite(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix);
if taicpu(hp).ops<>0 then
begin
if is_calljmp(taicpu(hp).opcode) then
s:=#9+getopstr_jmp(taicpu(hp).oper[0],taicpu(hp).opsize)
begin
AsmWrite(#9);
WriteOper_jmp(taicpu(hp).oper[0],taicpu(hp).opsize);
end
else
begin
for i:=0to taicpu(hp).ops-1 do
begin
if i=0 then
sep:=#9
AsmWrite(#9)
else
sep:=',';
s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
AsmWrite(',');
WriteOper(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,(i=2));
end;
end;
end;
AsmWriteLn(#9#9+prefix+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]+suffix+s);
AsmLn;
end;
{$ifdef GDB}
ait_stabn,
@ -840,7 +844,10 @@ initialization
end.
{
$Log$
Revision 1.30 2002-11-17 16:31:58 carl
Revision 1.31 2002-12-24 18:10:34 peter
* Long symbol names support
Revision 1.30 2002/11/17 16:31:58 carl
* memory optimization (3-4%) : cleanup of tai fields,
cleanup of tdef and tsym fields.
* make it work for m68k

371
compiler/i386/ag386nsm.pas
View File

@ -27,10 +27,17 @@ unit ag386nsm;
interface
uses aasmbase,aasmtai,aasmcpu,assemble;
uses
cpubase,
aasmbase,aasmtai,aasmcpu,assemble;
type
T386NasmAssembler = class(texternalassembler)
private
procedure WriteReference(var ref : treference);
procedure WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean);
procedure WriteOper_jmp(const o:toper; op : tasmop);
public
procedure WriteTree(p:taasmoutput);override;
procedure WriteAsmList;override;
procedure WriteExternals;
@ -45,7 +52,7 @@ interface
sysutils,
{$endif}
cutils,globtype,globals,systems,cclasses,
fmodule,finput,verbose,cpubase,cpuinfo
fmodule,finput,verbose,cpuinfo
;
const
@ -154,54 +161,6 @@ interface
end;
function getreferencestring(var ref : treference) : string;
var
s : string;
first : boolean;
begin
with ref do
begin
first:=true;
inc(offset,offsetfixup);
offsetfixup:=0;
if ref.segment<>R_NO then
s:='['+std_reg2str[segment]+':'
else
s:='[';
if assigned(symbol) then
begin
s:=s+symbol.name;
first:=false;
end;
if (base<>R_NO) then
begin
if not(first) then
s:=s+'+'
else
first:=false;
s:=s+std_reg2str[base];
end;
if (index<>R_NO) then
begin
if not(first) then
s:=s+'+'
else
first:=false;
s:=s+std_reg2str[index];
if scalefactor<>0 then
s:=s+'*'+tostr(scalefactor);
end;
if offset<0 then
s:=s+tostr(offset)
else if (offset>0) then
s:=s+'+'+tostr(offset);
if s[length(s)]='[' then
s:=s+'0';
s:=s+']';
end;
getreferencestring:=s;
end;
function sizestr(s:topsize;dest:boolean):string;
begin
case s of
@ -232,85 +191,23 @@ interface
end;
function getopstr(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean) : string;
Function PadTabs(const p:string;addch:char):string;
var
hs : string;
s : string;
i : longint;
begin
case o.typ of
top_reg :
getopstr:=int_nasmreg2str[o.reg];
top_const :
begin
if (ops=1) and (opcode<>A_RET) then
getopstr:=sizestr(s,dest)+tostr(longint(o.val))
else
getopstr:=tostr(longint(o.val));
end;
top_symbol :
begin
if assigned(o.sym) then
hs:='dword '+o.sym.name
else
hs:='dword ';
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs)
else
if not(assigned(o.sym)) then
hs:=hs+'0';
getopstr:=hs;
end;
top_ref :
begin
hs:=getreferencestring(o.ref^);
if not ((opcode = A_LEA) or (opcode = A_LGS) or
(opcode = A_LSS) or (opcode = A_LFS) or
(opcode = A_LES) or (opcode = A_LDS) or
(opcode = A_SHR) or (opcode = A_SHL) or
(opcode = A_SAR) or (opcode = A_SAL) or
(opcode = A_OUT) or (opcode = A_IN)) then
begin
hs:=sizestr(s,dest)+hs;
end;
getopstr:=hs;
end;
else
internalerror(10001);
end;
end;
function getopstr_jmp(const o:toper; op : tasmop) : string;
var
hs : string;
begin
case o.typ of
top_reg :
getopstr_jmp:=int_nasmreg2str[o.reg];
top_ref :
getopstr_jmp:=getreferencestring(o.ref^);
top_const :
getopstr_jmp:=tostr(longint(o.val));
top_symbol :
begin
hs:=o.sym.name;
if o.symofs>0 then
hs:=hs+'+'+tostr(o.symofs)
else
if o.symofs<0 then
hs:=hs+tostr(o.symofs);
if (op=A_JCXZ) or (op=A_JECXZ) or
(op=A_LOOP) or (op=A_LOOPE) or
(op=A_LOOPNE) or (op=A_LOOPNZ) or
(op=A_LOOPZ) then
getopstr_jmp:=hs
else
getopstr_jmp:='NEAR '+hs;
end;
else
internalerror(10001);
end;
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;
@ -318,6 +215,131 @@ interface
T386NasmAssembler
****************************************************************************}
procedure T386NasmAssembler.WriteReference(var ref : treference);
var
first : boolean;
begin
with ref do
begin
AsmWrite('[');
first:=true;
inc(offset,offsetfixup);
offsetfixup:=0;
if ref.segment<>R_NO then
AsmWrite(std_reg2str[segment]+':');
if assigned(symbol) then
begin
AsmWrite(symbol.name);
first:=false;
end;
if (base<>R_NO) then
begin
if not(first) then
AsmWrite('+')
else
first:=false;
AsmWrite(int_nasmreg2str[base]);
end;
if (index<>R_NO) then
begin
if not(first) then
AsmWrite('+')
else
first:=false;
AsmWrite(int_nasmreg2str[index]);
if scalefactor<>0 then
AsmWrite('*'+tostr(scalefactor));
end;
if offset<0 then
begin
AsmWrite(tostr(offset));
first:=false;
end
else if (offset>0) then
begin
AsmWrite('+'+tostr(offset));
first:=false;
end;
if first then
AsmWrite('0');
AsmWrite(']');
end;
end;
procedure T386NasmAssembler.WriteOper(const o:toper;s : topsize; opcode: tasmop;ops:longint;dest : boolean);
begin
case o.typ of
top_reg :
AsmWrite(int_nasmreg2str[o.reg]);
top_const :
begin
if (ops=1) and (opcode<>A_RET) then
AsmWrite(sizestr(s,dest));
AsmWrite(tostr(longint(o.val)));
end;
top_symbol :
begin
AsmWrite('dword ');
if assigned(o.sym) then
AsmWrite(o.sym.name);
if o.symofs>0 then
AsmWrite('+'+tostr(o.symofs))
else
if o.symofs<0 then
AsmWrite(tostr(o.symofs))
else
if not(assigned(o.sym)) then
AsmWrite('0');
end;
top_ref :
begin
if not ((opcode = A_LEA) or (opcode = A_LGS) or
(opcode = A_LSS) or (opcode = A_LFS) or
(opcode = A_LES) or (opcode = A_LDS) or
(opcode = A_SHR) or (opcode = A_SHL) or
(opcode = A_SAR) or (opcode = A_SAL) or
(opcode = A_OUT) or (opcode = A_IN)) then
AsmWrite(sizestr(s,dest));
WriteReference(o.ref^);
end;
else
internalerror(10001);
end;
end;
procedure T386NasmAssembler.WriteOper_jmp(const o:toper; op : tasmop);
begin
case o.typ of
top_reg :
AsmWrite(int_nasmreg2str[o.reg]);
top_ref :
WriteReference(o.ref^);
top_const :
AsmWrite(tostr(longint(o.val)));
top_symbol :
begin
if not(
(op=A_JCXZ) or (op=A_JECXZ) or
(op=A_LOOP) or (op=A_LOOPE) or
(op=A_LOOPNE) or (op=A_LOOPNZ) or
(op=A_LOOPZ)
) then
AsmWrite('NEAR ');
AsmWrite(o.sym.name);
if o.symofs>0 then
AsmWrite('+'+tostr(o.symofs))
else
if o.symofs<0 then
AsmWrite(tostr(o.symofs));
end;
else
internalerror(10001);
end;
end;
var
LasTSec : TSection;
@ -325,26 +347,6 @@ interface
ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
(#9'DD'#9,#9'DW'#9,#9'DB'#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;
procedure T386NasmAssembler.WriteTree(p:taasmoutput);
const
allocstr : array[boolean] of string[10]=(' released',' allocated');
@ -360,7 +362,6 @@ interface
found,
do_line,
quoted : boolean;
sep : char;
begin
if not assigned(p) then
exit;
@ -375,7 +376,7 @@ interface
if not(hp.typ in SkipLineInfo) then
begin
hp1:=hp as tailineinfo;
hp1:=hp as tailineinfo;
aktfilepos:=hp1.fileinfo;
if do_line then
begin
@ -633,11 +634,8 @@ interface
ait_instruction :
begin
taicpu(hp).CheckNonCommutativeOpcodes;
{ We need intel order, no At&t }
{ We need intel order, no At&t }
taicpu(hp).SetOperandOrder(op_intel);
{ Reset
suffix:='';
prefix:='';}
s:='';
if ((taicpu(hp).opcode=A_FADDP) or
(taicpu(hp).opcode=A_FMULP))
@ -649,38 +647,42 @@ interface
taicpu(hp).oper[1].typ:=top_reg;
taicpu(hp).oper[1].reg:=R_ST;
end;
if taicpu(hp).ops<>0 then
begin
if is_calljmp(taicpu(hp).opcode) then
s:=#9+getopstr_jmp(taicpu(hp).oper[0],taicpu(hp).opcode)
else
begin
{ We need to explicitely set
word prefix to get selectors
to be pushed in 2 bytes PM }
if (taicpu(hp).opsize=S_W) and
((taicpu(hp).opcode=A_PUSH) or
(taicpu(hp).opcode=A_POP)) and
(taicpu(hp).oper[0].typ=top_reg) and
((taicpu(hp).oper[0].reg>=firstsreg) and
(taicpu(hp).oper[0].reg<=lastsreg)) then
AsmWriteln(#9#9'DB'#9'066h');
for i:=0 to taicpu(hp).ops-1 do
begin
if i=0 then
sep:=#9
else
sep:=',';
s:=s+sep+getopstr(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,
taicpu(hp).ops,(i=2));
end;
end;
end;
if taicpu(hp).opcode=A_FWAIT then
AsmWriteln(#9#9'DB'#9'09bh')
else
AsmWriteLn(#9#9+{prefix+}std_op2str[taicpu(hp).opcode]+
cond2str[taicpu(hp).condition]+{suffix+}s);
begin
{ We need to explicitely set
word prefix to get selectors
to be pushed in 2 bytes PM }
if (taicpu(hp).opsize=S_W) and
((taicpu(hp).opcode=A_PUSH) or
(taicpu(hp).opcode=A_POP)) and
(taicpu(hp).oper[0].typ=top_reg) and
((taicpu(hp).oper[0].reg>=firstsreg) and
(taicpu(hp).oper[0].reg<=lastsreg)) then
AsmWriteln(#9#9'DB'#9'066h');
AsmWrite(#9#9+std_op2str[taicpu(hp).opcode]+cond2str[taicpu(hp).condition]);
if taicpu(hp).ops<>0 then
begin
if is_calljmp(taicpu(hp).opcode) then
begin
AsmWrite(#9);
WriteOper_jmp(taicpu(hp).oper[0],taicpu(hp).opcode);
end
else
begin
for i:=0 to taicpu(hp).ops-1 do
begin
if i=0 then
AsmWrite(#9)
else
AsmWrite(',');
WriteOper(taicpu(hp).oper[i],taicpu(hp).opsize,taicpu(hp).opcode,taicpu(hp).ops,(i=2));
end;
end;
end;
AsmLn;
end;
end;
{$ifdef GDB}
ait_stabn,
@ -893,7 +895,10 @@ initialization
end.
{
$Log$
Revision 1.28 2002-11-17 16:31:59 carl
Revision 1.29 2002-12-24 18:10:34 peter
* Long symbol names support
Revision 1.28 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