paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-08 03:48:07 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ temporary variables now in temp_gen.pas unit

Browse Source 
because it is processor independent
  * mppc68k.bat modified to undefine i386 and support_mmx
    (which are defaults for i386)
This commit is contained in:
pierre 1998-06-08 13:13:28 +00:00
parent 05b01ddb00
commit 0e8616ed1f
15 changed files with 113 additions and 698 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
compiler/cg386add.pas
View File

@ -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
}

10
compiler/cg386cal.pas
View File

@ -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
}

10
compiler/cg386cnv.pas
View File

@ -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

10
compiler/cg386con.pas
View File

@ -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

10
compiler/cg386flw.pas
View File

@ -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
}

10
compiler/cg386ld.pas
View File

@ -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
}

10
compiler/cg386mem.pas
View File

@ -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
}

10
compiler/cg68k.pas
View File

@ -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

10
compiler/cg68k2.pas
View File

@ -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

10
compiler/cga68k.pas
View File

@ -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

10
compiler/cgi386.pas
View File

@ -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

2
compiler/mppc68k.bat
View File

@ -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

10
compiler/pmodules.pas
View File

@ -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

295
compiler/tgen68k.pas
View File

@ -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.offset<firsttemp));
end;
procedure ungettemp(pos : longint;size : longint);
var
hp,newhp : pfreerecord;
begin
if (size mod 4)<>0 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:

394
compiler/tgeni386.pas
View File

@ -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.offset<firsttemp) and (ref.index=R_NO));
end;
procedure persistanttemptonormal(pos : longint);
var hp : pfreerecord;
begin
hp:=templist;
while assigned(hp) do
if (hp^.persistant) and (hp^.pos=pos) then
begin
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment : persistanttemptonormal()'+
' at pos '+tostr(pos)+ ' found !');
{$endif}
hp^.persistant:=false;
exit;
end
else
hp:=hp^.next;
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment problem : persistanttemptonormal()'+
' at pos '+tostr(pos)+ ' not found !');
{$endif}
end;
procedure ungetpersistanttemp(pos : longint;size : longint);
var
prev,hp : pfreerecord;
begin
ungettemp(pos,size);
prev:=nil;
hp:=templist;
while assigned(hp) do
begin
if (hp^.persistant) and (hp^.pos=pos) and (hp^.size=size) then
begin
if assigned(prev) then
prev^.next:=hp^.next
else
templist:=hp^.next;
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp managment : ungetpersistanttemp()'+
' at pos '+tostr(pos)+ ' found !');
{$endif}
dispose(hp);
exit;
end;
prev:=hp;
hp:=hp^.next;
end;
{$ifdef EXTDEBUG}
Comment(V_Warning,'temp managment problem : ungetpersistanttemp()'+
' at pos '+tostr(pos)+ ' not found !');
{$endif}
end;
procedure ungettemp(pos : longint;size : longint);
var
hp,newhp : pfreerecord;
begin
if (size mod 4)<>0 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<tl^.pos+tl^.size) then
begin
{$ifdef EXTDEBUG}
Comment(V_Debug,'temp '+
' at pos '+tostr(ref.offset)+ ' not released because persistant !');
{$endif}
exit;
end;
if (ref.offset=tl^.pos) then
begin
ungettemp(ref.offset,tl^.size);
{$ifdef TEMPDEBUG}
Comment(V_Debug,'temp managment : ungettemp()'+
' at pos '+tostr(tl^.pos)+ ' found !');
{$endif}
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
usableregs:=[R_EAX,R_EBX,R_ECX,R_EDX];
@ -694,12 +310,16 @@ begin
usableregs:=usableregs+[R_MM0..R_MM6];
{$endif SUPPORT_MMX}
c_usableregs:=4;
tmpfreelist:=nil;
templist:=nil;
end.
{
$Log$
Revision 1.6 1998-05-20 09:42:38 pierre
Revision 1.7 1998-06-08 13:13:47 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.6 1998/05/20 09:42:38 pierre
+ UseTokenInfo now default
* unit in interface uses and implementation uses gives error now
* only one error for unknown symbol (uses lastsymknown boolean)