diff --git a/compiler/nadd.pas b/compiler/nadd.pas index 2ccbf78349..94113e3ca3 100644 --- a/compiler/nadd.pas +++ b/compiler/nadd.pas @@ -39,13 +39,14 @@ interface { parts explicitely in the code generator (JM) } function first_addstring: tnode; virtual; end; + taddnodeclass = class of taddnode; var { caddnode is used to create nodes of the add type } { the virtual constructor allows to assign } { another class type to caddnode => processor } { specific node types can be created } - caddnode : class of taddnode; + caddnode : taddnodeclass; implementation @@ -120,7 +121,6 @@ implementation hp:=self; if isbinaryoverloaded(hp) then begin - resulttypepass(hp); result:=hp; exit; end; @@ -261,18 +261,19 @@ implementation slashn : begin { int/int becomes a real } - if int(rv)=0 then + rvd:=rv; + lvd:=lv; + if int(rvd)=0 then begin Message(parser_e_invalid_float_operation); t:=crealconstnode.create(0,pbestrealtype^); end else - t:=crealconstnode.create(int(lv)/int(rv),pbestrealtype^); + t:=crealconstnode.create(int(lvd)/int(rvd),pbestrealtype^); end; else CGMessage(type_e_mismatch); end; - resulttypepass(t); result:=t; exit; end; @@ -327,7 +328,6 @@ implementation else CGMessage(type_e_mismatch); end; - resulttypepass(t); result:=t; exit; end; @@ -367,7 +367,6 @@ implementation end; donewidestring(ws1); donewidestring(ws2); - resulttypepass(t); result:=t; exit; end; @@ -432,7 +431,6 @@ implementation end; ansistringdispose(s1,l1); ansistringdispose(s2,l2); - resulttypepass(t); result:=t; exit; end; @@ -526,7 +524,6 @@ implementation End; end; dispose(resultset); - resulttypepass(t); result:=t; exit; end; @@ -585,7 +582,6 @@ implementation (b and (ot=unequaln)) then begin hp:=cnotnode.create(hp); - resulttypepass(hp); end; result:=hp; exit; @@ -602,7 +598,6 @@ implementation (b and (ot=unequaln)) then begin hp:=cnotnode.create(hp); - resulttypepass(hp); end; result:=hp; exit; @@ -623,7 +618,6 @@ implementation begin inserttypeconv(left,cshortstringtype); hp := genaddsstringcharoptnode(self); - resulttypepass(hp); result := hp; exit; end; @@ -811,7 +805,7 @@ implementation if not(is_shortstring(rd) or is_char(rd)) then inserttypeconv(right,cshortstringtype); end; - + end { pointer comparision and subtraction } @@ -1375,7 +1369,10 @@ begin end. { $Log$ - Revision 1.35 2001-08-31 15:42:15 jonas + Revision 1.36 2001-09-02 21:12:06 peter + * move class of definitions into type section for delphi + + Revision 1.35 2001/08/31 15:42:15 jonas * added missing type conversion from small to normal sets Revision 1.34 2001/08/30 15:43:14 jonas diff --git a/compiler/nbas.pas b/compiler/nbas.pas index 7952056328..29977f3be2 100644 --- a/compiler/nbas.pas +++ b/compiler/nbas.pas @@ -35,12 +35,14 @@ interface function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tnothingnodeclass = class of tnothingnode; terrornode = class(tnode) constructor create;virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + terrornodeclass = class of terrornode; tasmnode = class(tnode) p_asm : taasmoutput; @@ -51,6 +53,7 @@ interface function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; end; + tasmnodeclass = class of tasmnode; tstatementnode = class(tbinarynode) constructor create(l,r : tnode);virtual; @@ -60,12 +63,14 @@ interface procedure dowrite;override; {$endif extdebug} end; + tstatementnodeclass = class of tstatementnode; tblocknode = class(tunarynode) constructor create(l : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tblocknodeclass = class of tblocknode; { to allow access to the location by temp references even after the temp has } { already been disposed and to make sure the coherency between temps and } @@ -100,6 +105,7 @@ interface protected persistent: boolean; end; + ttempcreatenodeclass = class of ttempcreatenode; { a node which is a reference to a certain temp } ttemprefnode = class(tnode) @@ -111,6 +117,7 @@ interface protected tempinfo: ptempinfo; end; + ttemprefnodeclass = class of ttemprefnode; { a node which removes a temp } ttempdeletenode = class(tnode) @@ -123,16 +130,17 @@ interface protected tempinfo: ptempinfo; end; + ttempdeletenodeclass = class of ttempdeletenode; var - cnothingnode : class of tnothingnode; - cerrornode : class of terrornode; - casmnode : class of tasmnode; - cstatementnode : class of tstatementnode; - cblocknode : class of tblocknode; - ctempcreatenode : class of ttempcreatenode; - ctemprefnode : class of ttemprefnode; - ctempdeletenode : class of ttempdeletenode; + cnothingnode : tnothingnodeclass; + cerrornode : terrornodeclass; + casmnode : tasmnodeclass; + cstatementnode : tstatementnodeclass; + cblocknode : tblocknodeclass; + ctempcreatenode : ttempcreatenodeclass; + ctemprefnode : ttemprefnodeclass; + ctempdeletenode : ttempdeletenodeclass; implementation @@ -617,7 +625,10 @@ begin end. { $Log$ - Revision 1.16 2001-08-26 13:36:38 florian + Revision 1.17 2001-09-02 21:12:06 peter + * move class of definitions into type section for delphi + + Revision 1.16 2001/08/26 13:36:38 florian * some cg reorganisation * some PPC updates diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 5c1a35d1f9..edb476df06 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -47,7 +47,7 @@ interface { the RTL) (JM) } restype: ttype; restypeset: boolean; - + { only the processor specific nodes need to override this } { constructor } constructor create(l:tnode; v : tprocsym;st : tsymtable; mp : tnode);virtual; @@ -61,6 +61,7 @@ interface function docompare(p: tnode): boolean; override; procedure set_procvar(procvar:tnode); end; + tcallnodeclass = class of tcallnode; tcallparaflags = ( { flags used by tcallparanode } @@ -89,6 +90,7 @@ interface para_alignment,para_offset : longint);virtual;abstract; function docompare(p: tnode): boolean; override; end; + tcallparanodeclass = class of tcallparanode; tprocinlinenode = class(tnode) inlinetree : tnode; @@ -101,14 +103,15 @@ interface function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; end; + tprocinlinenodeclass = class of tprocinlinenode; function reverseparameters(p: tcallparanode): tcallparanode; var - ccallnode : class of tcallnode; - ccallparanode : class of tcallparanode; - cprocinlinenode : class of tprocinlinenode; + ccallnode : tcallnodeclass; + ccallparanode : tcallparanodeclass; + cprocinlinenode : tprocinlinenodeclass; implementation @@ -1357,7 +1360,6 @@ implementation end else hpt:=geninlinenode(tprocdef(procdefinition).extnumber,is_const,nil); - resulttypepass(hpt); result:=hpt; goto errorexit; end; @@ -1744,7 +1746,10 @@ begin end. { $Log$ - Revision 1.48 2001-08-30 15:39:59 jonas + Revision 1.49 2001-09-02 21:12:06 peter + * move class of definitions into type section for delphi + + Revision 1.48 2001/08/30 15:39:59 jonas * fixed docompare for the fields I added to tcallnode in my previous commit * removed nested comment warning diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index bdf921e180..372c0b4c83 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -77,23 +77,26 @@ interface function first_char_to_char : tnode;virtual; function first_call_helper(c : tconverttype) : tnode; end; + ttypeconvnodeclass = class of ttypeconvnode; tasnode = class(tbinarynode) constructor create(l,r : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tasnodeclass = class of tasnode; tisnode = class(tbinarynode) constructor create(l,r : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tisnodeclass = class of tisnode; var - ctypeconvnode : class of ttypeconvnode; - casnode : class of tasnode; - cisnode : class of tisnode; + ctypeconvnode : ttypeconvnodeclass; + casnode : tasnodeclass; + cisnode : tisnodeclass; procedure inserttypeconv(var p:tnode;const t:ttype); procedure arrayconstructor_to_set(var p : tarrayconstructornode); @@ -398,14 +401,14 @@ implementation if left.nodetype=ordconstn then begin { check if we have a valid pointer constant (JM) } - if (sizeof(tordconstnode) > sizeof(tpointerord)) then - if (sizeof(tpointerord) = 4) then + if (sizeof(pointer) > sizeof(TConstPtrUInt)) then + if (sizeof(TConstPtrUInt) = 4) then begin if (tordconstnode(left).value < low(longint)) or (tordconstnode(left).value > high(cardinal)) then CGMessage(parser_e_range_check_error); end - else if (sizeof(tpointerord) = 8) then + else if (sizeof(TConstPtrUInt) = 8) then begin if (tordconstnode(left).value < low(int64)) or (tordconstnode(left).value > high(qword)) then @@ -413,8 +416,7 @@ implementation end else internalerror(2001020801); - t:=cpointerconstnode.create(tpointerord(tordconstnode(left).value),resulttype); - resulttypepass(t); + t:=cpointerconstnode.create(TConstPtrUInt(tordconstnode(left).value),resulttype); result:=t; end else @@ -427,9 +429,8 @@ implementation 'fpc_chararray_to_'+lower(tstringdef(resulttype.def).stringtypname), ccallparanode.create(left,nil),resulttype); left := nil; - resulttypepass(result); end; - + function ttypeconvnode.resulttype_string_to_chararray : tnode; var arrsize: longint; @@ -454,9 +455,8 @@ implementation '_to_chararray',ccallparanode.create(left,ccallparanode.create( cordconstnode.create(arrsize,s32bittype),nil)),resulttype); left := nil; - resulttypepass(result); end; - + function ttypeconvnode.resulttype_string_to_string : tnode; var procname: string[31]; @@ -509,10 +509,9 @@ implementation st_shortstring) then stringpara.right := ccallparanode.create(cinlinenode.create( in_high_x,false,self.getcopy),nil); - + { and create the callnode } result := ccallnode.createinternres(procname,stringpara,resulttype); - resulttypepass(result); end; end; @@ -536,7 +535,6 @@ implementation end else hp:=cstringconstnode.createstr(chr(tordconstnode(left).value),tstringdef(resulttype.def).string_typ); - resulttypepass(hp); result:=hp; end else @@ -553,7 +551,6 @@ implementation { and finally the call } result := ccallnode.createinternres(procname,para,resulttype); - resulttypepass(result); end; end; @@ -570,7 +567,6 @@ implementation begin hp:=cordconstnode.create( ord(unicode2asciichar(tcompilerwidechar(tordconstnode(left).value))),cchartype); - resulttypepass(hp); result:=hp; end else if (torddef(resulttype.def).typ=uwidechar) and @@ -578,7 +574,6 @@ implementation begin hp:=cordconstnode.create( asciichar2unicode(chr(tordconstnode(left).value)),cwidechartype); - resulttypepass(hp); result:=hp; end else @@ -596,7 +591,6 @@ implementation if left.nodetype=ordconstn then begin t:=crealconstnode.create(tordconstnode(left).value,resulttype); - resulttypepass(t); result:=t; exit; end; @@ -611,7 +605,6 @@ implementation if left.nodetype=realconstn then begin t:=crealconstnode.create(trealconstnode(left).value_real,resulttype); - resulttypepass(t); result:=t; end; end; @@ -651,8 +644,6 @@ implementation left:=nil; { create a set constructor tree } arrayconstructor_to_set(tarrayconstructornode(hp)); - { now resulttypepass the set } - resulttypepass(hp); result:=hp; end; @@ -663,7 +654,6 @@ implementation 'fpc_pchar_to_'+lower(tstringdef(resulttype.def).stringtypname), ccallparanode.create(left,nil),resulttype); left := nil; - resulttypepass(result); end; @@ -765,7 +755,6 @@ implementation { tell explicitly which def we must use !! (PM) } tcallnode(hp).procdefinition:=aprocdef; left:=nil; - resulttypepass(hp); result:=hp; exit; end; @@ -843,7 +832,6 @@ implementation if left.nodetype=ordconstn then begin hp:=cordconstnode.create(tordconstnode(left).value,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -862,7 +850,6 @@ implementation if left.nodetype=ordconstn then begin hp:=cordconstnode.create(tordconstnode(left).value,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -877,7 +864,6 @@ implementation else if (left.nodetype=niln) and is_ordinal(resulttype.def) then begin hp:=cordconstnode.create(0,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -887,7 +873,6 @@ implementation (left.nodetype=pointerconstn) then begin hp:=cordconstnode.create(tpointerconstnode(left).value,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -900,7 +885,6 @@ implementation if left.nodetype=ordconstn then begin hp:=cordconstnode.create(tordconstnode(left).value,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -919,7 +903,6 @@ implementation if left.nodetype=ordconstn then begin hp:=cordconstnode.create(tordconstnode(left).value,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -938,7 +921,6 @@ implementation if left.nodetype=ordconstn then begin hp:=cordconstnode.create(tordconstnode(left).value,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -956,7 +938,6 @@ implementation if left.nodetype=ordconstn then begin hp:=cordconstnode.create(tordconstnode(left).value,resulttype); - resulttypepass(hp); result:=hp; exit; end @@ -1039,7 +1020,6 @@ implementation begin hp:=cnilnode.create; hp.resulttype:=resulttype; - resulttypepass(hp); result:=hp; exit; end; @@ -1486,7 +1466,10 @@ begin end. { $Log$ - Revision 1.35 2001-08-29 19:49:03 jonas + Revision 1.36 2001-09-02 21:12:06 peter + * move class of definitions into type section for delphi + + Revision 1.35 2001/08/29 19:49:03 jonas * some fixes in compilerprocs for chararray to string conversions * conversion from string to chararray is now also done via compilerprocs diff --git a/compiler/ncon.pas b/compiler/ncon.pas index 6ed90291d0..b29909e144 100644 --- a/compiler/ncon.pas +++ b/compiler/ncon.pas @@ -43,6 +43,7 @@ interface function det_resulttype:tnode;override; function docompare(p: tnode) : boolean; override; end; + trealconstnodeclass = class of trealconstnode; tordconstnode = class(tnode) restype : ttype; @@ -53,16 +54,18 @@ interface function det_resulttype:tnode;override; function docompare(p: tnode) : boolean; override; end; + tordconstnodeclass = class of tordconstnode; tpointerconstnode = class(tnode) restype : ttype; - value : TPointerOrd; - constructor create(v : tpointerord;const t:ttype);virtual; + value : TConstPtrUInt; + constructor create(v : TConstPtrUInt;const t:ttype);virtual; 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; @@ -79,6 +82,7 @@ interface function getpcharcopy : pchar; function docompare(p: tnode) : boolean; override; end; + tstringconstnodeclass = class of tstringconstnode; tsetconstnode = class(tunarynode) restype : ttype; @@ -91,20 +95,22 @@ interface 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; var - crealconstnode : class of trealconstnode; - cordconstnode : class of tordconstnode; - cpointerconstnode : class of tpointerconstnode; - cstringconstnode : class of tstringconstnode; - csetconstnode : class of tsetconstnode; - cnilnode : class of tnilnode; + crealconstnode : trealconstnodeclass; + cordconstnode : tordconstnodeclass; + cpointerconstnode : tpointerconstnodeclass; + cstringconstnode : tstringconstnodeclass; + csetconstnode : tsetconstnodeclass; + cnilnode : tnilnodeclass; function genintconstnode(v : TConstExprInt) : tordconstnode; function genenumnode(v : tenumsym) : tordconstnode; @@ -255,29 +261,29 @@ implementation p1:=nil; case p.consttyp of constint : - p1:=genintconstnode(p.value); + 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(tpointerord(p.value))^,pc^,len); + move(pchar(p.valueptr)^,pc^,len); pc[len]:=#0; p1:=cstringconstnode.createpchar(pc,len); end; constchar : - p1:=cordconstnode.create(p.value,cchartype); + p1:=cordconstnode.create(p.valueord,cchartype); constreal : - p1:=crealconstnode.create(pbestreal(tpointerord(p.value))^,pbestrealtype^); + p1:=crealconstnode.create(pbestreal(p.valueptr)^,pbestrealtype^); constbool : - p1:=cordconstnode.create(p.value,booltype); + p1:=cordconstnode.create(p.valueord,booltype); constset : - p1:=csetconstnode.create(pconstset(tpointerord(p.value)),p.consttype); + p1:=csetconstnode.create(pconstset(p.valueptr),p.consttype); constord : - p1:=cordconstnode.create(p.value,p.consttype); + p1:=cordconstnode.create(p.valueord,p.consttype); constpointer : - p1:=cpointerconstnode.create(p.value,p.consttype); + p1:=cpointerconstnode.create(p.valueordptr,p.consttype); constnil : p1:=cnilnode.create; constresourcestring: @@ -383,7 +389,7 @@ implementation TPOINTERCONSTNODE *****************************************************************************} - constructor tpointerconstnode.create(v : tpointerord;const t:ttype); + constructor tpointerconstnode.create(v : TConstPtrUInt;const t:ttype); begin inherited create(pointerconstn); @@ -656,7 +662,10 @@ begin end. { $Log$ - Revision 1.21 2001-08-26 13:36:40 florian + Revision 1.22 2001-09-02 21:12:06 peter + * move class of definitions into type section for delphi + + Revision 1.21 2001/08/26 13:36:40 florian * some cg reorganisation * some PPC updates diff --git a/compiler/nflw.pas b/compiler/nflw.pas index cce538ec23..eeab05e154 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -48,36 +48,42 @@ interface function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + twhilerepeatnodeclass = class of twhilerepeatnode; tifnode = class(tloopnode) constructor create(l,r,_t1 : tnode);virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + tifnodeclass = class of tifnode; tfornode = class(tloopnode) constructor create(l,r,_t1,_t2 : tnode;back : boolean);virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + tfornodeclass = class of tfornode; texitnode = class(tunarynode) constructor create(l:tnode);virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + texitnodeclass = class of texitnode; tbreaknode = class(tnode) constructor create;virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + tbreaknodeclass = class of tbreaknode; tcontinuenode = class(tnode) constructor create;virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + tcontinuenodeclass = class of tcontinuenode; tgotonode = class(tnode) labelnr : tasmlabel; @@ -89,6 +95,7 @@ interface function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; end; + tgotonodeclass = class of tgotonode; tlabelnode = class(tunarynode) labelnr : tasmlabel; @@ -101,6 +108,7 @@ interface function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; end; + tlabelnodeclass = class of tlabelnode; traisenode = class(tbinarynode) frametree : tnode; @@ -111,18 +119,21 @@ interface function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; end; + traisenodeclass = class of traisenode; ttryexceptnode = class(tloopnode) constructor create(l,r,_t1 : tnode);virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + ttryexceptnodeclass = class of ttryexceptnode; ttryfinallynode = class(tbinarynode) constructor create(l,r:tnode);virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + ttryfinallynodeclass = class of ttryfinallynode; tonnode = class(tbinarynode) exceptsymtable : tsymtable; @@ -134,6 +145,7 @@ interface function getcopy : tnode;override; function docompare(p: tnode): boolean; override; end; + tonnodeclass = class of tonnode; tfailnode = class(tnode) constructor create;virtual; @@ -141,24 +153,25 @@ interface function pass_1: tnode;override; function docompare(p: tnode): boolean; override; end; + tfailnodeclass = class of tfailnode; { for compatibilty } function genloopnode(t : tnodetype;l,r,n1 : tnode;back : boolean) : tnode; var - cwhilerepeatnode : class of twhilerepeatnode; - cifnode : class of tifnode; - cfornode : class of tfornode; - cexitnode : class of texitnode; - cbreaknode : class of tbreaknode; - ccontinuenode : class of tcontinuenode; - cgotonode : class of tgotonode; - clabelnode : class of tlabelnode; - craisenode : class of traisenode; - ctryexceptnode : class of ttryexceptnode; - ctryfinallynode : class of ttryfinallynode; - connode : class of tonnode; - cfailnode : class of tfailnode; + cwhilerepeatnode : twhilerepeatnodeclass; + cifnode : tifnodeclass; + cfornode : tfornodeclass; + cexitnode : texitnodeclass; + cbreaknode : tbreaknodeclass; + ccontinuenode : tcontinuenodeclass; + cgotonode : tgotonodeclass; + clabelnode : tlabelnodeclass; + craisenode : traisenodeclass; + ctryexceptnode : ttryexceptnodeclass; + ctryfinallynode : ttryfinallynodeclass; + connode : tonnodeclass; + cfailnode : tfailnodeclass; implementation @@ -1167,7 +1180,10 @@ begin end. { $Log$ - Revision 1.23 2001-08-30 20:56:38 peter + Revision 1.24 2001-09-02 21:12:07 peter + * move class of definitions into type section for delphi + + Revision 1.23 2001/08/30 20:56:38 peter * exit() with exceptions fix Revision 1.22 2001/08/26 13:36:40 florian diff --git a/compiler/ninl.pas b/compiler/ninl.pas index 2c7463d7eb..da598f1fb1 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -45,9 +45,10 @@ interface function handle_read_write: tnode; function handle_val: tnode; end; + tinlinenodeclass = class of tinlinenode; var - cinlinenode : class of tinlinenode; + cinlinenode : tinlinenodeclass; function geninlinenode(number : byte;is_const:boolean;l : tnode) : tinlinenode; @@ -380,7 +381,7 @@ implementation { temprefs will be part of the filepara, of which we need } { the resulttype later on and temprefs can only be } { resulttypepassed if the resulttype of the temp is known) } - resulttypepass(filetemp); + resulttypepass(tnode(filetemp)); { assign the address of the file to the temp } newstatement.left := cstatementnode.create(nil, @@ -781,7 +782,6 @@ implementation { otherwise return the newly generated block of instructions, } { but first free the errornode we generated at the beginning } result.free; - resulttypepass(newblock); result := newblock end; end; @@ -859,7 +859,7 @@ implementation newstatement := tstatementnode(newstatement.left); { set the resulttype of the temp (needed to be able to get } { the resulttype of the tempref used in the new code para) } - resulttypepass(tempcode); + resulttypepass(tnode(tempcode)); { create a temp codepara, but save the original code para to } { assign the result to later on } if assigned(codepara) then @@ -959,8 +959,6 @@ implementation { free the errornode } result.free; - { resulttypepass our new code } - resulttypepass(newblock); { and return it } result := newblock; end; @@ -1041,12 +1039,8 @@ implementation end; procedure setconstrealvalue(r : bestreal); - var - hp : tnode; begin - hp:=crealconstnode.create(r,pbestrealtype^); - resulttypepass(hp); - result:=hp; + result:=crealconstnode.create(r,pbestrealtype^); end; var @@ -1268,7 +1262,6 @@ implementation end; if hp=nil then hp:=tnode.create(errorn); - resulttypepass(hp); result:=hp; goto myexit; end @@ -1304,7 +1297,6 @@ implementation in_hi_qword : hp:=cordconstnode.create(tordconstnode(left).value shr 32,left.resulttype); end; - resulttypepass(hp); result:=hp; goto myexit; end; @@ -1342,7 +1334,6 @@ implementation if (left.nodetype=ordconstn) then begin hp:=cordconstnode.create(tordconstnode(left).value,s32bittype); - resulttypepass(hp); result:=hp; goto myexit; end; @@ -1358,7 +1349,6 @@ implementation hp:=ctypeconvnode.create(left,u8bittype); left:=nil; include(hp.flags,nf_explizit); - resulttypepass(hp); result:=hp; end; bool16bit, @@ -1368,7 +1358,6 @@ implementation hp:=ctypeconvnode.create(left,u16bittype); left:=nil; include(hp.flags,nf_explizit); - resulttypepass(hp); result:=hp; end; bool32bit : @@ -1377,7 +1366,6 @@ implementation hp:=ctypeconvnode.create(left,u32bittype); left:=nil; include(hp.flags,nf_explizit); - resulttypepass(hp); result:=hp; end; uvoid : @@ -1396,7 +1384,6 @@ implementation hp:=ctypeconvnode.create(left,s32bittype); left:=nil; include(hp.flags,nf_explizit); - resulttypepass(hp); result:=hp; end; else @@ -1411,7 +1398,6 @@ implementation hp:=ctypeconvnode.create(left,cchartype); include(hp.flags,nf_explizit); left:=nil; - resulttypepass(hp); result:=hp; end; @@ -1436,7 +1422,6 @@ implementation if (left.nodetype=stringconstn) then begin hp:=cordconstnode.create(tstringconstnode(left).len,s32bittype); - resulttypepass(hp); result:=hp; goto myexit; end; @@ -1448,7 +1433,6 @@ implementation is_widechar(left.resulttype.def) then begin hp:=cordconstnode.create(1,s32bittype); - resulttypepass(hp); result:=hp; goto myexit; end @@ -1463,7 +1447,6 @@ implementation srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name); hp:=caddnode.create(addn,cloadnode.create(tvarsym(srsym),tloadnode(left).symtable), cordconstnode.create(1,s32bittype)); - resulttypepass(hp); result:=hp; goto myexit; end @@ -1473,7 +1456,6 @@ implementation hp:=cordconstnode.create(tarraydef(left.resulttype.def).highrange- tarraydef(left.resulttype.def).lowrange+1, s32bittype); - resulttypepass(hp); result:=hp; goto myexit; end; @@ -1509,7 +1491,6 @@ implementation begin set_varstate(left,false); hp:=cordconstnode.create(0,s32bittype); - resulttypepass(hp); result:=hp; goto myexit; end; @@ -1535,7 +1516,6 @@ implementation hp:=cordconstnode.create(tordconstnode(left).value+1,left.resulttype) else hp:=cordconstnode.create(tordconstnode(left).value-1,left.resulttype); - resulttypepass(hp); result:=hp; end; end; @@ -1650,7 +1630,6 @@ implementation hp:=ccallparanode.create(cordconstnode.create(tcallparanode(left).left.resulttype.def.size,s32bittype),left); hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil); left:=nil; - resulttypepass(hp); result:=hp; end; @@ -1714,13 +1693,11 @@ implementation enumdef: begin hp:=do_lowhigh(left.resulttype); - resulttypepass(hp); result:=hp; end; setdef: begin hp:=do_lowhigh(tsetdef(left.resulttype.def).elementtype); - resulttypepass(hp); result:=hp; end; arraydef: @@ -1728,7 +1705,6 @@ implementation if inlinenumber=in_low_x then begin hp:=cordconstnode.create(tarraydef(left.resulttype.def).lowrange,tarraydef(left.resulttype.def).rangetype); - resulttypepass(hp); result:=hp; end else @@ -1738,7 +1714,6 @@ implementation begin srsym:=searchsymonlyin(tloadnode(left).symtable,'high'+tvarsym(tloadnode(left).symtableentry).name); hp:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable); - resulttypepass(hp); result:=hp; end else @@ -1753,7 +1728,6 @@ implementation { make sure the left node doesn't get disposed, since it's } { reused in the new node (JM) } left:=nil; - resulttypepass(hp); result:=hp; end else @@ -2303,7 +2277,10 @@ begin end. { $Log$ - Revision 1.54 2001-08-28 13:24:46 jonas + Revision 1.55 2001-09-02 21:12:07 peter + * move class of definitions into type section for delphi + + Revision 1.54 2001/08/28 13:24:46 jonas + compilerproc implementation of most string-related type conversions - removed all code from the compiler which has been replaced by compilerproc implementations (using {$ifdef hascompilerproc} is not diff --git a/compiler/nld.pas b/compiler/nld.pas index 4b525daa2f..2c2dcebdf4 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -41,6 +41,7 @@ interface function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; end; + tloadnodeclass = class of tloadnode; { different assignment types } tassigntype = (at_normal,at_plus,at_minus,at_star,at_slash); @@ -53,6 +54,7 @@ interface function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; end; + tassignmentnodeclass = class of tassignmentnode; tfuncretnode = class(tnode) funcretsym : tfuncretsym; @@ -62,12 +64,14 @@ interface function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; end; + tfuncretnodeclass = class of tfuncretnode; tarrayconstructorrangenode = class(tbinarynode) constructor create(l,r : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tarrayconstructorrangenodeclass = class of tarrayconstructorrangenode; tarrayconstructornode = class(tbinarynode) constructor create(l,r : tnode);virtual; @@ -77,6 +81,7 @@ interface function docompare(p: tnode): boolean; override; procedure force_type(tt:ttype); end; + tarrayconstructornodeclass = class of tarrayconstructornode; ttypenode = class(tnode) allowed : boolean; @@ -86,14 +91,15 @@ interface function det_resulttype:tnode;override; function docompare(p: tnode): boolean; override; end; + ttypenodeclass = class of ttypenode; var - cloadnode : class of tloadnode; - cassignmentnode : class of tassignmentnode; - cfuncretnode : class of tfuncretnode; - carrayconstructorrangenode : class of tarrayconstructorrangenode; - carrayconstructornode : class of tarrayconstructornode; - ctypenode : class of ttypenode; + cloadnode : tloadnodeclass; + cassignmentnode : tassignmentnodeclass; + cfuncretnode : tfuncretnodeclass; + carrayconstructorrangenode : tarrayconstructorrangenodeclass; + carrayconstructornode : tarrayconstructornodeclass; + ctypenode : ttypenodeclass; implementation @@ -153,7 +159,6 @@ implementation p1:=tnode(twithsymtable(symtable).withrefnode).getcopy; p1:=csubscriptnode.create(tvarsym(symtableentry),p1); left:=nil; - resulttypepass(p1); result:=p1; exit; end; @@ -184,7 +189,7 @@ implementation ((tfuncretsym(symtableentry)=p^.procdef.resultfuncretsym) or (tfuncretsym(symtableentry)=p^.procdef.funcretsym)) then begin - symtableentry:=p^.procdef.funcretsym; + symtableentry:=p^.procdef.funcretsym; break; end; p:=p^.parent; @@ -592,7 +597,6 @@ implementation begin hp:=tarrayconstructornode(getcopy); arrayconstructor_to_set(hp); - resulttypepass(hp); result:=hp; exit; end; @@ -796,7 +800,10 @@ begin end. { $Log$ - Revision 1.24 2001-08-30 15:48:34 jonas + Revision 1.25 2001-09-02 21:12:07 peter + * move class of definitions into type section for delphi + + Revision 1.24 2001/08/30 15:48:34 jonas * fix from Peter for getting correct symtableentry for funcret loads Revision 1.23 2001/08/26 13:36:41 florian diff --git a/compiler/nmat.pas b/compiler/nmat.pas index 1913dcd2ef..1a481359cc 100644 --- a/compiler/nmat.pas +++ b/compiler/nmat.pas @@ -34,29 +34,33 @@ interface function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tmoddivnodeclass = class of tmoddivnode; tshlshrnode = class(tbinopnode) function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tshlshrnodeclass = class of tshlshrnode; tunaryminusnode = class(tunarynode) constructor create(expr : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tunaryminusnodeclass = class of tunaryminusnode; tnotnode = class(tunarynode) constructor create(expr : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tnotnodeclass = class of tnotnode; var - cmoddivnode : class of tmoddivnode; - cshlshrnode : class of tshlshrnode; - cunaryminusnode : class of tunaryminusnode; - cnotnode : class of tnotnode; + cmoddivnode : tmoddivnodeclass; + cshlshrnode : tshlshrnodeclass; + cunaryminusnode : tunaryminusnodeclass; + cnotnode : tnotnodeclass; implementation @@ -110,7 +114,6 @@ implementation divn: t:=genintconstnode(lv div rv); end; - resulttypepass(t); result:=t; exit; end; @@ -119,7 +122,6 @@ implementation t:=self; if isbinaryoverloaded(t) then begin - resulttypepass(t); result:=t; exit; end; @@ -236,7 +238,6 @@ implementation shln: t:=genintconstnode(tordconstnode(left).value shl tordconstnode(right).value); end; - resulttypepass(t); result:=t; exit; end; @@ -245,7 +246,6 @@ implementation t:=self; if isbinaryoverloaded(t) then begin - resulttypepass(t); result:=t; exit; end; @@ -362,7 +362,6 @@ implementation t:=ccallnode.create(ccallparanode.create(left,nil), overloaded_operators[_minus],nil,nil); left:=nil; - resulttypepass(t); result:=t; exit; end; @@ -478,7 +477,6 @@ implementation CGMessage(type_e_mismatch); end; t:=cordconstnode.create(v,left.resulttype); - resulttypepass(t); result:=t; exit; end; @@ -515,7 +513,6 @@ implementation t:=ccallnode.create(ccallparanode.create(left,nil), overloaded_operators[_op_not],nil,nil); left:=nil; - resulttypepass(t); result:=t; exit; end; @@ -590,7 +587,10 @@ begin end. { $Log$ - Revision 1.21 2001-08-26 13:36:41 florian + Revision 1.22 2001-09-02 21:12:07 peter + * move class of definitions into type section for delphi + + Revision 1.21 2001/08/26 13:36:41 florian * some cg reorganisation * some PPC updates diff --git a/compiler/nmem.pas b/compiler/nmem.pas index f78b075f25..04d849bf7b 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -37,48 +37,56 @@ interface function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tloadvmtnodeclass = class of tloadvmtnode; thnewnode = class(tnode) constructor create;virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + thnewnodeclass = class of thnewnode; tnewnode = class(tunarynode) constructor create(l : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tnewnodeclass = class of tnewnode; thdisposenode = class(tunarynode) constructor create(l : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + thdisposenodeclass = class of thdisposenode; tsimplenewdisposenode = class(tunarynode) constructor create(n : tnodetype;l : tnode); function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tsimplenewdisposenodeclass = class of tsimplenewdisposenode; taddrnode = class(tunarynode) constructor create(l : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + taddrnodeclass = class of taddrnode; tdoubleaddrnode = class(tunarynode) constructor create(l : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tdoubleaddrnodeclass = class of tdoubleaddrnode; tderefnode = class(tunarynode) constructor create(l : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tderefnodeclass = class of tderefnode; tsubscriptnode = class(tunarynode) vs : tvarsym; @@ -88,12 +96,14 @@ interface function docompare(p: tnode): boolean; override; function det_resulttype:tnode;override; end; + tsubscriptnodeclass = class of tsubscriptnode; tvecnode = class(tbinarynode) constructor create(l,r : tnode);virtual; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tvecnodeclass = class of tvecnode; tselfnode = class(tnode) classdef : tobjectdef; @@ -101,6 +111,7 @@ interface function pass_1 : tnode;override; function det_resulttype:tnode;override; end; + tselfnodeclass = class of tselfnode; twithnode = class(tbinarynode) withsymtable : twithsymtable; @@ -113,20 +124,21 @@ interface function docompare(p: tnode): boolean; override; function det_resulttype:tnode;override; end; + twithnodeclass = class of twithnode; var - cloadvmtnode : class of tloadvmtnode; - chnewnode : class of thnewnode; - cnewnode : class of tnewnode; - chdisposenode : class of thdisposenode; - csimplenewdisposenode : class of tsimplenewdisposenode; - caddrnode : class of taddrnode; - cdoubleaddrnode : class of tdoubleaddrnode; - cderefnode : class of tderefnode; - csubscriptnode : class of tsubscriptnode; - cvecnode : class of tvecnode; - cselfnode : class of tselfnode; - cwithnode : class of twithnode; + cloadvmtnode : tloadvmtnodeclass; + chnewnode : thnewnodeclass; + cnewnode : tnewnodeclass; + chdisposenode : thdisposenodeclass; + csimplenewdisposenode : tsimplenewdisposenodeclass; + caddrnode : taddrnodeclass; + cdoubleaddrnode : tdoubleaddrnodeclass; + cderefnode : tderefnodeclass; + csubscriptnode : tsubscriptnodeclass; + cvecnode : tvecnodeclass; + cselfnode : tselfnodeclass; + cwithnode : twithnodeclass; implementation @@ -970,7 +982,10 @@ begin end. { $Log$ - Revision 1.19 2001-08-26 13:36:42 florian + Revision 1.20 2001-09-02 21:12:07 peter + * move class of definitions into type section for delphi + + Revision 1.19 2001/08/26 13:36:42 florian * some cg reorganisation * some PPC updates diff --git a/compiler/nopt.pas b/compiler/nopt.pas index 3ea9c04d22..6fbcb25c20 100644 --- a/compiler/nopt.pas +++ b/compiler/nopt.pas @@ -62,11 +62,13 @@ type taddsstringcharoptnode = class(taddsstringoptnode) constructor create(l,r : tnode); virtual; end; + taddsstringcharoptnodeclass = class of taddsstringcharoptnode; { add a constant string to a short string } taddsstringcsstringoptnode = class(taddsstringoptnode) constructor create(l,r : tnode); virtual; end; + taddsstringcsstringoptnodeclass = class of taddsstringcsstringoptnode; function canbeaddsstringcharoptnode(p: taddnode): boolean; function genaddsstringcharoptnode(p: taddnode): tnode; @@ -77,10 +79,8 @@ function genaddsstringcsstringoptnode(p: taddnode): tnode; function is_addsstringoptnode(p: tnode): boolean; var -{ these are never used directly - caddoptnode: class of taddoptnode; } - caddsstringcharoptnode: class of taddsstringcharoptnode; - caddsstringcsstringoptnode: class of taddsstringcsstringoptnode; + caddsstringcharoptnode: taddsstringcharoptnodeclass; + caddsstringcsstringoptnode: taddsstringcsstringoptnodeclass; implementation @@ -278,7 +278,10 @@ end. { $Log$ - Revision 1.4 2001-08-26 13:36:43 florian + Revision 1.5 2001-09-02 21:12:07 peter + * move class of definitions into type section for delphi + + Revision 1.4 2001/08/26 13:36:43 florian * some cg reorganisation * some PPC updates diff --git a/compiler/nset.pas b/compiler/nset.pas index 830b4ae341..bcb0f8389d 100644 --- a/compiler/nset.pas +++ b/compiler/nset.pas @@ -54,18 +54,21 @@ interface function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + tsetelementnodeclass = class of tsetelementnode; tinnode = class(tbinopnode) constructor create(l,r : tnode);virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + tinnodeclass = class of tinnode; trangenode = class(tbinarynode) constructor create(l,r : tnode);virtual; function det_resulttype:tnode;override; function pass_1 : tnode;override; end; + trangenodeclass = class of trangenode; tcasenode = class(tbinarynode) nodes : pcaserecord; @@ -78,12 +81,13 @@ interface function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; end; + tcasenodeclass = class of tcasenode; var - csetelementnode : class of tsetelementnode; - cinnode : class of tinnode; - crangenode : class of trangenode; - ccasenode : class of tcasenode; + csetelementnode : tsetelementnodeclass; + cinnode : tinnodeclass; + crangenode : trangenodeclass; + ccasenode : tcasenodeclass; { counts the labels } function case_count_labels(root : pcaserecord) : longint; @@ -584,7 +588,10 @@ begin end. { $Log$ - Revision 1.14 2001-08-26 13:36:43 florian + Revision 1.15 2001-09-02 21:12:07 peter + * move class of definitions into type section for delphi + + Revision 1.14 2001/08/26 13:36:43 florian * some cg reorganisation * some PPC updates