123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020 |
- {
- $Id$
- Copyright (c) 2000-2002 by Florian Klaempfl
- Type checking and register allocation for constants
- 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 ncon;
- {$i fpcdefs.inc}
- interface
- uses
- globtype,widestr,
- node,
- aasmbase,aasmtai,cpuinfo,globals,
- symconst,symppu,symtype,symdef,symsym;
- type
- trealconstnode = class(tnode)
- restype : ttype;
- value_real : bestreal;
- lab_real : tasmlabel;
- constructor create(v : bestreal;const t:ttype);virtual;
- constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
- procedure ppuwrite(ppufile:tcompilerppufile);override;
- procedure derefimpl;override;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- function det_resulttype:tnode;override;
- function docompare(p: tnode) : boolean; override;
- end;
- trealconstnodeclass = class of trealconstnode;
- tordconstnode = class(tnode)
- restype : ttype;
- value : TConstExprInt;
- rangecheck : boolean;
- { create an ordinal constant node of the specified type and value.
- _rangecheck determines if the value of the ordinal should be checked
- against the ranges of the type definition.
- }
- constructor create(v : tconstexprint;const t:ttype; _rangecheck : boolean);virtual;
- constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
- procedure ppuwrite(ppufile:tcompilerppufile);override;
- procedure derefimpl;override;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- function det_resulttype:tnode;override;
- function docompare(p: tnode) : boolean; override;
- {$ifdef extdebug}
- procedure _dowrite;override;
- {$endif}
- end;
- tordconstnodeclass = class of tordconstnode;
- tpointerconstnode = class(tnode)
- restype : ttype;
- value : TConstPtrUInt;
- constructor create(v : TConstPtrUInt;const t:ttype);virtual;
- constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
- procedure ppuwrite(ppufile:tcompilerppufile);override;
- procedure derefimpl;override;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- function det_resulttype:tnode;override;
- function docompare(p: tnode) : boolean; override;
- end;
- tpointerconstnodeclass = class of tpointerconstnode;
- tstringconstnode = class(tnode)
- value_str : pchar;
- len : longint;
- lab_str : tasmlabel;
- st_type : tstringtype;
- constructor createstr(const s : string;st:tstringtype);virtual;
- constructor createpchar(s : pchar;l : longint);virtual;
- constructor createwstr(w : pcompilerwidestring);virtual;
- constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
- procedure ppuwrite(ppufile:tcompilerppufile);override;
- procedure derefimpl;override;
- destructor destroy;override;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- function det_resulttype:tnode;override;
- function getpcharcopy : pchar;
- function docompare(p: tnode) : boolean; override;
- end;
- tstringconstnodeclass = class of tstringconstnode;
- tsetconstnode = class(tunarynode)
- restype : ttype;
- value_set : pconstset;
- lab_set : tasmlabel;
- constructor create(s : pconstset;const t:ttype);virtual;
- destructor destroy;override;
- constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
- procedure ppuwrite(ppufile:tcompilerppufile);override;
- procedure derefimpl;override;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- function det_resulttype:tnode;override;
- function docompare(p: tnode) : boolean; override;
- end;
- tsetconstnodeclass = class of tsetconstnode;
- tnilnode = class(tnode)
- constructor create;virtual;
- function pass_1 : tnode;override;
- function det_resulttype:tnode;override;
- end;
- tnilnodeclass = class of tnilnode;
- tguidconstnode = class(tnode)
- value : tguid;
- constructor create(const g:tguid);virtual;
- constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override;
- procedure ppuwrite(ppufile:tcompilerppufile);override;
- function getcopy : tnode;override;
- function pass_1 : tnode;override;
- function det_resulttype:tnode;override;
- function docompare(p: tnode) : boolean; override;
- end;
- tguidconstnodeclass = class of tguidconstnode;
- var
- crealconstnode : trealconstnodeclass;
- cordconstnode : tordconstnodeclass;
- cpointerconstnode : tpointerconstnodeclass;
- cstringconstnode : tstringconstnodeclass;
- csetconstnode : tsetconstnodeclass;
- cguidconstnode : tguidconstnodeclass;
- cnilnode : tnilnodeclass;
- function genintconstnode(v : TConstExprInt) : tordconstnode;
- function genenumnode(v : tenumsym) : tordconstnode;
- { some helper routines }
- {$ifdef INT64FUNCRESOK}
- function get_ordinal_value(p : tnode) : TConstExprInt;
- {$else INT64FUNCRESOK}
- function get_ordinal_value(p : tnode) : longint;
- {$endif INT64FUNCRESOK}
- function is_constnode(p : tnode) : boolean;
- function is_constintnode(p : tnode) : boolean;
- function is_constcharnode(p : tnode) : boolean;
- function is_constrealnode(p : tnode) : boolean;
- function is_constboolnode(p : tnode) : boolean;
- function is_constresourcestringnode(p : tnode) : boolean;
- function is_constwidecharnode(p : tnode) : boolean;
- function str_length(p : tnode) : longint;
- function is_emptyset(p : tnode):boolean;
- function genconstsymtree(p : tconstsym) : tnode;
- implementation
- uses
- cutils,verbose,systems,
- defbase,cpubase,nld;
- function genintconstnode(v : TConstExprInt) : tordconstnode;
- var
- i,i2 : TConstExprInt;
- begin
- { we need to bootstrap this code, so it's a little bit messy }
- i:=2147483647;
- { maxcardinal }
- i2 := i+i+1;
- if (v<=i) and (v>=-i-1) then
- genintconstnode:=cordconstnode.create(v,s32bittype,true)
- else if (v > i) and (v <= i2) then
- genintconstnode:=cordconstnode.create(v,u32bittype,true)
- else
- genintconstnode:=cordconstnode.create(v,cs64bittype,true);
- end;
- function genenumnode(v : tenumsym) : tordconstnode;
- var
- htype : ttype;
- begin
- htype.setdef(v.definition);
- genenumnode:=cordconstnode.create(v.value,htype,true);
- end;
- {$ifdef INT64FUNCRESOK}
- function get_ordinal_value(p : tnode) : TConstExprInt;
- {$else INT64FUNCRESOK}
- function get_ordinal_value(p : tnode) : longint;
- {$endif INT64FUNCRESOK}
- begin
- if p.nodetype=ordconstn then
- get_ordinal_value:=tordconstnode(p).value
- else
- begin
- Message(type_e_ordinal_expr_expected);
- get_ordinal_value:=0;
- end;
- end;
- function is_constnode(p : tnode) : boolean;
- begin
- is_constnode:=(p.nodetype in [ordconstn,realconstn,stringconstn,setconstn,guidconstn]);
- end;
- function is_constintnode(p : tnode) : boolean;
- begin
- is_constintnode:=(p.nodetype=ordconstn) and is_integer(p.resulttype.def);
- end;
- function is_constcharnode(p : tnode) : boolean;
- begin
- is_constcharnode:=(p.nodetype=ordconstn) and is_char(p.resulttype.def);
- end;
- function is_constwidecharnode(p : tnode) : boolean;
- begin
- is_constwidecharnode:=(p.nodetype=ordconstn) and is_widechar(p.resulttype.def);
- end;
- function is_constrealnode(p : tnode) : boolean;
- begin
- is_constrealnode:=(p.nodetype=realconstn);
- end;
- function is_constboolnode(p : tnode) : boolean;
- begin
- is_constboolnode:=(p.nodetype=ordconstn) and is_boolean(p.resulttype.def);
- end;
- function is_constresourcestringnode(p : tnode) : boolean;
- begin
- is_constresourcestringnode:=(p.nodetype=loadn) and
- (tloadnode(p).symtableentry.typ=constsym) and
- (tconstsym(tloadnode(p).symtableentry).consttyp=constresourcestring);
- end;
- function str_length(p : tnode) : longint;
- begin
- str_length:=tstringconstnode(p).len;
- end;
- {$ifdef oldset}
- function is_emptyset(p : tnode):boolean;
- var
- i : longint;
- begin
- i:=0;
- if p.nodetype=setconstn then
- begin
- while (i<32) and (tsetconstnode(p).value_set^[i]=0) do
- inc(i);
- end;
- is_emptyset:=(i=32);
- end;
- {$else}
- function is_emptyset(p : tnode):boolean;
- begin
- is_emptyset:=(p.nodetype=setconstn) and
- (Tsetconstnode(p).value_set^=[]);
- end;
- {$endif}
- function genconstsymtree(p : tconstsym) : tnode;
- var
- p1 : tnode;
- len : longint;
- pc : pchar;
- begin
- p1:=nil;
- case p.consttyp of
- constint :
- p1:=genintconstnode(p.valueord);
- conststring :
- begin
- len:=p.len;
- if not(cs_ansistrings in aktlocalswitches) and (len>255) then
- len:=255;
- getmem(pc,len+1);
- move(pchar(p.valueptr)^,pc^,len);
- pc[len]:=#0;
- p1:=cstringconstnode.createpchar(pc,len);
- end;
- constchar :
- p1:=cordconstnode.create(p.valueord,cchartype,true);
- constreal :
- p1:=crealconstnode.create(pbestreal(p.valueptr)^,pbestrealtype^);
- constbool :
- p1:=cordconstnode.create(p.valueord,booltype,true);
- constset :
- p1:=csetconstnode.create(pconstset(p.valueptr),p.consttype);
- constord :
- p1:=cordconstnode.create(p.valueord,p.consttype,true);
- constpointer :
- p1:=cpointerconstnode.create(p.valueordptr,p.consttype);
- constnil :
- p1:=cnilnode.create;
- else
- internalerror(200205103);
- end;
- genconstsymtree:=p1;
- end;
- {*****************************************************************************
- TREALCONSTNODE
- *****************************************************************************}
- { generic code }
- { overridden by: }
- { i386 }
- constructor trealconstnode.create(v : bestreal;const t:ttype);
- begin
- inherited create(realconstn);
- restype:=t;
- value_real:=v;
- lab_real:=nil;
- end;
- constructor trealconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
- begin
- inherited ppuload(t,ppufile);
- ppufile.gettype(restype);
- value_real:=ppufile.getreal;
- lab_real:=tasmlabel(ppufile.getasmsymbol);
- end;
- procedure trealconstnode.ppuwrite(ppufile:tcompilerppufile);
- begin
- inherited ppuwrite(ppufile);
- ppufile.puttype(restype);
- ppufile.putreal(value_real);
- ppufile.putasmsymbol(lab_real);
- end;
- procedure trealconstnode.derefimpl;
- begin
- inherited derefimpl;
- restype.resolve;
- objectlibrary.derefasmsymbol(tasmsymbol(lab_real));
- end;
- function trealconstnode.getcopy : tnode;
- var
- n : trealconstnode;
- begin
- n:=trealconstnode(inherited getcopy);
- n.value_real:=value_real;
- n.lab_real:=lab_real;
- getcopy:=n;
- end;
- function trealconstnode.det_resulttype:tnode;
- begin
- result:=nil;
- resulttype:=restype;
- end;
- function trealconstnode.pass_1 : tnode;
- begin
- result:=nil;
- location.loc:=LOC_CREFERENCE;
- { needs to be loaded into an FPU register }
- registersfpu:=1;
- end;
- function trealconstnode.docompare(p: tnode): boolean;
- begin
- docompare :=
- inherited docompare(p) and
- (value_real = trealconstnode(p).value_real);
- end;
- {*****************************************************************************
- TORDCONSTNODE
- *****************************************************************************}
- constructor tordconstnode.create(v : tconstexprint;const t:ttype;_rangecheck : boolean);
- begin
- inherited create(ordconstn);
- value:=v;
- restype:=t;
- rangecheck := _rangecheck;
- end;
- constructor tordconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
- begin
- inherited ppuload(t,ppufile);
- ppufile.gettype(restype);
- value:=ppufile.getexprint;
- { normally, the value is already compiled, so we don't need
- to do once again a range check
- }
- rangecheck := false;
- end;
- procedure tordconstnode.ppuwrite(ppufile:tcompilerppufile);
- begin
- inherited ppuwrite(ppufile);
- ppufile.puttype(restype);
- ppufile.putexprint(value);
- end;
- procedure tordconstnode.derefimpl;
- begin
- inherited derefimpl;
- restype.resolve;
- end;
- function tordconstnode.getcopy : tnode;
- var
- n : tordconstnode;
- begin
- n:=tordconstnode(inherited getcopy);
- n.value:=value;
- n.restype := restype;
- getcopy:=n;
- end;
- function tordconstnode.det_resulttype:tnode;
- begin
- result:=nil;
- resulttype:=restype;
- { only do range checking when explicitly asked for it }
- if rangecheck then
- testrange(resulttype.def,value,false);
- end;
- function tordconstnode.pass_1 : tnode;
- begin
- result:=nil;
- if is_64bitint(resulttype.def) then
- location.loc:=LOC_CREFERENCE
- else
- location.loc:=LOC_CONSTANT;
- end;
- function tordconstnode.docompare(p: tnode): boolean;
- begin
- docompare :=
- inherited docompare(p) and
- (value = tordconstnode(p).value);
- end;
- {$ifdef extdebug}
- procedure Tordconstnode._dowrite;
- begin
- inherited _dowrite;
- system.write(',value = ',value);
- end;
- {$endif}
- {*****************************************************************************
- TPOINTERCONSTNODE
- *****************************************************************************}
- constructor tpointerconstnode.create(v : TConstPtrUInt;const t:ttype);
- begin
- inherited create(pointerconstn);
- value:=v;
- restype:=t;
- end;
- constructor tpointerconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
- begin
- inherited ppuload(t,ppufile);
- ppufile.gettype(restype);
- value:=ppufile.getptruint;
- end;
- procedure tpointerconstnode.ppuwrite(ppufile:tcompilerppufile);
- begin
- inherited ppuwrite(ppufile);
- ppufile.puttype(restype);
- ppufile.putptruint(value);
- end;
- procedure tpointerconstnode.derefimpl;
- begin
- inherited derefimpl;
- restype.resolve;
- end;
- function tpointerconstnode.getcopy : tnode;
- var
- n : tpointerconstnode;
- begin
- n:=tpointerconstnode(inherited getcopy);
- n.value:=value;
- n.restype := restype;
- getcopy:=n;
- end;
- function tpointerconstnode.det_resulttype:tnode;
- begin
- result:=nil;
- resulttype:=restype;
- end;
- function tpointerconstnode.pass_1 : tnode;
- begin
- result:=nil;
- location.loc:=LOC_CONSTANT;
- end;
- function tpointerconstnode.docompare(p: tnode): boolean;
- begin
- docompare :=
- inherited docompare(p) and
- (value = tpointerconstnode(p).value);
- end;
- {*****************************************************************************
- TSTRINGCONSTNODE
- *****************************************************************************}
- constructor tstringconstnode.createstr(const s : string;st:tstringtype);
- var
- l : longint;
- begin
- inherited create(stringconstn);
- l:=length(s);
- len:=l;
- { stringdup write even past a #0 }
- getmem(value_str,l+1);
- move(s[1],value_str^,l);
- value_str[l]:=#0;
- lab_str:=nil;
- if st=st_default then
- begin
- if cs_ansistrings in aktlocalswitches then
- st_type:=st_ansistring
- else
- st_type:=st_shortstring;
- end
- else
- st_type:=st;
- end;
- constructor tstringconstnode.createwstr(w : pcompilerwidestring);
- begin
- inherited create(stringconstn);
- len:=getlengthwidestring(w);
- initwidestring(pcompilerwidestring(value_str));
- copywidestring(w,pcompilerwidestring(value_str));
- lab_str:=nil;
- st_type:=st_widestring;
- end;
- constructor tstringconstnode.createpchar(s : pchar;l : longint);
- begin
- inherited create(stringconstn);
- len:=l;
- value_str:=s;
- if (cs_ansistrings in aktlocalswitches) or
- (len>255) then
- st_type:=st_ansistring
- else
- st_type:=st_shortstring;
- lab_str:=nil;
- end;
- destructor tstringconstnode.destroy;
- begin
- if st_type=st_widestring then
- donewidestring(pcompilerwidestring(value_str))
- else
- ansistringdispose(value_str,len);
- inherited destroy;
- end;
- constructor tstringconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
- begin
- inherited ppuload(t,ppufile);
- st_type:=tstringtype(ppufile.getbyte);
- len:=ppufile.getlongint;
- getmem(value_str,len+1);
- ppufile.getdata(value_str^,len);
- value_str[len]:=#0;
- lab_str:=tasmlabel(ppufile.getasmsymbol);
- end;
- procedure tstringconstnode.ppuwrite(ppufile:tcompilerppufile);
- begin
- inherited ppuwrite(ppufile);
- ppufile.putbyte(byte(st_type));
- ppufile.putlongint(len);
- ppufile.putdata(value_str^,len);
- ppufile.putasmsymbol(lab_str);
- end;
- procedure tstringconstnode.derefimpl;
- begin
- inherited derefimpl;
- objectlibrary.derefasmsymbol(tasmsymbol(lab_str));
- end;
- function tstringconstnode.getcopy : tnode;
- var
- n : tstringconstnode;
- begin
- n:=tstringconstnode(inherited getcopy);
- n.st_type:=st_type;
- n.len:=len;
- n.lab_str:=lab_str;
- if st_type=st_widestring then
- begin
- initwidestring(pcompilerwidestring(n.value_str));
- copywidestring(pcompilerwidestring(value_str),pcompilerwidestring(n.value_str));
- end
- else
- n.value_str:=getpcharcopy;
- getcopy:=n;
- end;
- function tstringconstnode.det_resulttype:tnode;
- begin
- result:=nil;
- case st_type of
- st_shortstring :
- resulttype:=cshortstringtype;
- st_ansistring :
- resulttype:=cansistringtype;
- st_widestring :
- resulttype:=cwidestringtype;
- st_longstring :
- resulttype:=clongstringtype;
- end;
- end;
- function tstringconstnode.pass_1 : tnode;
- begin
- result:=nil;
- location.loc:=LOC_CREFERENCE;
- end;
- function tstringconstnode.getpcharcopy : pchar;
- var
- pc : pchar;
- begin
- pc:=nil;
- getmem(pc,len+1);
- if pc=nil then
- Message(general_f_no_memory_left);
- move(value_str^,pc^,len+1);
- getpcharcopy:=pc;
- end;
- function tstringconstnode.docompare(p: tnode): boolean;
- begin
- docompare :=
- inherited docompare(p) and
- (len = tstringconstnode(p).len) and
- { Don't compare the pchars, since they may contain null chars }
- { Since all equal constant strings are replaced by the same }
- { label, the following compare should be enough (JM) }
- (lab_str = tstringconstnode(p).lab_str);
- end;
- {*****************************************************************************
- TSETCONSTNODE
- *****************************************************************************}
- constructor tsetconstnode.create(s : pconstset;const t:ttype);
- begin
- inherited create(setconstn,nil);
- restype:=t;
- if assigned(s) then
- begin
- new(value_set);
- value_set^:=s^;
- end
- else
- value_set:=nil;
- end;
- destructor tsetconstnode.destroy;
- begin
- if assigned(value_set) then
- dispose(value_set);
- inherited destroy;
- end;
- constructor tsetconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
- begin
- inherited ppuload(t,ppufile);
- ppufile.gettype(restype);
- new(value_set);
- ppufile.getdata(value_set^,sizeof(tconstset));
- end;
- procedure tsetconstnode.ppuwrite(ppufile:tcompilerppufile);
- begin
- inherited ppuwrite(ppufile);
- ppufile.puttype(restype);
- ppufile.putdata(value_set^,sizeof(tconstset));
- end;
- procedure tsetconstnode.derefimpl;
- begin
- inherited derefimpl;
- restype.resolve;
- end;
- function tsetconstnode.getcopy : tnode;
- var
- n : tsetconstnode;
- begin
- n:=tsetconstnode(inherited getcopy);
- if assigned(value_set) then
- begin
- new(n.value_set);
- n.value_set^:=value_set^
- end
- else
- n.value_set:=nil;
- n.restype := restype;
- n.lab_set:=lab_set;
- getcopy:=n;
- end;
- function tsetconstnode.det_resulttype:tnode;
- begin
- result:=nil;
- resulttype:=restype;
- end;
- function tsetconstnode.pass_1 : tnode;
- begin
- result:=nil;
- if tsetdef(resulttype.def).settype=smallset then
- location.loc:=LOC_CONSTANT
- else
- location.loc:=LOC_CREFERENCE;
- end;
- {$ifdef oldset}
- function tsetconstnode.docompare(p: tnode): boolean;
- var
- i: 0..31;
- begin
- if inherited docompare(p) then
- begin
- for i := 0 to 31 do
- if (value_set^[i] <> tsetconstnode(p).value_set^[i]) then
- begin
- docompare := false;
- exit
- end;
- docompare := true;
- end
- else
- docompare := false;
- end;
- {$else}
- function tsetconstnode.docompare(p: tnode): boolean;
- begin
- docompare:=(inherited docompare(p))
- and (value_set^=Tsetconstnode(p).value_set^);
- end;
- {$endif}
- {*****************************************************************************
- TNILNODE
- *****************************************************************************}
- constructor tnilnode.create;
- begin
- inherited create(niln);
- end;
- function tnilnode.det_resulttype:tnode;
- begin
- result:=nil;
- resulttype:=voidpointertype;
- end;
- function tnilnode.pass_1 : tnode;
- begin
- result:=nil;
- location.loc:=LOC_CONSTANT;
- end;
- {*****************************************************************************
- TGUIDCONSTNODE
- *****************************************************************************}
- constructor tguidconstnode.create(const g:tguid);
- begin
- inherited create(guidconstn);
- value:=g;
- end;
- constructor tguidconstnode.ppuload(t:tnodetype;ppufile:tcompilerppufile);
- begin
- inherited ppuload(t,ppufile);
- ppufile.getguid(value);
- end;
- procedure tguidconstnode.ppuwrite(ppufile:tcompilerppufile);
- begin
- inherited ppuwrite(ppufile);
- ppufile.putguid(value);
- end;
- function tguidconstnode.getcopy : tnode;
- var
- n : tguidconstnode;
- begin
- n:=tguidconstnode(inherited getcopy);
- n.value:=value;
- getcopy:=n;
- end;
- function tguidconstnode.det_resulttype:tnode;
- begin
- result:=nil;
- resulttype.setdef(rec_tguid);
- end;
- function tguidconstnode.pass_1 : tnode;
- begin
- result:=nil;
- location.loc:=LOC_CREFERENCE;
- end;
- function tguidconstnode.docompare(p: tnode): boolean;
- begin
- docompare :=
- inherited docompare(p) and
- (guid2string(value) = guid2string(tguidconstnode(p).value));
- end;
- begin
- crealconstnode:=trealconstnode;
- cordconstnode:=tordconstnode;
- cpointerconstnode:=tpointerconstnode;
- cstringconstnode:=tstringconstnode;
- csetconstnode:=tsetconstnode;
- cnilnode:=tnilnode;
- cguidconstnode:=tguidconstnode;
- end.
- {
- $Log$
- Revision 1.43 2002-10-05 12:43:25 carl
- * fixes for Delphi 6 compilation
- (warning : Some features do not work under Delphi)
- Revision 1.42 2002/09/07 15:25:03 peter
- * old logs removed and tabs fixed
- Revision 1.41 2002/09/07 12:16:04 carl
- * second part bug report 1996 fix, testrange in cordconstnode
- only called if option is set (also make parsing a tiny faster)
- Revision 1.40 2002/08/22 11:21:44 florian
- + register32 is now written by tnode.dowrite
- * fixed write of value of tconstnode
- Revision 1.39 2002/08/18 20:06:23 peter
- * inlining is now also allowed in interface
- * renamed write/load to ppuwrite/ppuload
- * tnode storing in ppu
- * nld,ncon,nbas are already updated for storing in ppu
- Revision 1.38 2002/08/17 22:09:45 florian
- * result type handling in tcgcal.pass_2 overhauled
- * better tnode.dowrite
- * some ppc stuff fixed
- Revision 1.37 2002/07/23 12:34:30 daniel
- * Readded old set code. To use it define 'oldset'. Activated by default
- for ppc.
- Revision 1.36 2002/07/22 11:48:04 daniel
- * Sets are now internally sets.
- Revision 1.35 2002/07/20 11:57:54 florian
- * types.pas renamed to defbase.pas because D6 contains a types
- unit so this would conflicts if D6 programms are compiled
- + Willamette/SSE2 instructions to assembler added
- Revision 1.34 2002/07/14 18:00:43 daniel
- + Added the beginning of a state tracker. This will track the values of
- variables through procedures and optimize things away.
- Revision 1.33 2002/07/01 18:46:23 peter
- * internal linker
- * reorganized aasm layer
- Revision 1.32 2002/05/18 13:34:09 peter
- * readded missing revisions
- Revision 1.31 2002/05/16 19:46:37 carl
- + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
- + try to fix temp allocation (still in ifdef)
- + generic constructor calls
- + start of tassembler / tmodulebase class cleanup
- Revision 1.29 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.28 2002/04/07 13:25:20 carl
- + change unit use
- Revision 1.27 2002/04/04 19:05:58 peter
- * removed unused units
- * use tlocation.size in cg.a_*loc*() routines
- Revision 1.26 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.25 2002/03/04 19:10:11 peter
- * removed compiler warnings
- }
|