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

* optimizer working for ag386bin

Browse Source
This commit is contained in:
peter 1999-03-29 16:05:43 +00:00
parent 528383c8c8
commit 0dfd104173
2 changed files with 161 additions and 173 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

152
compiler/ag386int.pas
View File

@ -160,85 +160,87 @@ unit ag386int;
{$ifdef AG386BIN} {$ifdef AG386BIN}
function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string; function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
var var
hs : string; hs : string;
begin begin
if ((t and OT_REGISTER)=OT_REGISTER) or ((t and OT_FPUREG)=OT_FPUREG) then case o.typ of
getopstr:=int_reg2str[tregister(o)] top_reg :
else getopstr:=int_reg2str[o.reg];
if (t and OT_SYMBOL)=OT_SYMBOL then top_const :
begin getopstr:=tostr(o.val);
hs:='offset '+preference(o)^.symbol^.name; top_symbol :
if preference(o)^.offset>0 then begin
hs:=hs+'+'+tostr(preference(o)^.offset) hs:='offset '+o.sym^.name;
else if o.symofs>0 then
if preference(o)^.offset<0 then hs:=hs+'+'+tostr(o.symofs)
hs:=hs+tostr(preference(o)^.offset); else
getopstr:=hs; if o.symofs<0 then
end hs:=hs+tostr(o.symofs);
else getopstr:=hs;
if (t and (OT_IMMEDIATE or OT_MEMORY))<>0 then end;
begin top_ref :
hs:=getreferencestring(preference(o)^); begin
{ can possibly give a range check error under tp } hs:=getreferencestring(o.ref^);
{ if using in... } if ((opcode <> A_LGS) and (opcode <> A_LSS) and
if ((_operator <> A_LGS) and (_operator <> A_LSS) and (opcode <> A_LFS) and (opcode <> A_LDS) and
(_operator <> A_LFS) and (_operator <> A_LDS) and (opcode <> A_LES)) then
(_operator <> A_LES)) then Begin
Begin case s of
case s of S_B : hs:='byte ptr '+hs;
S_B : hs:='byte ptr '+hs; S_W : hs:='word ptr '+hs;
S_W : hs:='word ptr '+hs; S_L : hs:='dword ptr '+hs;
S_L : hs:='dword ptr '+hs; S_IS : hs:='word ptr '+hs;
S_IS : hs:='word ptr '+hs; S_IL : hs:='dword ptr '+hs;
S_IL : hs:='dword ptr '+hs; S_IQ : hs:='qword ptr '+hs;
S_IQ : hs:='qword ptr '+hs; S_FS : hs:='dword ptr '+hs;
S_FS : hs:='dword ptr '+hs; S_FL : hs:='qword ptr '+hs;
S_FL : hs:='qword ptr '+hs; S_FX : hs:='tbyte ptr '+hs;
S_FX : hs:='tbyte ptr '+hs; S_BW : if dest then
S_BW : if dest then hs:='word ptr '+hs
hs:='word ptr '+hs else
else hs:='byte ptr '+hs;
hs:='byte ptr '+hs; S_BL : if dest then
S_BL : if dest then hs:='dword ptr '+hs
hs:='dword ptr '+hs else
else hs:='byte ptr '+hs;
hs:='byte ptr '+hs; S_WL : if dest then
S_WL : if dest then hs:='dword ptr '+hs
hs:='dword ptr '+hs else
else hs:='word ptr '+hs;
hs:='word ptr '+hs; end;
end; end;
end; getopstr:=hs;
getopstr:=hs; end;
end else
else internalerror(10001);
internalerror(10001); end;
end; end;
function getopstr_jmp(t : byte;o : pointer) : string; function getopstr_jmp(const o:toper) : string;
var var
hs : string; hs : string;
begin begin
if ((t and OT_REGISTER)=OT_REGISTER) or ((t and OT_FPUREG)=OT_FPUREG) then case o.typ of
getopstr_jmp:=int_reg2str[tregister(o)] top_reg :
else getopstr_jmp:=int_reg2str[o.reg];
if (t and OT_SYMBOL)=OT_SYMBOL then top_const :
begin getopstr_jmp:=tostr(o.val);
hs:=preference(o)^.symbol^.name; top_symbol :
if preference(o)^.offset>0 then begin
hs:=hs+'+'+tostr(preference(o)^.offset) hs:=o.sym^.name;
else if o.symofs>0 then
if preference(o)^.offset<0 then hs:=hs+'+'+tostr(o.symofs)
hs:=hs+tostr(preference(o)^.offset); else
getopstr_jmp:=hs; if o.symofs<0 then
end hs:=hs+tostr(o.symofs);
else getopstr_jmp:=hs;
if (t and (OT_MEMORY or OT_IMMEDIATE))<>0 then end;
getopstr_jmp:=getreferencestring(preference(o)^) top_ref :
else getopstr_jmp:=getreferencestring(o.ref^);
internalerror(10001); else
internalerror(10001);
end;
end; end;
{$else} {$else}
@ -580,7 +582,7 @@ ait_labeled_instruction : AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]
if pai386(hp)^.ops<>0 then if pai386(hp)^.ops<>0 then
begin begin
if pai386(hp)^.opcode=A_CALL then if pai386(hp)^.opcode=A_CALL then
s:='dword ptr '+getopstr_jmp(pai386(hp)^.opertype[0],pai386(hp)^.oper[0]) s:='dword ptr '+getopstr_jmp(pai386(hp)^.oper[0])
else else
begin begin
for i:=0to pai386(hp)^.ops-1 do for i:=0to pai386(hp)^.ops-1 do
@ -589,8 +591,7 @@ ait_labeled_instruction : AsmWriteLn(#9#9+int_op2str[pai386_labeled(hp)^.opcode]
sep:=#9 sep:=#9
else else
sep:=','; sep:=',';
s:=s+sep+getopstr(pai386(hp)^.opertype[i],pai386(hp)^.oper[i], s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1))
end; end;
end; end;
end end
@ -787,7 +788,10 @@ ait_stab_function_name : ;
end. end.
{ {
$Log$ $Log$
Revision 1.29 1999-03-02 02:56:10 peter Revision 1.30 1999-03-29 16:05:43 peter
* optimizer working for ag386bin
Revision 1.29 1999/03/02 02:56:10 peter
+ stabs support for binary writers + stabs support for binary writers
* more fixes and missing updates from the previous commit :( * more fixes and missing updates from the previous commit :(

182
compiler/ag386nsm.pas
View File

@ -161,86 +161,90 @@ unit ag386nsm;
{$ifdef AG386BIN} {$ifdef AG386BIN}
function getopstr(t : byte;o : pointer;s : topsize; opcode: tasmop;dest : boolean) : string; function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
var var
hs : string; hs : string;
begin begin
if ((t and OT_REGISTER)=OT_REGISTER) or ((t and OT_FPUREG)=OT_FPUREG) then case o.typ of
getopstr:=int_nasmreg2str[tregister(o)] top_reg :
else getopstr:=int_nasmreg2str[o.reg];
if (t and OT_SYMBOL)=OT_SYMBOL then top_const :
begin getopstr:=tostr(o.val);
hs:='dword '+preference(o)^.symbol^.name; top_symbol :
if preference(o)^.offset>0 then begin
hs:=hs+'+'+tostr(preference(o)^.offset) hs:='dword '+o.sym^.name;
else if o.symofs>0 then
if preference(o)^.offset<0 then hs:=hs+'+'+tostr(o.symofs)
hs:=hs+tostr(preference(o)^.offset); else
getopstr:=hs; if o.symofs<0 then
end hs:=hs+tostr(o.symofs);
else getopstr:=hs;
if (t and (OT_IMMEDIATE or OT_MEMORY))<>0 then end;
begin top_ref :
hs:=getreferencestring(preference(o)^); begin
if not ((opcode = A_LEA) or (opcode = A_LGS) or hs:=getreferencestring(o.ref^);
(opcode = A_LSS) or (opcode = A_LFS) or if not ((opcode = A_LEA) or (opcode = A_LGS) or
(opcode = A_LES) or (opcode = A_LDS) or (opcode = A_LSS) or (opcode = A_LFS) or
(opcode = A_SHR) or (opcode = A_SHL) or (opcode = A_LES) or (opcode = A_LDS) or
(opcode = A_SAR) or (opcode = A_SAL) or (opcode = A_SHR) or (opcode = A_SHL) or
(opcode = A_OUT) or (opcode = A_IN)) then (opcode = A_SAR) or (opcode = A_SAL) or
begin (opcode = A_OUT) or (opcode = A_IN)) then
case s of begin
S_B : hs:='byte '+hs; case s of
S_W : hs:='word '+hs; S_B : hs:='byte '+hs;
S_L : hs:='dword '+hs; S_W : hs:='word '+hs;
S_IS : hs:='word '+hs; S_L : hs:='dword '+hs;
S_IL : hs:='dword '+hs; S_IS : hs:='word '+hs;
S_IQ : hs:='qword '+hs; S_IL : hs:='dword '+hs;
S_FS : hs:='dword '+hs; S_IQ : hs:='qword '+hs;
S_FL : hs:='qword '+hs; S_FS : hs:='dword '+hs;
S_FX : hs:='tword '+hs; S_FL : hs:='qword '+hs;
S_BW : if dest then S_FX : hs:='tword '+hs;
hs:='word '+hs S_BW : if dest then
else hs:='word '+hs
hs:='byte '+hs; else
S_BL : if dest then hs:='byte '+hs;
hs:='dword '+hs S_BL : if dest then
else hs:='dword '+hs
hs:='byte '+hs; else
S_WL : if dest then hs:='byte '+hs;
hs:='dword '+hs S_WL : if dest then
else hs:='dword '+hs
hs:='word '+hs; else
end hs:='word '+hs;
end; end
getopstr:=hs; end;
end getopstr:=hs;
else end;
internalerror(10001); else
internalerror(10001);
end;
end; end;
function getopstr_jmp(t : byte;o : pointer) : string; function getopstr_jmp(const o:toper) : string;
var var
hs : string; hs : string;
begin begin
if ((t and OT_REGISTER)=OT_REGISTER) or ((t and OT_FPUREG)=OT_FPUREG) then case o.typ of
getopstr_jmp:=int_nasmreg2str[tregister(o)] top_reg :
else getopstr_jmp:=int_nasmreg2str[o.reg];
if (t and OT_SYMBOL)=OT_SYMBOL then top_ref :
begin getopstr_jmp:=getreferencestring(o.ref^);
hs:=preference(o)^.symbol^.name; top_const :
if preference(o)^.offset>0 then getopstr_jmp:=tostr(o.val);
hs:=hs+'+'+tostr(preference(o)^.offset) top_symbol :
else begin
if preference(o)^.offset<0 then hs:=o.sym^.name;
hs:=hs+tostr(preference(o)^.offset); if o.symofs>0 then
getopstr_jmp:=hs; hs:=hs+'+'+tostr(o.symofs)
end else
else if o.symofs<0 then
if (t and (OT_MEMORY or OT_IMMEDIATE))<>0 then hs:=hs+tostr(o.symofs);
getopstr_jmp:=getreferencestring(preference(o)^) getopstr_jmp:=hs;
else end;
internalerror(10001); else
internalerror(10001);
end;
end; end;
{$else} {$else}
@ -557,7 +561,7 @@ ait_labeled_instruction :
if pai386(hp)^.ops<>0 then if pai386(hp)^.ops<>0 then
begin begin
if pai386(hp)^.opcode=A_CALL then if pai386(hp)^.opcode=A_CALL then
s:=#9+getopstr_jmp(pai386(hp)^.opertype[0],pai386(hp)^.oper[0]) s:=#9+getopstr_jmp(pai386(hp)^.oper[0])
else else
begin begin
for i:=0to pai386(hp)^.ops-1 do for i:=0to pai386(hp)^.ops-1 do
@ -566,35 +570,12 @@ ait_labeled_instruction :
sep:=#9 sep:=#9
else else
sep:=','; sep:=',';
s:=s+sep+getopstr(pai386(hp)^.opertype[i],pai386(hp)^.oper[i], s:=s+sep+getopstr(pai386(hp)^.oper[i],pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1));
pai386(hp)^.opsize,pai386(hp)^.opcode,(i=1))
end; end;
end; end;
end end
else else
begin s:='';
{ check if string instruction }
{ long form, otherwise may give range check errors }
{ in turbo pascal... }
{ if ((pai386(hp)^.opcode = A_CMPS) or
(pai386(hp)^.opcode = A_INS) or
(pai386(hp)^.opcode = A_OUTS) or
(pai386(hp)^.opcode = A_SCAS) or
(pai386(hp)^.opcode = A_STOS) or
(pai386(hp)^.opcode = A_MOVS) or
(pai386(hp)^.opcode = A_LODS) or
(pai386(hp)^.opcode = A_XLAT)) then
Begin
case pai386(hp)^.opsize of
S_B: suffix:='b';
S_W: suffix:='w';
S_L: suffix:='d';
else
Message(assem_f_invalid_suffix_intel);
end;
end; }
s:='';
end;
if pai386(hp)^.opcode=A_FWAIT then if pai386(hp)^.opcode=A_FWAIT then
AsmWriteln(#9#9'DB'#9'09bh') AsmWriteln(#9#9'DB'#9'09bh')
else else
@ -752,7 +733,10 @@ ait_stab_function_name : ;
end. end.
{ {
$Log$ $Log$
Revision 1.24 1999-03-10 13:25:44 pierre Revision 1.25 1999-03-29 16:05:44 peter
* optimizer working for ag386bin
Revision 1.24 1999/03/10 13:25:44 pierre
section order changed to get closer output from coff writer section order changed to get closer output from coff writer
Revision 1.23 1999/03/04 13:55:39 pierre Revision 1.23 1999/03/04 13:55:39 pierre