From 0e8616ed1f015b612493b732f0020887a5af956c Mon Sep 17 00:00:00 2001 From: pierre Date: Mon, 8 Jun 1998 13:13:28 +0000 Subject: [PATCH] + temporary variables now in temp_gen.pas unit because it is processor independent * mppc68k.bat modified to undefine i386 and support_mmx (which are defaults for i386) --- compiler/cg386add.pas | 10 +- compiler/cg386cal.pas | 10 +- compiler/cg386cnv.pas | 10 +- compiler/cg386con.pas | 10 +- compiler/cg386flw.pas | 10 +- compiler/cg386ld.pas | 10 +- compiler/cg386mem.pas | 10 +- compiler/cg68k.pas | 10 +- compiler/cg68k2.pas | 10 +- compiler/cga68k.pas | 10 +- compiler/cgi386.pas | 10 +- compiler/mppc68k.bat | 2 +- compiler/pmodules.pas | 10 +- compiler/tgen68k.pas | 295 +------------------------------ compiler/tgeni386.pas | 394 +----------------------------------------- 15 files changed, 113 insertions(+), 698 deletions(-) diff --git a/compiler/cg386add.pas b/compiler/cg386add.pas index 55b775d299..044b7d3eab 100644 --- a/compiler/cg386add.pas +++ b/compiler/cg386add.pas @@ -33,7 +33,7 @@ implementation uses cobjects,verbose,globals, symtable,aasm,i386,types, - cgi386,cgai386,tgeni386,hcodegen; + cgi386,cgai386,temp_gen,tgeni386,hcodegen; {***************************************************************************** SecondAdd @@ -1198,7 +1198,13 @@ implementation end. { $Log$ - Revision 1.1 1998-06-05 17:44:10 peter + Revision 1.2 1998-06-08 13:13:28 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.1 1998/06/05 17:44:10 peter * splitted cgi386 } diff --git a/compiler/cg386cal.pas b/compiler/cg386cal.pas index 279595bb0b..d0a4d97312 100644 --- a/compiler/cg386cal.pas +++ b/compiler/cg386cal.pas @@ -38,7 +38,7 @@ implementation uses cobjects,verbose,globals,systems, aasm,i386,types, - cgi386,cgai386,tgeni386,hcodegen, + cgi386,cgai386,temp_gen,tgeni386,hcodegen, cg386ld; @@ -2190,7 +2190,13 @@ implementation end. { $Log$ - Revision 1.1 1998-06-05 17:44:10 peter + Revision 1.2 1998-06-08 13:13:29 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.1 1998/06/05 17:44:10 peter * splitted cgi386 } diff --git a/compiler/cg386cnv.pas b/compiler/cg386cnv.pas index d258526128..93449b0754 100644 --- a/compiler/cg386cnv.pas +++ b/compiler/cg386cnv.pas @@ -39,7 +39,7 @@ implementation uses cobjects,verbose,globals, symtable,aasm,i386, - cgi386,cgai386,tgeni386,hcodegen; + cgi386,cgai386,temp_gen,tgeni386,hcodegen; {***************************************************************************** SecondTypeConv @@ -1062,7 +1062,13 @@ implementation end. { $Log$ - Revision 1.4 1998-06-05 17:44:10 peter + Revision 1.5 1998-06-08 13:13:30 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.4 1998/06/05 17:44:10 peter * splitted cgi386 Revision 1.3 1998/06/03 22:48:50 peter diff --git a/compiler/cg386con.pas b/compiler/cg386con.pas index db4c62d8e3..3815d93d2b 100644 --- a/compiler/cg386con.pas +++ b/compiler/cg386con.pas @@ -39,7 +39,7 @@ implementation uses cobjects,verbose, symtable,aasm,i386, - hcodegen,cgai386,tgeni386,cgi386; + hcodegen,cgai386,temp_gen,tgeni386,cgi386; {***************************************************************************** SecondRealConst @@ -328,7 +328,13 @@ implementation end. { $Log$ - Revision 1.3 1998-06-05 17:44:11 peter + Revision 1.4 1998-06-08 13:13:31 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.3 1998/06/05 17:44:11 peter * splitted cgi386 Revision 1.2 1998/06/05 16:13:31 pierre diff --git a/compiler/cg386flw.pas b/compiler/cg386flw.pas index 375837c60d..d7e34ba44d 100644 --- a/compiler/cg386flw.pas +++ b/compiler/cg386flw.pas @@ -45,7 +45,7 @@ implementation uses cobjects,verbose,globals,systems, symtable,aasm,i386,types, - cgi386,cgai386,tgeni386,hcodegen; + cgi386,cgai386,temp_gen,tgeni386,hcodegen; {***************************************************************************** Second_While_RepeatN @@ -589,7 +589,13 @@ do_jmp: end. { $Log$ - Revision 1.1 1998-06-05 17:44:12 peter + Revision 1.2 1998-06-08 13:13:33 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.1 1998/06/05 17:44:12 peter * splitted cgi386 } diff --git a/compiler/cg386ld.pas b/compiler/cg386ld.pas index cc4a4f2ed9..c1876e7da1 100644 --- a/compiler/cg386ld.pas +++ b/compiler/cg386ld.pas @@ -47,7 +47,7 @@ implementation uses cobjects,verbose,globals, symtable,aasm,types, - cgi386,cgai386,tgeni386,hcodegen; + cgi386,cgai386,temp_gen,tgeni386,hcodegen; {***************************************************************************** @@ -510,7 +510,13 @@ implementation end. { $Log$ - Revision 1.1 1998-06-05 17:44:12 peter + Revision 1.2 1998-06-08 13:13:34 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.1 1998/06/05 17:44:12 peter * splitted cgi386 } diff --git a/compiler/cg386mem.pas b/compiler/cg386mem.pas index 287c815849..9bf459c727 100644 --- a/compiler/cg386mem.pas +++ b/compiler/cg386mem.pas @@ -45,7 +45,7 @@ implementation uses cobjects,verbose,globals,systems, symtable,aasm,i386,types, - cgi386,cgai386,tgeni386,hcodegen; + cgi386,cgai386,temp_gen,tgeni386,hcodegen; {***************************************************************************** SecondLoadVMT @@ -578,7 +578,13 @@ implementation end. { $Log$ - Revision 1.1 1998-06-05 17:44:13 peter + Revision 1.2 1998-06-08 13:13:35 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.1 1998/06/05 17:44:13 peter * splitted cgi386 } diff --git a/compiler/cg68k.pas b/compiler/cg68k.pas index 677d4cfa15..089e25f2d7 100644 --- a/compiler/cg68k.pas +++ b/compiler/cg68k.pas @@ -39,7 +39,7 @@ interface {***************************************************************************} uses objects,verbose,cobjects,systems,globals,tree, - symtable,types,strings,pass_1,hcodegen, + symtable,types,strings,pass_1,hcodegen,temp_gen, aasm,m68k,tgen68k,files,cga68k,cg68k2,link {$ifdef GDB} ,gdb @@ -5137,7 +5137,13 @@ end. { $Log$ - Revision 1.5 1998-06-04 23:51:34 peter + Revision 1.6 1998-06-08 13:13:36 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.5 1998/06/04 23:51:34 peter * m68k compiles + .def file creation moved to gendef.pas so it could also be used for win32 diff --git a/compiler/cg68k2.pas b/compiler/cg68k2.pas index 8d9cd56979..8d2df8b2c3 100644 --- a/compiler/cg68k2.pas +++ b/compiler/cg68k2.pas @@ -30,7 +30,7 @@ Interface uses objects,verbose,cobjects,systems,globals,tree, - symtable,types,strings,pass_1,hcodegen, + symtable,types,strings,pass_1,hcodegen,temp_gen, aasm,m68k,tgen68k,files,cga68k; const @@ -1921,7 +1921,13 @@ Implementation end. { $Log$ - Revision 1.4 1998-06-04 23:51:35 peter + Revision 1.5 1998-06-08 13:13:37 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.4 1998/06/04 23:51:35 peter * m68k compiles + .def file creation moved to gendef.pas so it could also be used for win32 diff --git a/compiler/cga68k.pas b/compiler/cga68k.pas index 0cd8c0053f..2b273de9dd 100644 --- a/compiler/cga68k.pas +++ b/compiler/cga68k.pas @@ -75,7 +75,7 @@ unit cga68k; uses systems,globals,verbose,files,types,pbase, - tgen68k,hcodegen + tgen68k,hcodegen,temp_gen {$ifdef GDB} ,gdb {$endif} @@ -1216,7 +1216,13 @@ end; end. { $Log$ - Revision 1.5 1998-06-04 23:51:36 peter + Revision 1.6 1998-06-08 13:13:39 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.5 1998/06/04 23:51:36 peter * m68k compiles + .def file creation moved to gendef.pas so it could also be used for win32 diff --git a/compiler/cgi386.pas b/compiler/cgi386.pas index 6bbe52991f..380bfaf0e2 100644 --- a/compiler/cgi386.pas +++ b/compiler/cgi386.pas @@ -59,7 +59,7 @@ implementation uses verbose,cobjects,systems,globals,files, symtable,types,aasm, - pass_1,hcodegen + pass_1,hcodegen,temp_gen {$ifdef GDB} ,gdb {$endif} @@ -516,7 +516,13 @@ implementation end. { $Log$ - Revision 1.36 1998-06-05 17:49:54 peter + Revision 1.37 1998-06-08 13:13:41 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.36 1998/06/05 17:49:54 peter * cleanup of cgai386 Revision 1.35 1998/06/05 16:13:32 pierre diff --git a/compiler/mppc68k.bat b/compiler/mppc68k.bat index 30d803d41c..7d0c8daf3e 100644 --- a/compiler/mppc68k.bat +++ b/compiler/mppc68k.bat @@ -1,2 +1,2 @@ -ppc386 -Ch8000000 -dm68k -dGDB -a -Sg pp.pas %1 %2 %3 %4 %5 %6 %7 %8 %9 +ppc386 -Ch8000000 -uSUPPORT_MMX -ui386 -dm68k -dGDB -a -Sg pp.pas %1 %2 %3 %4 %5 %6 %7 %8 %9 copy pp.exe ppc68k.exe diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index fc7d836cd2..627a6b8584 100644 --- a/compiler/pmodules.pas +++ b/compiler/pmodules.pas @@ -22,6 +22,8 @@ } unit pmodules; +{$define TEST_IMPL} + interface uses @@ -977,7 +979,13 @@ unit pmodules; end. { $Log$ - Revision 1.23 1998-06-05 17:47:29 peter + Revision 1.24 1998-06-08 13:13:44 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.23 1998/06/05 17:47:29 peter * some better uses clauses Revision 1.22 1998/06/05 14:37:34 pierre diff --git a/compiler/tgen68k.pas b/compiler/tgen68k.pas index 764e8a8eb8..1f53ecef36 100644 --- a/compiler/tgen68k.pas +++ b/compiler/tgen68k.pas @@ -52,14 +52,6 @@ unit tgen68k; procedure cleartempgen; - { generates temporary variables } - procedure resettempgen; - procedure setfirsttemp(l : longint); - function gettempsize : longint; - function gettempofsize(size : longint) : longint; - procedure gettempofsizereference(l : longint;var ref : treference); - function istemp(const ref : treference) : boolean; - procedure ungetiftemp(const ref : treference); function getfloatreg: tregister; { returns a free floating point register } { used in real, fpu mode, otherwise we } @@ -297,294 +289,23 @@ unit tgen68k; usablereg32:=c_usableregs; end; - type - pfreerecord = ^tfreerecord; - - tfreerecord = record - next : pfreerecord; - pos : longint; - size : longint; -{$ifdef EXTDEBUG} - line : longint; -{$endif} - end; - - var - tmpfreelist : pfreerecord; - templist : pfreerecord; - lastoccupied : longint; - firsttemp, maxtemp : longint; - - procedure resettempgen; - - var - hp : pfreerecord; - - begin - while assigned(tmpfreelist) do - begin - hp:=tmpfreelist; - tmpfreelist:=hp^.next; - dispose(hp); - end; - while assigned(templist) do - begin -{$ifdef EXTDEBUG} - Comment(V_Warning,'temporary assignment of size ' - +tostr(templist^.size)+' from '+tostr(templist^.line)+ - +' at pos '+tostr(templist^.pos)+ - ' not freed at the end of the procedure'); -{$endif} - hp:=templist; - templist:=hp^.next; -{$ifndef EXTDEBUG} - dispose(hp); -{$endif not EXTDEBUG} - end; - templist:=nil; - tmpfreelist:=nil; - firsttemp:=0; - maxtemp:=0; - lastoccupied:=0; - end; - - procedure setfirsttemp(l : longint); - - begin - if odd(l) then - l:=l+1; - firsttemp:=l; - maxtemp := l; - lastoccupied:=l; - end; - - function gettempofsize(size : longint) : longint; - - var - last,hp : pfreerecord; - - begin - { this code comes from the heap management of FPC ... } - if (size mod 4)<>0 then - size:=size+(4-(size mod 4)); - if assigned(tmpfreelist) then - begin - last:=nil; - hp:=tmpfreelist; - while assigned(hp) do - begin - { first fit } - if hp^.size>=size then - begin - gettempofsize:=hp^.pos; - if hp^.pos-size < maxtemp then - maxtemp := hp^.size-size; - { the whole block is needed ? } - if hp^.size>size then - begin - hp^.size:=hp^.size-size; - hp^.pos:=hp^.pos-size; - end - else - begin - if assigned(last) then - last^.next:=hp^.next - else - tmpfreelist:=nil; - dispose(hp); - end; - exit; - end; - last:=hp; - hp:=hp^.next; - end; - end; - { nothing free is big enough : expand temp } - gettempofsize:=lastoccupied-size; - lastoccupied:=lastoccupied-size; - if lastoccupied < maxtemp then - maxtemp := lastoccupied; - end; - - function gettempsize : longint; - - begin - { we only push words and we want to stay on } - { even stack addresses } - { maxtemp is negative } - if (maxtemp mod 2)<>0 then - dec(maxtemp); - gettempsize:=-maxtemp; - end; - - procedure gettempofsizereference(l : longint;var ref : treference); - - var - tl : pfreerecord; - - begin - { do a reset, because the reference isn't used } - reset_reference(ref); - ref.offset:=gettempofsize(l); - ref.base:=procinfo.framepointer; - new(tl); - tl^.pos:=ref.offset; - tl^.size:=l; - tl^.next:=templist; - templist:=tl; -{$ifdef EXTDEBUG} - tl^.line:=current_module^.current_inputfile^.line_no; -{$endif} - end; - - function istemp(const ref : treference) : boolean; - - begin - istemp:=((ref.base=procinfo.framepointer) and - (ref.offset0 then - size:=size+(4-(size mod 4)); - if size = 0 then - exit; - if pos<=lastoccupied then - if pos=lastoccupied then - begin - lastoccupied:=pos+size; - hp:=tmpfreelist; - newhp:=nil; - while assigned(hp) do - begin - { conneting a free block } - if hp^.pos=lastoccupied then - begin - if assigned(newhp) then newhp^.next:=nil - else tmpfreelist:=nil; - lastoccupied:=lastoccupied+hp^.size; - dispose(hp); - break; - end; - newhp:=hp; - hp:=hp^.next; - end; - end - else - begin -{$ifdef EXTDEBUG} - Comment(V_Warning,'temp managment problem : ungettemp() pos < lastoccupied !'); -{$endif} - end - else - begin - new(newhp); - { size can be allways set } - newhp^.size:=size; - newhp^.pos := pos; - { if there is no free list } - if not assigned(tmpfreelist) then - begin - { then generate one } - tmpfreelist:=newhp; - newhp^.next:=nil; - exit; - end; - { search the position to insert } - hp:=tmpfreelist; - while assigned(hp) do - begin - { conneting two blocks ? } - if hp^.pos+hp^.size=pos then - begin - inc(hp^.size,size); - dispose(newhp); - break; - end - { if the end is reached, then concat } - else if hp^.next=nil then - begin - hp^.next:=newhp; - newhp^.next:=nil; - break; - end - { falls der n„chste Zeiger gr”áer ist, dann } - { Einh„ngen } - else if hp^.next^.pos<=pos+size then - begin - { concat two blocks ? } - if pos+size=hp^.next^.pos then - begin - newhp^.next:=hp^.next^.next; - inc(newhp^.size,hp^.next^.size); - dispose(hp^.next); - hp^.next:=newhp; - end - else - begin - newhp^.next:=hp^.next; - hp^.next:=newhp; - end; - break; - end; - hp:=hp^.next; - end; - end; - end; - - procedure ungetiftemp(const ref : treference); - - var - tl,prev : pfreerecord; - - begin - if istemp(ref) then - begin - prev:=nil; - tl:=templist; - while assigned(tl) do - begin - if ref.offset=tl^.pos then - begin - ungettemp(ref.offset,tl^.size); - if assigned(prev) then - prev^.next:=tl^.next - else - templist:=tl^.next; - dispose(tl); - exit; - end - else - begin - prev:=tl; - tl:=tl^.next; - end; - end; -{$ifdef EXTDEBUG} - Comment(V_Warning,'Internal: temp managment problem : '+ - 'temp not found for release at offset '+tostr(ref.offset)); -{$endIf} - end; - end; - begin { contains both information on Address registers and data registers } { even if they are allocated separately. } usableregs:=[R_D0,R_D1,R_D2,R_D3,R_D4,R_D5,R_D6,R_D7,R_A0,R_A1,R_A2,R_A3,R_A4, R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,R_FP7]; c_usableregs:=4; - tmpfreelist:=nil; - templist:=nil; end. { $Log$ - Revision 1.1 1998-03-25 11:18:15 root - Initial revision + Revision 1.2 1998-06-08 13:13:46 pierre + + temporary variables now in temp_gen.pas unit + because it is processor independent + * mppc68k.bat modified to undefine i386 and support_mmx + (which are defaults for i386) + + Revision 1.1.1.1 1998/03/25 11:18:15 root + * Restored version Revision 1.12 1998/03/22 12:45:38 florian * changes of Carl-Eric to m68k target commit: diff --git a/compiler/tgeni386.pas b/compiler/tgeni386.pas index 67ab0797a0..743f5b24ac 100644 --- a/compiler/tgeni386.pas +++ b/compiler/tgeni386.pas @@ -52,22 +52,6 @@ unit tgeni386; procedure ungetregister(r : tregister); procedure cleartempgen; - - { generates temporary variables } - procedure resettempgen; - procedure setfirsttemp(l : longint); - function gettempsize : longint; - function gettempofsize(size : longint) : longint; - { special call for inlined procedures } - function gettempofsizepersistant(size : longint) : longint; - { for parameter func returns } - procedure persistanttemptonormal(pos : longint); - procedure ungettemp(pos : longint;size : longint); - procedure ungetpersistanttemp(pos : longint;size : longint); - procedure gettempofsizereference(l : longint;var ref : treference); - function istemp(const ref : treference) : boolean; - procedure ungetiftemp(const ref : treference); - procedure del_reference(const ref : treference); procedure del_locref(const location : tlocation); @@ -319,374 +303,6 @@ unit tgeni386; usablereg32:=c_usableregs; end; - type - pfreerecord = ^tfreerecord; - - tfreerecord = record - next : pfreerecord; - pos : longint; - size : longint; - persistant : boolean; { used for inlined procedures } -{$ifdef EXTDEBUG} - line : longint; -{$endif} - end; - - var - tmpfreelist : pfreerecord; - templist : pfreerecord; - lastoccupied : longint; - firsttemp, maxtemp : longint; - - procedure resettempgen; - - var - hp : pfreerecord; - - begin - while assigned(tmpfreelist) do - begin - hp:=tmpfreelist; - tmpfreelist:=hp^.next; - dispose(hp); - end; - while assigned(templist) do - begin -{$ifdef EXTDEBUG} - Comment(V_Warning,'temporary assignment of size ' - +tostr(templist^.size)+' from line '+tostr(templist^.line)+ - +' at pos '+tostr(templist^.pos)+ - ' not freed at the end of the procedure'); -{$endif} - hp:=templist; - templist:=hp^.next; -{$ifndef EXTDEBUG} - dispose(hp); -{$endif not EXTDEBUG} - end; - templist:=nil; - tmpfreelist:=nil; - firsttemp:=0; - maxtemp:=0; - lastoccupied:=0; - end; - - procedure setfirsttemp(l : longint); - - begin - { generates problems - if (l mod 4 <> 0) then dec(l,l mod 4);} - firsttemp:=l; - maxtemp := l; - lastoccupied:=l; - end; - - function gettempofsize(size : longint) : longint; - - var - tl,last,hp : pfreerecord; - ofs : longint; - - begin - { this code comes from the heap management of FPC ... } - if (size mod 4)<>0 then - size:=size+(4-(size mod 4)); - ofs:=0; - if assigned(tmpfreelist) then - begin - last:=nil; - hp:=tmpfreelist; - while assigned(hp) do - begin - { first fit } - if hp^.size>=size then - begin - ofs:=hp^.pos; - if hp^.pos-size < maxtemp then - maxtemp := hp^.size-size; - { the whole block is needed ? } - if hp^.size>size then - begin - hp^.size:=hp^.size-size; - hp^.pos:=hp^.pos-size; - end - else - begin - if assigned(last) then - last^.next:=hp^.next - else - tmpfreelist:=nil; - dispose(hp); - end; - break; - end; - last:=hp; - hp:=hp^.next; - end; - end; - { nothing free is big enough : expand temp } - if ofs=0 then - begin - ofs:=lastoccupied-size; - lastoccupied:=lastoccupied-size; - if lastoccupied < maxtemp then - maxtemp := lastoccupied; - end; - new(tl); - tl^.pos:=ofs; - tl^.size:=size; - tl^.next:=templist; - tl^.persistant:=false; - templist:=tl; -{$ifdef EXTDEBUG} - tl^.line:=current_module^.current_inputfile^.line_no; -{$endif} - gettempofsize:=ofs; - end; - - function gettempofsizepersistant(size : longint) : longint; - - var - l : longint; - - begin - l:=gettempofsize(size); - templist^.persistant:=true; -{$ifdef EXTDEBUG} - Comment(V_Debug,'temp managment : call to gettempofsizepersistant()'+ - ' with size '+tostr(size)+' returned '+tostr(l)); -{$endif} - gettempofsizepersistant:=l; - end; - - function gettempsize : longint; - - begin - { align local data to dwords } - if (maxtemp mod 4)<>0 then - dec(maxtemp,4+(maxtemp mod 4)); - gettempsize:=-maxtemp; - end; - - procedure gettempofsizereference(l : longint;var ref : treference); - - begin - { do a reset, because the reference isn't used } - reset_reference(ref); - ref.offset:=gettempofsize(l); - ref.base:=procinfo.framepointer; - end; - - function istemp(const ref : treference) : boolean; - - begin - { ref.index = R_NO was missing - led to problems with local arrays - with lower bound > 0 (PM) } - istemp:=((ref.base=procinfo.framepointer) and - (ref.offset0 then - size:=size+(4-(size mod 4)); - if size = 0 then - exit; - - if pos<=lastoccupied then - if pos=lastoccupied then - begin - lastoccupied:=pos+size; - hp:=tmpfreelist; - newhp:=nil; - while assigned(hp) do - begin - { conneting a free block } - if hp^.pos=lastoccupied then - begin - if assigned(newhp) then newhp^.next:=nil - else tmpfreelist:=nil; - lastoccupied:=lastoccupied+hp^.size; - dispose(hp); - break; - end; - newhp:=hp; - hp:=hp^.next; - end; - end - else - begin -{$ifdef EXTDEBUG} - Comment(V_Warning,'temp managment problem : ungettemp()'+ - 'pos '+tostr(pos)+ '< lastoccupied '+tostr(lastoccupied)+' !'); -{$endif} - end - else - begin - new(newhp); - { size can be allways set } - newhp^.size:=size; - newhp^.pos := pos; - { if there is no free list } - if not assigned(tmpfreelist) then - begin - { then generate one } - tmpfreelist:=newhp; - newhp^.next:=nil; - exit; - end; - { search the position to insert } - hp:=tmpfreelist; - while assigned(hp) do - begin - { conneting two blocks ? } - if hp^.pos+hp^.size=pos then - begin - inc(hp^.size,size); - dispose(newhp); - break; - end - { if the end is reached, then concat } - else if hp^.next=nil then - begin - hp^.next:=newhp; - newhp^.next:=nil; - break; - end - { falls der n„chste Zeiger gr”áer ist, dann } - { Einh„ngen } - else if hp^.next^.pos<=pos+size then - begin - { concat two blocks ? } - if pos+size=hp^.next^.pos then - begin - newhp^.next:=hp^.next^.next; - inc(newhp^.size,hp^.next^.size); - dispose(hp^.next); - hp^.next:=newhp; - end - else - begin - newhp^.next:=hp^.next; - hp^.next:=newhp; - end; - break; - end; - hp:=hp^.next; - end; - end; - end; - - procedure ungetiftemp(const ref : treference); - - var - tl,prev : pfreerecord; - - begin - if istemp(ref) then - begin - prev:=nil; - tl:=templist; - while assigned(tl) do - begin - { no release of persistant blocks this way!! } - if tl^.persistant then - if (ref.offset>=tl^.pos) and - (ref.offset