paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-27 12:13:48 +02:00
Code Issues Packages Projects Releases Wiki Activity
4dcd96747e
fpc/compiler/ncgflw.pas
peter 4dcd96747e * 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
2002-05-12 16:53:04 +00:00

731 lines
25 KiB
ObjectPascal
Raw Blame History

{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Generate assembler for nodes that influence the flow which are
the same for all (most?) processors
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 ncgflw;
{$i defines.inc}
interface
uses
node,nflw;
type
tcgwhilerepeatnode = class(twhilerepeatnode)
procedure pass_2;override;
end;
tcgifnode = class(tifnode)
procedure pass_2;override;
end;
tcgfornode = class(tfornode)
procedure pass_2;override;
end;
tcgexitnode = class(texitnode)
procedure pass_2;override;
end;
tcgbreaknode = class(tbreaknode)
procedure pass_2;override;
end;
tcgcontinuenode = class(tcontinuenode)
procedure pass_2;override;
end;
tcggotonode = class(tgotonode)
procedure pass_2;override;
end;
tcglabelnode = class(tlabelnode)
procedure pass_2;override;
end;
implementation
uses
verbose,globals,systems,globtype,
symconst,symdef,symsym,aasm,types,
cginfo,cgbase,pass_2,
cpubase,cpuasm,cpuinfo,
nld,ncon,
tgobj,rgobj,
ncgutil,
regvars,cgobj,cgcpu,cg64f32;
{*****************************************************************************
Second_While_RepeatN
*****************************************************************************}
procedure tcgwhilerepeatnode.pass_2;
var
lcont,lbreak,lloop,
oldclabel,oldblabel : tasmlabel;
otlabel,oflabel : tasmlabel;
begin
getlabel(lloop);
getlabel(lcont);
getlabel(lbreak);
{ arrange continue and breaklabels: }
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
load_all_regvars(exprasmlist);
{ handling code at the end as it is much more efficient, and makes
while equal to repeat loop, only the end true/false is swapped (PFV) }
if nodetype=whilen then
cg.a_jmp_always(exprasmlist,lcont);
{ align loop target }
exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
cg.a_label(exprasmlist,lloop);
aktcontinuelabel:=lcont;
aktbreaklabel:=lbreak;
rg.cleartempgen;
if assigned(right) then
secondpass(right);
load_all_regvars(exprasmlist);
cg.a_label(exprasmlist,lcont);
otlabel:=truelabel;
oflabel:=falselabel;
if nodetype=whilen then
begin
truelabel:=lloop;
falselabel:=lbreak;
end
{ repeatn }
else
begin
truelabel:=lbreak;
falselabel:=lloop;
end;
rg.cleartempgen;
secondpass(left);
maketojumpbool(exprasmlist,left,lr_load_regvars);
cg.a_label(exprasmlist,lbreak);
truelabel:=otlabel;
falselabel:=oflabel;
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a while/repeat block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
end;
{*****************************************************************************
tcgIFNODE
*****************************************************************************}
procedure tcgifnode.pass_2;
var
hl,otlabel,oflabel : tasmlabel;
org_regvar_loaded,
then_regvar_loaded,
else_regvar_loaded : regvar_booleanarray;
org_list,
then_list,
else_list : taasmoutput;
begin
otlabel:=truelabel;
oflabel:=falselabel;
getlabel(truelabel);
getlabel(falselabel);
rg.cleartempgen;
secondpass(left);
{ save regvars loaded in the beginning so that we can restore them }
{ when processing the else-block }
if cs_regalloc in aktglobalswitches then
begin
org_list := exprasmlist;
exprasmlist := taasmoutput.create;
end;
maketojumpbool(exprasmlist,left,lr_dont_load_regvars);
if cs_regalloc in aktglobalswitches then
org_regvar_loaded := rg.regvar_loaded;
if assigned(right) then
begin
cg.a_label(exprasmlist,truelabel);
rg.cleartempgen;
secondpass(right);
end;
{ save current asmlist (previous instructions + then-block) and }
{ loaded regvar state and create new clean ones }
if cs_regalloc in aktglobalswitches then
begin
then_regvar_loaded := rg.regvar_loaded;
rg.regvar_loaded := org_regvar_loaded;
then_list := exprasmlist;
exprasmlist := taasmoutput.create;
end;
if assigned(t1) then
begin
if assigned(right) then
begin
getlabel(hl);
{ do go back to if line !! }
if not(cs_regalloc in aktglobalswitches) then
aktfilepos:=exprasmList.getlasttaifilepos^
else
aktfilepos:=then_list.getlasttaifilepos^;
cg.a_jmp_always(exprasmlist,hl);
end;
cg.a_label(exprasmlist,falselabel);
rg.cleartempgen;
secondpass(t1);
{ save current asmlist (previous instructions + else-block) }
{ and loaded regvar state and create a new clean list }
if cs_regalloc in aktglobalswitches then
begin
else_regvar_loaded := rg.regvar_loaded;
else_list := exprasmlist;
exprasmlist := taasmoutput.create;
end;
if assigned(right) then
cg.a_label(exprasmlist,hl);
end
else
begin
if cs_regalloc in aktglobalswitches then
begin
else_regvar_loaded := rg.regvar_loaded;
else_list := exprasmlist;
exprasmlist := taasmoutput.create;
end;
cg.a_label(exprasmlist,falselabel);
end;
if not(assigned(right)) then
begin
cg.a_label(exprasmlist,truelabel);
end;
if cs_regalloc in aktglobalswitches then
begin
{ add loads of regvars at the end of the then- and else-blocks }
{ so that at the end of both blocks the same regvars are loaded }
{ no else block? }
if not assigned(t1) then
sync_regvars(org_list,then_list,org_regvar_loaded,
then_regvar_loaded)
{ no then block? }
else if not assigned(right) then
sync_regvars(org_list,else_list,org_regvar_loaded,
else_regvar_loaded)
{ both else and then blocks }
else
sync_regvars(then_list,else_list,then_regvar_loaded,
else_regvar_loaded);
{ add all lists together }
org_list.concatlist(then_list);
then_list.free;
org_list.concatlist(else_list);
else_list.free;
org_list.concatlist(exprasmlist);
exprasmlist.free;
exprasmlist := org_list;
end;
truelabel:=otlabel;
falselabel:=oflabel;
end;
{*****************************************************************************
SecondFor
*****************************************************************************}
procedure tcgfornode.pass_2;
var
l3,oldclabel,oldblabel : tasmlabel;
omitfirstcomp,temptovalue : boolean;
hs : byte;
temp1 : treference;
hop : topcg;
hcond : topcmp;
opsize : tcgsize;
count_var_is_signed : boolean;
begin
oldclabel:=aktcontinuelabel;
oldblabel:=aktbreaklabel;
getlabel(aktcontinuelabel);
getlabel(aktbreaklabel);
getlabel(l3);
{ could we spare the first comparison ? }
omitfirstcomp:=false;
if right.nodetype=ordconstn then
if tassignmentnode(left).right.nodetype=ordconstn then
omitfirstcomp:=((nf_backward in flags) and
(tordconstnode(tassignmentnode(left).right).value>=tordconstnode(right).value))
or (not(nf_backward in flags) and
(tordconstnode(tassignmentnode(left).right).value<=tordconstnode(right).value));
{ only calculate reference }
rg.cleartempgen;
secondpass(t2);
hs := t2.resulttype.def.size;
opsize := def_cgsize(t2.resulttype.def);
{ first set the to value
because the count var can be in the expression !! }
rg.cleartempgen;
secondpass(right);
{ calculate pointer value and check if changeable and if so }
{ load into temporary variable }
if right.nodetype<>ordconstn then
begin
temp1.symbol:=nil;
tg.gettempofsizereference(exprasmlist,hs,temp1);
temptovalue:=true;
if (right.location.loc=LOC_REGISTER) or
(right.location.loc=LOC_CREGISTER) then
begin
cg.a_load_reg_ref(exprasmlist,opsize,
right.location.register,temp1);
rg.ungetregister(exprasmlist,right.location.register);
end
else
cg.g_concatcopy(exprasmlist,right.location.reference,temp1,
hs,true,false);
end
else
temptovalue:=false;
{ produce start assignment }
rg.cleartempgen;
secondpass(left);
count_var_is_signed:=is_signed(t2.resulttype.def);
if nf_backward in flags then
if count_var_is_signed then
hcond:=OC_LT
else
hcond:=OC_B
else
if count_var_is_signed then
hcond:=OC_GT
else
hcond:=OC_A;
load_all_regvars(exprasmlist);
if temptovalue then
begin
cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,
temp1,t2.location,aktbreaklabel);
end
else
begin
if not(omitfirstcomp) then
begin
cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
aword(tordconstnode(right).value),
t2.location,aktbreaklabel);
end;
end;
{ align loop target }
exprasmList.concat(Tai_align.Create(aktalignment.loopalign));
cg.a_label(exprasmlist,l3);
{ help register must not be in instruction block }
rg.cleartempgen;
if assigned(t1) then
begin
secondpass(t1);
load_all_regvars(exprasmlist);
end;
cg.a_label(exprasmlist,aktcontinuelabel);
{ makes no problems there }
rg.cleartempgen;
if nf_backward in flags then
if count_var_is_signed then
hcond:=OC_LTE
else
hcond:=OC_BE
else
if count_var_is_signed then
hcond:=OC_GTE
else
hcond:=OC_AE;
load_all_regvars(exprasmlist);
{ produce comparison and the corresponding }
{ jump }
if temptovalue then
begin
cg.a_cmp_ref_loc_label(exprasmlist,opsize,hcond,temp1,
t2.location,aktbreaklabel);
end
else
begin
cg.a_cmp_const_loc_label(exprasmlist,opsize,hcond,
aword(tordconstnode(right).value),t2.location,aktbreaklabel);
end;
{ according to count direction DEC or INC... }
{ must be after the test because of 0 to 255 for bytes !! }
if nf_backward in flags then
hop:=OP_SUB
else
hop:=OP_ADD;
cg.a_op_const_loc(exprasmlist,hop,1,t2.location);
cg.a_jmp_always(exprasmlist,l3);
if temptovalue then
tg.ungetiftemp(exprasmlist,temp1);
{ this is the break label: }
cg.a_label(exprasmlist,aktbreaklabel);
aktcontinuelabel:=oldclabel;
aktbreaklabel:=oldblabel;
{ a break/continue in a for block can't be seen outside }
flowcontrol:=flowcontrol-[fc_break,fc_continue];
end;
{*****************************************************************************
SecondExitN
*****************************************************************************}
procedure tcgexitnode.pass_2;
var
{op : tasmop;
s : topsize;}
otlabel,oflabel : tasmlabel;
cgsize : tcgsize;
hreg : tregister;
allocated_acc,
allocated_acchigh: boolean;
label
do_jmp;
begin
{ load_all_regvars(exprasmlist); }
include(flowcontrol,fc_exit);
if assigned(left) then
if left.nodetype=assignn then
begin
{ just do a normal assignment followed by exit }
secondpass(left);
cg.a_jmp_always(exprasmlist,aktexitlabel);
end
else
begin
allocated_acc := false;
allocated_acchigh := false;
otlabel:=truelabel;
oflabel:=falselabel;
getlabel(truelabel);
getlabel(falselabel);
secondpass(left);
{ the result of left is not needed anymore after this
node }
location_freetemp(exprasmlist,left.location);
location_release(exprasmlist,left.location);
case left.location.loc of
LOC_FPUREGISTER :
goto do_jmp;
LOC_FLAGS :
begin
cg.a_reg_alloc(exprasmlist,accumulator);
allocated_acc := true;
cg.g_flags2reg(exprasmlist,left.location.resflags,accumulator);
goto do_jmp;
end;
LOC_JUMP :
begin
cg.a_reg_alloc(exprasmlist,accumulator);
{ get an 8-bit register }
hreg:=rg.makeregsize(accumulator,OS_8);
allocated_acc := true;
cg.a_label(exprasmlist,truelabel);
cg.a_load_const_reg(exprasmlist,OS_8,1,hreg);
cg.a_jmp_always(exprasmlist,aktexit2label);
cg.a_label(exprasmlist,falselabel);
cg.a_load_const_reg(exprasmlist,OS_8,0,hreg);
goto do_jmp;
end;
end;
case aktprocdef.rettype.def.deftype of
pointerdef,
procvardef :
begin
cg.a_reg_alloc(exprasmlist,accumulator);
allocated_acc := true;
cg.a_load_loc_reg(exprasmlist,left.location,accumulator);
end;
floatdef :
begin
{$ifndef i386}
cg.a_reg_alloc(exprasmlist,fpuresultreg);
{$endif not i386}
cg.a_loadfpu_loc_reg(exprasmlist,left.location,fpuresultreg);
end;
else
begin
cgsize:=def_cgsize(aktprocdef.rettype.def);
cg.a_reg_alloc(exprasmlist,accumulator);
allocated_acc := true;
case cgsize of
OS_64,OS_S64 :
begin
cg.a_reg_alloc(exprasmlist,accumulatorhigh);
allocated_acchigh := true;
tcg64f32(cg).a_load64_loc_reg(exprasmlist,left.location,
accumulator,accumulatorhigh);
end
else
begin
hreg:=rg.makeregsize(accumulator,cgsize);
cg.a_load_loc_reg(exprasmlist,left.location,hreg);
end;
end;
end;
end;
do_jmp:
truelabel:=otlabel;
falselabel:=oflabel;
cg.a_jmp_always(exprasmlist,aktexit2label);
if allocated_acc then
cg.a_reg_dealloc(exprasmlist,accumulator);
if allocated_acchigh then
cg.a_reg_dealloc(exprasmlist,accumulatorhigh);
{$ifndef i386}
if (aktprocdef.rettype.def.deftype = floatdef) then
cg.a_reg_dealloc(exprasmlist,fpuresultreg);
{$endif not i386}
end
else
cg.a_jmp_always(exprasmlist,aktexitlabel);
end;
{*****************************************************************************
SecondBreakN
*****************************************************************************}
procedure tcgbreaknode.pass_2;
begin
include(flowcontrol,fc_break);
if aktbreaklabel<>nil then
begin
load_all_regvars(exprasmlist);
cg.a_jmp_always(exprasmlist,aktbreaklabel)
end
else
CGMessage(cg_e_break_not_allowed);
end;
{*****************************************************************************
SecondContinueN
*****************************************************************************}
procedure tcgcontinuenode.pass_2;
begin
include(flowcontrol,fc_continue);
if aktcontinuelabel<>nil then
begin
load_all_regvars(exprasmlist);
cg.a_jmp_always(exprasmlist,aktcontinuelabel)
end
else
CGMessage(cg_e_continue_not_allowed);
end;
{*****************************************************************************
SecondGoto
*****************************************************************************}
procedure tcggotonode.pass_2;
begin
load_all_regvars(exprasmlist);
cg.a_jmp_always(exprasmlist,labelnr)
end;
{*****************************************************************************
SecondLabel
*****************************************************************************}
procedure tcglabelnode.pass_2;
begin
load_all_regvars(exprasmlist);
cg.a_label(exprasmlist,labelnr);
rg.cleartempgen;
secondpass(left);
end;
begin
cwhilerepeatnode:=tcgwhilerepeatnode;
cifnode:=tcgifnode;
cfornode:=tcgfornode;
cexitnode:=tcgexitnode;
cbreaknode:=tcgbreaknode;
ccontinuenode:=tcgcontinuenode;
cgotonode:=tcggotonode;
clabelnode:=tcglabelnode;
end.
{
$Log$
Revision 1.14 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.13 2002/04/21 15:24:38 carl
+ a_jmp_cond -> a_jmp_always (a_jmp_cond is NOT portable)
+ changeregsize -> rg.makeregsize
Revision 1.12 2002/04/15 19:44:19 peter
* fixed stackcheck that would be called recursively when a stack
error was found
* generic changeregsize(reg,size) for i386 register resizing
* removed some more routines from cga unit
* fixed returnvalue handling
* fixed default stacksize of linux and go32v2, 8kb was a bit small :-)
Revision 1.11 2002/04/04 19:05:57 peter
* removed unused units
* use tlocation.size in cg.a_*loc*() routines
Revision 1.10 2002/04/02 17:11:28 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.9 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
Revision 1.8 2002/03/04 19:10:11 peter
* removed compiler warnings
Revision 1.7 2001/12/30 17:24:48 jonas
* range checking is now processor independent (part in cgobj,
part in cg64f32) and should work correctly again (it needed
some changes after the changes of the low and high of
tordef's to int64)
* maketojumpbool() is now processor independent (in ncgutil)
* getregister32 is now called getregisterint
Revision 1.6 2001/12/29 15:28:57 jonas
* powerpc/cgcpu.pas compiles :)
* several powerpc-related fixes
* cpuasm unit is now based on common tainst unit
+ nppcmat unit for powerpc (almost complete)
Revision 1.4 2001/11/02 22:58:01 peter
* procsym definition rewrite
Revision 1.3 2001/10/04 14:33:28 jonas
* fixed range check errors
Revision 1.2 2001/09/30 16:19:58 jonas
- removed unused units
Revision 1.1 2001/09/28 20:39:33 jonas
* changed all flow control structures (except for exception handling
related things) to processor independent code (in new ncgflw unit)
+ generic cgobj unit which contains lots of code generator helpers with
global "cg" class instance variable
+ cgcpu unit for i386 (implements processor specific routines of the above
unit)
* updated cgbase and cpubase for the new code generator units
* include ncgflw unit in cpunode unit
Revision 1.4 2001/09/09 17:10:25 jonas
* some more things implemented
Revision 1.3 2001/09/06 15:25:55 jonas
* changed type of tcg from object to class -> abstract methods are now
a lot cleaner :)
+ more updates: load_*_loc methods, op_*_* methods, g_flags2reg method
(if possible with geenric implementation and necessary ppc
implementations)
* worked a bit further on cgflw, now working on exitnode
Revision 1.2 2001/09/05 20:21:03 jonas
* new cgflow based on n386flw with all nodes until forn "translated"
+ a_cmp_*_loc_label methods for tcg
+ base implementatino for a_cmp_ref_*_label methods
* small bugfixes to powerpc cg
}
Reference in New Issue View Git Blame Copy Permalink