mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-17 07:19:14 +02:00
* initial release
This commit is contained in:
florian
parent
f72f5c636a
commit
8e1a4890a1
1298
compiler/nadd.pas
Normal file
1298
compiler/nadd.pas
Normal file
File diff suppressed because it is too large
Load Diff
332
compiler/node.inc
Normal file
332
compiler/node.inc
Normal file
@ -0,0 +1,332 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1999-2000 by Florian Klaempfl
|
||||
|
||||
The implementation of the abstract 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.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
|
||||
{****************************************************************************
|
||||
TNODE
|
||||
****************************************************************************}
|
||||
|
||||
constructor tnode.init(tt : tnodetype);
|
||||
|
||||
begin
|
||||
inherited init;
|
||||
treetype:=tt;
|
||||
{ this allows easier error tracing }
|
||||
location.loc:=LOC_INVALID;
|
||||
{ save local info }
|
||||
fileinfo:=aktfilepos;
|
||||
localswitches:=aktlocalswitches;
|
||||
resulttype:=nil;
|
||||
registersint:=0;
|
||||
registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
flags:=[];
|
||||
end;
|
||||
|
||||
destructor tnode.done;
|
||||
|
||||
begin
|
||||
{ reference info }
|
||||
if (location.loc in [LOC_MEM,LOC_REFERENCE]) and
|
||||
assigned(location.reference.symbol) then
|
||||
dispose(location.reference.symbol,done);
|
||||
{$ifdef EXTDEBUG}
|
||||
if firstpasscount>maxfirstpasscount then
|
||||
maxfirstpasscount:=firstpasscount;
|
||||
{$endif EXTDEBUG}
|
||||
end;
|
||||
|
||||
procedure tnode.pass_1;
|
||||
|
||||
begin
|
||||
if not(assigned(resulttype)) then
|
||||
det_resulttype;
|
||||
|
||||
det_temp;
|
||||
end;
|
||||
|
||||
procedure tnode.det_resulttype;
|
||||
|
||||
begin
|
||||
abstract;
|
||||
end;
|
||||
|
||||
procedure tnode.det_temp;
|
||||
|
||||
begin
|
||||
abstract;
|
||||
end;
|
||||
|
||||
procedure tnode.secondpass;
|
||||
|
||||
begin
|
||||
abstract;
|
||||
end;
|
||||
|
||||
procedure tnode.concattolist(l : plinkedlist);
|
||||
|
||||
begin
|
||||
l^.concat(@self);
|
||||
end;
|
||||
|
||||
function tnode.ischild(p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
ischild:=false;
|
||||
end;
|
||||
|
||||
{$ifdef EXTDEBUG}
|
||||
procedure tnode.dowrite;
|
||||
|
||||
const treetype2str : array[tnodetype] of string[20] = (
|
||||
'addn',
|
||||
'muln',
|
||||
'subn',
|
||||
'divn',
|
||||
'symdifn',
|
||||
'modn',
|
||||
'assignn',
|
||||
'loadn',
|
||||
'rangen',
|
||||
'ltn',
|
||||
'lten',
|
||||
'gtn',
|
||||
'gten',
|
||||
'equaln',
|
||||
'unequaln',
|
||||
'inn',
|
||||
'orn',
|
||||
'xorn',
|
||||
'shrn',
|
||||
'shln',
|
||||
'slashn',
|
||||
'andn',
|
||||
'subscriptn',
|
||||
'derefn',
|
||||
'addrn',
|
||||
'doubleaddrn',
|
||||
'ordconstn',
|
||||
'typeconvn',
|
||||
'calln',
|
||||
'callparan',
|
||||
'realconstn',
|
||||
'fixconstn',
|
||||
'umminusn',
|
||||
'asmn',
|
||||
'vecn',
|
||||
'stringconstn',
|
||||
'funcretn',
|
||||
'selfn',
|
||||
'notn',
|
||||
'inlinen',
|
||||
'niln',
|
||||
'errorn',
|
||||
'typen',
|
||||
'hnewn',
|
||||
'hdisposen',
|
||||
'newn',
|
||||
'simpledisposen',
|
||||
'setelementn',
|
||||
'setconstn',
|
||||
'blockn',
|
||||
'statementn',
|
||||
'loopn',
|
||||
'ifn',
|
||||
'breakn',
|
||||
'continuen',
|
||||
'repeatn',
|
||||
'whilen',
|
||||
'forn',
|
||||
'exitn',
|
||||
'withn',
|
||||
'casen',
|
||||
'labeln',
|
||||
'goton',
|
||||
'simplenewn',
|
||||
'tryexceptn',
|
||||
'raisen',
|
||||
'switchesn',
|
||||
'tryfinallyn',
|
||||
'onn',
|
||||
'isn',
|
||||
'asn',
|
||||
'caretn',
|
||||
'failn',
|
||||
'starstarn',
|
||||
'procinlinen',
|
||||
'arrayconstructn',
|
||||
'arrayconstructrangen',
|
||||
'nothingn',
|
||||
'loadvmtn',
|
||||
'pointerconstn');
|
||||
|
||||
begin
|
||||
write(indention,'(',treetype2str[nodetype]);
|
||||
end;
|
||||
{$endif EXTDEBUG}
|
||||
|
||||
function tnode.isequal(p : node) : boolean;
|
||||
|
||||
begin
|
||||
isequal:=assigned(p) and (p^.nodetype=nodetype) and
|
||||
(flags*flagsequal=p^.flags*flagsequal) and
|
||||
docompare(p);
|
||||
end;
|
||||
|
||||
function tnode.docompare(p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
docompare:=true;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
TUNARYNODE
|
||||
****************************************************************************}
|
||||
|
||||
constructor tunarynode.init(tt : tnodetype;l : pnode);
|
||||
|
||||
begin
|
||||
inherited init(tt);
|
||||
left:=l;
|
||||
end;
|
||||
|
||||
function tunarynode.docompare(p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
docompare:=(inherited docompare(p)) and
|
||||
left^.isequal(p^.left);
|
||||
end;
|
||||
|
||||
{$ifdef extdebug}
|
||||
procedure tunarynode.dowrite;
|
||||
|
||||
begin
|
||||
inherited dowrite;
|
||||
writeln(',');
|
||||
writenode(left);
|
||||
writeln(')');
|
||||
dec(byte(indention[0]),2);
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
procedure tunarynode.concattolist(l : plinkedlist);
|
||||
|
||||
begin
|
||||
left^.parent:=@self;
|
||||
left^.concattolist(l);
|
||||
inherited concattolist(l);
|
||||
end;
|
||||
|
||||
function tunarynode.ischild(p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
ischild:=p=left;
|
||||
end;
|
||||
|
||||
procedure tunarynode.det_resulttype;
|
||||
|
||||
begin
|
||||
left^.det_resulttype;
|
||||
end;
|
||||
|
||||
procedure tunarynode.det_temp;
|
||||
|
||||
begin
|
||||
left^.det_temp;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
TBINARYNODE
|
||||
****************************************************************************}
|
||||
|
||||
constructor tbinarynode.init(tt : tnodetype;l,r : pnode);
|
||||
|
||||
begin
|
||||
inherited init(tt,l);
|
||||
right:=r
|
||||
end;
|
||||
|
||||
procedure tbinarynode.concattolist(l : plinkedlist);
|
||||
|
||||
begin
|
||||
{ we could change that depending on the number of }
|
||||
{ required registers }
|
||||
left^.parent:=@self;
|
||||
left^.concattolist(l);
|
||||
left^.parent:=@self;
|
||||
left^.concattolist(l);
|
||||
inherited concattolist(l);
|
||||
end;
|
||||
|
||||
function tbinarynode.ischild(p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
ischild:=(p=right) or (p=right);
|
||||
end;
|
||||
|
||||
procedure tbinarynode.det_resulttype;
|
||||
|
||||
begin
|
||||
left^.det_resulttype;
|
||||
right^.det_resulttype;
|
||||
end;
|
||||
|
||||
procedure tbinarynode.det_temp;
|
||||
|
||||
begin
|
||||
left^.det_temp;
|
||||
right^.det_temp;
|
||||
end;
|
||||
|
||||
function tbinarynode.docompare(p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
docompare:=left^.isequal(p^.left) and
|
||||
right^.isequal(p^.right);
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
TBINOPYNODE
|
||||
****************************************************************************}
|
||||
|
||||
constructor tbinopnode.init(tt : tnodetype;l,r : pnode);
|
||||
|
||||
begin
|
||||
inherited init(tt,l,r);
|
||||
end;
|
||||
|
||||
function tbinopnode.docompare(p : pnode) : boolean;
|
||||
|
||||
begin
|
||||
docompare:=(inherited docompare(p)) or
|
||||
((nf_swapable in flags) and
|
||||
left^.isequal(p^.right) and
|
||||
right^.isequal(p^.left));
|
||||
end;
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2000-08-26 12:27:17 florian
|
||||
* initial release
|
||||
|
||||
}
|
||||
39
compiler/node.pas
Normal file
39
compiler/node.pas
Normal file
@ -0,0 +1,39 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 2000 by Florian Klaempfl
|
||||
|
||||
Basic node handling
|
||||
|
||||
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 node;
|
||||
|
||||
interface
|
||||
|
||||
{$I nodeh.inc}
|
||||
|
||||
implementation
|
||||
|
||||
{$I node.inc}
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2000-08-26 12:27:35 florian
|
||||
* initial release
|
||||
|
||||
}
|
||||
278
compiler/nodeh.inc
Normal file
278
compiler/nodeh.inc
Normal file
@ -0,0 +1,278 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1999-2000 by Florian Klaempfl
|
||||
|
||||
The declarations of the nodes for the new code generator
|
||||
|
||||
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.
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
type
|
||||
pconstset = ^tconstset;
|
||||
tconstset = array[0..31] of byte;
|
||||
|
||||
tnodetype = (
|
||||
addn, {Represents the + operator.}
|
||||
muln, {Represents the * operator.}
|
||||
subn, {Represents the - operator.}
|
||||
divn, {Represents the div operator.}
|
||||
symdifn, {Represents the >< operator.}
|
||||
modn, {Represents the mod operator.}
|
||||
assignn, {Represents an assignment.}
|
||||
loadn, {Represents the use of a variabele.}
|
||||
rangen, {Represents a range (i.e. 0..9).}
|
||||
ltn, {Represents the < operator.}
|
||||
lten, {Represents the <= operator.}
|
||||
gtn, {Represents the > operator.}
|
||||
gten, {Represents the >= operator.}
|
||||
equaln, {Represents the = operator.}
|
||||
unequaln, {Represents the <> operator.}
|
||||
inn, {Represents the in operator.}
|
||||
orn, {Represents the or operator.}
|
||||
xorn, {Represents the xor operator.}
|
||||
shrn, {Represents the shr operator.}
|
||||
shln, {Represents the shl operator.}
|
||||
slashn, {Represents the / operator.}
|
||||
andn, {Represents the and operator.}
|
||||
subscriptn, {??? Field in a record/object?}
|
||||
derefn, {Dereferences a pointer.}
|
||||
addrn, {Represents the @ operator.}
|
||||
doubleaddrn, {Represents the @@ operator.}
|
||||
ordconstn, {Represents an ordinal value.}
|
||||
typeconvn, {Represents type-conversion/typecast.}
|
||||
calln, {Represents a call node.}
|
||||
callparan, {Represents a parameter.}
|
||||
realconstn, {Represents a real value.}
|
||||
fixconstn, {Represents a fixed value.}
|
||||
unaryminusn, {Represents a sign change (i.e. -2).}
|
||||
asmn, {Represents an assembler node }
|
||||
vecn, {Represents array indexing.}
|
||||
pointerconstn,
|
||||
stringconstn, {Represents a string constant.}
|
||||
funcretn, {Represents the function result var.}
|
||||
selfn, {Represents the self parameter.}
|
||||
notn, {Represents the not operator.}
|
||||
inlinen, {Internal procedures (i.e. writeln).}
|
||||
niln, {Represents the nil pointer.}
|
||||
errorn, {This part of the tree could not be
|
||||
parsed because of a compiler error.}
|
||||
typen, {A type name. Used for i.e. typeof(obj).}
|
||||
hnewn, {The new operation, constructor call.}
|
||||
hdisposen, {The dispose operation with destructor call.}
|
||||
newn, {The new operation, constructor call.}
|
||||
simpledisposen, {The dispose operation.}
|
||||
setelementn, {A set element(s) (i.e. [a,b] and also [a..b]).}
|
||||
setconstn, {A set constant (i.e. [1,2]).}
|
||||
blockn, {A block of statements.}
|
||||
statementn, {One statement in a block of nodes.}
|
||||
loopn, { used in genloopnode, must be converted }
|
||||
ifn, {An if statement.}
|
||||
breakn, {A break statement.}
|
||||
continuen, {A continue statement.}
|
||||
repeatn, {A repeat until block.}
|
||||
whilen, {A while do statement.}
|
||||
forn, {A for loop.}
|
||||
exitn, {An exit statement.}
|
||||
withn, {A with statement.}
|
||||
casen, {A case statement.}
|
||||
labeln, {A label.}
|
||||
goton, {A goto statement.}
|
||||
simplenewn, {The new operation.}
|
||||
tryexceptn, {A try except block.}
|
||||
raisen, {A raise statement.}
|
||||
switchesn, {??? Currently unused...}
|
||||
tryfinallyn, {A try finally statement.}
|
||||
onn, { for an on statement in exception code }
|
||||
isn, {Represents the is operator.}
|
||||
asn, {Represents the as typecast.}
|
||||
caretn, {Represents the ^ operator.}
|
||||
failn, {Represents the fail statement.}
|
||||
starstarn, {Represents the ** operator exponentiation }
|
||||
procinlinen, {Procedures that can be inlined }
|
||||
arrayconstructn, {Construction node for [...] parsing}
|
||||
arrayconstructrangen, {Range element to allow sets in array construction tree}
|
||||
{ added for optimizations where we cannot suppress }
|
||||
nothingn,
|
||||
loadvmtn
|
||||
);
|
||||
|
||||
tconverttype = (
|
||||
tc_equal,
|
||||
tc_not_possible,
|
||||
tc_string_2_string,
|
||||
tc_char_2_string,
|
||||
tc_pchar_2_string,
|
||||
tc_cchar_2_pchar,
|
||||
tc_cstring_2_pchar,
|
||||
tc_ansistring_2_pchar,
|
||||
tc_string_2_chararray,
|
||||
tc_chararray_2_string,
|
||||
tc_array_2_pointer,
|
||||
tc_pointer_2_array,
|
||||
tc_int_2_int,
|
||||
tc_int_2_bool,
|
||||
tc_bool_2_bool,
|
||||
tc_bool_2_int,
|
||||
tc_real_2_real,
|
||||
tc_int_2_real,
|
||||
tc_int_2_fix,
|
||||
tc_real_2_fix,
|
||||
tc_fix_2_real,
|
||||
tc_proc_2_procvar,
|
||||
tc_arrayconstructor_2_set,
|
||||
tc_load_smallset,
|
||||
tc_cord_2_pointer
|
||||
);
|
||||
|
||||
{ allows to determine which elementes are to be replaced }
|
||||
tdisposetyp = (dt_nothing,dt_leftright,dt_left,dt_leftrighthigh,
|
||||
dt_mbleft,dt_typeconv,dt_inlinen,dt_leftrightmethod,
|
||||
dt_mbleft_and_method,dt_loop,dt_case,dt_with,dt_onn,
|
||||
dt_leftrightframe);
|
||||
|
||||
{ different assignment types }
|
||||
tassigntyp = (at_normal,at_plus,at_minus,at_star,at_slash);
|
||||
|
||||
pcaserecord = ^tcaserecord;
|
||||
tcaserecord = record
|
||||
{ range }
|
||||
_low,_high : longint;
|
||||
|
||||
{ only used by gentreejmp }
|
||||
_at : pasmlabel;
|
||||
|
||||
{ label of instruction }
|
||||
statement : pasmlabel;
|
||||
|
||||
{ is this the first of an case entry, needed to release statement
|
||||
label (PFV) }
|
||||
firstlabel : boolean;
|
||||
|
||||
{ left and right tree node }
|
||||
less,greater : pcaserecord;
|
||||
end;
|
||||
|
||||
{ this will be used mainly for the newcg }
|
||||
tnodeflags = (
|
||||
nf_needs_truefalselabel,
|
||||
nf_callunique,
|
||||
nf_swapable, { tbinop operands can be swaped }
|
||||
nf_swaped, { tbinop operands are swaped }
|
||||
nf_error
|
||||
);
|
||||
|
||||
tnodeflagset = set of tnodeflags;
|
||||
|
||||
const
|
||||
{ contains the flags which must be equal for the equality }
|
||||
{ of nodes }
|
||||
flagsequal : tnodeflagset = [nf_error];
|
||||
|
||||
type
|
||||
{ later (for the newcg) tnode will inherit from tlinkedlist_item }
|
||||
tnode = class
|
||||
nodetype : tnodetype;
|
||||
{ the location of the result of this node }
|
||||
location : tlocation;
|
||||
{ do we need to parse childs to set var state }
|
||||
varstateset : boolean;
|
||||
{ the parent node of this is node }
|
||||
{ this field is set by concattolist }
|
||||
parent : pnode;
|
||||
{ there are some properties about the node stored }
|
||||
flags : tnodeflagset;
|
||||
{ the number of registers needed to evalute the node }
|
||||
registersint,registersfpu : longint; { must be longint !!!! }
|
||||
{$ifdef SUPPORT_MMX}
|
||||
registersmmx,registerskni : longint;
|
||||
{$endif SUPPORT_MMX}
|
||||
resulttype : pdef;
|
||||
fileinfo : tfileposinfo;
|
||||
localswitches : tlocalswitches;
|
||||
{$ifdef extdebug}
|
||||
firstpasscount : longint;
|
||||
{$endif extdebug}
|
||||
list : paasmoutput;
|
||||
constructor init(tt : tnodetype);virtual;
|
||||
destructor done;virtual;
|
||||
|
||||
{ the 1.1 code generator may override pass_1 }
|
||||
{ and it need not to implement det_* then }
|
||||
{ 1.1: pass_1 returns a value<>0 if the node has been transformed }
|
||||
{ 2.0: runs det_resulttype and det_temp }
|
||||
function pass_1 : tnode;virtual;
|
||||
{ dermines the resulttype of the node }
|
||||
procedure det_resulttype;virtual;
|
||||
{ dermines the number of necessary temp. locations to evaluate
|
||||
the node }
|
||||
procedure det_temp;virtual;
|
||||
|
||||
procedure secondpass;virtual;
|
||||
|
||||
{ comparing of nodes }
|
||||
function isequal(p : tnode) : boolean;
|
||||
{ to implement comparisation, override this method }
|
||||
function docompare(p : tnode) : boolean;virtual;
|
||||
{$ifdef EXTDEBUG}
|
||||
{ writes a node for debugging purpose, shouldn't be called }
|
||||
{ direct, because there is no test for nil, use writenode }
|
||||
{ to write a complete tree }
|
||||
procedure dowrite;virtual;
|
||||
{$endif EXTDEBUG}
|
||||
procedure concattolist(l : plinkedlist);virtual;
|
||||
function ischild(p : tnode) : boolean;virtual;
|
||||
end;
|
||||
|
||||
{ this node is the anchestor for all nodes with at least }
|
||||
{ one child, you have to use it if you want to use }
|
||||
{ true- and falselabel }
|
||||
tparentnode = class(tnode);
|
||||
falselabel,truelabel : plabel;
|
||||
end;
|
||||
|
||||
punarynode = ^tunarynode;
|
||||
tunarynode = class(tparentnode)
|
||||
left : tnode;
|
||||
{$ifdef extdebug}
|
||||
procedure dowrite;virtual;
|
||||
{$endif extdebug}
|
||||
constructor init(tt : tnodetype;l : tnode);virtual
|
||||
procedure concattolist(l : plinkedlist);virtual;
|
||||
function ischild(p : tnode) : boolean;virtual;
|
||||
procedure det_resulttype;virtual;
|
||||
procedure det_temp;virtual;
|
||||
end;
|
||||
|
||||
pbinarynode = ^tbinarynode;
|
||||
tbinarynode = class(tunarynode)
|
||||
right : tnode;
|
||||
constructor init(tt : tnodetype;l,r : pnode);virtual;
|
||||
procedure concattolist(l : plinkedlist);virtual;
|
||||
function ischild(p : pnode) : boolean;virtual;
|
||||
procedure det_resulttype;virtual;
|
||||
procedure det_temp;virtual;
|
||||
end;
|
||||
|
||||
pbinopnode = ^tbinopnode;
|
||||
tbinopnode = class(tbinarynode)
|
||||
constructor init(tt : tnodetype;l,r : pnode);virtual;
|
||||
end;
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2000-08-26 12:27:04 florian
|
||||
* initial release
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user