diff --git a/compiler/aasmbase.pas b/compiler/aasmbase.pas index 35247e6e12..079614b58a 100644 --- a/compiler/aasmbase.pas +++ b/compiler/aasmbase.pas @@ -184,6 +184,7 @@ interface function newasmsymboltype(const s : string;_bind:TAsmSymBind;_typ:TAsmsymtype) : tasmsymbol; function getasmsymbol(const s : string) : tasmsymbol; function renameasmsymbol(const sold, snew : string):tasmsymbol; + function newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel; {# create a new assembler label } procedure getlabel(var l : tasmlabel); { make l as a new label and flag is_addr } @@ -665,9 +666,9 @@ implementation begin if not assigned(asmsymbolidx) then internalerror(200208072); - if longint(pointer(s))>=asmsymbolppuidx then + if (longint(pointer(s))<1) or (longint(pointer(s))>asmsymbolppuidx) then internalerror(200208073); - s:=asmsymbolidx^[longint(pointer(s))]; + s:=asmsymbolidx^[longint(pointer(s))-1]; end; end; @@ -809,6 +810,21 @@ implementation end; + function TAsmLibraryData.newasmlabel(nr:longint;is_addr,is_data:boolean) : tasmlabel; + var + hp : tasmlabel; + begin + if is_addr then + hp:=tasmlabel.createaddr(nr) + else if is_data then + hp:=tasmlabel.createdata(nr) + else + hp:=tasmlabel.create(nr); + symbolsearch.insert(hp); + newasmlabel:=hp; + end; + + procedure TAsmLibraryData.getlabel(var l : tasmlabel); begin l:=tasmlabel.create(nextlabelnr); @@ -843,7 +859,13 @@ implementation end. { $Log$ - Revision 1.7 2002-08-18 20:06:23 peter + Revision 1.8 2002-08-19 19:36:42 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.7 2002/08/18 20:06:23 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/aasmtai.pas b/compiler/aasmtai.pas index e52bd74b28..705209303d 100644 --- a/compiler/aasmtai.pas +++ b/compiler/aasmtai.pas @@ -467,7 +467,7 @@ uses internalerror(200208182); if not assigned(aiclass[t]) then internalerror(200208183); -writeln('taiload: ',taitypestr[t]); + //writeln('taiload: ',taitypestr[t]); { generate tai of the correct class } ppuloadai:=aiclass[t].ppuload(t,ppufile); end @@ -484,7 +484,7 @@ writeln('taiload: ',taitypestr[t]); begin { type, read by ppuloadnode } ppufile.putbyte(byte(n.typ)); -writeln('taiwrite: ',taitypestr[n.typ]); + //writeln('taiwrite: ',taitypestr[n.typ]); n.ppuwrite(ppufile); end else @@ -513,11 +513,6 @@ writeln('taiwrite: ',taitypestr[n.typ]); procedure tai.ppuwrite(ppufile:tcompilerppufile); begin - { marker, read by tailoadnode } - ppufile.putbyte(pputaimarker); - { type, read by tailoadnode } - ppufile.putbyte(byte(typ)); - { read by tai.ppuload } ppufile.putposinfo(fileinfo); end; @@ -1036,7 +1031,6 @@ writeln('taiwrite: ',taitypestr[n.typ]); begin inherited ppuload(t,ppufile); l:=tasmlabel(ppufile.getasmsymbol); - l.is_set:=true; is_global:=boolean(ppufile.getbyte); end; @@ -1052,6 +1046,7 @@ writeln('taiwrite: ',taitypestr[n.typ]); procedure tai_label.derefimpl; begin objectlibrary.DerefAsmsymbol(l); + l.is_set:=true; end; @@ -1467,6 +1462,7 @@ writeln('taiwrite: ',taitypestr[n.typ]); {$ifdef i386} ppufile.putbyte(byte(segprefix)); {$endif i386} + ppufile.putbyte(byte(is_jmp)); end; @@ -1552,7 +1548,13 @@ writeln('taiwrite: ',taitypestr[n.typ]); end. { $Log$ - Revision 1.7 2002-08-18 20:06:23 peter + Revision 1.8 2002-08-19 19:36:42 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.7 2002/08/18 20:06:23 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/fppu.pas b/compiler/fppu.pas index 8e3391a3ad..2ea7c62654 100644 --- a/compiler/fppu.pas +++ b/compiler/fppu.pas @@ -461,7 +461,7 @@ uses procedure tppumodule.putasmsymbol_in_idx(s:tnamedindexitem;arg:pointer); begin if tasmsymbol(s).ppuidx<>-1 then - librarydata.asmsymbolidx^[tasmsymbol(s).ppuidx]:=tasmsymbol(s); + librarydata.asmsymbolidx^[tasmsymbol(s).ppuidx-1]:=tasmsymbol(s); end; @@ -469,9 +469,11 @@ uses var s : tasmsymbol; i : longint; + asmsymtype : byte; begin { get an ordered list of all symbols to put in the ppu } getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer)); + fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0); librarydata.symbolsearch.foreach({$ifdef FPCPROCVAR}@{$endif}putasmsymbol_in_idx,nil); { write the number of symbols } ppufile.putlongint(librarydata.asmsymbolppuidx); @@ -481,7 +483,23 @@ uses s:=librarydata.asmsymbolidx^[i-1]; if not assigned(s) then internalerror(200208071); - ppufile.putstring(s.name); + asmsymtype:=1; + if s.Classtype=tasmlabel then + begin + if tasmlabel(s).is_addr then + asmsymtype:=4 + else if tasmlabel(s).typ=AT_DATA then + asmsymtype:=3 + else + asmsymtype:=2; + end; + ppufile.putbyte(asmsymtype); + case asmsymtype of + 1 : + ppufile.putstring(s.name); + 2 : + ppufile.putlongint(tasmlabel(s).labelnr); + end; ppufile.putbyte(byte(s.defbind)); ppufile.putbyte(byte(s.typ)); end; @@ -670,21 +688,41 @@ uses procedure tppumodule.readasmsymbols; var + labelnr, i : longint; name : string; bind : TAsmSymBind; typ : TAsmSymType; + asmsymtype : byte; begin librarydata.asmsymbolppuidx:=ppufile.getlongint; if librarydata.asmsymbolppuidx>0 then begin getmem(librarydata.asmsymbolidx,librarydata.asmsymbolppuidx*sizeof(pointer)); + fillchar(librarydata.asmsymbolidx^,librarydata.asmsymbolppuidx*sizeof(pointer),0); for i:=1 to librarydata.asmsymbolppuidx do begin - name:=ppufile.getstring; + asmsymtype:=ppufile.getbyte; + case asmsymtype of + 1 : + name:=ppufile.getstring; + 2..4 : + labelnr:=ppufile.getlongint; + else + internalerror(200208192); + end; bind:=tasmsymbind(ppufile.getbyte); typ:=tasmsymtype(ppufile.getbyte); - librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymboltype(name,bind,typ); + case asmsymtype of + 1 : + librarydata.asmsymbolidx^[i-1]:=librarydata.newasmsymboltype(name,bind,typ); + 2 : + librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,false); + 3 : + librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,true,false); + 4 : + librarydata.asmsymbolidx^[i-1]:=librarydata.newasmlabel(labelnr,false,true); + end; end; end; end; @@ -740,6 +778,7 @@ uses procedure tppumodule.load_implementation; var b : byte; + oldobjectlibrary : tasmlibrarydata; begin { read implementation part } repeat @@ -755,9 +794,12 @@ uses until false; { we can now derefence all pointers to the implementation parts } + oldobjectlibrary:=objectlibrary; + objectlibrary:=librarydata; tstoredsymtable(globalsymtable).derefimpl; if assigned(localsymtable) then tstoredsymtable(localsymtable).derefimpl; + objectlibrary:=oldobjectlibrary; end; @@ -1275,7 +1317,13 @@ uses end. { $Log$ - Revision 1.22 2002-08-18 19:58:28 peter + Revision 1.23 2002-08-19 19:36:42 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.22 2002/08/18 19:58:28 peter * more current_scanner fixes Revision 1.21 2002/08/15 15:09:41 carl diff --git a/compiler/globals.pas b/compiler/globals.pas index 03c23d4cb3..d3309f60a9 100644 --- a/compiler/globals.pas +++ b/compiler/globals.pas @@ -1169,7 +1169,6 @@ implementation 'FAR16', 'FPCCALL', 'INLINE', - '', { internconst } '', { internproc } '', { palmossyscall } 'PASCAL', @@ -1480,7 +1479,13 @@ begin end. { $Log$ - Revision 1.64 2002-08-12 15:08:39 carl + Revision 1.65 2002-08-19 19:36:42 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.64 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/globtype.pas b/compiler/globtype.pas index 34ff8fadb9..88020a5b88 100644 --- a/compiler/globtype.pas +++ b/compiler/globtype.pas @@ -134,7 +134,6 @@ interface pocall_far16, { Far16 for OS/2 } pocall_fpccall, { FPC default calling } pocall_inline, { Procedure is an assembler macro } - pocall_internconst, { procedure has constant evaluator intern } pocall_internproc, { Procedure has compiler magic} pocall_palmossyscall, { procedure is a PalmOS system call } pocall_pascal, { pascal standard left to right } @@ -153,7 +152,6 @@ interface 'Far16', 'FPCCall', 'Inline', - 'InternConst', 'InternProc', 'PalmOSSysCall', 'Pascal', @@ -209,7 +207,13 @@ implementation end. { $Log$ - Revision 1.30 2002-08-12 15:08:39 carl + Revision 1.31 2002-08-19 19:36:42 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.30 2002/08/12 15:08:39 carl + stab register indexes for powerpc (moved from gdb to cpubase) + tprocessor enumeration moved to cpuinfo + linker in target_info is now a class diff --git a/compiler/ncal.pas b/compiler/ncal.pas index 3dbd270eb3..7095afc91e 100644 --- a/compiler/ncal.pas +++ b/compiler/ncal.pas @@ -32,7 +32,7 @@ interface {$ifdef state_tracking} nstate, {$endif state_tracking} - symbase,symtype,symsym,symdef,symtable; + symbase,symtype,symppu,symsym,symdef,symtable; type tcallnode = class(tbinarynode) @@ -62,6 +62,9 @@ interface constructor createinternres(const name: string; params: tnode; const res: ttype); constructor createinternreturn(const name: string; params: tnode; returnnode : tnode); destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; function pass_1 : tnode;override; @@ -89,6 +92,9 @@ interface { constructor } constructor create(expr,next : tnode);virtual; destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; procedure gen_high_tree(openstring:boolean); @@ -107,9 +113,13 @@ interface inlinetree : tnode; inlineprocdef : tprocdef; retoffset,para_offset,para_size : longint; - constructor create(callp,code : tnode);virtual; + constructor create(p:tprocdef);virtual; destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function getcopy : tnode;override; + function det_resulttype : tnode;override; procedure insertintolist(l : tnodelist);override; function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; @@ -240,6 +250,31 @@ implementation inherited destroy; end; + + constructor tcallparanode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.getsmallset(callparaflags); + hightree:=ppuloadnode(ppufile); + end; + + + procedure tcallparanode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putsmallset(callparaflags); + ppuwritenode(ppufile,hightree); + end; + + + procedure tcallparanode.derefimpl; + begin + inherited derefimpl; + if assigned(hightree) then + hightree.derefimpl; + end; + + function tcallparanode.getcopy : tnode; var @@ -704,6 +739,43 @@ implementation end; + constructor tcallnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + symtableprocentry:=tprocsym(ppufile.getderef); +{$warning FIXME: No withsymtable support} + symtableproc:=nil; + procdefinition:=tprocdef(ppufile.getderef); + restypeset:=boolean(ppufile.getbyte); + methodpointer:=ppuloadnode(ppufile); + funcretrefnode:=ppuloadnode(ppufile); + end; + + + procedure tcallnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(symtableprocentry); + ppufile.putderef(procdefinition); + ppufile.putbyte(byte(restypeset)); + ppuwritenode(ppufile,methodpointer); + ppuwritenode(ppufile,funcretrefnode); + end; + + + procedure tcallnode.derefimpl; + begin + inherited derefimpl; + resolvesym(pointer(symtableprocentry)); + symtableproc:=symtableprocentry.owner; + resolvedef(pointer(procdefinition)); + if assigned(methodpointer) then + methodpointer.derefimpl; + if assigned(funcretrefnode) then + funcretrefnode.derefimpl; + end; + + procedure tcallnode.set_procvar(procvar:tnode); begin right:=procvar; @@ -1470,7 +1542,7 @@ implementation end; { handle predefined procedures } - is_const:=(procdefinition.proccalloption=pocall_internconst) and + is_const:=(po_internconst in procdefinition.procoptions) and ((block_type in [bt_const,bt_type]) or (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn]))); if (procdefinition.proccalloption=pocall_internproc) or is_const then @@ -1617,7 +1689,7 @@ implementation if not assigned(right) then begin if assigned(tprocdef(procdefinition).code) then - inlinecode:=cprocinlinenode.create(self,tnode(tprocdef(procdefinition).code)) + inlinecode:=cprocinlinenode.create(tprocdef(procdefinition)) else CGMessage(cg_e_no_code_for_inline_stored); if assigned(inlinecode) then @@ -1830,28 +1902,22 @@ implementation TPROCINLINENODE ****************************************************************************} - constructor tprocinlinenode.create(callp,code : tnode); + constructor tprocinlinenode.create(p:tprocdef); begin inherited create(procinlinen); - inlineprocdef:=tcallnode(callp).symtableprocentry.defs^.def; + inlineprocdef:=p; retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) } para_offset:=0; - para_size:=inlineprocdef.para_size(target_info.alignment.paraalign); - if paramanager.ret_in_param(inlineprocdef.rettype.def) then - inc(para_size,POINTER_SIZE); - { copy args } - if assigned(code) then - inlinetree:=code.getcopy - else inlinetree := nil; - registers32:=code.registers32; - registersfpu:=code.registersfpu; -{$ifdef SUPPORT_MMX} - registersmmx:=code.registersmmx; -{$endif SUPPORT_MMX} - resulttype:=inlineprocdef.rettype; + para_size:=0; + { copy inlinetree } + if assigned(p.code) then + inlinetree:=p.code.getcopy + else + inlinetree:=nil; end; + destructor tprocinlinenode.destroy; begin if assigned(inlinetree) then @@ -1859,6 +1925,35 @@ implementation inherited destroy; end; + + constructor tprocinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + inlineprocdef:=tprocdef(ppufile.getderef); + inlinetree:=ppuloadnode(ppufile); + retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) } + para_offset:=0; + para_size:=0; + end; + + + procedure tprocinlinenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(inlineprocdef); + ppuwritenode(ppufile,inlinetree); + end; + + + procedure tprocinlinenode.derefimpl; + begin + inherited derefimpl; + if assigned(inlinetree) then + inlinetree.derefimpl; + resolvedef(pointer(inlineprocdef)); + end; + + function tprocinlinenode.getcopy : tnode; var @@ -1866,11 +1961,11 @@ implementation begin n:=tprocinlinenode(inherited getcopy); + n.inlineprocdef:=inlineprocdef; if assigned(inlinetree) then n.inlinetree:=inlinetree.getcopy else n.inlinetree:=nil; - n.inlineprocdef:=inlineprocdef; n.retoffset:=retoffset; n.para_offset:=para_offset; n.para_size:=para_size; @@ -1882,13 +1977,29 @@ implementation begin end; + + function tprocinlinenode.det_resulttype : tnode; + begin + resulttype:=inlineprocdef.rettype; + { retrieve info from inlineprocdef } + retoffset:=-POINTER_SIZE; { less dangerous as zero (PM) } + para_offset:=0; + para_size:=inlineprocdef.para_size(target_info.alignment.paraalign); + if paramanager.ret_in_param(inlineprocdef.rettype.def) then + inc(para_size,POINTER_SIZE); + result:=nil; + end; + + function tprocinlinenode.pass_1 : tnode; begin + firstpass(inlinetree); + registers32:=inlinetree.registers32; + registersfpu:=inlinetree.registersfpu; +{$ifdef SUPPORT_MMX} + registersmmx:=inlinetree.registersmmx; +{$endif SUPPORT_MMX} result:=nil; - { left contains the code in tree form } - { but it has already been firstpassed } - { so firstpass(left); does not seem required } - { might be required later if we change the arg handling !! } end; function tprocinlinenode.docompare(p: tnode): boolean; @@ -1906,7 +2017,13 @@ begin end. { $Log$ - Revision 1.86 2002-08-17 22:09:44 florian + Revision 1.87 2002-08-19 19:36:42 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.86 2002/08/17 22:09:44 florian * result type handling in tcgcal.pass_2 overhauled * better tnode.dowrite * some ppc stuff fixed diff --git a/compiler/ncgcal.pas b/compiler/ncgcal.pas index c1316c32cd..938859fe84 100644 --- a/compiler/ncgcal.pas +++ b/compiler/ncgcal.pas @@ -1405,11 +1405,17 @@ implementation inlineexitcode:=TAAsmoutput.Create; ps:=para_size; make_global:=false; { to avoid warning } + aktfilepos.line:=0; + aktfilepos.column:=0; + aktfilepos.fileindex:=0; genentrycode(inlineentrycode,make_global,0,ps,nostackframe,true); if po_assembler in aktprocdef.procoptions then inlineentrycode.insert(Tai_marker.Create(asmblockstart)); exprasmList.concatlist(inlineentrycode); secondpass(inlinetree); + aktfilepos.line:=0; + aktfilepos.column:=0; + aktfilepos.fileindex:=0; genexitcode(inlineexitcode,0,false,true); if po_assembler in aktprocdef.procoptions then inlineexitcode.concat(Tai_marker.Create(asmblockend)); @@ -1469,7 +1475,13 @@ begin end. { $Log$ - Revision 1.12 2002-08-18 20:06:23 peter + Revision 1.13 2002-08-19 19:36:42 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.12 2002/08/18 20:06:23 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/ncgflw.pas b/compiler/ncgflw.pas index 73630e21de..efe8aaeb70 100644 --- a/compiler/ncgflw.pas +++ b/compiler/ncgflw.pas @@ -602,7 +602,7 @@ do_jmp: begin load_all_regvars(exprasmlist); - cg.a_jmp_always(exprasmlist,labelnr) + cg.a_jmp_always(exprasmlist,labsym.lab) end; @@ -1225,7 +1225,13 @@ begin end. { $Log$ - Revision 1.36 2002-08-15 15:15:55 carl + Revision 1.37 2002-08-19 19:36:43 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.36 2002/08/15 15:15:55 carl * jmpbuf size allocation for exceptions is now cpu specific (as it should) * more generic nodes for maths * several fixes for better m68k support diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas index 852b1850e4..fcbd83c8db 100644 --- a/compiler/ncnv.pas +++ b/compiler/ncnv.pas @@ -28,7 +28,7 @@ interface uses node, - symtype,defbase, + symtype,symppu,defbase, nld; type @@ -37,6 +37,9 @@ interface convtype : tconverttype; constructor create(node : tnode;const t : ttype);virtual; constructor create_explicit(node : tnode;const t : ttype); + 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; @@ -483,6 +486,29 @@ implementation end; + constructor ttypeconvnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.gettype(totype); + convtype:=tconverttype(ppufile.getbyte); + end; + + + procedure ttypeconvnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.puttype(totype); + ppufile.putbyte(byte(convtype)); + end; + + + procedure ttypeconvnode.derefimpl; + begin + inherited derefimpl; + totype.resolve; + end; + + function ttypeconvnode.getcopy : tnode; var @@ -1357,13 +1383,13 @@ implementation function ttypeconvnode.first_int_to_real: tnode; var fname: string[19]; - typname : string[12]; + typname : string[12]; begin { Get the type name } { Normally the typename should be one of the following: single, double - carl - } - typname := lower(pbestrealtype^.def.gettypename); + } + typname := lower(pbestrealtype^.def.gettypename); { converting a 64bit integer to a float requires a helper } if is_64bitint(left.resulttype.def) then begin @@ -1939,7 +1965,13 @@ begin end. { $Log$ - Revision 1.70 2002-08-17 09:23:36 florian + Revision 1.71 2002-08-19 19:36:43 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.70 2002/08/17 09:23:36 florian * first part of procinfo rewrite Revision 1.69 2002/08/14 19:26:55 carl diff --git a/compiler/nflw.pas b/compiler/nflw.pas index 26bf97ea28..4d9ea5a2df 100644 --- a/compiler/nflw.pas +++ b/compiler/nflw.pas @@ -28,8 +28,9 @@ unit nflw; interface uses - node,aasmbase,aasmtai,aasmcpu,cpubase, - symbase,symdef,symsym; + node,cpubase, + aasmbase,aasmtai,aasmcpu, + symppu,symtype,symbase,symdef,symsym; type tloopnode = class(tbinarynode) @@ -37,6 +38,9 @@ interface constructor create(tt : tnodetype;l,r,_t1,_t2 : tnode);virtual; destructor destroy;override; function getcopy : tnode;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; procedure insertintolist(l : tnodelist);override; {$ifdef extdebug} procedure _dowrite;override; @@ -49,7 +53,7 @@ interface function det_resulttype:tnode;override; function pass_1 : tnode;override; {$ifdef state_tracking} - function track_state_pass(exec_known:boolean):boolean;override; + function track_state_pass(exec_known:boolean):boolean;override; {$endif} end; twhilerepeatnodeclass = class of twhilerepeatnode; @@ -90,10 +94,12 @@ interface tcontinuenodeclass = class of tcontinuenode; tgotonode = class(tnode) - labelnr : tasmlabel; labsym : tlabelsym; exceptionblock : integer; constructor create(p : tlabelsym);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function getcopy : tnode;override; function det_resulttype:tnode;override; function pass_1 : tnode;override; @@ -107,6 +113,9 @@ interface exceptionblock : integer; constructor createcase(p : tasmlabel;l:tnode);virtual; constructor create(p : tlabelsym;l:tnode);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function getcopy : tnode;override; function det_resulttype:tnode;override; function pass_1 : tnode;override; @@ -117,6 +126,9 @@ interface traisenode = class(tbinarynode) frametree : tnode; constructor create(l,taddr,tframe:tnode);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; function det_resulttype:tnode;override; @@ -144,6 +156,7 @@ interface excepttype : tobjectdef; constructor create(l,r:tnode);virtual; destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; function det_resulttype:tnode;override; function pass_1 : tnode;override; function getcopy : tnode;override; @@ -199,12 +212,12 @@ implementation case t of ifn: p:=cifnode.create(l,r,n1); - whilerepeatn: - if back then - {Repeat until.} - p:=cwhilerepeatnode.create(l,r,n1,false,true) - else - {While do.} + whilerepeatn: + if back then + {Repeat until.} + p:=cwhilerepeatnode.create(l,r,n1,false,true) + else + {While do.} p:=cwhilerepeatnode.create(l,r,n1,true,false); forn: p:=cfornode.create(l,r,n1,nil,back); @@ -233,6 +246,33 @@ implementation inherited destroy; end; + + constructor tloopnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + t1:=ppuloadnode(ppufile); + t2:=ppuloadnode(ppufile); + end; + + + procedure tloopnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,t1); + ppuwritenode(ppufile,t2); + end; + + + procedure tloopnode.derefimpl; + begin + inherited derefimpl; + if assigned(t1) then + t1.derefimpl; + if assigned(t2) then + t2.derefimpl; + end; + + function tloopnode.getcopy : tnode; var @@ -281,11 +321,11 @@ implementation constructor Twhilerepeatnode.create(l,r,_t1:Tnode;tab,cn:boolean); begin - inherited create(whilerepeatn,l,r,_t1,nil); - if tab then - include(flags,nf_testatbegin); - if cn then - include(flags,nf_checknegate); + inherited create(whilerepeatn,l,r,_t1,nil); + if tab then + include(flags,nf_testatbegin); + if cn then + include(flags,nf_checknegate); end; function twhilerepeatnode.det_resulttype:tnode; @@ -296,16 +336,16 @@ implementation resulttype:=voidtype; resulttypepass(left); - {A not node can be removed.} - if left.nodetype=notn then - begin - t:=Tunarynode(left); - left:=Tunarynode(left).left; - t.left:=nil; - t.destroy; - {Symdif operator, in case you are wondering:} - flags:=flags >< [nf_checknegate]; - end; + {A not node can be removed.} + if left.nodetype=notn then + begin + t:=Tunarynode(left); + left:=Tunarynode(left).left; + t.left:=nil; + t.destroy; + {Symdif operator, in case you are wondering:} + flags:=flags >< [nf_checknegate]; + end; { loop instruction } if assigned(right) then resulttypepass(right); @@ -366,88 +406,88 @@ implementation function Twhilerepeatnode.track_state_pass(exec_known:boolean):boolean; var condition:Tnode; - code:Tnode; - done:boolean; - value:boolean; - change:boolean; - firsttest:boolean; - factval:Tnode; + code:Tnode; + done:boolean; + value:boolean; + change:boolean; + firsttest:boolean; + factval:Tnode; begin - track_state_pass:=false; - done:=false; - firsttest:=true; - {For repeat until statements, first do a pass through the code.} - if not(nf_testatbegin in flags) then - begin - code:=right.getcopy; - if code.track_state_pass(exec_known) then - track_state_pass:=true; - code.destroy; - end; - repeat - condition:=left.getcopy; - code:=right.getcopy; - change:=condition.track_state_pass(exec_known); - factval:=aktstate.find_fact(left); - if factval<>nil then - begin - condition.destroy; - condition:=factval.getcopy; - change:=true; - end; - if change then - begin - track_state_pass:=true; - {Force new resulttype pass.} - condition.resulttype.def:=nil; - do_resulttypepass(condition); - end; - if is_constboolnode(condition) then - begin - {Try to turn a while loop into a repeat loop.} - if firsttest then - exclude(flags,testatbegin); - value:=(Tordconstnode(condition).value<>0) xor checknegate; - if value then - begin - if code.track_state_pass(exec_known) then - track_state_pass:=true; - end - else - done:=true; - end - else - begin - {Remove any modified variables from the state.} - code.track_state_pass(false); - done:=true; - end; - code.destroy; - condition.destroy; - firsttest:=false; - until done; - {The loop condition is also known, for example: - while i<10 do - begin - ... - end; - - When the loop is done, we do know that i<10 = false. - } - condition:=left.getcopy; + track_state_pass:=false; + done:=false; + firsttest:=true; + {For repeat until statements, first do a pass through the code.} + if not(nf_testatbegin in flags) then + begin + code:=right.getcopy; + if code.track_state_pass(exec_known) then + track_state_pass:=true; + code.destroy; + end; + repeat + condition:=left.getcopy; + code:=right.getcopy; + change:=condition.track_state_pass(exec_known); + factval:=aktstate.find_fact(left); + if factval<>nil then + begin + condition.destroy; + condition:=factval.getcopy; + change:=true; + end; + if change then + begin + track_state_pass:=true; + {Force new resulttype pass.} + condition.resulttype.def:=nil; + do_resulttypepass(condition); + end; + if is_constboolnode(condition) then + begin + {Try to turn a while loop into a repeat loop.} + if firsttest then + exclude(flags,testatbegin); + value:=(Tordconstnode(condition).value<>0) xor checknegate; + if value then + begin + if code.track_state_pass(exec_known) then + track_state_pass:=true; + end + else + done:=true; + end + else + begin + {Remove any modified variables from the state.} + code.track_state_pass(false); + done:=true; + end; + code.destroy; + condition.destroy; + firsttest:=false; + until done; + {The loop condition is also known, for example: + while i<10 do + begin + ... + end; + + When the loop is done, we do know that i<10 = false. + } + condition:=left.getcopy; if condition.track_state_pass(exec_known) then - begin - track_state_pass:=true; - {Force new resulttype pass.} - condition.resulttype.def:=nil; - do_resulttypepass(condition); - end; - if not is_constboolnode(condition) then - aktstate.store_fact(condition, - cordconstnode.create(byte(checknegate),booltype)) - else - condition.destroy; + begin + track_state_pass:=true; + {Force new resulttype pass.} + condition.resulttype.def:=nil; + do_resulttypepass(condition); + end; + if not is_constboolnode(condition) then + aktstate.store_fact(condition, + cordconstnode.create(byte(checknegate),booltype)) + else + condition.destroy; end; {$endif} @@ -579,7 +619,7 @@ implementation inherited create(forn,l,r,_t1,_t2); if back then include(flags,nf_backward); - include(flags,nf_testatbegin); + include(flags,nf_testatbegin); end; @@ -590,20 +630,20 @@ implementation result:=nil; resulttype:=voidtype; - + if left.nodetype<>assignn then begin CGMessage(cg_e_illegal_expression); exit; end; - {Can we spare the first comparision?} + {Can we spare the first comparision?} if (right.nodetype=ordconstn) and (Tassignmentnode(left).right.nodetype=ordconstn) then - if not(((nf_backward in flags) and + if not(((nf_backward in flags) and (Tordconstnode(Tassignmentnode(left).right).value>=Tordconstnode(right).value)) or (not(nf_backward in flags) and (Tordconstnode(Tassignmentnode(left).right).value<=Tordconstnode(right).value))) then - exclude(flags,nf_testatbegin); + exclude(flags,nf_testatbegin); { save counter var } t2:=tassignmentnode(left).left.getcopy; @@ -829,7 +869,29 @@ implementation inherited create(goton); exceptionblock:=aktexceptblock; labsym:=p; - labelnr:=p.lab; + end; + + + constructor tgotonode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + labsym:=tlabelsym(ppufile.getderef); + exceptionblock:=ppufile.getbyte; + end; + + + procedure tgotonode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(labsym); + ppufile.putbyte(exceptionblock); + end; + + + procedure tgotonode.derefimpl; + begin + inherited derefimpl; + resolvesym(pointer(labsym)); end; @@ -860,7 +922,6 @@ implementation p : tgotonode; begin p:=tgotonode(inherited getcopy); - p.labelnr:=labelnr; p.labsym:=labsym; p.exceptionblock:=exceptionblock; result:=p; @@ -898,6 +959,32 @@ implementation end; + constructor tlabelnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + labsym:=tlabelsym(ppufile.getderef); + labelnr:=tasmlabel(ppufile.getasmsymbol); + exceptionblock:=ppufile.getbyte; + end; + + + procedure tlabelnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(labsym); + ppufile.putasmsymbol(labelnr); + ppufile.putbyte(exceptionblock); + end; + + + procedure tlabelnode.derefimpl; + begin + inherited derefimpl; + resolvesym(pointer(labsym)); + objectlibrary.derefasmsymbol(labelnr); + end; + + function tlabelnode.det_resulttype:tnode; begin result:=nil; @@ -953,6 +1040,28 @@ implementation end; + constructor traisenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + frametree:=ppuloadnode(ppufile); + end; + + + procedure traisenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,frametree); + end; + + + procedure traisenode.derefimpl; + begin + inherited derefimpl; + if assigned(frametree) then + frametree.derefimpl; + end; + + function traisenode.getcopy : tnode; var n : traisenode; @@ -1136,6 +1245,14 @@ implementation end; + constructor tonnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + exceptsymtable:=nil; + excepttype:=nil; + end; + + function tonnode.getcopy : tnode; var n : tonnode; @@ -1244,7 +1361,13 @@ begin end. { $Log$ - Revision 1.46 2002-08-17 22:09:46 florian + Revision 1.47 2002-08-19 19:36:43 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.46 2002/08/17 22:09:46 florian * result type handling in tcgcal.pass_2 overhauled * better tnode.dowrite * some ppc stuff fixed diff --git a/compiler/ninl.pas b/compiler/ninl.pas index b250b6d41d..f059a9b5bd 100644 --- a/compiler/ninl.pas +++ b/compiler/ninl.pas @@ -27,7 +27,7 @@ unit ninl; interface uses - node,htypechk,cpuinfo; + node,htypechk,cpuinfo,symppu; {$i compinnr.inc} @@ -35,6 +35,8 @@ interface tinlinenode = class(tunarynode) inlinenumber : byte; constructor create(number : byte;is_const:boolean;l : tnode);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; @@ -96,6 +98,20 @@ implementation end; + constructor tinlinenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + inlinenumber:=ppufile.getbyte; + end; + + + procedure tinlinenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putbyte(inlinenumber); + end; + + function tinlinenode.getcopy : tnode; var n : tinlinenode; @@ -2346,7 +2362,13 @@ begin end. { $Log$ - Revision 1.83 2002-08-02 07:44:31 jonas + Revision 1.84 2002-08-19 19:36:43 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.83 2002/08/02 07:44:31 jonas * made assigned() handling generic * add nodes now can also evaluate constant expressions at compile time that contain nil nodes diff --git a/compiler/nld.pas b/compiler/nld.pas index 0ad83a7623..12cbd06933 100644 --- a/compiler/nld.pas +++ b/compiler/nld.pas @@ -696,6 +696,7 @@ implementation procedure tfuncretnode.derefimpl; begin + inherited derefimpl; resolvesym(pointer(funcretsym)); end; @@ -996,6 +997,7 @@ implementation procedure ttypenode.derefimpl; begin + inherited derefimpl; restype.resolve; end; @@ -1060,6 +1062,7 @@ implementation procedure trttinode.derefimpl; begin + inherited derefimpl; resolvedef(pointer(rttidef)); end; @@ -1117,7 +1120,13 @@ begin end. { $Log$ - Revision 1.52 2002-08-18 20:06:23 peter + Revision 1.53 2002-08-19 19:36:43 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.52 2002/08/18 20:06:23 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/nmem.pas b/compiler/nmem.pas index 9b05aa1aaa..4b15d6d4f4 100644 --- a/compiler/nmem.pas +++ b/compiler/nmem.pas @@ -28,7 +28,7 @@ interface uses node, - symtype,symdef,symsym,symtable, + symtype,symppu,symdef,symsym,symtable, cpubase; type @@ -42,6 +42,9 @@ interface thnewnode = class(tnode) objtype : ttype; constructor create(t:ttype);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; @@ -57,6 +60,10 @@ interface taddrnode = class(tunarynode) getprocvardef : tprocvardef; constructor create(l : tnode);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; end; @@ -79,6 +86,9 @@ interface tsubscriptnode = class(tunarynode) vs : tvarsym; constructor create(varsym : tsym;l : tnode);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 docompare(p: tnode): boolean; override; @@ -96,6 +106,9 @@ interface tselfnode = class(tnode) classdef : tdef; { objectdef or classrefdef } constructor create(_class : tdef);virtual; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function pass_1 : tnode;override; function det_resulttype:tnode;override; end; @@ -107,6 +120,8 @@ interface withreference : treference; constructor create(symtable : twithsymtable;l,r : tnode;count : longint);virtual; destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; function getcopy : tnode;override; function pass_1 : tnode;override; function docompare(p: tnode): boolean; override; @@ -173,6 +188,27 @@ implementation end; + constructor thnewnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + ppufile.gettype(objtype); + end; + + + procedure thnewnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.puttype(objtype); + end; + + + procedure thnewnode.derefimpl; + begin + inherited derefimpl; + objtype.resolve; + end; + + function thnewnode.det_resulttype:tnode; begin result:=nil; @@ -242,6 +278,40 @@ implementation begin inherited create(addrn,l); + getprocvardef:=nil; + end; + + + constructor taddrnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + getprocvardef:=tprocvardef(ppufile.getderef); + end; + + + procedure taddrnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(getprocvardef); + end; + + + procedure taddrnode.derefimpl; + begin + inherited derefimpl; + resolvedef(pointer(getprocvardef)); + end; + + + function taddrnode.getcopy : tnode; + + var + p : taddrnode; + + begin + p:=taddrnode(inherited getcopy); + p.getprocvardef:=getprocvardef; + getcopy:=p; end; @@ -528,6 +598,27 @@ implementation vs:=tvarsym(varsym); end; + constructor tsubscriptnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + vs:=tvarsym(ppufile.getderef); + end; + + + procedure tsubscriptnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(vs); + end; + + + procedure tsubscriptnode.derefimpl; + begin + inherited derefimpl; + resolvesym(pointer(vs)); + end; + + function tsubscriptnode.getcopy : tnode; var @@ -755,6 +846,27 @@ implementation classdef:=_class; end; + constructor tselfnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + classdef:=tdef(ppufile.getderef); + end; + + + procedure tselfnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppufile.putderef(classdef); + end; + + + procedure tselfnode.derefimpl; + begin + inherited derefimpl; + resolvedef(pointer(classdef)); + end; + + function tselfnode.det_resulttype:tnode; begin result:=nil; @@ -807,6 +919,20 @@ implementation end; + constructor twithnode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + internalerror(200208192); + end; + + + procedure twithnode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + internalerror(200208193); + end; + + function twithnode.getcopy : tnode; var @@ -894,7 +1020,13 @@ begin end. { $Log$ - Revision 1.35 2002-07-23 09:51:23 daniel + Revision 1.36 2002-08-19 19:36:43 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.35 2002/07/23 09:51:23 daniel * Tried to make Tprocsym.defs protected. I didn't succeed but the cleanups are worth comitting. diff --git a/compiler/node.pas b/compiler/node.pas index 925d1b5fe8..fd7f81bed7 100644 --- a/compiler/node.pas +++ b/compiler/node.pas @@ -468,7 +468,7 @@ implementation begin if not assigned(nodeclass[t]) then internalerror(200208153); -writeln('load: ',nodetype2str[t]); + //writeln('load: ',nodetype2str[t]); { generate node of the correct class } ppuloadnode:=nodeclass[t].ppuload(t,ppufile); end @@ -485,7 +485,7 @@ writeln('load: ',nodetype2str[t]); if assigned(n) then begin ppufile.putbyte(byte(n.nodetype)); -writeln('write: ',nodetype2str[n.nodetype]); + //writeln('write: ',nodetype2str[n.nodetype]); n.ppuwrite(ppufile); end else @@ -972,7 +972,13 @@ writeln('write: ',nodetype2str[n.nodetype]); end. { $Log$ - Revision 1.37 2002-08-18 20:06:24 peter + Revision 1.38 2002-08-19 19:36:44 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.37 2002/08/18 20:06:24 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/nset.pas b/compiler/nset.pas index 18b1d0d917..c8a89ecff4 100644 --- a/compiler/nset.pas +++ b/compiler/nset.pas @@ -27,7 +27,9 @@ unit nset; interface uses - node,globals,aasmbase,aasmtai; + node,globals, + aasmbase,aasmtai, + symppu; type pcaserecord = ^tcaserecord; @@ -75,6 +77,9 @@ interface elseblock : tnode; constructor create(l,r : tnode;n : pcaserecord);virtual; destructor destroy;override; + constructor ppuload(t:tnodetype;ppufile:tcompilerppufile);override; + procedure ppuwrite(ppufile:tcompilerppufile);override; + procedure derefimpl;override; function getcopy : tnode;override; procedure insertintolist(l : tnodelist);override; function det_resulttype:tnode;override; @@ -198,22 +203,22 @@ implementation pes:=tenumsym(tenumdef(psd.elementtype.def).firstenum); while assigned(pes) do begin - {$ifdef oldset} - pcs^[pes.value div 8]:=pcs^[pes.value div 8] or (1 shl (pes.value mod 8)); - {$else} - include(pcs^,pes.value); - {$endif} + {$ifdef oldset} + pcs^[pes.value div 8]:=pcs^[pes.value div 8] or (1 shl (pes.value mod 8)); + {$else} + include(pcs^,pes.value); + {$endif} pes:=pes.nextenum; end; end; orddef : begin for i:=torddef(psd.elementtype.def).low to torddef(psd.elementtype.def).high do - {$ifdef oldset} + {$ifdef oldset} pcs^[i div 8]:=pcs^[i div 8] or (1 shl (i mod 8)); - {$else} - include(pcs^,i); - {$endif} + {$else} + include(pcs^,i); + {$endif} end; end; createsetconst:=pcs; @@ -276,11 +281,11 @@ implementation { constant evaluation } if (left.nodetype=ordconstn) and (right.nodetype=setconstn) then begin - {$ifdef oldset} - t:=cordconstnode.create(byte(tordconstnode(left).value in byteset(tsetconstnode(right).value_set^)),booltype); - {$else} + {$ifdef oldset} + t:=cordconstnode.create(byte(tordconstnode(left).value in byteset(tsetconstnode(right).value_set^)),booltype); + {$else} t:=cordconstnode.create(byte(tordconstnode(left).value in Tsetconstnode(right).value_set^),booltype); - {$endif} + {$endif} resulttypepass(t); result:=t; exit; @@ -446,6 +451,65 @@ implementation copycaserecord:=n; end; + + procedure ppuwritecaserecord(ppufile:tcompilerppufile;p : pcaserecord); + var + b : byte; + begin + ppufile.putexprint(p^._low); + ppufile.putexprint(p^._high); + ppufile.putasmsymbol(p^._at); + ppufile.putasmsymbol(p^.statement); + ppufile.putbyte(byte(p^.firstlabel)); + b:=0; + if assigned(p^.greater) then + b:=b or 1; + if assigned(p^.less) then + b:=b or 2; + ppufile.putbyte(b); + if assigned(p^.greater) then + ppuwritecaserecord(ppufile,p^.greater); + if assigned(p^.less) then + ppuwritecaserecord(ppufile,p^.less); + end; + + + function ppuloadcaserecord(ppufile:tcompilerppufile):pcaserecord; + var + b : byte; + p : pcaserecord; + begin + new(p); + p^._low:=ppufile.getexprint; + p^._high:=ppufile.getexprint; + p^._at:=tasmlabel(ppufile.getasmsymbol); + p^.statement:=tasmlabel(ppufile.getasmsymbol); + p^.firstlabel:=boolean(ppufile.getbyte); + b:=ppufile.getbyte; + if (b and 1)=1 then + p^.greater:=ppuloadcaserecord(ppufile) + else + p^.greater:=nil; + if (b and 2)=2 then + p^.less:=ppuloadcaserecord(ppufile) + else + p^.less:=nil; + ppuloadcaserecord:=p; + end; + + + procedure ppuderefcaserecord(p : pcaserecord); + begin + objectlibrary.derefasmsymbol(p^._at); + objectlibrary.derefasmsymbol(p^.statement); + if assigned(p^.greater) then + ppuderefcaserecord(p^.greater); + if assigned(p^.less) then + ppuderefcaserecord(p^.less); + end; + + + {***************************************************************************** TCASENODE *****************************************************************************} @@ -467,6 +531,31 @@ implementation end; + constructor tcasenode.ppuload(t:tnodetype;ppufile:tcompilerppufile); + begin + inherited ppuload(t,ppufile); + elseblock:=ppuloadnode(ppufile); + nodes:=ppuloadcaserecord(ppufile); + end; + + + procedure tcasenode.ppuwrite(ppufile:tcompilerppufile); + begin + inherited ppuwrite(ppufile); + ppuwritenode(ppufile,elseblock); + ppuwritecaserecord(ppufile,nodes); + end; + + + procedure tcasenode.derefimpl; + begin + inherited derefimpl; + if assigned(elseblock) then + elseblock.derefimpl; + ppuderefcaserecord(nodes); + end; + + function tcasenode.det_resulttype : tnode; begin result:=nil; @@ -559,7 +648,10 @@ implementation p.elseblock:=elseblock.getcopy else p.elseblock:=nil; - p.nodes:=copycaserecord(nodes); + if assigned(nodes) then + p.nodes:=copycaserecord(nodes) + else + p.nodes:=nil; getcopy:=p; end; @@ -597,7 +689,13 @@ begin end. { $Log$ - Revision 1.31 2002-08-17 09:23:38 florian + Revision 1.32 2002-08-19 19:36:44 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.31 2002/08/17 09:23:38 florian * first part of procinfo rewrite Revision 1.30 2002/07/23 13:19:40 jonas diff --git a/compiler/pass_2.pas b/compiler/pass_2.pas index d6be60eec1..6a9c18420a 100644 --- a/compiler/pass_2.pas +++ b/compiler/pass_2.pas @@ -179,7 +179,14 @@ implementation curptree:=@p; p^.usableregs:=usablereg32; {$endif TEMPREGDEBUG} - aktfilepos:=p.fileinfo; + if inlining_procedure then + begin + aktfilepos.line:=0; + aktfilepos.column:=0; + aktfilepos.fileindex:=0; + end + else + aktfilepos:=p.fileinfo; aktlocalswitches:=p.localswitches; codegenerror:=false; {$ifdef EXTDEBUG} @@ -330,7 +337,13 @@ implementation end. { $Log$ - Revision 1.36 2002-08-18 20:06:24 peter + Revision 1.37 2002-08-19 19:36:44 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.36 2002/08/18 20:06:24 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 2b33cfd499..ddd6ed09c9 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -1114,8 +1114,8 @@ const idtok:_INTERNCONST; pd_flags : pd_implemen+pd_body+pd_notobjintf; handler : {$ifdef FPCPROCVAR}@{$endif}pd_intern; - pocall : pocall_internconst; - pooption : []; + pocall : pocall_none; + pooption : [po_internconst]; mutexclpocall : []; mutexclpotype : [potype_operator]; mutexclpo : [] @@ -1774,11 +1774,15 @@ const end; { internconst or internproc only need to be defined once } - if (hd.proccalloption in [pocall_internconst,pocall_internproc]) then + if (hd.proccalloption=pocall_internproc) then aprocdef.proccalloption:=hd.proccalloption else - if (aprocdef.proccalloption in [pocall_internconst,pocall_internproc]) then + if (aprocdef.proccalloption=pocall_internproc) then hd.proccalloption:=aprocdef.proccalloption; + if (po_internconst in hd.procoptions) then + include(aprocdef.procoptions,po_internconst) + else if (po_internconst in aprocdef.procoptions) then + include(hd.procoptions,po_internconst); { Check calling convention } if (hd.proccalloption<>aprocdef.proccalloption) then @@ -1957,7 +1961,13 @@ const end. { $Log$ - Revision 1.65 2002-08-18 20:06:24 peter + Revision 1.66 2002-08-19 19:36:44 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.65 2002/08/18 20:06:24 peter * inlining is now also allowed in interface * renamed write/load to ppuwrite/ppuload * tnode storing in ppu diff --git a/compiler/symconst.pas b/compiler/symconst.pas index f43670fbdf..028fa4024f 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -191,7 +191,8 @@ type po_overload, { procedure is declared with overload directive } po_varargs, { printf like arguments } po_leftright, { push arguments from left to right } - po_clearstack { caller clears the stack } + po_clearstack, { caller clears the stack } + po_internconst { procedure has constant evaluator intern } ); tprocoptions=set of tprocoption; @@ -334,7 +335,13 @@ implementation end. { $Log$ - Revision 1.33 2002-07-01 16:23:54 peter + Revision 1.34 2002-08-19 19:36:44 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.33 2002/07/01 16:23:54 peter * cg64 patch * basics for currency * asnode updates for class and interface (not finished) diff --git a/compiler/utils/ppudump.pp b/compiler/utils/ppudump.pp index 1043f0429c..8af9f1bd48 100644 --- a/compiler/utils/ppudump.pp +++ b/compiler/utils/ppudump.pp @@ -516,7 +516,6 @@ type pocall_far16, { Far16 for OS/2 } pocall_fpccall, { FPC default calling } pocall_inline, { Procedure is an assembler macro } - pocall_internconst, { procedure has constant evaluator intern } pocall_internproc, { Procedure has compiler magic} pocall_palmossyscall, { procedure is a PalmOS system call } pocall_pascal, { pascal standard left to right } @@ -553,7 +552,10 @@ type po_savestdregs, { save std regs cdecl and stdcall need that ! } po_saveregisters, { save all registers } po_overload, { procedure is declared with overload directive } - po_varargs { printf like arguments } + po_varargs, { printf like arguments } + po_leftright, { push arguments from left to right } + po_clearstack, { caller clears the stack } + po_internconst { procedure has constant evaluator intern } ); tprocoptions=set of tprocoption; function read_abstract_proc_def:tproccalloption; @@ -578,7 +580,6 @@ const 'Far16', 'FPCCall', 'Inline', - 'InternConst', 'InternProc', 'PalmOSSysCall', 'Pascal', @@ -596,7 +597,7 @@ const (mask:potype_destructor; str:'Destructor'), (mask:potype_operator; str:'Operator') ); - procopts=18; + procopts=21; procopt : array[1..procopts] of tprocopt=( (mask:po_classmethod; str:'ClassMethod'), (mask:po_virtualmethod; str:'VirtualMethod'), @@ -615,7 +616,10 @@ const (mask:po_savestdregs; str:'SaveStdRegs'), (mask:po_saveregisters; str:'SaveRegisters'), (mask:po_overload; str:'Overload'), - (mask:po_varargs; str:'VarArgs') + (mask:po_varargs; str:'VarArgs'), + (mask:po_leftright; str:'LeftRight'), + (mask:po_clearstack; str:'ClearStack'), + (mask:po_internconst; str:'InternConst') ); tvarspez : array[0..3] of string[5]=('Value','Const','Var ','Out '); var @@ -1824,7 +1828,13 @@ begin end. { $Log$ - Revision 1.27 2002-08-15 15:15:56 carl + Revision 1.28 2002-08-19 19:36:44 peter + * More fixes for cross unit inlining, all tnodes are now implemented + * Moved pocall_internconst to po_internconst because it is not a + calling type at all and it conflicted when inlining of these small + functions was requested + + Revision 1.27 2002/08/15 15:15:56 carl * jmpbuf size allocation for exceptions is now cpu specific (as it should) * more generic nodes for maths * several fixes for better m68k support