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