paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-17 07:19:37 +02:00
Code Issues Packages Projects Releases Wiki Activity
87aa88e9b7
fpc/compiler/pass_2.pas
carl 87aa88e9b7 + generic FPC_CHECKPOINTER 
+ first parameter offset in stack now portable
* rename some constants
+ move some cpu stuff to other units
- remove unused constents
* fix stacksize for some targets
* fix generic size problems which depend now on EXTEND_SIZE constant
2002-04-20 21:32:23 +00:00

440 lines
16 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
This unit handles the codegeneration pass
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 pass_2;
{$i defines.inc}
interface
uses
node;
type
tenumflowcontrol = (fc_exit,fc_break,fc_continue);
tflowcontrol = set of tenumflowcontrol;
var
flowcontrol : tflowcontrol;
{ produces assembler for the expression in variable p }
{ and produces an assembler node at the end }
procedure generatecode(var p : tnode);
{ produces the actual code }
function do_secondpass(var p : tnode) : boolean;
procedure secondpass(var p : tnode);
implementation
uses
{$ifdef logsecondpass}
cutils,
{$endif}
globtype,systems,verbose,
cclasses,globals,
symconst,symbase,symtype,symsym,aasm,
pass_1,cpubase,cgbase,regvars,nflw,rgobj;
{*****************************************************************************
SecondPass
*****************************************************************************}
{$ifdef logsecondpass}
procedure logsecond(ht:tnodetype; entry: boolean);
const
secondnames: array[tnodetype] of string[13] =
('add-addn', {addn}
'add-muln', {muln}
'add-subn', {subn}
'moddiv-divn', {divn}
'add-symdifn', {symdifn}
'moddiv-modn', {modn}
'assignment', {assignn}
'load', {loadn}
'nothing-range', {range}
'add-ltn', {ltn}
'add-lten', {lten}
'add-gtn', {gtn}
'add-gten', {gten}
'add-equaln', {equaln}
'add-unequaln', {unequaln}
'in', {inn}
'add-orn', {orn}
'add-xorn', {xorn}
'shlshr-shrn', {shrn}
'shlshr-shln', {shln}
'add-slashn', {slashn}
'add-andn', {andn}
'subscriptn', {subscriptn}
'dderef', {derefn}
'addr', {addrn}
'doubleaddr', {doubleaddrn}
'ordconst', {ordconstn}
'typeconv', {typeconvn}
'calln', {calln}
'nothing-callp', {callparan}
'realconst', {realconstn}
'fixconst', {fixconstn}
'unaryminus', {unaryminusn}
'asm', {asmn}
'vecn', {vecn}
'pointerconst', {pointerconstn}
'stringconst', {stringconstn}
'funcret', {funcretn}
'selfn', {selfn}
'not', {notn}
'inline', {inlinen}
'niln', {niln}
'error', {errorn}
'nothing-typen', {typen}
'hnewn', {hnewn}
'hdisposen', {hdisposen}
'newn', {newn}
'simplenewDISP', {simpledisposen}
'setelement', {setelementn}
'setconst', {setconstn}
'blockn', {blockn}
'statement', {statementn}
'nothing-loopn', {loopn}
'ifn', {ifn}
'breakn', {breakn}
'continuen', {continuen}
'_while_REPEAT', {repeatn}
'_WHILE_repeat', {whilen}
'for', {forn}
'exitn', {exitn}
'with', {withn}
'case', {casen}
'label', {labeln}
'goto', {goton}
'simpleNEWdisp', {simplenewn}
'tryexcept', {tryexceptn}
'raise', {raisen}
'nothing-swtch', {switchesn}
'tryfinally', {tryfinallyn}
'on', {onn}
'is', {isn}
'as', {asn}
'error-caret', {caretn}
'fail', {failn}
'add-startstar', {starstarn}
'procinline', {procinlinen}
'arrayconstruc', {arrayconstructn}
'noth-arrcnstr', {arrayconstructrangen}
'nothing-nothg', {nothingn}
'loadvmt' {loadvmtn}
);
var
p: pchar;
begin
if entry then
p := strpnew('second'+secondnames[ht]+' (entry)')
else
p := strpnew('second'+secondnames[ht]+' (exit)');
exprasmlist.concat(tai_asm_comment.create(p));
end;
{$endif logsecondpass}
procedure secondpass(var p : tnode);
var
oldcodegenerror : boolean;
oldlocalswitches : tlocalswitches;
oldpos : tfileposinfo;
{$ifdef TEMPREGDEBUG}
prevp : pptree;
{$endif TEMPREGDEBUG}
{$ifdef EXTDEBUG}
oldloc : tloc;
{$endif EXTDEBUG}
begin
if not(nf_error in p.flags) then
begin
oldcodegenerror:=codegenerror;
oldlocalswitches:=aktlocalswitches;
oldpos:=aktfilepos;
{$ifdef TEMPREGDEBUG}
testregisters32;
prevp:=curptree;
curptree:=@p;
p^.usableregs:=usablereg32;
{$endif TEMPREGDEBUG}
aktfilepos:=p.fileinfo;
aktlocalswitches:=p.localswitches;
codegenerror:=false;
{$ifdef EXTDEBUG}
oldloc:=p.location.loc;
p.location.loc:=LOC_INVALID;
{$endif EXTDEBUG}
{$ifdef logsecondpass}
logsecond(p.nodetype,true);
{$endif logsecondpass}
p.pass_2;
{$ifdef logsecondpass}
logsecond(p.nodetype,false);
{$endif logsecondpass}
{$ifdef EXTDEBUG}
if (not codegenerror) and
(oldloc<>LOC_INVALID) and
(p.location.loc=LOC_INVALID) then
Comment(V_Fatal,'Location not set in secondpass: '+nodetype2str[p.nodetype]);
{$endif EXTDEBUG}
if codegenerror then
include(p.flags,nf_error);
codegenerror:=codegenerror or oldcodegenerror;
aktlocalswitches:=oldlocalswitches;
aktfilepos:=oldpos;
{$ifdef TEMPREGDEBUG}
curptree:=prevp;
{$endif TEMPREGDEBUG}
{$ifdef EXTTEMPREGDEBUG}
if p.usableregs-usablereg32>p.reallyusedregs then
p.reallyusedregs:=p.usableregs-usablereg32;
if p.reallyusedregs<p.registers32 then
Comment(V_Debug,'registers32 overestimated '+tostr(p^.registers32)+
'>'+tostr(p^.reallyusedregs));
{$endif EXTTEMPREGDEBUG}
end
else
codegenerror:=true;
end;
function do_secondpass(var p : tnode) : boolean;
begin
codegenerror:=false;
if not(nf_error in p.flags) then
secondpass(p);
do_secondpass:=codegenerror;
end;
procedure clearrefs(p : tnamedindexitem);
begin
if (tsym(p).typ=varsym) then
if tvarsym(p).refs>1 then
tvarsym(p).refs:=1;
end;
procedure generatecode(var p : tnode);
begin
rg.cleartempgen;
flowcontrol:=[];
{ when size optimization only count occurrence }
if cs_littlesize in aktglobalswitches then
rg.t_times:=1
else
{ reference for repetition is 100 }
rg.t_times:=100;
{ clear register count }
rg.clearregistercount;
use_esp_stackframe:=false;
symtablestack.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs);
symtablestack.next.foreach_static({$ifdef FPCPROCVAR}@{$endif}clearrefs);
{ firstpass everything }
do_firstpass(p);
{ only do secondpass if there are no errors }
if ErrorCount=0 then
begin
if (cs_regalloc in aktglobalswitches) and
((procinfo^.flags and (pi_uses_asm or pi_uses_exceptions))=0) then
begin
{ can we omit the stack frame ? }
{ conditions:
1. procedure (not main block)
2. no constructor or destructor
3. no call to other procedures
4. no interrupt handler
}
{!!!!!! this doesn work yet, because of problems with
with linux and windows
}
(*
if assigned(aktprocsym) then
begin
if not(assigned(procinfo^._class)) and
not(aktprocdef.proctypeoption in [potype_constructor,potype_destructor]) and
not(po_interrupt in aktprocdef.procoptions) and
((procinfo^.flags and pi_do_call)=0) and
(lexlevel>=normal_function_level) then
begin
{ use ESP as frame pointer }
procinfo^.framepointer:=STACK_POINTER_REG;
use_esp_stackframe:=true;
{ calc parameter distance new }
dec(procinfo^.framepointer_offset,4);
dec(procinfo^.selfpointer_offset,4);
{ is this correct ???}
{ retoffset can be negativ for results in eax !! }
{ the value should be decreased only if positive }
if procinfo^.retoffset>=0 then
dec(procinfo^.retoffset,4);
dec(procinfo^.para_offset,4);
aktprocdef.parast.address_fixup:=procinfo^.para_offset;
end;
end;
*)
end;
{ process register variable stuff (JM) }
assign_regvars(p);
load_regvars(procinfo^.aktentrycode,p);
{ for the i386 it must be done in genexitcode because it has }
{ to add 'fstp' instructions when using fpu regvars and those }
{ must come after the "exitlabel" (JM) }
{$ifndef i386}
cleanup_regvars(procinfo^.aktexitcode);
{$endif i386}
do_secondpass(p);
if assigned(procinfo^.procdef) then
procinfo^.procdef.fpu_used:=p.registersfpu;
end;
procinfo^.aktproccode.concatlist(exprasmlist);
end;
end.
{
$Log$
Revision 1.25 2002-04-20 21:32:24 carl
+ generic FPC_CHECKPOINTER
+ first parameter offset in stack now portable
* rename some constants
+ move some cpu stuff to other units
- remove unused constents
* fix stacksize for some targets
* fix generic size problems which depend now on EXTEND_SIZE constant
Revision 1.24 2002/04/07 13:30:13 carl
- removed unused variable
Revision 1.23 2002/04/02 17:11:29 peter
* tlocation,treference update
* LOC_CONSTANT added for better constant handling
* secondadd splitted in multiple routines
* location_force_reg added for loading a location to a register
of a specified size
* secondassignment parses now first the right and then the left node
(this is compatible with Kylix). This saves a lot of push/pop especially
with string operations
* adapted some routines to use the new cg methods
Revision 1.22 2002/03/31 20:26:35 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
Revision 1.21 2001/11/06 16:39:02 jonas
* moved call to "cleanup_regvars" to cga.pas for i386 because it has
to insert "fstp %st0" instructions after the exit label
Revision 1.20 2001/11/02 22:58:02 peter
* procsym definition rewrite
Revision 1.19 2001/10/25 21:22:35 peter
* calling convention rewrite
Revision 1.18 2001/08/26 13:36:44 florian
* some cg reorganisation
* some PPC updates
Revision 1.17 2001/08/06 21:40:47 peter
* funcret moved from tprocinfo to tprocdef
Revision 1.16 2001/05/09 19:57:07 peter
* check for errorcount after firstpass
Revision 1.15 2001/04/15 09:48:30 peter
* fixed crash in labelnode
* easier detection of goto and label in try blocks
Revision 1.14 2001/04/13 01:22:10 peter
* symtable change to classes
* range check generation and errors fixed, make cycle DEBUG=1 works
* memory leaks fixed
Revision 1.13 2001/04/02 21:20:31 peter
* resulttype rewrite
Revision 1.12 2000/12/25 00:07:27 peter
+ new tlinkedlist class (merge of old tstringqueue,tcontainer and
tlinkedlist objects)
Revision 1.11 2000/11/29 00:30:35 florian
* unused units removed from uses clause
* some changes for widestrings
Revision 1.10 2000/10/31 22:02:49 peter
* symtable splitted, no real code changes
Revision 1.9 2000/10/14 10:14:51 peter
* moehrendorf oct 2000 rewrite
Revision 1.8 2000/09/24 15:06:21 peter
* use defines.inc
Revision 1.7 2000/08/27 16:11:51 peter
* moved some util functions from globals,cobjects to cutils
* splitted files into finput,fmodule
Revision 1.6 2000/08/12 15:34:22 peter
+ usedasmsymbollist to check and reset only the used symbols (merged)
Revision 1.5 2000/08/03 13:17:25 jonas
+ allow regvars to be used inside inlined procs, which required the
following changes:
+ load regvars in genentrycode/free them in genexitcode (cgai386)
* moved all regvar related code to new regvars unit
+ added pregvarinfo type to hcodegen
+ added regvarinfo field to tprocinfo (symdef/symdefh)
* deallocate the regvars of the caller in secondprocinline before
inlining the called procedure and reallocate them afterwards
Revision 1.4 2000/08/03 11:15:42 jonas
- disable regvars for inlined procedures (merged from fixes branch)
Revision 1.3 2000/07/21 15:14:02 jonas
+ added is_addr field for labels, if they are only used for getting the address
(e.g. for io checks) and corresponding getaddrlabel() procedure
Revision 1.2 2000/07/13 11:32:44 michael
+ removed logs
}
Reference in New Issue View Git Blame Copy Permalink