paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 09:49:35 +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

251
rtl/i386/i386.inc
View File

@ -161,47 +161,47 @@ asm
0 %ebp 0 %ebp
} }
{ eax isn't touched anywhere, so it doesn't have to reloaded } { eax isn't touched anywhere, so it doesn't have to reloaded }
movl 8(%ebp),%eax movl 8(%ebp),%eax
{ initialise self ? } { initialise self ? }
orl %esi,%esi orl %esi,%esi
jne .LHC_4 jne .LHC_4
{ get memory, but save register first temporary variable } { get memory, but save register first temporary variable }
subl $4,%esp subl $4,%esp
movl %esp,%esi movl %esp,%esi
{ Save Register} { Save Register}
pushal pushal
{ Memory size } { Memory size }
pushl (%eax) pushl (%eax)
pushl %esi pushl %esi
call GETMEM call GETMEM
popal popal
{ Memory size to %esi } { Memory size to %esi }
movl (%esi),%esi movl (%esi),%esi
addl $4,%esp addl $4,%esp
{ If no memory available : fail() } { If no memory available : fail() }
orl %esi,%esi orl %esi,%esi
jz .LHC_5 jz .LHC_5
{ init self for the constructor } { init self for the constructor }
movl %esi,12(%ebp) movl %esi,12(%ebp)
.LHC_4: .LHC_4:
{ is there a VMT address ? } { is there a VMT address ? }
orl %eax,%eax orl %eax,%eax
jnz .LHC_7 jnz .LHC_7
{ In case the constructor doesn't do anything, the Zero-Flag } { In case the constructor doesn't do anything, the Zero-Flag }
{ can't be put, because this calls Fail() } { can't be put, because this calls Fail() }
incl %eax incl %eax
ret ret
.LHC_7: .LHC_7:
{ set zero inside the object } { set zero inside the object }
pushal pushal
pushw $0 pushw $0
pushl (%eax) pushl (%eax)
pushl %esi pushl %esi
call FILL_OBJECT call FILL_OBJECT
popal popal
{ set the VMT address for the new created object } { set the VMT address for the new created object }
movl %eax,(%esi) movl %eax,(%esi)
orl %eax,%eax orl %eax,%eax
.LHC_5: .LHC_5:
end; end;
@ -286,29 +286,29 @@ asm
0 %ebp 0 %ebp
} }
{ temporary Variable } { temporary Variable }
subl $4,%esp subl $4,%esp
movl %esp,%edi movl %esp,%edi
pushal pushal
{ Should the object be resolved ? } { Should the object be resolved ? }
movl 8(%ebp),%eax movl 8(%ebp),%eax
orl %eax,%eax orl %eax,%eax
jz .LHD_3 jz .LHD_3
{ Yes, get size from SELF! } { Yes, get size from SELF! }
movl 12(%ebp),%eax movl 12(%ebp),%eax
{ get VMT-pointer (from Self) to %ebx } { get VMT-pointer (from Self) to %ebx }
movl (%eax),%ebx movl (%eax),%ebx
{ And put size on the Stack } { And put size on the Stack }
pushl (%ebx) pushl (%ebx)
{ SELF } { SELF }
{ I think for precaution } { I think for precaution }
{ that we should clear the VMT here } { that we should clear the VMT here }
movl $0,(%eax) movl $0,(%eax)
movl %eax,(%edi) movl %eax,(%edi)
pushl %edi pushl %edi
call FREEMEM call FREEMEM
.LHD_3: .LHD_3:
popal popal
addl $4,%esp addl $4,%esp
end; end;
{$ASMMODE ATT} {$ASMMODE ATT}
@ -448,6 +448,7 @@ begin
end; end;
{$ASMMODE DIRECT}
function strpas(p:pchar):string; function strpas(p:pchar):string;
begin begin
asm asm
@ -483,6 +484,8 @@ begin
movsb movsb
end ['ECX','EAX','ESI','EDI']; end ['ECX','EAX','ESI','EDI'];
end; end;
{$ASMMODE ATT}
function strlen(p:pchar):longint;assembler; function strlen(p:pchar):longint;assembler;
asm asm
@ -502,20 +505,20 @@ end ['EDI','ECX','EAX'];
function get_addr(addrbp:longint):longint;assembler; function get_addr(addrbp:longint):longint;assembler;
asm asm
movl addrbp,%eax movl addrbp,%eax
orl %eax,%eax orl %eax,%eax
jz .Lg_a_null jz .Lg_a_null
movl 4(%eax),%eax movl 4(%eax),%eax
.Lg_a_null: .Lg_a_null:
end ['EAX']; end ['EAX'];
function get_next_frame(framebp:longint):longint;assembler; function get_next_frame(framebp:longint):longint;assembler;
asm asm
movl framebp,%eax movl framebp,%eax
orl %eax,%eax orl %eax,%eax
jz .Lgnf_null jz .Lgnf_null
movl (%eax),%eax movl (%eax),%eax
.Lgnf_null: .Lgnf_null:
end ['EAX']; end ['EAX'];
@ -557,7 +560,7 @@ begin
{ Since IOCHECK is called directly and only later the optimiser } { Since IOCHECK is called directly and only later the optimiser }
{ Maybe also save global registers } { Maybe also save global registers }
asm asm
pushal pushal
end; end;
l:=ioresult; l:=ioresult;
if l<>0 then if l<>0 then
@ -566,7 +569,7 @@ begin
halt(l); halt(l);
end; end;
asm asm
popal popal
end; end;
end; end;
@ -577,8 +580,8 @@ var
begin begin
{ Overflow was shortly before the return address } { Overflow was shortly before the return address }
asm asm
movl 4(%ebp),%edi movl 4(%ebp),%edi
movl %edi,addr movl %edi,addr
end; end;
writeln('Overflow at ',addr); writeln('Overflow at ',addr);
RunError(215); RunError(215);
@ -587,26 +590,26 @@ end;
function abs(l:longint):longint;assembler; function abs(l:longint):longint;assembler;
asm asm
movl l,%eax movl l,%eax
orl %eax,%eax orl %eax,%eax
jns .LMABS1 jns .LMABS1
negl %eax negl %eax
.LMABS1: .LMABS1:
end ['EAX']; end ['EAX'];
function odd(l:longint):boolean;assembler; function odd(l:longint):boolean;assembler;
asm asm
movl l,%eax movl l,%eax
andl $1,%eax andl $1,%eax
setnz %al setnz %al
end ['EAX']; end ['EAX'];
function sqr(l:longint):longint;assembler; function sqr(l:longint):longint;assembler;
asm asm
mov l,%eax mov l,%eax
imull %eax,%eax imull %eax,%eax
end ['EAX']; end ['EAX'];
@ -708,22 +711,28 @@ begin
end; end;
{$I386_ATT} {can be removed}
Function Random(L: LongInt): LongInt;assembler; Function Random(L: LongInt): LongInt;assembler;
asm asm
movl $134775813,%eax movl $134775813,%eax
mull RandSeed mull RandSeed
incl %eax incl %eax
movl %eax,RandSeed movl %eax,RandSeed
mull 4(%esp) mull 4(%esp)
movl %edx,%eax movl %edx,%eax
end; end;
{$I386_DIRECT} {$I386_DIRECT} {can be removed}
{$ASMMODE ATT}
{ {
$Log$ $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 * force att reading
Revision 1.10 1998/05/25 10:40:49 peter 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 Revision 1.2 1998/04/08 07:53:31 michael
+ Changed Random() function. Moved from system to processor dependent files (from Pedro Gimeno) + 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
=============================================================================
} }

166
rtl/i386/math.inc
View File

@ -1,7 +1,9 @@
{ {
$Id$ $Id$
This file is part of the Free Pascal run time library. 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, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -12,7 +14,7 @@
**********************************************************************} **********************************************************************}
{ Implementation of mathamatical Routines (only for real) } {$ASMMODE DIRECT}
function abs(d : real) : real; function abs(d : real) : real;
@ -73,9 +75,9 @@
fldl .LCOS0 fldl .LCOS0
.LCOS1: .LCOS1:
leave leave
ret $8 ret $8
.LCOS0: .LCOS0:
.quad 0xffffffffffffffff .quad 0xffffffffffffffff
end ['EAX']; end ['EAX'];
end; end;
@ -84,35 +86,35 @@
begin begin
asm asm
// comes from DJ GPP // comes from DJ GPP
fldl 8(%ebp) fldl 8(%ebp)
fldl2e fldl2e
fmulp fmulp
fstcww .LCW1 fstcww .LCW1
fstcww .LCW2 fstcww .LCW2
fwait fwait
andw $0xf3ff,.LCW2 andw $0xf3ff,.LCW2
orw $0x0400,.LCW2 orw $0x0400,.LCW2
fldcww .LCW2 fldcww .LCW2
fldl %st(0) fldl %st(0)
frndint frndint
fldcww .LCW1 fldcww .LCW1
fxch %st(1) fxch %st(1)
fsub %st(1),%st fsub %st(1),%st
f2xm1 f2xm1
faddl .LC0 faddl .LC0
fscale fscale
fstp %st(1) fstp %st(1)
leave leave
ret $8 ret $8
// store some help data in the data segment // store some help data in the data segment
.data .data
.LCW1: .LCW1:
.word 0 .word 0
.LCW2: .LCW2:
.word 0 .word 0
.LC0: .LC0:
.double 0d1.0e+00 .double 0d1.0e+00
// do not forget to switch back to text // do not forget to switch back to text
.text .text
@ -239,9 +241,9 @@
fldl .LSIN0 fldl .LSIN0
.LSIN1: .LSIN1:
leave leave
ret $8 ret $8
.LSIN0: .LSIN0:
.quad 0xffffffffffffffff .quad 0xffffffffffffffff
end ['EAX']; end ['EAX'];
end; end;
@ -260,29 +262,29 @@
function sqrt(d : fixed) : fixed; function sqrt(d : fixed) : fixed;
begin begin
asm asm
movl d,%eax movl d,%eax
movl %eax,%ebx movl %eax,%ebx
movl %eax,%ecx movl %eax,%ecx
jecxz .L_kl jecxz .L_kl
xorl %esi,%esi xorl %esi,%esi
.L_it: .L_it:
xorl %edx,%edx xorl %edx,%edx
idivl %ebx idivl %ebx
addl %ebx,%eax addl %ebx,%eax
shrl $1,%eax shrl $1,%eax
subl %eax,%esi subl %eax,%esi
cmpl $1,%esi cmpl $1,%esi
jbe .L_kl jbe .L_kl
movl %eax,%esi movl %eax,%esi
movl %eax,%ebx movl %eax,%ebx
movl %ecx,%eax movl %ecx,%eax
jmp .L_it jmp .L_it
.L_kl: .L_kl:
shl $8,%eax shl $8,%eax
leave leave
ret $4 ret $4
end; end;
end; end;
function int(d : fixed) : fixed; function int(d : fixed) : fixed;
@ -317,14 +319,14 @@
begin begin
asm asm
movl d,%eax movl d,%eax
rol $16,%eax { Swap high & low word.} rol $16,%eax { Swap high & low word.}
{Absolute value: Invert all bits and increment when <0 .} {Absolute value: Invert all bits and increment when <0 .}
cwd { When ax<0, dx contains $ffff} cwd { When ax<0, dx contains $ffff}
xorw %dx,%ax { Inverts all bits when dx=$ffff.} xorw %dx,%ax { Inverts all bits when dx=$ffff.}
subw %dx,%ax { Increments 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 leave
ret $4 ret $4
end; end;
end; end;
@ -367,51 +369,11 @@
{$endif} {$endif}
{$ASMMODE ATT}
{ {
$Log$ $Log$
Revision 1.1 1998-03-25 11:18:42 root Revision 1.2 1998-05-31 14:15:49 peter
Initial revision * 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 uses
cpu; cpu;
{$ASMMODE DIRECT}
{ returns true, if the processor supports the mmx instructions } { returns true, if the processor supports the mmx instructions }
function mmx_support : boolean; function mmx_support : boolean;
@ -64,7 +66,7 @@ unit mmx;
asm asm
movl $1,%eax movl $1,%eax
cpuid cpuid
movl %edx,-4(%ebp) // _edx is ebp-4 movl %edx,_edx
end; end;
mmx_support:=(_edx and $800000)<>0; mmx_support:=(_edx and $800000)<>0;
end end
@ -84,7 +86,7 @@ unit mmx;
asm asm
movl $0x80000001,%eax movl $0x80000001,%eax
cpuid cpuid
movl %edx,-4(%ebp) // _edx is ebp-4 movl %edx,_edx
end; end;
amd_3d_support:=(_edx and $80000000)<>0; amd_3d_support:=(_edx and $80000000)<>0;
end end
@ -92,6 +94,7 @@ unit mmx;
{ a cpu with without cpuid instruction supports never mmx } { a cpu with without cpuid instruction supports never mmx }
amd_3d_support:=false; amd_3d_support:=false;
end; end;
procedure emms;assembler; procedure emms;assembler;
asm asm
@ -120,34 +123,8 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 1998-03-25 11:18:43 root Revision 1.2 1998-05-31 14:15:50 peter
Initial revision * force to use ATT or direct parsing
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
} }

595
rtl/i386/set.inc
View File

@ -3,6 +3,8 @@
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by the Free Pascal development team 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, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -12,15 +14,13 @@
**********************************************************************} **********************************************************************}
{ include file with procedures used for set operations } {$ASMMODE ATT}
{ these procedures should never be called directly }
{ the compiler calls them }
{ add the element b to the set pointed by p } procedure do_set(p : pointer;b : byte); [public,alias: 'SET_SET_BYTE'];
procedure do_set(p : pointer;b : byte); {
[public,alias: 'SET_SET_BYTE']; add the element b to the set pointed by p
}
begin begin
asm asm
pushl %eax pushl %eax
movl p,%edi movl p,%edi
@ -36,36 +36,39 @@
leave leave
ret $6 ret $6
end; 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 {$ASMMODE DIRECT}
asm procedure do_set(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
pushl %eax {
xorl %eax,%eax bad implementation, but it's very seldom used
movb h,%al }
.LSET_SET_RANGE_LOOP: begin
cmpb %al,l asm
jb .LSET_SET_RANGE_EXIT pushl %eax
pushw %ax xorl %eax,%eax
pushl p movb h,%al
call SET_SET_BYTE .LSET_SET_RANGE_LOOP:
dec %al cmpb %al,l
jmp .LSET_SET_RANGE_LOOP jb .LSET_SET_RANGE_EXIT
.LSET_SET_RANGE_EXIT: pushw %ax
popl %eax pushl p
end; call SET_SET_BYTE
end; 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); procedure do_in(p : pointer;b : byte);[public,alias: 'SET_IN_BYTE'];
[public,alias: 'SET_IN_BYTE']; {
tests if the element b is in the set p the carryflag is set if it present
begin }
begin
asm asm
pushl %eax pushl %eax
movl p,%edi movl p,%edi
@ -81,309 +84,277 @@
leave leave
ret $6 ret $6
end; 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; end;
{ adds set1 and set2 into set dest } end;
procedure add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
begin { multiplies (i.E. takes common elements of) set1 and set2 }
asm { result put in dest }
movl 8(%ebp),%esi
movl 12(%ebp),%ebx procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
movl 16(%ebp),%edi begin
movl $8,%ecx asm
.LMADDSETS1: movl 8(%ebp),%esi
lodsl movl 12(%ebp),%ebx
orl (%ebx),%eax movl 16(%ebp),%edi
stosl movl $8,%ecx
addl $4,%ebx .LMMULSETS1:
decl %ecx lodsl
jnz .LMADDSETS1 andl (%ebx),%eax
end; 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;
end;
{ multiplies (i.E. takes common elements of) set1 and set2 } procedure sym_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
{ result put in dest } {
computes the symetric diff from set1 to set2 result in dest
procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS']; }
begin
begin asm
asm movl 8(%ebp),%esi
movl 8(%ebp),%esi movl 12(%ebp),%ebx
movl 12(%ebp),%ebx movl 16(%ebp),%edi
movl 16(%ebp),%edi movl $8,%ecx
movl $8,%ecx .LMSYMDIFSETS1:
.LMMULSETS1: lodsl
lodsl movl (%ebx),%edx
andl (%ebx),%eax xorl %edx,%eax
stosl stosl
addl $4,%ebx addl $4,%ebx
decl %ecx decl %ecx
jnz .LMMULSETS1 jnz .LMSYMDIFSETS1
end;
end; end;
end;
{ computes the diff from set1 to set2 } procedure comp_sets(set1,set2 : pointer);[public,alias: 'SET_COMP_SETS'];
{ result in dest } {
compares set1 and set2 zeroflag is set if they are equal
procedure sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS']; }
begin
begin asm
asm movl 8(%ebp),%esi
movl 8(%ebp),%esi movl 12(%ebp),%edi
movl 12(%ebp),%ebx movl $8,%ecx
movl 16(%ebp),%edi .LMCOMPSETS1:
movl $8,%ecx lodsl
.LMSUBSETS1: movl (%edi),%edx
lodsl cmpl %edx,%eax
movl (%ebx),%edx jne .LMCOMPSETEND
notl %edx addl $4,%edi
andl %edx,%eax decl %ecx
stosl jnz .LMCOMPSETS1
addl $4,%ebx { we are here only if the two sets are equal
decl %ecx we have zero flag set, and that what is expected }
jnz .LMSUBSETS1 cmpl %eax,%eax
end; .LMCOMPSETEND:
end; 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 procedure do_set(p : pointer;b : word);[public,alias: 'SET_SET_WORD'];
asm {
movl 8(%ebp),%esi sets the element b in set p works for sets larger than 256 elements
movl 12(%ebp),%ebx not yet use by the compiler so
movl 16(%ebp),%edi }
movl $8,%ecx begin
.LMSYMDIFSETS1: asm
lodsl pushl %eax
movl (%ebx),%edx movl 8(%ebp),%edi
xorl %edx,%eax movw 12(%ebp),%ax
stosl andl $0xfff8,%eax
addl $4,%ebx shrl $3,%eax
decl %ecx addl %eax,%edi
jnz .LMSYMDIFSETS1 movb 12(%ebp),%al
end; andl $7,%eax
end; btsl %eax,(%edi)
popl %eax
{ 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;
end; 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']; procedure do_in(p : pointer;b : word);[public,alias: 'SET_IN_WORD'];
{
begin tests if the element b is in the set p the carryflag is set if it present
asm works for sets larger than 256 elements
pushl %eax }
movl 8(%ebp),%edi begin
movw 12(%ebp),%ax asm
andl $0xfff8,%eax pushl %eax
shrl $3,%eax movl 8(%ebp),%edi
addl %eax,%edi movw 12(%ebp),%ax
movb 12(%ebp),%al andl $0xfff8,%eax
andl $7,%eax shrl $3,%eax
btl %eax,(%edi) addl %eax,%edi
popl %eax movb 12(%ebp),%al
end; andl $7,%eax
end; btl %eax,(%edi)
popl %eax
{ 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;
end; 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 begin
asm asm
movl 8(%ebp),%esi movl 8(%ebp),%esi
movl 12(%ebp),%ebx movl 12(%ebp),%ebx
movl 16(%ebp),%edi movl 16(%ebp),%edi
movl 20(%ebp),%ecx movl 20(%ebp),%ecx
.LMSUBSETSIZES1: .LMADDSETSIZES1:
lodsl lodsl
movl (%ebx),%edx orl (%ebx),%eax
notl %edx stosl
andl %edx,%eax addl $4,%ebx
stosl decl %ecx
addl $4,%ebx jnz .LMADDSETSIZES1
decl %ecx end;
jnz .LMSUBSETSIZES1 end;
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;
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$ $Log$
Revision 1.1 1998-03-25 11:18:42 root Revision 1.2 1998-05-31 14:15:51 peter
Initial revision * 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 ['EDI','ESI','EBX','EAX','ECX'];
end; end;
{$ASMMODE DIRECT}
function strpas(p : pchar) : string; function strpas(p : pchar) : string;
begin begin
asm asm
@ -268,6 +269,7 @@ implementation
movsb movsb
end ['ECX','EAX','ESI','EDI']; end ['ECX','EAX','ESI','EDI'];
end; end;
{$ASMMODE ATT}
function strcat(dest,source : pchar) : pchar; function strcat(dest,source : pchar) : pchar;
@ -587,7 +589,10 @@ end.
{ {
$Log$ $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 * force att reading
Revision 1.2 1998/05/23 01:14:06 peter Revision 1.2 1998/05/23 01:14:06 peter