mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-16 04:09:15 +02:00
* some updates e.g. getcopy added
This commit is contained in:
florian
parent
91da57baf1
commit
c9dfdcfbcd
@ -1,4 +1,4 @@
|
||||
{
|
||||
7{
|
||||
$Id$
|
||||
Copyright (c) 1999-2000 by Florian Klaempfl
|
||||
|
||||
@ -44,6 +44,11 @@
|
||||
flags:=[];
|
||||
end;
|
||||
|
||||
constructor tnode.createforcopy;
|
||||
|
||||
begin
|
||||
end;
|
||||
|
||||
destructor tnode.destroy;
|
||||
|
||||
begin
|
||||
@ -183,6 +188,36 @@
|
||||
docompare:=true;
|
||||
end;
|
||||
|
||||
function tnode.getcopy : tnode;
|
||||
|
||||
var
|
||||
p : tnode;
|
||||
|
||||
begin
|
||||
{ this is quite tricky because we need a node of the current }
|
||||
{ node type and not one of tnode! }
|
||||
p:=classtype.createforcopy;
|
||||
p.nodetype:=nodetype;
|
||||
p.location:=location;
|
||||
p.varstateset:=varstateset;
|
||||
p.parent:=parent;
|
||||
p.flags:=flags;
|
||||
p.registers32:=registers32
|
||||
p.registersfpu:=registersfpu;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
p.registersmmx:=registersmmx;
|
||||
p.registerskni:=registerskni
|
||||
{$endif SUPPORT_MMX}
|
||||
p.resulttype:=resulttype;
|
||||
p.fileinfo:=fileinfo;
|
||||
p.localswitches:=localswitches;
|
||||
{$ifdef extdebug}
|
||||
p.firstpasscount:=firstpasscount;
|
||||
{$endif extdebug}
|
||||
p.list:=list;
|
||||
getcopy:=p;
|
||||
end;
|
||||
|
||||
procedure tnode.set_file_line(from : tnode);
|
||||
|
||||
begin
|
||||
@ -196,6 +231,148 @@
|
||||
fileinfo:=filepos;
|
||||
end;
|
||||
|
||||
procedure tnode.unset_varstate;
|
||||
|
||||
begin
|
||||
internalerror(220920002);
|
||||
end;
|
||||
|
||||
procedure tnode.set_varstate(must_be_valid : boolean);
|
||||
|
||||
begin
|
||||
internalerror(220920001);
|
||||
end;
|
||||
|
||||
{$warning FIX ME !!!!!}
|
||||
{$ifdef dummy}
|
||||
procedure unset_varstate(p : ptree);
|
||||
begin
|
||||
while assigned(p) do
|
||||
begin
|
||||
p^.varstateset:=false;
|
||||
case p^.treetype of
|
||||
typeconvn,
|
||||
subscriptn,
|
||||
vecn :
|
||||
p:=p^.left;
|
||||
else
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure set_varstate(p : ptree;must_be_valid : boolean);
|
||||
|
||||
begin
|
||||
if not assigned(p) then
|
||||
exit
|
||||
else
|
||||
begin
|
||||
if p^.varstateset then
|
||||
exit;
|
||||
case p^.treetype of
|
||||
typeconvn :
|
||||
if p^.convtyp in
|
||||
[
|
||||
tc_cchar_2_pchar,
|
||||
tc_cstring_2_pchar,
|
||||
tc_array_2_pointer
|
||||
] then
|
||||
set_varstate(p^.left,false)
|
||||
else if p^.convtyp in
|
||||
[
|
||||
tc_pchar_2_string,
|
||||
tc_pointer_2_array
|
||||
] then
|
||||
set_varstate(p^.left,true)
|
||||
else
|
||||
set_varstate(p^.left,must_be_valid);
|
||||
subscriptn :
|
||||
set_varstate(p^.left,must_be_valid);
|
||||
vecn:
|
||||
begin
|
||||
if (p^.left^.resulttype^.deftype in [stringdef,arraydef]) then
|
||||
set_varstate(p^.left,must_be_valid)
|
||||
else
|
||||
set_varstate(p^.left,true);
|
||||
set_varstate(p^.right,true);
|
||||
end;
|
||||
{ do not parse calln }
|
||||
calln : ;
|
||||
callparan:
|
||||
begin
|
||||
set_varstate(p^.left,must_be_valid);
|
||||
set_varstate(p^.right,must_be_valid);
|
||||
end;
|
||||
loadn :
|
||||
if (p^.symtableentry^.typ=varsym) then
|
||||
begin
|
||||
if must_be_valid and p^.is_first then
|
||||
begin
|
||||
if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) or
|
||||
(pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed) then
|
||||
if (assigned(pvarsym(p^.symtableentry)^.owner) and
|
||||
assigned(aktprocsym) and
|
||||
(pvarsym(p^.symtableentry)^.owner = aktprocsym^.definition^.localst)) then
|
||||
begin
|
||||
if p^.symtable^.symtabletype=localsymtable then
|
||||
CGMessage1(sym_n_uninitialized_local_variable,pvarsym(p^.symtableentry)^.name)
|
||||
else
|
||||
CGMessage1(sym_n_uninitialized_variable,pvarsym(p^.symtableentry)^.name);
|
||||
end;
|
||||
end;
|
||||
if (p^.is_first) then
|
||||
begin
|
||||
if pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found then
|
||||
{ this can only happen at left of an assignment, no ? PM }
|
||||
if (parsing_para_level=0) and not must_be_valid then
|
||||
pvarsym(p^.symtableentry)^.varstate:=vs_assigned
|
||||
else
|
||||
pvarsym(p^.symtableentry)^.varstate:=vs_used;
|
||||
if pvarsym(p^.symtableentry)^.varstate=vs_set_but_first_not_passed then
|
||||
pvarsym(p^.symtableentry)^.varstate:=vs_used;
|
||||
p^.is_first:=false;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (pvarsym(p^.symtableentry)^.varstate=vs_assigned) and
|
||||
(must_be_valid or (parsing_para_level>0) or
|
||||
(p^.resulttype^.deftype=procvardef)) then
|
||||
pvarsym(p^.symtableentry)^.varstate:=vs_used;
|
||||
if (pvarsym(p^.symtableentry)^.varstate=vs_declared_and_first_found) and
|
||||
(must_be_valid or (parsing_para_level>0) or
|
||||
(p^.resulttype^.deftype=procvardef)) then
|
||||
pvarsym(p^.symtableentry)^.varstate:=vs_set_but_first_not_passed;
|
||||
end;
|
||||
end;
|
||||
funcretn:
|
||||
begin
|
||||
{ no claim if setting higher return value_str }
|
||||
if must_be_valid and
|
||||
(procinfo=pprocinfo(p^.funcretprocinfo)) and
|
||||
((procinfo^.funcret_state=vs_declared) or
|
||||
((p^.is_first_funcret) and
|
||||
(procinfo^.funcret_state=vs_declared_and_first_found))) then
|
||||
begin
|
||||
CGMessage(sym_w_function_result_not_set);
|
||||
{ avoid multiple warnings }
|
||||
procinfo^.funcret_state:=vs_assigned;
|
||||
end;
|
||||
if p^.is_first_funcret and not must_be_valid then
|
||||
pprocinfo(p^.funcretprocinfo)^.funcret_state:=vs_assigned;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
{internalerror(565656);}
|
||||
end;
|
||||
end;{case }
|
||||
p^.varstateset:=true;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
|
||||
{****************************************************************************
|
||||
TUNARYNODE
|
||||
****************************************************************************}
|
||||
@ -214,6 +391,16 @@
|
||||
left.isequal(tunarynode(p).left);
|
||||
end;
|
||||
|
||||
function.tunarynode.getcopy : tnode;
|
||||
|
||||
var
|
||||
p : tunarynode;
|
||||
|
||||
begin
|
||||
p:=tunarynode(inherited getcopy);
|
||||
p.left:=left.getcopy;
|
||||
end;
|
||||
|
||||
{$ifdef extdebug}
|
||||
procedure tunarynode.dowrite;
|
||||
|
||||
@ -302,6 +489,16 @@
|
||||
right.isequal(tbinarynode(p).right);
|
||||
end;
|
||||
|
||||
function.tbinarynode.getcopy : tnode;
|
||||
|
||||
var
|
||||
p : tbinarynode;
|
||||
|
||||
begin
|
||||
p:=tbinarynode(inherited getcopy);
|
||||
p.right:=right.getcopy;
|
||||
end;
|
||||
|
||||
function tbinarynode.isbinaryoverloaded(var t : tnode) : boolean;
|
||||
|
||||
var
|
||||
@ -420,7 +617,10 @@
|
||||
end;
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-09-20 21:52:38 florian
|
||||
Revision 1.3 2000-09-22 21:45:36 florian
|
||||
* some updates e.g. getcopy added
|
||||
|
||||
Revision 1.2 2000/09/20 21:52:38 florian
|
||||
* removed a lot of errors
|
||||
|
||||
Revision 1.1 2000/08/26 12:27:17 florian
|
||||
|
||||
@ -33,14 +33,17 @@ unit node;
|
||||
implementation
|
||||
|
||||
uses
|
||||
htypechk,ncal,hcodegen,verbose;
|
||||
htypechk,ncal,hcodegen,verbose,nmat,pass_1;
|
||||
|
||||
{$I node.inc}
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-09-20 21:52:38 florian
|
||||
Revision 1.3 2000-09-22 21:45:35 florian
|
||||
* some updates e.g. getcopy added
|
||||
|
||||
Revision 1.2 2000/09/20 21:52:38 florian
|
||||
* removed a lot of errors
|
||||
|
||||
Revision 1.1 2000/08/26 12:27:35 florian
|
||||
|
||||
@ -183,7 +183,11 @@
|
||||
nf_exact_match_found,
|
||||
nf_convlevel1found,
|
||||
nf_convlevel2found,
|
||||
nf_is_colon_para
|
||||
nf_is_colon_para,
|
||||
|
||||
{ flags used by loop nodes }
|
||||
nf_backward, { set if it is a for ... downto ... do loop }
|
||||
nf_varstate { do we need to parse childs to set var state }
|
||||
);
|
||||
|
||||
tnodeflagset = set of tnodeflags;
|
||||
@ -191,7 +195,7 @@
|
||||
const
|
||||
{ contains the flags which must be equal for the equality }
|
||||
{ of nodes }
|
||||
flagsequal : tnodeflagset = [nf_error,nf_static_call];
|
||||
flagsequal : tnodeflagset = [nf_error,nf_static_call,nf_backward];
|
||||
|
||||
type
|
||||
{ later (for the newcg) tnode will inherit from tlinkedlist_item }
|
||||
@ -199,15 +203,13 @@
|
||||
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 : tnode;
|
||||
{ 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 !!!! }
|
||||
registers32,registersfpu : longint; { must be longint !!!! }
|
||||
{$ifdef SUPPORT_MMX}
|
||||
registersmmx,registerskni : longint;
|
||||
{$endif SUPPORT_MMX}
|
||||
@ -218,7 +220,10 @@
|
||||
firstpasscount : longint;
|
||||
{$endif extdebug}
|
||||
list : paasmoutput;
|
||||
constructor create(tt : tnodetype);virtual;
|
||||
constructor create(tt : tnodetype);
|
||||
{ this constructor is only for creating copies of class }
|
||||
{ the fields are copied by getcopy }
|
||||
constructor createforcopy;
|
||||
destructor destroy;virtual;
|
||||
|
||||
{ the 1.1 code generator may override pass_1 }
|
||||
@ -238,6 +243,10 @@
|
||||
function isequal(p : tnode) : boolean;
|
||||
{ to implement comparisation, override this method }
|
||||
function docompare(p : tnode) : boolean;virtual;
|
||||
{ gets a copy of the node }
|
||||
function getcopy : tnode;virtual;
|
||||
procedure unset_varstate;virtual;
|
||||
procedure set_varstate(must_be_valid : boolean);virtual;
|
||||
{$ifdef EXTDEBUG}
|
||||
{ writes a node for debugging purpose, shouldn't be called }
|
||||
{ direct, because there is no test for nil, use writenode }
|
||||
@ -263,18 +272,19 @@
|
||||
{$ifdef extdebug}
|
||||
procedure dowrite;override;
|
||||
{$endif extdebug}
|
||||
constructor create(tt : tnodetype;l : tnode);virtual;
|
||||
constructor create(tt : tnodetype;l : tnode);
|
||||
procedure concattolist(l : plinkedlist);override;
|
||||
function ischild(p : tnode) : boolean;override;
|
||||
procedure det_resulttype;override;
|
||||
procedure det_temp;override;
|
||||
function docompare(p : tnode) : boolean;override;
|
||||
function getcopy : tnode;override;
|
||||
end;
|
||||
|
||||
pbinarynode = ^tbinarynode;
|
||||
tbinarynode = class(tunarynode)
|
||||
right : tnode;
|
||||
constructor create(tt : tnodetype;l,r : tnode);virtual;
|
||||
constructor create(tt : tnodetype;l,r : tnode);
|
||||
procedure concattolist(l : plinkedlist);override;
|
||||
function ischild(p : tnode) : boolean;override;
|
||||
procedure det_resulttype;override;
|
||||
@ -282,19 +292,23 @@
|
||||
function docompare(p : tnode) : boolean;override;
|
||||
procedure swapleftright;
|
||||
function isbinaryoverloaded(var t : tnode) : boolean;
|
||||
function getcopy : tnode;override;
|
||||
end;
|
||||
|
||||
pbinopnode = ^tbinopnode;
|
||||
tbinopnode = class(tbinarynode)
|
||||
constructor create(tt : tnodetype;l,r : tnode);virtual;
|
||||
constructor create(tt : tnodetype;l,r : tnode);
|
||||
function docompare(p : tnode) : boolean;override;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-09-20 21:52:38 florian
|
||||
Revision 1.3 2000-09-22 21:45:36 florian
|
||||
* some updates e.g. getcopy added
|
||||
|
||||
Revision 1.2 2000/09/20 21:52:38 florian
|
||||
* removed a lot of errors
|
||||
|
||||
Revision 1.1 2000/08/26 12:27:04 florian
|
||||
* initial release
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user