paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-29 19:21:40 +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

80
compiler/ag386int.pas
View File

@ -160,32 +160,31 @@ 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 :
getopstr:=tostr(o.val);
top_symbol :
begin begin
hs:='offset '+preference(o)^.symbol^.name; hs:='offset '+o.sym^.name;
if preference(o)^.offset>0 then if o.symofs>0 then
hs:=hs+'+'+tostr(preference(o)^.offset) hs:=hs+'+'+tostr(o.symofs)
else else
if preference(o)^.offset<0 then if o.symofs<0 then
hs:=hs+tostr(preference(o)^.offset); hs:=hs+tostr(o.symofs);
getopstr:=hs; getopstr:=hs;
end end;
else top_ref :
if (t and (OT_IMMEDIATE or OT_MEMORY))<>0 then
begin begin
hs:=getreferencestring(preference(o)^); hs:=getreferencestring(o.ref^);
{ can possibly give a range check error under tp } if ((opcode <> A_LGS) and (opcode <> A_LSS) and
{ if using in... } (opcode <> A_LFS) and (opcode <> A_LDS) and
if ((_operator <> A_LGS) and (_operator <> A_LSS) and (opcode <> A_LES)) then
(_operator <> A_LFS) and (_operator <> A_LDS) and
(_operator <> A_LES)) then
Begin Begin
case s of case s of
S_B : hs:='byte ptr '+hs; S_B : hs:='byte ptr '+hs;
@ -212,34 +211,37 @@ unit ag386int;
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 :
getopstr_jmp:=tostr(o.val);
top_symbol :
begin begin
hs:=preference(o)^.symbol^.name; hs:=o.sym^.name;
if preference(o)^.offset>0 then if o.symofs>0 then
hs:=hs+'+'+tostr(preference(o)^.offset) hs:=hs+'+'+tostr(o.symofs)
else else
if preference(o)^.offset<0 then if o.symofs<0 then
hs:=hs+tostr(preference(o)^.offset); hs:=hs+tostr(o.symofs);
getopstr_jmp:=hs; getopstr_jmp:=hs;
end end;
else top_ref :
if (t and (OT_MEMORY or OT_IMMEDIATE))<>0 then getopstr_jmp:=getreferencestring(o.ref^);
getopstr_jmp:=getreferencestring(preference(o)^)
else else
internalerror(10001); 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 :(

94
compiler/ag386nsm.pas
View File

@ -161,27 +161,28 @@ 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 :
getopstr:=tostr(o.val);
top_symbol :
begin begin
hs:='dword '+preference(o)^.symbol^.name; hs:='dword '+o.sym^.name;
if preference(o)^.offset>0 then if o.symofs>0 then
hs:=hs+'+'+tostr(preference(o)^.offset) hs:=hs+'+'+tostr(o.symofs)
else else
if preference(o)^.offset<0 then if o.symofs<0 then
hs:=hs+tostr(preference(o)^.offset); hs:=hs+tostr(o.symofs);
getopstr:=hs; getopstr:=hs;
end end;
else top_ref :
if (t and (OT_IMMEDIATE or OT_MEMORY))<>0 then
begin begin
hs:=getreferencestring(preference(o)^); hs:=getreferencestring(o.ref^);
if not ((opcode = A_LEA) or (opcode = A_LGS) or if not ((opcode = A_LEA) or (opcode = A_LGS) or
(opcode = A_LSS) or (opcode = A_LFS) or (opcode = A_LSS) or (opcode = A_LFS) or
(opcode = A_LES) or (opcode = A_LDS) or (opcode = A_LES) or (opcode = A_LDS) or
@ -214,34 +215,37 @@ unit ag386nsm;
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_nasmreg2str[tregister(o)] top_reg :
else getopstr_jmp:=int_nasmreg2str[o.reg];
if (t and OT_SYMBOL)=OT_SYMBOL then top_ref :
getopstr_jmp:=getreferencestring(o.ref^);
top_const :
getopstr_jmp:=tostr(o.val);
top_symbol :
begin begin
hs:=preference(o)^.symbol^.name; hs:=o.sym^.name;
if preference(o)^.offset>0 then if o.symofs>0 then
hs:=hs+'+'+tostr(preference(o)^.offset) hs:=hs+'+'+tostr(o.symofs)
else else
if preference(o)^.offset<0 then if o.symofs<0 then
hs:=hs+tostr(preference(o)^.offset); hs:=hs+tostr(o.symofs);
getopstr_jmp:=hs; getopstr_jmp:=hs;
end end;
else
if (t and (OT_MEMORY or OT_IMMEDIATE))<>0 then
getopstr_jmp:=getreferencestring(preference(o)^)
else else
internalerror(10001); 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
{ 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:=''; 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