mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-28 19:33:50 +02:00
34e8266af4
* fixed inlining of write()
* switched statementnode left and right parts so the statements are
processed in the correct order when getcopy is used. This is
required for tempnodes
400 lines
14 KiB
ObjectPascal
400 lines
14 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (c) 2000-2002 by Florian Klaempfl
|
|
|
|
This unit implements some basic nodes
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************
|
|
}
|
|
unit ncgbas;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
node,nbas;
|
|
|
|
type
|
|
tcgnothingnode = class(tnothingnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
tcgasmnode = class(tasmnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
tcgstatementnode = class(tstatementnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
tcgblocknode = class(tblocknode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
tcgtempcreatenode = class(ttempcreatenode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
tcgtemprefnode = class(ttemprefnode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
tcgtempdeletenode = class(ttempdeletenode)
|
|
procedure pass_2;override;
|
|
end;
|
|
|
|
implementation
|
|
|
|
uses
|
|
globtype,systems,
|
|
cutils,verbose,globals,
|
|
aasmbase,aasmtai,aasmcpu,symsym,
|
|
cpubase,
|
|
nflw,pass_2,
|
|
cgbase,cgobj,tgobj,rgobj
|
|
;
|
|
|
|
{*****************************************************************************
|
|
TNOTHING
|
|
*****************************************************************************}
|
|
|
|
procedure tcgnothingnode.pass_2;
|
|
begin
|
|
{ avoid an abstract rte }
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TSTATEMENTNODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgstatementnode.pass_2;
|
|
var
|
|
hp : tnode;
|
|
begin
|
|
hp:=self;
|
|
while assigned(hp) do
|
|
begin
|
|
if assigned(tstatementnode(hp).left) then
|
|
begin
|
|
rg.cleartempgen;
|
|
secondpass(tstatementnode(hp).left);
|
|
{ Compiler inserted blocks can return values }
|
|
location_copy(location,tstatementnode(hp).left.location);
|
|
end;
|
|
hp:=tstatementnode(hp).right;
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TASMNODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgasmnode.pass_2;
|
|
|
|
procedure ReLabel(var p:tasmsymbol);
|
|
begin
|
|
if p.defbind = AB_LOCAL then
|
|
begin
|
|
if not assigned(p.altsymbol) then
|
|
objectlibrary.GenerateAltSymbol(p);
|
|
p:=p.altsymbol;
|
|
p.increfs;
|
|
end;
|
|
end;
|
|
|
|
var
|
|
hp,hp2 : tai;
|
|
localfixup,parafixup,
|
|
i : longint;
|
|
skipnode : boolean;
|
|
begin
|
|
if inlining_procedure then
|
|
begin
|
|
objectlibrary.CreateUsedAsmSymbolList;
|
|
localfixup:=aktprocdef.localst.address_fixup;
|
|
parafixup:=aktprocdef.parast.address_fixup;
|
|
hp:=tai(p_asm.first);
|
|
while assigned(hp) do
|
|
begin
|
|
hp2:=tai(hp.getcopy);
|
|
skipnode:=false;
|
|
case hp2.typ of
|
|
ait_label :
|
|
begin
|
|
{ regenerate the labels by setting altsymbol }
|
|
ReLabel(tasmsymbol(tai_label(hp2).l));
|
|
end;
|
|
ait_const_rva,
|
|
ait_const_symbol :
|
|
begin
|
|
ReLabel(tai_const_symbol(hp2).sym);
|
|
end;
|
|
ait_instruction :
|
|
begin
|
|
{ remove cached insentry, because the new code can
|
|
require an other less optimized instruction }
|
|
{$ifdef i386}
|
|
{$ifndef NOAG386BIN}
|
|
taicpu(hp2).ResetPass1;
|
|
{$endif}
|
|
{$endif}
|
|
{ fixup the references }
|
|
for i:=1 to taicpu(hp2).ops do
|
|
begin
|
|
with taicpu(hp2).oper[i-1] do
|
|
begin
|
|
case typ of
|
|
top_ref :
|
|
begin
|
|
case ref^.options of
|
|
ref_parafixup :
|
|
ref^.offsetfixup:=parafixup;
|
|
ref_localfixup :
|
|
ref^.offsetfixup:=localfixup;
|
|
end;
|
|
if assigned(ref^.symbol) then
|
|
ReLabel(ref^.symbol);
|
|
end;
|
|
top_symbol :
|
|
begin
|
|
ReLabel(sym);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
ait_marker :
|
|
begin
|
|
{ it's not an assembler block anymore }
|
|
if (tai_marker(hp2).kind in [AsmBlockStart, AsmBlockEnd]) then
|
|
skipnode:=true;
|
|
end;
|
|
else
|
|
end;
|
|
if not skipnode then
|
|
exprasmList.concat(hp2)
|
|
else
|
|
hp2.free;
|
|
hp:=tai(hp.next);
|
|
end;
|
|
{ restore used symbols }
|
|
objectlibrary.UsedAsmSymbolListResetAltSym;
|
|
objectlibrary.DestroyUsedAsmSymbolList;
|
|
end
|
|
else
|
|
begin
|
|
{ if the routine is an inline routine, then we must hold a copy
|
|
because it can be necessary for inlining later }
|
|
if (aktprocdef.proccalloption=pocall_inline) then
|
|
exprasmList.concatlistcopy(p_asm)
|
|
else
|
|
exprasmList.concatlist(p_asm);
|
|
end;
|
|
if not (nf_object_preserved in flags) then
|
|
cg.g_maybe_loadself(exprasmlist);
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TBLOCKNODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgblocknode.pass_2;
|
|
begin
|
|
{ do second pass on left node }
|
|
if assigned(left) then
|
|
begin
|
|
secondpass(left);
|
|
{ Compiler inserted blocks can return values }
|
|
location_copy(location,left.location);
|
|
end;
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
TTEMPCREATENODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgtempcreatenode.pass_2;
|
|
var
|
|
temptype : ttemptype;
|
|
begin
|
|
{ if we're secondpassing the same tcgtempcreatenode twice, we have a bug }
|
|
if tempinfo^.valid then
|
|
internalerror(200108222);
|
|
|
|
{ get a (persistent) temp }
|
|
if persistent then
|
|
temptype:=tt_persistant
|
|
else
|
|
temptype:=tt_normal;
|
|
tg.GetTemp(exprasmlist,size,temptype,tempinfo^.ref);
|
|
tempinfo^.valid := true;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TTEMPREFNODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgtemprefnode.pass_2;
|
|
begin
|
|
{ check if the temp is valid }
|
|
if not tempinfo^.valid then
|
|
internalerror(200108231);
|
|
{ set the temp's location }
|
|
location_reset(location,LOC_REFERENCE,def_cgsize(tempinfo^.restype.def));
|
|
location.reference := tempinfo^.ref;
|
|
inc(location.reference.offset,offset);
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
TTEMPDELETENODE
|
|
*****************************************************************************}
|
|
|
|
procedure tcgtempdeletenode.pass_2;
|
|
begin
|
|
if release_to_normal then
|
|
tg.ChangeTempType(exprasmlist,tempinfo^.ref,tt_normal)
|
|
else
|
|
tg.UnGetTemp(exprasmlist,tempinfo^.ref);
|
|
end;
|
|
|
|
|
|
begin
|
|
cnothingnode:=tcgnothingnode;
|
|
casmnode:=tcgasmnode;
|
|
cstatementnode:=tcgstatementnode;
|
|
cblocknode:=tcgblocknode;
|
|
ctempcreatenode:=tcgtempcreatenode;
|
|
ctemprefnode:=tcgtemprefnode;
|
|
ctempdeletenode:=tcgtempdeletenode;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.27 2002-11-27 02:37:13 peter
|
|
* case statement inlining added
|
|
* fixed inlining of write()
|
|
* switched statementnode left and right parts so the statements are
|
|
processed in the correct order when getcopy is used. This is
|
|
required for tempnodes
|
|
|
|
Revision 1.26 2002/11/17 16:31:56 carl
|
|
* memory optimization (3-4%) : cleanup of tai fields,
|
|
cleanup of tdef and tsym fields.
|
|
* make it work for m68k
|
|
|
|
Revision 1.25 2002/11/15 16:29:30 peter
|
|
* made tasmsymbol.refs private (merged)
|
|
|
|
Revision 1.24 2002/11/15 01:58:51 peter
|
|
* merged changes from 1.0.7 up to 04-11
|
|
- -V option for generating bug report tracing
|
|
- more tracing for option parsing
|
|
- errors for cdecl and high()
|
|
- win32 import stabs
|
|
- win32 records<=8 are returned in eax:edx (turned off by default)
|
|
- heaptrc update
|
|
- more info for temp management in .s file with EXTDEBUG
|
|
|
|
Revision 1.23 2002/08/23 16:14:48 peter
|
|
* tempgen cleanup
|
|
* tt_noreuse temp type added that will be used in genentrycode
|
|
|
|
Revision 1.22 2002/08/11 14:32:26 peter
|
|
* renamed current_library to objectlibrary
|
|
|
|
Revision 1.21 2002/08/11 13:24:11 peter
|
|
* saving of asmsymbols in ppu supported
|
|
* asmsymbollist global is removed and moved into a new class
|
|
tasmlibrarydata that will hold the info of a .a file which
|
|
corresponds with a single module. Added librarydata to tmodule
|
|
to keep the library info stored for the module. In the future the
|
|
objectfiles will also be stored to the tasmlibrarydata class
|
|
* all getlabel/newasmsymbol and friends are moved to the new class
|
|
|
|
Revision 1.20 2002/07/01 18:46:22 peter
|
|
* internal linker
|
|
* reorganized aasm layer
|
|
|
|
Revision 1.19 2002/05/18 13:34:09 peter
|
|
* readded missing revisions
|
|
|
|
Revision 1.18 2002/05/16 19:46:37 carl
|
|
+ defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
|
|
+ try to fix temp allocation (still in ifdef)
|
|
+ generic constructor calls
|
|
+ start of tassembler / tmodulebase class cleanup
|
|
|
|
Revision 1.16 2002/05/13 19:54:37 peter
|
|
* removed n386ld and n386util units
|
|
* maybe_save/maybe_restore added instead of the old maybe_push
|
|
|
|
Revision 1.15 2002/05/12 16:53:07 peter
|
|
* moved entry and exitcode to ncgutil and cgobj
|
|
* foreach gets extra argument for passing local data to the
|
|
iterator function
|
|
* -CR checks also class typecasts at runtime by changing them
|
|
into as
|
|
* fixed compiler to cycle with the -CR option
|
|
* fixed stabs with elf writer, finally the global variables can
|
|
be watched
|
|
* removed a lot of routines from cga unit and replaced them by
|
|
calls to cgobj
|
|
* u32bit-s32bit updates for and,or,xor nodes. When one element is
|
|
u32bit then the other is typecasted also to u32bit without giving
|
|
a rangecheck warning/error.
|
|
* fixed pascal calling method with reversing also the high tree in
|
|
the parast, detected by tcalcst3 test
|
|
|
|
Revision 1.14 2002/04/23 19:16:34 peter
|
|
* add pinline unit that inserts compiler supported functions using
|
|
one or more statements
|
|
* moved finalize and setlength from ninl to pinline
|
|
|
|
Revision 1.13 2002/04/21 19:02:03 peter
|
|
* removed newn and disposen nodes, the code is now directly
|
|
inlined from pexpr
|
|
* -an option that will write the secondpass nodes to the .s file, this
|
|
requires EXTDEBUG define to actually write the info
|
|
* fixed various internal errors and crashes due recent code changes
|
|
|
|
Revision 1.12 2002/04/04 19:05:57 peter
|
|
* removed unused units
|
|
* use tlocation.size in cg.a_*loc*() routines
|
|
|
|
Revision 1.11 2002/03/31 20:26:34 jonas
|
|
+ a_loadfpu_* and a_loadmm_* methods in tcg
|
|
* register allocation is now handled by a class and is mostly processor
|
|
independent (+rgobj.pas and i386/rgcpu.pas)
|
|
* temp allocation is now handled by a class (+tgobj.pas, -i386\tgcpu.pas)
|
|
* some small improvements and fixes to the optimizer
|
|
* some register allocation fixes
|
|
* some fpuvaroffset fixes in the unary minus node
|
|
* push/popusedregisters is now called rg.save/restoreusedregisters and
|
|
(for i386) uses temps instead of push/pop's when using -Op3 (that code is
|
|
also better optimizable)
|
|
* fixed and optimized register saving/restoring for new/dispose nodes
|
|
* LOC_FPU locations now also require their "register" field to be set to
|
|
R_ST, not R_ST0 (the latter is used for LOC_CFPUREGISTER locations only)
|
|
- list field removed of the tnode class because it's not used currently
|
|
and can cause hard-to-find bugs
|
|
|
|
}
|