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

* force to use ATT or direct parsing

Browse Source
This commit is contained in:
peter 1998-05-31 14:15:47 +00:00
parent 128212755c
commit 12f6e38140
5 changed files with 464 additions and 654 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

259
rtl/i386/i386.inc
View File

@ -5,7 +5,7 @@
Processor dependent implementation for the system unit for
intel i386+
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -161,47 +161,47 @@ asm
0 %ebp
}
{ eax isn't touched anywhere, so it doesn't have to reloaded }
movl 8(%ebp),%eax
movl 8(%ebp),%eax
{ initialise self ? }
orl %esi,%esi
jne .LHC_4
orl %esi,%esi
jne .LHC_4
{ get memory, but save register first temporary variable }
subl $4,%esp
movl %esp,%esi
subl $4,%esp
movl %esp,%esi
{ Save Register}
pushal
{ Memory size }
pushl (%eax)
pushl %esi
call GETMEM
pushl (%eax)
pushl %esi
call GETMEM
popal
{ Memory size to %esi }
movl (%esi),%esi
addl $4,%esp
movl (%esi),%esi
addl $4,%esp
{ If no memory available : fail() }
orl %esi,%esi
jz .LHC_5
orl %esi,%esi
jz .LHC_5
{ init self for the constructor }
movl %esi,12(%ebp)
movl %esi,12(%ebp)
.LHC_4:
{ is there a VMT address ? }
orl %eax,%eax
jnz .LHC_7
orl %eax,%eax
jnz .LHC_7
{ In case the constructor doesn't do anything, the Zero-Flag }
{ can't be put, because this calls Fail() }
incl %eax
incl %eax
ret
.LHC_7:
{ set zero inside the object }
pushal
pushw $0
pushl (%eax)
pushl %esi
call FILL_OBJECT
pushw $0
pushl (%eax)
pushl %esi
call FILL_OBJECT
popal
{ set the VMT address for the new created object }
movl %eax,(%esi)
orl %eax,%eax
movl %eax,(%esi)
orl %eax,%eax
.LHC_5:
end;
@ -286,36 +286,36 @@ asm
0 %ebp
}
{ temporary Variable }
subl $4,%esp
movl %esp,%edi
subl $4,%esp
movl %esp,%edi
pushal
{ Should the object be resolved ? }
movl 8(%ebp),%eax
orl %eax,%eax
jz .LHD_3
movl 8(%ebp),%eax
orl %eax,%eax
jz .LHD_3
{ Yes, get size from SELF! }
movl 12(%ebp),%eax
movl 12(%ebp),%eax
{ get VMT-pointer (from Self) to %ebx }
movl (%eax),%ebx
movl (%eax),%ebx
{ And put size on the Stack }
pushl (%ebx)
pushl (%ebx)
{ SELF }
{ I think for precaution }
{ that we should clear the VMT here }
movl $0,(%eax)
movl %eax,(%edi)
pushl %edi
call FREEMEM
movl $0,(%eax)
movl %eax,(%edi)
pushl %edi
call FREEMEM
.LHD_3:
popal
addl $4,%esp
addl $4,%esp
end;
{$ASMMODE ATT}
{****************************************************************************
String
String
****************************************************************************}
procedure strcopy(dstr,sstr:pointer;len:longint);[public,alias:'STRCOPY'];
@ -448,6 +448,7 @@ begin
end;
{$ASMMODE DIRECT}
function strpas(p:pchar):string;
begin
asm
@ -483,6 +484,8 @@ begin
movsb
end ['ECX','EAX','ESI','EDI'];
end;
{$ASMMODE ATT}
function strlen(p:pchar):longint;assembler;
asm
@ -497,25 +500,25 @@ asm
end ['EDI','ECX','EAX'];
{****************************************************************************
Other
Other
****************************************************************************}
function get_addr(addrbp:longint):longint;assembler;
asm
movl addrbp,%eax
orl %eax,%eax
jz .Lg_a_null
movl 4(%eax),%eax
movl addrbp,%eax
orl %eax,%eax
jz .Lg_a_null
movl 4(%eax),%eax
.Lg_a_null:
end ['EAX'];
function get_next_frame(framebp:longint):longint;assembler;
asm
movl framebp,%eax
orl %eax,%eax
jz .Lgnf_null
movl (%eax),%eax
movl framebp,%eax
orl %eax,%eax
jz .Lgnf_null
movl (%eax),%eax
.Lgnf_null:
end ['EAX'];
@ -557,7 +560,7 @@ begin
{ Since IOCHECK is called directly and only later the optimiser }
{ Maybe also save global registers }
asm
pushal
pushal
end;
l:=ioresult;
if l<>0 then
@ -566,7 +569,7 @@ begin
halt(l);
end;
asm
popal
popal
end;
end;
@ -577,8 +580,8 @@ var
begin
{ Overflow was shortly before the return address }
asm
movl 4(%ebp),%edi
movl %edi,addr
movl 4(%ebp),%edi
movl %edi,addr
end;
writeln('Overflow at ',addr);
RunError(215);
@ -587,26 +590,26 @@ end;
function abs(l:longint):longint;assembler;
asm
movl l,%eax
orl %eax,%eax
jns .LMABS1
negl %eax
movl l,%eax
orl %eax,%eax
jns .LMABS1
negl %eax
.LMABS1:
end ['EAX'];
function odd(l:longint):boolean;assembler;
asm
movl l,%eax
andl $1,%eax
setnz %al
movl l,%eax
andl $1,%eax
setnz %al
end ['EAX'];
function sqr(l:longint):longint;assembler;
asm
mov l,%eax
imull %eax,%eax
mov l,%eax
imull %eax,%eax
end ['EAX'];
@ -697,7 +700,7 @@ end ['EAX'];
end;
end;
Function Sptr : Longint;
begin
asm
@ -708,22 +711,28 @@ begin
end;
{$I386_ATT} {can be removed}
Function Random(L: LongInt): LongInt;assembler;
asm
movl $134775813,%eax
mull RandSeed
incl %eax
movl %eax,RandSeed
mull 4(%esp)
movl %edx,%eax
movl $134775813,%eax
mull RandSeed
incl %eax
movl %eax,RandSeed
mull 4(%esp)
movl %edx,%eax
end;
{$I386_DIRECT}
{$I386_DIRECT} {can be removed}
{$ASMMODE ATT}
{
$Log$
Revision 1.11 1998-05-30 14:30:21 peter
Revision 1.12 1998-05-31 14:15:47 peter
* force to use ATT or direct parsing
Revision 1.11 1998/05/30 14:30:21 peter
* force att reading
Revision 1.10 1998/05/25 10:40:49 peter
@ -740,118 +749,4 @@ end;
Revision 1.2 1998/04/08 07:53:31 michael
+ Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno)
Revision 1.1.1.1 1998/03/25 11:18:43 root
* Restored version
Revision 1.30 1998/03/20 05:11:17 carl
* bugfix of register usage list for strcmp and strconcat
Revision 1.29 1998/03/15 19:38:41 peter
* fixed a bug in Move()
Revision 1.28 1998/03/10 23:50:39 florian
* strcopy saves now the used registers except ESI and EDI, solves
a problem with the optimizer
Revision 1.27 1998/03/10 16:25:52 jonas
* removed reloading of eax with 8(ebp), in int_help_constructor, as eax is nowhere modified
Revision 1.25 1998/03/02 11:44:43 florian
* writing of large cardinals fixed
Revision 1.24 1998/03/02 04:14:02 carl
* page fault bug fix with CHECK_OBJECT
warning: Will only work with GAS as VMT pointer field is an
.lcomm and will be ZEROED by linker (might not be true for TASM)
Revision 1.23 1998/02/24 17:50:46 peter
* upto 100% (255's char is different ;) faster STRCMP
* faster StrPas from i386.inc also strings.pp
Revision 1.22 1998/02/22 22:01:26 carl
+ IOCHECK halts with the correct errorcode now
Revision 1.21 1998/02/11 16:55:14 michael
fixed cardinal printing. Large cardinals (>0fffffff) not yet working
Revision 1.20 1998/02/06 09:12:39 florian
* bug in CHECK_OBJECT fixed
Revision 1.19 1998/02/05 22:30:25 florian
+ CHECK_OBJECT to check for an valid VMT (before calling a virtual method)
Revision 1.18 1998/02/04 14:46:36 daniel
* Some small tweaks
Revision 1.17 1998/01/27 22:05:07 florian
* again small fixes to DOM (Delphi Object Model)
Revision 1.16 1998/01/26 11:59:01 michael
+ Added log at the end
revision 1.15
date: 1998/01/25 22:52:52; author: peter; state: Exp; lines: +140 -122
* Faster string functions by using aligning
----------------------------
revision 1.14
date: 1998/01/25 22:30:48; author: florian; state: Exp; lines: +14 -2
* DOM: some fixes to tobject and the con-/destructor help routines
----------------------------
revision 1.13
date: 1998/01/23 18:08:29; author: florian; state: Exp; lines: +10 -4
* more bugs in FCL object model removed
----------------------------
revision 1.12
date: 1998/01/23 15:54:47; author: florian; state: Exp; lines: +5 -5
+ small extensions to FCL object model
----------------------------
revision 1.11
date: 1998/01/20 00:14:24; author: peter; state: Exp; lines: +18 -5
* .type is linux only, go32v2 doesn't like it
----------------------------
revision 1.10
date: 1998/01/19 16:19:53; author: peter; state: Exp; lines: +7 -1
* Works now correct with shared libs, .globl always needs a .type
----------------------------
revision 1.9
date: 1998/01/19 10:21:35; author: michael; state: Exp; lines: +1 -6
* moved Fillchar t(..,char) to system.inc
----------------------------
revision 1.8
date: 1998/01/19 09:15:05; author: michael; state: Exp; lines: +40 -132
* Bugfixes in Move and FillChar
----------------------------
revision 1.7
date: 1998/01/16 23:10:52; author: florian; state: Exp; lines: +23 -1
+ some tobject stuff
----------------------------
revision 1.6
date: 1998/01/16 22:21:35; author: michael; state: Exp; lines: +601 -493
+ Installed pentium-optimized move (optional)
----------------------------
revision 1.5
date: 1998/01/12 03:39:17; author: carl; state: Exp; lines: +2 -2
* bugfix of RE_OVERFLOW, gives out now a Runerror(215)
----------------------------
revision 1.4
date: 1998/01/01 16:57:36; author: michael; state: Exp; lines: +1 -21
Moved DO_EXIT to system.inc. Now processor independent
----------------------------
revision 1.3
date: 1997/12/10 12:12:31; author: michael; state: Exp; lines: +2 -2
* changed dateifunc to FileFunc
----------------------------
revision 1.2
date: 1997/12/01 12:34:36; author: michael; state: Exp; lines: +13 -0
+ added copyright reference in header.
----------------------------
revision 1.1
date: 1997/11/27 08:33:48; author: michael; state: Exp;
Initial revision
----------------------------
revision 1.1.1.1
date: 1997/11/27 08:33:48; author: michael; state: Exp; lines: +0 -0
FPC RTL CVS start
=============================================================================
}

220
rtl/i386/math.inc
View File

@ -1,7 +1,9 @@
{
$Id$
This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by the Free Pascal development team
Copyright (c) 1993-98 by the Free Pascal development team
Implementation of mathamatical Routines (only for real)
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -12,10 +14,10 @@
**********************************************************************}
{ Implementation of mathamatical Routines (only for real) }
{$ASMMODE DIRECT}
function abs(d : real) : real;
begin
asm
fldl 8(%ebp)
@ -24,9 +26,9 @@
ret $8
end [];
end;
function sqr(d : real) : real;
begin
asm
fldl 8(%ebp)
@ -36,9 +38,9 @@
ret $8
end [];
end;
function sqrt(d : real) : real;
begin
asm
fldl 8(%ebp)
@ -47,9 +49,9 @@
ret $8
end [];
end;
function arctan(d : real) : real;
begin
asm
fldl 8(%ebp)
@ -59,9 +61,9 @@
ret $8
end [];
end;
function cos(d : real) : real;
begin
asm
fldl 8(%ebp)
@ -73,46 +75,46 @@
fldl .LCOS0
.LCOS1:
leave
ret $8
ret $8
.LCOS0:
.quad 0xffffffffffffffff
.quad 0xffffffffffffffff
end ['EAX'];
end;
function exp(d : real) : real;
begin
asm
// comes from DJ GPP
fldl 8(%ebp)
fldl2e
fmulp
fstcww .LCW1
fstcww .LCW2
fwait
andw $0xf3ff,.LCW2
orw $0x0400,.LCW2
fldcww .LCW2
fldl %st(0)
frndint
fldcww .LCW1
fxch %st(1)
fsub %st(1),%st
f2xm1
faddl .LC0
fscale
fstp %st(1)
fldl 8(%ebp)
fldl2e
fmulp
fstcww .LCW1
fstcww .LCW2
fwait
andw $0xf3ff,.LCW2
orw $0x0400,.LCW2
fldcww .LCW2
fldl %st(0)
frndint
fldcww .LCW1
fxch %st(1)
fsub %st(1),%st
f2xm1
faddl .LC0
fscale
fstp %st(1)
leave
ret $8
ret $8
// store some help data in the data segment
.data
.data
.LCW1:
.word 0
.word 0
.LCW2:
.word 0
.word 0
.LC0:
.double 0d1.0e+00
.double 0d1.0e+00
// do not forget to switch back to text
.text
@ -140,11 +142,11 @@
fldcw -4(%ebp)
leave
ret $8
end ['ECX'];
end ['ECX'];
end;
function int(d : real) : real;
begin
asm
subl $16,%esp
@ -161,11 +163,11 @@
fldcw -4(%ebp)
leave
ret $8
end ['ECX'];
end ['ECX'];
end;
function trunc(d : real) : longint;
begin
asm
subl $16,%esp
@ -182,11 +184,11 @@
fldcw -4(%ebp)
leave
ret $8
end ['EAX','ECX'];
end ['EAX','ECX'];
end;
function round(d : real) : longint;
begin
asm
subl $8,%esp
@ -201,11 +203,11 @@
fldcw -4(%ebp)
leave
ret $8
end ['EAX','ECX'];
end ['EAX','ECX'];
end;
function ln(d : real) : real;
begin
asm
fldln2
@ -215,9 +217,9 @@
ret $8
end [];
end;
function pi : real;
begin
asm
fldpi
@ -225,9 +227,9 @@
ret
end [];
end;
function sin(d : real) : real;
begin
asm
fldl 8(%ebp)
@ -239,9 +241,9 @@
fldl .LSIN0
.LSIN1:
leave
ret $8
ret $8
.LSIN0:
.quad 0xffffffffffffffff
.quad 0xffffffffffffffff
end ['EAX'];
end;
@ -258,31 +260,31 @@
{$ifdef fixed}
function sqrt(d : fixed) : fixed;
begin
asm
movl d,%eax
movl %eax,%ebx
movl %eax,%ecx
jecxz .L_kl
xorl %esi,%esi
.L_it:
xorl %edx,%edx
idivl %ebx
addl %ebx,%eax
shrl $1,%eax
subl %eax,%esi
cmpl $1,%esi
jbe .L_kl
movl %eax,%esi
movl %eax,%ebx
movl %ecx,%eax
jmp .L_it
.L_kl:
shl $8,%eax
leave
ret $4
end;
asm
movl d,%eax
movl %eax,%ebx
movl %eax,%ecx
jecxz .L_kl
xorl %esi,%esi
.L_it:
xorl %edx,%edx
idivl %ebx
addl %ebx,%eax
shrl $1,%eax
subl %eax,%esi
cmpl $1,%esi
jbe .L_kl
movl %eax,%esi
movl %eax,%ebx
movl %ecx,%eax
jmp .L_it
.L_kl:
shl $8,%eax
leave
ret $4
end;
end;
function int(d : fixed) : fixed;
@ -317,14 +319,14 @@
begin
asm
movl d,%eax
rol $16,%eax { Swap high & low word.}
{Absolute value: Invert all bits and increment when <0 .}
cwd { When ax<0, dx contains $ffff}
xorw %dx,%ax { Inverts all bits when dx=$ffff.}
rol $16,%eax { Swap high & low word.}
{Absolute value: Invert all bits and increment when <0 .}
cwd { When ax<0, dx contains $ffff}
xorw %dx,%ax { Inverts all bits when dx=$ffff.}
subw %dx,%ax { Increments when dx=$ffff.}
rol $16,%eax { Swap high & low word.}
rol $16,%eax { Swap high & low word.}
leave
ret $4
ret $4
end;
end;
@ -367,51 +369,11 @@
{$endif}
{$ASMMODE ATT}
{
$Log$
Revision 1.1 1998-03-25 11:18:42 root
Initial revision
Revision 1.2 1998-05-31 14:15:49 peter
* force to use ATT or direct parsing
Revision 1.9 1998/02/04 14:40:31 daniel
* Translated abs for fixed to assembler.
Revision 1.8 1998/01/27 12:44:48 peter
* removed comment level 2 warning
Revision 1.7 1998/01/26 11:59:04 michael
+ Added log at the end
Working file: rtl/i386/math.inc
description:
----------------------------
revision 1.6
date: 1998/01/20 15:12:27; author: peter; state: Exp; lines: +4 -3
* fixes bug 65
----------------------------
revision 1.5
date: 1997/12/01 12:34:37; author: michael; state: Exp; lines: +11 -4
+ added copyright reference in header.
----------------------------
revision 1.4
date: 1997/11/28 23:26:44; author: florian; state: Exp; lines: +34 -33
$ifdef fixed added
----------------------------
revision 1.3
date: 1997/11/28 19:46:11; author: pierre; state: Exp; lines: +360 -358
+ fixed math in define (does not compile yet)
----------------------------
revision 1.2
date: 1997/11/28 16:50:04; author: carl; state: Exp; lines: +358 -278
+ added fixes point routines.
----------------------------
revision 1.1
date: 1997/11/27 08:33:48; author: michael; state: Exp;
Initial revision
----------------------------
revision 1.1.1.1
date: 1997/11/27 08:33:48; author: michael; state: Exp; lines: +0 -0
FPC RTL CVS start
=============================================================================
}

37
rtl/i386/mmx.pp
View File

@ -52,6 +52,8 @@ unit mmx;
uses
cpu;
{$ASMMODE DIRECT}
{ returns true, if the processor supports the mmx instructions }
function mmx_support : boolean;
@ -64,7 +66,7 @@ unit mmx;
asm
movl $1,%eax
cpuid
movl %edx,-4(%ebp) // _edx is ebp-4
movl %edx,_edx
end;
mmx_support:=(_edx and $800000)<>0;
end
@ -84,7 +86,7 @@ unit mmx;
asm
movl $0x80000001,%eax
cpuid
movl %edx,-4(%ebp) // _edx is ebp-4
movl %edx,_edx
end;
amd_3d_support:=(_edx and $80000000)<>0;
end
@ -92,6 +94,7 @@ unit mmx;
{ a cpu with without cpuid instruction supports never mmx }
amd_3d_support:=false;
end;
procedure emms;assembler;
asm
@ -120,34 +123,8 @@ begin
end.
{
$Log$
Revision 1.1 1998-03-25 11:18:43 root
Initial revision
Revision 1.7 1998/03/24 09:32:57 peter
* fixed comments
Revision 1.6 1998/03/22 12:41:51 florian
* fix of amd_3d_support procedure
Revision 1.5 1998/03/20 23:27:48 florian
+ some AMD 3D support:
single type and detection of AMD 3D
Revision 1.4 1998/03/03 22:47:01 florian
* small problems fixed
Revision 1.3 1998/02/09 23:48:18 florian
+ exit handler added (executes emms)
+ is_mmx_cpu variable added
Revision 1.2 1998/02/05 22:30:48 florian
+ types for fixed mmx type
Revision 1.1 1998/02/04 23:00:30 florian
+ Initial revision
+ basic data types
+ emms procedure
+ mmx detection from unit cpu inserted
Revision 1.2 1998-05-31 14:15:50 peter
* force to use ATT or direct parsing
}

595
rtl/i386/set.inc
View File

@ -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
Include file with set operations called by the compiler
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
@ -12,15 +14,13 @@
**********************************************************************}
{ include file with procedures used for set operations }
{ these procedures should never be called directly }
{ the compiler calls them }
{$ASMMODE ATT}
{ add the element b to the set pointed by p }
procedure do_set(p : pointer;b : byte);
[public,alias: 'SET_SET_BYTE'];
begin
procedure do_set(p : pointer;b : byte); [public,alias: 'SET_SET_BYTE'];
{
add the element b to the set pointed by p
}
begin
asm
pushl %eax
movl p,%edi
@ -36,36 +36,39 @@
leave
ret $6
end;
end;
end;
{ bad implementation, but it's very seldom used }
procedure do_set(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
begin
asm
pushl %eax
xorl %eax,%eax
movb h,%al
.LSET_SET_RANGE_LOOP:
cmpb %al,l
jb .LSET_SET_RANGE_EXIT
pushw %ax
pushl p
call SET_SET_BYTE
dec %al
jmp .LSET_SET_RANGE_LOOP
.LSET_SET_RANGE_EXIT:
popl %eax
end;
end;
{$ASMMODE DIRECT}
procedure do_set(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
{
bad implementation, but it's very seldom used
}
begin
asm
pushl %eax
xorl %eax,%eax
movb h,%al
.LSET_SET_RANGE_LOOP:
cmpb %al,l
jb .LSET_SET_RANGE_EXIT
pushw %ax
pushl p
call SET_SET_BYTE
dec %al
jmp .LSET_SET_RANGE_LOOP
.LSET_SET_RANGE_EXIT:
popl %eax
end;
end;
{$ASMMODE ATT}
{ tests if the element b is in the set p }
{ the carryflag is set if it present }
procedure do_in(p : pointer;b : byte);
[public,alias: 'SET_IN_BYTE'];
begin
procedure do_in(p : pointer;b : byte);[public,alias: 'SET_IN_BYTE'];
{
tests if the element b is in the set p the carryflag is set if it present
}
begin
asm
pushl %eax
movl p,%edi
@ -81,309 +84,277 @@
leave
ret $6
end;
end;
procedure add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
{
adds set1 and set2 into set dest
}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMADDSETS1:
lodsl
orl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMADDSETS1
end;
{ adds set1 and set2 into set dest }
end;
procedure add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMADDSETS1:
lodsl
orl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMADDSETS1
end;
{ multiplies (i.E. takes common elements of) set1 and set2 }
{ result put in dest }
procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMMULSETS1:
lodsl
andl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMMULSETS1
end;
end;
procedure sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS'];
{
computes the diff from set1 to set2 result in dest
}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMSUBSETS1:
lodsl
movl (%ebx),%edx
notl %edx
andl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSUBSETS1
end;
end;
{ multiplies (i.E. takes common elements of) set1 and set2 }
{ result put in dest }
procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMMULSETS1:
lodsl
andl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMMULSETS1
end;
procedure sym_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
{
computes the symetric diff from set1 to set2 result in dest
}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMSYMDIFSETS1:
lodsl
movl (%ebx),%edx
xorl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSYMDIFSETS1
end;
end;
{ computes the diff from set1 to set2 }
{ result in dest }
procedure sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMSUBSETS1:
lodsl
movl (%ebx),%edx
notl %edx
andl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSUBSETS1
end;
procedure comp_sets(set1,set2 : pointer);[public,alias: 'SET_COMP_SETS'];
{
compares set1 and set2 zeroflag is set if they are equal
}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%edi
movl $8,%ecx
.LMCOMPSETS1:
lodsl
movl (%edi),%edx
cmpl %edx,%eax
jne .LMCOMPSETEND
addl $4,%edi
decl %ecx
jnz .LMCOMPSETS1
{ we are here only if the two sets are equal
we have zero flag set, and that what is expected }
cmpl %eax,%eax
.LMCOMPSETEND:
end;
end;
{ computes the symetric diff from set1 to set2 }
{ result in dest }
procedure sym_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
{$ifdef LARGESETS}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl $8,%ecx
.LMSYMDIFSETS1:
lodsl
movl (%ebx),%edx
xorl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSYMDIFSETS1
end;
end;
{ compares set1 and set2 }
{ zeroflag is set if they are equal }
procedure comp_sets(set1,set2 : pointer);[public,alias: 'SET_COMP_SETS'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%edi
movl $8,%ecx
.LMCOMPSETS1:
lodsl
movl (%edi),%edx
cmpl %edx,%eax
jne .LMCOMPSETEND
addl $4,%edi
decl %ecx
jnz .LMCOMPSETS1
// we are here only if the two sets are equal
// we have zero flag set, and that what is expected
cmpl %eax,%eax
.LMCOMPSETEND:
end;
end;
{ sets the element b in set p }
{ works for sets larger than 256 elements }
{ not yet use by the compiler so }
{$ifdef ver_above without the number }
procedure do_set(p : pointer;b : word);[public,alias: 'SET_SET_WORD'];
begin
asm
pushl %eax
movl 8(%ebp),%edi
movw 12(%ebp),%ax
andl $0xfff8,%eax
shrl $3,%eax
addl %eax,%edi
movb 12(%ebp),%al
andl $7,%eax
btsl %eax,(%edi)
popl %eax
end;
procedure do_set(p : pointer;b : word);[public,alias: 'SET_SET_WORD'];
{
sets the element b in set p works for sets larger than 256 elements
not yet use by the compiler so
}
begin
asm
pushl %eax
movl 8(%ebp),%edi
movw 12(%ebp),%ax
andl $0xfff8,%eax
shrl $3,%eax
addl %eax,%edi
movb 12(%ebp),%al
andl $7,%eax
btsl %eax,(%edi)
popl %eax
end;
end;
{ tests if the element b is in the set p }
{ the carryflag is set if it present }
{ works for sets larger than 256 elements }
procedure do_in(p : pointer;b : word);[public,alias: 'SET_IN_WORD'];
begin
asm
pushl %eax
movl 8(%ebp),%edi
movw 12(%ebp),%ax
andl $0xfff8,%eax
shrl $3,%eax
addl %eax,%edi
movb 12(%ebp),%al
andl $7,%eax
btl %eax,(%edi)
popl %eax
end;
end;
{ adds set1 and set2 into set dest }
{ size is the number of bytes in the set }
procedure add_sets(set1,set2,dest : pointer;size : longint);
[public,alias: 'SET_ADD_SETS_SIZE'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMADDSETSIZES1:
lodsl
orl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMADDSETSIZES1
end;
end;
{ multiplies (i.E. takes common elements of) set1 and set2 }
{ result put in dest }
{ size is the number of bytes in the set }
procedure mul_sets(set1,set2,dest : pointer;size : longint);
[public,alias: 'SET_MUL_SETS_SIZE'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMMULSETSIZES1:
lodsl
andl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMMULSETSIZES1
end;
procedure do_in(p : pointer;b : word);[public,alias: 'SET_IN_WORD'];
{
tests if the element b is in the set p the carryflag is set if it present
works for sets larger than 256 elements
}
begin
asm
pushl %eax
movl 8(%ebp),%edi
movw 12(%ebp),%ax
andl $0xfff8,%eax
shrl $3,%eax
addl %eax,%edi
movb 12(%ebp),%al
andl $7,%eax
btl %eax,(%edi)
popl %eax
end;
end;
procedure sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SUB_SETS_SIZE'];
procedure add_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_ADD_SETS_SIZE'];
{
adds set1 and set2 into set dest size is the number of bytes in the set
}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMSUBSETSIZES1:
lodsl
movl (%ebx),%edx
notl %edx
andl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSUBSETSIZES1
end;
end;
{ computes the symetric diff from set1 to set2 }
{ result in dest }
procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SYMDIF_SETS_SIZE'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMSYMDIFSETSIZE1:
lodsl
movl (%ebx),%edx
xorl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSYMDIFSETSIZE1
end;
end;
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMADDSETSIZES1:
lodsl
orl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMADDSETSIZES1
end;
end;
procedure comp_sets(set1,set2 : pointer;size : longint);[public,alias: 'SET_COMP_SETS_SIZE'];
procedure mul_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_MUL_SETS_SIZE'];
{
multiplies (i.E. takes common elements of) set1 and set2 result put in
dest size is the number of bytes in the set
}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMMULSETSIZES1:
lodsl
andl (%ebx),%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMMULSETSIZES1
end;
end;
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%edi
movl 16(%ebp),%ecx
.LMCOMPSETSIZES1:
lodsl
movl (%edi),%edx
cmpl %edx,%eax
jne .LMCOMPSETSIZEEND
addl $4,%edi
decl %ecx
jnz .LMCOMPSETSIZES1
// we are here only if the two sets are equal
// we have zero flag set, and that what is expected
cmpl %eax,%eax
.LMCOMPSETSIZEEND:
end;
end;
{$endif ver_above without the number }
procedure sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SUB_SETS_SIZE'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMSUBSETSIZES1:
lodsl
movl (%ebx),%edx
notl %edx
andl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSUBSETSIZES1
end;
end;
procedure sym_sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SYMDIF_SETS_SIZE'];
{
computes the symetric diff from set1 to set2 result in dest
}
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%ebx
movl 16(%ebp),%edi
movl 20(%ebp),%ecx
.LMSYMDIFSETSIZE1:
lodsl
movl (%ebx),%edx
xorl %edx,%eax
stosl
addl $4,%ebx
decl %ecx
jnz .LMSYMDIFSETSIZE1
end;
end;
procedure comp_sets(set1,set2 : pointer;size : longint);[public,alias: 'SET_COMP_SETS_SIZE'];
begin
asm
movl 8(%ebp),%esi
movl 12(%ebp),%edi
movl 16(%ebp),%ecx
.LMCOMPSETSIZES1:
lodsl
movl (%edi),%edx
cmpl %edx,%eax
jne .LMCOMPSETSIZEEND
addl $4,%edi
decl %ecx
jnz .LMCOMPSETSIZES1
{ we are here only if the two sets are equal
we have zero flag set, and that what is expected }
cmpl %eax,%eax
.LMCOMPSETSIZEEND:
end;
end;
{$endif LARGESET}
{
$Log$
Revision 1.1 1998-03-25 11:18:42 root
Initial revision
Revision 1.2 1998-05-31 14:15:51 peter
* force to use ATT or direct parsing
Revision 1.7 1998/03/03 12:07:11 florian
* undid the change of some procedures to plain assembler procedures
Revision 1.6 1998/03/02 23:10:33 florian
* SET_* are now assembler procedures
Revision 1.5 1998/02/11 18:37:01 florian
* stupid typing mistake fixed (I though it compiles, but the assembler
wrote an error message)
Revision 1.4 1998/02/11 16:17:45 florian
+ helper routine for "dynamic" set constructors with ranges added
Revision 1.3 1998/01/26 11:59:09 michael
+ Added log at the end
Working file: rtl/i386/set.inc
description:
----------------------------
revision 1.2
date: 1997/12/01 12:34:37; author: michael; state: Exp; lines: +11 -4
+ added copyright reference in header.
----------------------------
revision 1.1
date: 1997/11/27 08:33:48; author: michael; state: Exp;
Initial revision
----------------------------
revision 1.1.1.1
date: 1997/11/27 08:33:48; author: michael; state: Exp; lines: +0 -0
FPC RTL CVS start
=============================================================================
}

7
rtl/i386/strings.pp
View File

@ -233,6 +233,7 @@ implementation
end ['EDI','ESI','EBX','EAX','ECX'];
end;
{$ASMMODE DIRECT}
function strpas(p : pchar) : string;
begin
asm
@ -268,6 +269,7 @@ implementation
movsb
end ['ECX','EAX','ESI','EDI'];
end;
{$ASMMODE ATT}
function strcat(dest,source : pchar) : pchar;
@ -587,7 +589,10 @@ end.
{
$Log$
Revision 1.3 1998-05-30 14:30:22 peter
Revision 1.4 1998-05-31 14:15:52 peter
* force to use ATT or direct parsing
Revision 1.3 1998/05/30 14:30:22 peter
* force att reading
Revision 1.2 1998/05/23 01:14:06 peter