mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-21 18:29:27 +02:00
* initial revision
This commit is contained in:
florian
parent
991db24e93
commit
f245ef187f
696
compiler/nld.pas
Normal file
696
compiler/nld.pas
Normal file
@ -0,0 +1,696 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 2000 by Florian Klaempfl
|
||||
|
||||
Type checking and register allocation for load/assignment 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 nld;
|
||||
interface
|
||||
|
||||
uses
|
||||
node,symtable;
|
||||
|
||||
type
|
||||
tloadnode = class(tunarynode)
|
||||
symtableentry : psym;
|
||||
symtable : psymtable;
|
||||
constructor create(v : pvarsym;st : psymtable);virtual;
|
||||
function getcopy : tnode;override;
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
|
||||
{ different assignment types }
|
||||
tassigntyp = (at_normal,at_plus,at_minus,at_star,at_slash);
|
||||
|
||||
tassignmentnode = class(tbinarynode)
|
||||
assigntyp : tassigntyp;
|
||||
constructor create(l,r : tnode);virtual;
|
||||
function getcopy : tnode;override;
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
|
||||
tfuncretnode = class(tnode)
|
||||
funcretprocinfo : pointer;
|
||||
{$IFDEF NEWST}
|
||||
retsym : Psym;
|
||||
{$ELSE}
|
||||
rettype : ttype;
|
||||
{$ENDIF}
|
||||
constructor create;virtual;
|
||||
function getcopy : tnode;override;
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
|
||||
tarrayconstructorrangenode = class(tbinarynode)
|
||||
constructor create(l,r : tnode);virtual;
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
|
||||
tarrayconstructnode = class(tbinarynode)
|
||||
constructdef : pdef;
|
||||
constructor create(l,r : tnode);virtual;
|
||||
function getcopy : tnode;
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
|
||||
ttypenode = class(tnode)
|
||||
typenodetype : pdef;
|
||||
typenodesym:ptypesym
|
||||
constructor create(t : pdef;sym:ptypesym);virtual;
|
||||
function getcopy : tnode;override;
|
||||
function pass_1 : tnode;override;
|
||||
end;
|
||||
|
||||
var
|
||||
cloadnode : class of tloadnode;
|
||||
cassignmentnode : class of tassignmentnode;
|
||||
cfuncretnode : class of tfuncretnode;
|
||||
carrayconstructorrangenode : class of tarrayconstructorrangenode;
|
||||
carrayconstructnode : class of tarrayconstructnode;
|
||||
ctypenode : class of ttypenode;
|
||||
|
||||
function gentypenode(t : pdef;sym:ptypesym) : ttypenode;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
cutils,cobjects,verbose,globtype,globals,systems,
|
||||
symconst,aasm,types,
|
||||
htypechk,pass_1,
|
||||
ncnv,cpubase
|
||||
{$ifdef newcg}
|
||||
,cgbase
|
||||
,tgobj
|
||||
,tgcpu
|
||||
{$else newcg}
|
||||
,hcodegen
|
||||
{$ifdef i386}
|
||||
,tgeni386
|
||||
{$endif}
|
||||
{$endif newcg}
|
||||
;
|
||||
|
||||
function genloadnode(v : pvarsym;st : psymtable) : tloadnode;
|
||||
|
||||
begin
|
||||
genloadnode:=cloadnode.create(v,st);
|
||||
end;
|
||||
|
||||
function gentypenode(t : pdef;sym:ptypesym) : ttypenode;
|
||||
begin
|
||||
gentypenode:=ctypenode.create(t,sym);
|
||||
end;
|
||||
|
||||
{*****************************************************************************
|
||||
TLOADNODE
|
||||
*****************************************************************************}
|
||||
|
||||
constructor tloadnode.create(v : pvarsym;st : psymtable);
|
||||
|
||||
begin
|
||||
inherited create(loadn,nil);
|
||||
symtableentry:=v;
|
||||
symtable:=st;
|
||||
end;
|
||||
|
||||
function tloadnode.getcopy : tnode;
|
||||
|
||||
var
|
||||
n : tloadnode;
|
||||
|
||||
begin
|
||||
n:=tloadnode(inherited getcopy);
|
||||
n.symtable:=symtable;
|
||||
n.symtableentry:=symtableentry;
|
||||
end;
|
||||
|
||||
function tloadnode.pass_1 : tnode;
|
||||
var
|
||||
p1 : tnode;
|
||||
begin
|
||||
if (symtable^.symtabletype=withsymtable) and
|
||||
(pwithsymtable(symtable)^.direct_with) and
|
||||
(symtableentry^.typ=varsym) then
|
||||
begin
|
||||
p1:=getcopy(ptree(pwithsymtable(symtable)^.withrefnode));
|
||||
p1:=gensubscriptnode(pvarsym(symtableentry),p1);
|
||||
putnode(p);
|
||||
p:=p1;
|
||||
firstpass(p);
|
||||
exit;
|
||||
end;
|
||||
|
||||
location.loc:=LOC_REFERENCE;
|
||||
registers32:=0;
|
||||
registersfpu:=0;
|
||||
{$ifdef SUPPORT_MMX}
|
||||
registersmmx:=0;
|
||||
{$endif SUPPORT_MMX}
|
||||
{ handle first absolute as it will replace the symtableentry }
|
||||
if symtableentry^.typ=absolutesym then
|
||||
begin
|
||||
resulttype:=pabsolutesym(symtableentry)^.vartype.def;
|
||||
{ replace the symtableentry when it points to a var, else
|
||||
we are finished }
|
||||
if pabsolutesym(symtableentry)^.abstyp=tovar then
|
||||
begin
|
||||
symtableentry:=pabsolutesym(symtableentry)^.ref;
|
||||
symtable:=symtableentry^.owner;
|
||||
is_absolute:=true;
|
||||
end
|
||||
else
|
||||
exit;
|
||||
end;
|
||||
case symtableentry^.typ of
|
||||
funcretsym :
|
||||
begin
|
||||
p1:=genzeronode(funcretn);
|
||||
p1.funcretprocinfo:=pprocinfo(pfuncretsym(symtableentry)^.funcretprocinfo);
|
||||
p1.rettype:=pfuncretsym(symtableentry)^.rettype;
|
||||
firstpass(p1);
|
||||
{ if it's refered as absolute then we need to have the
|
||||
type of the absolute instead of the function return,
|
||||
the function return is then also assigned }
|
||||
if is_absolute then
|
||||
begin
|
||||
pprocinfo(p1.funcretprocinfo)^.funcret_state:=vs_assigned;
|
||||
p1.resulttype:=resulttype;
|
||||
end;
|
||||
putnode(p);
|
||||
p:=p1;
|
||||
end;
|
||||
constsym:
|
||||
begin
|
||||
if pconstsym(symtableentry)^.consttyp=constresourcestring then
|
||||
begin
|
||||
resulttype:=cansistringdef;
|
||||
{ we use ansistrings so no fast exit here }
|
||||
if assigned(procinfo) then
|
||||
procinfo^.no_fast_exit:=true;
|
||||
location.loc:=LOC_MEM;
|
||||
end
|
||||
else
|
||||
internalerror(22799);
|
||||
end;
|
||||
varsym :
|
||||
begin
|
||||
{ if it's refered by absolute then it's used }
|
||||
if is_absolute then
|
||||
pvarsym(symtableentry)^.varstate:=vs_used
|
||||
else
|
||||
if (resulttype=nil) then
|
||||
resulttype:=pvarsym(symtableentry)^.vartype.def;
|
||||
if (symtable^.symtabletype in [parasymtable,localsymtable]) and
|
||||
(lexlevel>symtable^.symtablelevel) then
|
||||
begin
|
||||
{ if the variable is in an other stackframe then we need
|
||||
a register to dereference }
|
||||
if (symtable^.symtablelevel)>0 then
|
||||
begin
|
||||
registers32:=1;
|
||||
{ further, the variable can't be put into a register }
|
||||
pvarsym(symtableentry)^.varoptions:=
|
||||
pvarsym(symtableentry)^.varoptions-[vo_fpuregable,vo_regable];
|
||||
end;
|
||||
end;
|
||||
if (pvarsym(symtableentry)^.varspez=vs_const) then
|
||||
location.loc:=LOC_MEM;
|
||||
{ we need a register for call by reference parameters }
|
||||
if (pvarsym(symtableentry)^.varspez in [vs_var,vs_out]) or
|
||||
((pvarsym(symtableentry)^.varspez=vs_const) and
|
||||
push_addr_param(pvarsym(symtableentry)^.vartype.def)) or
|
||||
{ call by value open arrays are also indirect addressed }
|
||||
is_open_array(pvarsym(symtableentry)^.vartype.def) then
|
||||
registers32:=1;
|
||||
if symtable^.symtabletype=withsymtable then
|
||||
inc(registers32);
|
||||
|
||||
if ([vo_is_thread_var,vo_is_dll_var]*pvarsym(symtableentry)^.varoptions)<>[] then
|
||||
registers32:=1;
|
||||
{ a class variable is a pointer !!!
|
||||
yes, but we have to resolve the reference in an
|
||||
appropriate tree node (FK)
|
||||
|
||||
if (pvarsym(symtableentry)^.definition^.deftype=objectdef) and
|
||||
((pobjectdef(pvarsym(symtableentry)^.definition)^.options and oo_is_class)<>0) then
|
||||
registers32:=1;
|
||||
}
|
||||
|
||||
{ count variable references }
|
||||
|
||||
{ this will create problem with local var set by
|
||||
under_procedures
|
||||
if (assigned(pvarsym(symtableentry)^.owner) and assigned(aktprocsym)
|
||||
and ((pvarsym(symtableentry)^.owner = aktprocsym^.definition^.localst)
|
||||
or (pvarsym(symtableentry)^.owner = aktprocsym^.definition^.localst))) then }
|
||||
if t_times<1 then
|
||||
inc(pvarsym(symtableentry)^.refs)
|
||||
else
|
||||
inc(pvarsym(symtableentry)^.refs,t_times);
|
||||
end;
|
||||
typedconstsym :
|
||||
if not is_absolute then
|
||||
resulttype:=ptypedconstsym(symtableentry)^.typedconsttype.def;
|
||||
procsym :
|
||||
begin
|
||||
if assigned(pprocsym(symtableentry)^.definition^.nextoverloaded) then
|
||||
CGMessage(parser_e_no_overloaded_procvars);
|
||||
resulttype:=pprocsym(symtableentry)^.definition;
|
||||
{ if the owner of the procsym is a object, }
|
||||
{ left must be set, if left isn't set }
|
||||
{ it can be only self }
|
||||
{ this code is only used in TP procvar mode }
|
||||
if (m_tp_procvar in aktmodeswitches) and
|
||||
not(assigned(left)) and
|
||||
(pprocsym(symtableentry)^.owner^.symtabletype=objectsymtable) then
|
||||
left:=genselfnode(pobjectdef(symtableentry^.owner^.defowner));
|
||||
{ method pointer ? }
|
||||
if assigned(left) then
|
||||
begin
|
||||
firstpass(left);
|
||||
registers32:=max(registers32,left.registers32);
|
||||
registersfpu:=max(registersfpu,left.registersfpu);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
registersmmx:=max(registersmmx,left.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
end;
|
||||
end;
|
||||
else
|
||||
internalerror(3);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TASSIGNMENTNODE
|
||||
*****************************************************************************}
|
||||
|
||||
constructor tassignmentnode.create(l,r : tnode);
|
||||
|
||||
begin
|
||||
inherited create(assignn,l,r);
|
||||
assigntype:=at_normal;
|
||||
end;
|
||||
|
||||
function tassignmentnode.getcopy : tnode;
|
||||
|
||||
var
|
||||
n : tassignmentnode;
|
||||
|
||||
begin
|
||||
n:=tassignmentnode(inherited getcopy);
|
||||
n.assigntype:=assigntype;
|
||||
getcopy:=n;
|
||||
end;
|
||||
|
||||
function tassignmentnode.pass_1 : tnode;
|
||||
{$ifdef newoptimizations2}
|
||||
var
|
||||
hp : tnode;
|
||||
{$endif newoptimizations2}
|
||||
begin
|
||||
{ must be made unique }
|
||||
set_unique(left);
|
||||
|
||||
{ set we the function result? }
|
||||
set_funcret_is_valid(left);
|
||||
|
||||
firstpass(left);
|
||||
set_varstate(left,false);
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
{ assignements to open arrays aren't allowed }
|
||||
if is_open_array(left.resulttype) then
|
||||
CGMessage(type_e_mismatch);
|
||||
|
||||
{ test if we can avoid copying string to temp
|
||||
as in s:=s+...; (PM) }
|
||||
{$ifdef dummyi386}
|
||||
if ((right.treetype=addn) or (right.treetype=subn)) and
|
||||
equal_trees(left,right.left) and
|
||||
(ret_in_acc(left.resulttype)) and
|
||||
(not cs_rangechecking in aktmoduleswitches^) then
|
||||
begin
|
||||
disposetree(right.left);
|
||||
hp:=right;
|
||||
right:=right.right;
|
||||
if hp.treetype=addn then
|
||||
assigntyp:=at_plus
|
||||
else
|
||||
assigntyp:=at_minus;
|
||||
putnode(hp);
|
||||
end;
|
||||
if assigntyp<>at_normal then
|
||||
begin
|
||||
{ for fpu type there is no faster way }
|
||||
if is_fpu(left.resulttype) then
|
||||
case assigntyp of
|
||||
at_plus : right:=gennode(addn,getcopy(left),right);
|
||||
at_minus : right:=gennode(subn,getcopy(left),right);
|
||||
at_star : right:=gennode(muln,getcopy(left),right);
|
||||
at_slash : right:=gennode(slashn,getcopy(left),right);
|
||||
end;
|
||||
end;
|
||||
{$endif i386}
|
||||
firstpass(right);
|
||||
set_varstate(right,true);
|
||||
if codegenerror then
|
||||
exit;
|
||||
|
||||
{ some string functions don't need conversion, so treat them separatly }
|
||||
if is_shortstring(left.resulttype) and (assigned(right.resulttype)) then
|
||||
begin
|
||||
if not (is_shortstring(right.resulttype) or
|
||||
is_ansistring(right.resulttype) or
|
||||
is_char(right.resulttype)) then
|
||||
begin
|
||||
right:=gentypeconvnode(right,left.resulttype);
|
||||
firstpass(right);
|
||||
if codegenerror then
|
||||
exit;
|
||||
end;
|
||||
{ we call STRCOPY }
|
||||
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
||||
{ test for s:=s+anything ... }
|
||||
{ the problem is for
|
||||
s:=s+s+s;
|
||||
this is broken here !! }
|
||||
{$ifdef newoptimizations2}
|
||||
{ the above is fixed now, but still problem with s := s + f(); if }
|
||||
{ f modifies s (bad programming, so only enable if uncertain }
|
||||
{ optimizations are on) (JM) }
|
||||
if (cs_UncertainOpts in aktglobalswitches) then
|
||||
begin
|
||||
hp := right;
|
||||
while hp.treetype=addn do hp:=hp.left;
|
||||
if equal_trees(left,hp) and
|
||||
not multiple_uses(left,right) then
|
||||
begin
|
||||
concat_string:=true;
|
||||
hp:=right;
|
||||
while hp.treetype=addn do
|
||||
begin
|
||||
hp.use_strconcat:=true;
|
||||
hp:=hp.left;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif newoptimizations2}
|
||||
end
|
||||
else
|
||||
begin
|
||||
right:=gentypeconvnode(right,left.resulttype);
|
||||
firstpass(right);
|
||||
if codegenerror then
|
||||
exit;
|
||||
end;
|
||||
|
||||
{ test if node can be assigned, properties are allowed }
|
||||
valid_for_assign(left,true);
|
||||
|
||||
{ check if local proc/func is assigned to procvar }
|
||||
if right.resulttype^.deftype=procvardef then
|
||||
test_local_to_procvar(pprocvardef(right.resulttype),left.resulttype);
|
||||
|
||||
resulttype:=voiddef;
|
||||
{
|
||||
registers32:=max(left.registers32,right.registers32);
|
||||
registersfpu:=max(left.registersfpu,right.registersfpu);
|
||||
}
|
||||
registers32:=left.registers32+right.registers32;
|
||||
registersfpu:=max(left.registersfpu,right.registersfpu);
|
||||
{$ifdef SUPPORT_MMX}
|
||||
registersmmx:=max(left.registersmmx,right.registersmmx);
|
||||
{$endif SUPPORT_MMX}
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TFUNCRETNODE
|
||||
*****************************************************************************}
|
||||
|
||||
constructor tfuncretnode.create;
|
||||
|
||||
begin
|
||||
inherited create(tfuncretn);
|
||||
funcretprocinfo:=nil;
|
||||
n.rettype:=nil;
|
||||
end;
|
||||
|
||||
function tfuncretnode.getcopy : tnode;
|
||||
|
||||
var
|
||||
n : tfuncretnode;
|
||||
|
||||
begin
|
||||
n:=tfuncretnode(inherited getcopy);
|
||||
n.funcretprocinfo:=funcretprocinfo;
|
||||
{$ifdef NEWST}
|
||||
n.retsym:=retsym;
|
||||
{$else NEWST}
|
||||
n.rettype:=rettype;
|
||||
{$endif NEWST}
|
||||
getcopy:=n;
|
||||
end;
|
||||
|
||||
function tfuncretnode.pass_1 : tnode;
|
||||
begin
|
||||
resulttype:=rettype.def;
|
||||
location.loc:=LOC_REFERENCE;
|
||||
if ret_in_param(rettype.def) or
|
||||
(procinfo<>pprocinfo(funcretprocinfo)) then
|
||||
registers32:=1;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TARRAYCONSTRUCTRANGENODE
|
||||
*****************************************************************************}
|
||||
|
||||
constructor tarrayconstructrangenode.create(l,r : tnode);
|
||||
|
||||
begin
|
||||
inherited create(arrayconstructn,l,r);
|
||||
end;
|
||||
|
||||
function tarrayconstructrangenode.pass_1 : tnode;
|
||||
begin
|
||||
firstpass(left);
|
||||
left.set_varstate(true);
|
||||
firstpass(right);
|
||||
right.set_varstate(true);
|
||||
calcregisters(p,0,0,0);
|
||||
resulttype:=left.resulttype;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TARRAYCONSTRUCTNODE
|
||||
*****************************************************************************}
|
||||
|
||||
constructor tarrayconstrucnode.create(l,r : tnode);
|
||||
|
||||
begin
|
||||
inherited create(arrayconstructnode,l,r);
|
||||
constructdef:=nil;
|
||||
end;
|
||||
|
||||
function tarrayconstrucnode.getcopy : tnode;
|
||||
|
||||
var
|
||||
n : tarrayconstructnode;
|
||||
|
||||
begin
|
||||
n:=tarrayconstructnode(inherited getcopy);
|
||||
n.constructdef:=constructdef;
|
||||
end;
|
||||
|
||||
function tarrayconstructnode.pass_1 : tnode;
|
||||
var
|
||||
pd : pdef;
|
||||
thp,
|
||||
chp,
|
||||
hp : tnode;
|
||||
len : longint;
|
||||
varia : boolean;
|
||||
begin
|
||||
{ are we allowing array constructor? Then convert it to a set }
|
||||
if not allow_array_constructor then
|
||||
begin
|
||||
arrayconstructor_to_set(p);
|
||||
firstpass(p);
|
||||
exit;
|
||||
end;
|
||||
{ only pass left tree, right tree contains next construct if any }
|
||||
pd:=constructdef;
|
||||
len:=0;
|
||||
varia:=false;
|
||||
if assigned(left) then
|
||||
begin
|
||||
hp:=p;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
firstpass(hp.left);
|
||||
hp.left.set_varstate(true);
|
||||
if (not get_para_resulttype) and (not novariaallowed) then
|
||||
begin
|
||||
case hp.left.resulttype^.deftype of
|
||||
enumdef :
|
||||
begin
|
||||
hp.left:=gentypeconvnode(hp.left,s32bitdef);
|
||||
firstpass(hp.left);
|
||||
end;
|
||||
orddef :
|
||||
begin
|
||||
if is_integer(hp.left.resulttype) and
|
||||
not(is_64bitint(hp.left.resulttype)) then
|
||||
begin
|
||||
hp.left:=gentypeconvnode(hp.left,s32bitdef);
|
||||
firstpass(hp.left);
|
||||
end;
|
||||
end;
|
||||
floatdef :
|
||||
begin
|
||||
hp.left:=gentypeconvnode(hp.left,bestrealdef^);
|
||||
firstpass(hp.left);
|
||||
end;
|
||||
stringdef :
|
||||
begin
|
||||
if cargs then
|
||||
begin
|
||||
hp.left:=gentypeconvnode(hp.left,charpointerdef);
|
||||
firstpass(hp.left);
|
||||
end;
|
||||
end;
|
||||
procvardef :
|
||||
begin
|
||||
hp.left:=gentypeconvnode(hp.left,voidpointerdef);
|
||||
firstpass(hp.left);
|
||||
end;
|
||||
pointerdef,
|
||||
classrefdef,
|
||||
objectdef : ;
|
||||
else
|
||||
CGMessagePos1(hp.left.fileinfo,type_e_wrong_type_in_array_constructor,hp.left.resulttype^.typename);
|
||||
end;
|
||||
end;
|
||||
if (pd=nil) then
|
||||
pd:=hp.left.resulttype
|
||||
else
|
||||
begin
|
||||
if ((novariaallowed) or (not varia)) and
|
||||
(not is_equal(pd,hp.left.resulttype)) then
|
||||
begin
|
||||
{ if both should be equal try inserting a conversion }
|
||||
if novariaallowed then
|
||||
begin
|
||||
hp.left:=gentypeconvnode(hp.left,pd);
|
||||
firstpass(hp.left);
|
||||
end;
|
||||
varia:=true;
|
||||
end;
|
||||
end;
|
||||
inc(len);
|
||||
hp:=hp.right;
|
||||
end;
|
||||
{ swap the tree for cargs }
|
||||
if cargs and (not cargswap) then
|
||||
begin
|
||||
chp:=nil;
|
||||
hp:=p;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
thp:=hp.right;
|
||||
hp.right:=chp;
|
||||
chp:=hp;
|
||||
hp:=thp;
|
||||
end;
|
||||
p:=chp;
|
||||
cargs:=true;
|
||||
cargswap:=true;
|
||||
end;
|
||||
end;
|
||||
calcregisters(p,0,0,0);
|
||||
{ looks a little bit dangerous to me }
|
||||
{ len-1 gives problems with is_open_array if len=0, }
|
||||
{ is_open_array checks now for isconstructor (FK) }
|
||||
{ if no type is set then we set the type to voiddef to overcome a
|
||||
0 addressing }
|
||||
if not assigned(pd) then
|
||||
pd:=voiddef;
|
||||
{ skip if already done ! (PM) }
|
||||
if not assigned(resulttype) or
|
||||
(resulttype^.deftype<>arraydef) or
|
||||
not parraydef(resulttype)^.IsConstructor or
|
||||
(parraydef(resulttype)^.lowrange<>0) or
|
||||
(parraydef(resulttype)^.highrange<>len-1) then
|
||||
resulttype:=new(parraydef,init(0,len-1,s32bitdef));
|
||||
parraydef(resulttype)^.elementtype.def:=pd;
|
||||
parraydef(resulttype)^.IsConstructor:=true;
|
||||
parraydef(resulttype)^.IsVariant:=varia;
|
||||
location.loc:=LOC_MEM;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TTYPENODE
|
||||
*****************************************************************************}
|
||||
|
||||
constructor ttypenode.create(t : pdef;sym:ptypesym);
|
||||
|
||||
begin
|
||||
inherited create(typen);
|
||||
resulttype:=generrordef;
|
||||
typenodetype:=t;
|
||||
typenodesym:=sym;
|
||||
end;
|
||||
|
||||
function ttypenode.getcopy : tnode;
|
||||
|
||||
var
|
||||
n : ttypenode;
|
||||
|
||||
begin
|
||||
n:=ttypenode(inherited getcopy);
|
||||
n.typenodetype:=typenodetype;
|
||||
n.typenodesym:=typenodesym;
|
||||
end;
|
||||
|
||||
function ttypenode.pass_1 : tnode;
|
||||
begin
|
||||
pass_1:=nil;
|
||||
{ do nothing, resulttype is already set }
|
||||
end;
|
||||
|
||||
|
||||
begin
|
||||
cloadnode:=tloadnode;
|
||||
cassignmentnode:=tassignmentnode;
|
||||
cfuncretnode:=tfuncretnode;
|
||||
carrayconstructorrangenode:=tarrayconstructorrangenode;
|
||||
carrayconstructnode:=tarrayconstructnode;
|
||||
ctypenode:=ttypenode;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2000-09-25 14:55:05 florian
|
||||
* initial revision
|
||||
|
||||
}
|
||||
Loading…
Reference in New Issue
Block a user