mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 04:06:08 +02:00
* fixed the optimizes of daniel
This commit is contained in:
peter
parent
cfa06433c6
commit
d26106d745
@ -3,6 +3,8 @@
|
||||
This file is part of the Free Pascal run time library.
|
||||
Copyright (c) 1993,97 by the Free Pascal development team.
|
||||
|
||||
Heap management functions
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
@ -12,18 +14,46 @@
|
||||
|
||||
**********************************************************************}
|
||||
|
||||
{
|
||||
There are three conditionals:
|
||||
|
||||
TEMPHEAP to allow to split the heap in two parts for easier release
|
||||
started for the compiler
|
||||
USEBLOCKS if you want special allocation for small blocks
|
||||
CHECKHEAP if you want to test the heap integrity
|
||||
}
|
||||
|
||||
{****************************************************************************
|
||||
Assembler calls
|
||||
****************************************************************************}
|
||||
|
||||
{$I386_DIRECT}
|
||||
|
||||
{$ifndef OS2}
|
||||
{ OS2 function getheapstart is in sysos2.pas }
|
||||
function getheapstart : pointer;assembler;
|
||||
asm
|
||||
leal HEAP,%eax
|
||||
end ['EAX'];
|
||||
{$endif}
|
||||
|
||||
function getheapsize : longint;assembler;
|
||||
asm
|
||||
movl HEAPSIZE,%eax
|
||||
end ['EAX'];
|
||||
|
||||
function call_heaperror(addr : pointer; size : longint) : integer;assembler;
|
||||
asm
|
||||
pushl size
|
||||
movl addr,%eax
|
||||
call %eax
|
||||
end;
|
||||
|
||||
{$I386_ATT}
|
||||
|
||||
{****************************************************************************
|
||||
functions for heap management in the data segment
|
||||
****************************************************************************}
|
||||
{**** 10/06/97 added checkings and corrected some bugs in getmem/freemem ****}
|
||||
{**** Pierre Muller *********************************************************}
|
||||
|
||||
{ three conditionnals here }
|
||||
|
||||
{ TEMPHEAP to allow to split the heap in two parts for easier release}
|
||||
{ started for the compiler }
|
||||
{ USEBLOCKS if you want special allocation for small blocks }
|
||||
{ CHECKHEAP if you want to test the heap integrity }
|
||||
|
||||
{$IfDef CHECKHEAP}
|
||||
{ 4 levels of tracing }
|
||||
@ -103,29 +133,6 @@
|
||||
nblocks : pnblocks;
|
||||
|
||||
|
||||
{$ifndef OS2}
|
||||
{ OS2 function getheapstart is in sysos2.pas }
|
||||
function getheapstart : pointer;
|
||||
|
||||
begin
|
||||
asm
|
||||
leal HEAP,%eax
|
||||
leave
|
||||
ret
|
||||
end ['EAX'];
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
function getheapsize : longint;
|
||||
|
||||
begin
|
||||
asm
|
||||
movl HEAPSIZE,%eax
|
||||
leave
|
||||
ret
|
||||
end ['EAX'];
|
||||
end;
|
||||
|
||||
function heapsize : longint;
|
||||
|
||||
begin
|
||||
@ -500,18 +507,6 @@
|
||||
label check_new;
|
||||
{$endif CHECKHEAP}
|
||||
|
||||
{ changed to removed the OS conditionnals }
|
||||
function call_heaperror(addr : pointer; size : longint) : integer;
|
||||
begin
|
||||
asm
|
||||
pushl size
|
||||
movl addr,%eax
|
||||
{ movl HEAPERROR,%eax doesn't work !!}
|
||||
call %eax
|
||||
movw %ax,__RESULT
|
||||
end;
|
||||
end;
|
||||
|
||||
var
|
||||
last,hp : pfreerecord;
|
||||
nochmal : boolean;
|
||||
@ -1053,7 +1048,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 1998-04-21 10:22:48 peter
|
||||
Revision 1.5 1998-05-22 12:34:06 peter
|
||||
* fixed the optimizes of daniel
|
||||
|
||||
Revision 1.4 1998/04/21 10:22:48 peter
|
||||
+ heapblocks
|
||||
|
||||
Revision 1.3 1998/04/09 08:32:14 daniel
|
||||
|
||||
@ -97,7 +97,10 @@ asm
|
||||
cmpl $7,%ecx
|
||||
jl .LFill1
|
||||
movl %ecx,%edx
|
||||
imul $0x01010101,%eax
|
||||
movb %al,%ah
|
||||
movl %eax,%ebx
|
||||
shll $16,%eax
|
||||
movw %bx,%ax
|
||||
movl %edi,%ecx
|
||||
negl %ecx
|
||||
andl $3,%ecx
|
||||
@ -105,12 +108,11 @@ asm
|
||||
rep
|
||||
stosb
|
||||
movl %edx,%ecx
|
||||
andb $3,%dl {Saves some bytes, no speed penalties.}
|
||||
andl $3,%edx
|
||||
shrl $2,%ecx
|
||||
rep
|
||||
stosl
|
||||
{Ecx is zero.}
|
||||
movb %dl,%cl
|
||||
movl %edx,%ecx
|
||||
.LFill1:
|
||||
rep
|
||||
stosb
|
||||
@ -118,21 +120,21 @@ end;
|
||||
|
||||
{$ifndef RTLLITE}
|
||||
procedure fillword(var x;count : longint;value : word);assembler;
|
||||
|
||||
asm
|
||||
movl x,%edi
|
||||
movl count,%ecx
|
||||
movl value,%eax
|
||||
{fill EAX with 4 bytes:}
|
||||
imul $0x00010001,%eax
|
||||
movl %ecx,%edx
|
||||
shrl $1,%ecx
|
||||
movl x,%edi
|
||||
movl count,%ecx
|
||||
movl value,%eax
|
||||
movl %eax,%ebx
|
||||
shll $16,%eax
|
||||
movw %bx,%ax
|
||||
movl %ecx,%edx
|
||||
shrl $1,%ecx
|
||||
cld
|
||||
rep
|
||||
stosl
|
||||
{Ecx is zero.}
|
||||
movb %dl,%cl
|
||||
andb $1,%cl {Saves some bytes, no speed penalties.}
|
||||
movb %dl,%cl
|
||||
andb $1,%cl {Saves some bytes, no speed penalties.}
|
||||
rep
|
||||
stosw
|
||||
end ['EAX','ECX','EDX','EDI'];
|
||||
@ -247,7 +249,7 @@ end;
|
||||
|
||||
|
||||
{ checks for a correct vmt pointer }
|
||||
procedure int_check_obhject;assembler;[public,alias:'CHECK_OBJECT'];
|
||||
procedure int_check_object;assembler;[public,alias:'CHECK_OBJECT'];
|
||||
asm
|
||||
pushl %edi
|
||||
movl 8(%esp),%edi
|
||||
@ -308,9 +310,10 @@ end;
|
||||
|
||||
{****************************************************************************
|
||||
String
|
||||
|
||||
****************************************************************************}
|
||||
|
||||
{$I386_ATT}
|
||||
|
||||
procedure int_strcopy(len:longint;sstr,dstr:pointer);[public,alias:'STRCOPY'];
|
||||
{
|
||||
this procedure must save all modified registers except EDI and ESI !!!
|
||||
@ -456,7 +459,7 @@ begin
|
||||
scasb
|
||||
movl %ecx,%eax
|
||||
|
||||
movl 8(%ebp),%edi
|
||||
movl __RESULT,%edi
|
||||
notb %al
|
||||
decl %eax
|
||||
stosb
|
||||
@ -501,12 +504,8 @@ end ['EDI','ECX','EAX'];
|
||||
|
||||
Function Sptr : Longint;assembler;
|
||||
asm
|
||||
{Size optimized instead of speed optimized...}
|
||||
movl %esp,%eax
|
||||
incl %eax
|
||||
incl %eax
|
||||
incl %eax
|
||||
incl %eax
|
||||
movl %esp,%eax
|
||||
addl $4,%eax
|
||||
end ['EAX'];
|
||||
|
||||
|
||||
@ -707,8 +706,6 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
{$I386_ATT}
|
||||
|
||||
Function Random(L: LongInt): LongInt;assembler;
|
||||
asm
|
||||
movl $134775813,%eax
|
||||
@ -723,7 +720,10 @@ end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 1998-05-20 11:01:52 peter
|
||||
Revision 1.9 1998-05-22 12:34:07 peter
|
||||
* fixed the optimizes of daniel
|
||||
|
||||
Revision 1.8 1998/05/20 11:01:52 peter
|
||||
* .FILL_OBJECT and FILL_OBJECT are not the same names ;)
|
||||
|
||||
Revision 1.7 1998/05/20 08:09:24 daniel
|
||||
|
||||
@ -87,7 +87,7 @@ var
|
||||
Input,
|
||||
StdErr : Text;
|
||||
ExitCode,
|
||||
InOutRes : Longint;
|
||||
InOutRes : Word;
|
||||
StackBottom,
|
||||
LowestStack,
|
||||
RandSeed : Longint;
|
||||
@ -332,7 +332,10 @@ Procedure AddExitProc(Proc:TProcedure);
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-05-21 19:31:00 peter
|
||||
Revision 1.7 1998-05-22 12:34:11 peter
|
||||
* fixed the optimizes of daniel
|
||||
|
||||
Revision 1.6 1998/05/21 19:31:00 peter
|
||||
* objects compiles for linux
|
||||
+ assign(pchar), assign(char), rename(pchar), rename(char)
|
||||
* fixed read_text_as_array
|
||||
|
||||
Loading…
Reference in New Issue
Block a user