paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-16 01:39:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* move InterLocked functions to system unit

Browse Source 
git-svn-id: trunk@3933 -
This commit is contained in:
peter 2006-06-25 09:26:23 +00:00
parent f7f1f9917d
commit 4c065bce45
20 changed files with 491 additions and 393 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
.gitattributes vendored
View File

@ -3958,7 +3958,6 @@ rtl/arm/setjump.inc svneol=native#text/plain
rtl/arm/setjumph.inc svneol=native#text/plain
rtl/arm/strings.inc svneol=native#text/plain
rtl/arm/stringss.inc svneol=native#text/plain
rtl/arm/sysutilp.inc svneol=native#text/plain
rtl/atari/os.inc svneol=native#text/plain
rtl/atari/prt0.as -text
rtl/atari/readme -text
@ -4154,7 +4153,6 @@ rtl/i386/strings.inc svneol=native#text/plain
rtl/i386/stringss.inc svneol=native#text/plain
rtl/i386/strlen.inc svneol=native#text/plain
rtl/i386/strpas.inc svneol=native#text/plain
rtl/i386/sysutilp.inc svneol=native#text/plain
rtl/inc/aliases.inc svneol=native#text/plain
rtl/inc/astrings.inc svneol=native#text/plain
rtl/inc/cgeneric.inc svneol=native#text/plain
@ -4742,7 +4740,6 @@ rtl/powerpc/strings.inc svneol=native#text/plain
rtl/powerpc/stringss.inc svneol=native#text/plain
rtl/powerpc/strlen.inc svneol=native#text/plain
rtl/powerpc/strpas.inc svneol=native#text/plain
rtl/powerpc/sysutilp.inc svneol=native#text/plain
rtl/powerpc64/int64p.inc svneol=native#text/plain
rtl/powerpc64/makefile.cpu -text
rtl/powerpc64/math.inc svneol=native#text/plain
@ -4756,7 +4753,6 @@ rtl/powerpc64/strings.inc svneol=native#text/plain
rtl/powerpc64/stringss.inc svneol=native#text/plain
rtl/powerpc64/strlen.inc svneol=native#text/plain
rtl/powerpc64/strpas.inc svneol=native#text/plain
rtl/powerpc64/sysutilp.inc svneol=native#text/plain
rtl/solaris/Makefile svneol=native#text/plain
rtl/solaris/Makefile.fpc svneol=native#text/plain
rtl/solaris/errno.inc svneol=native#text/plain
@ -4995,7 +4991,6 @@ rtl/x86_64/setjumph.inc svneol=native#text/plain
rtl/x86_64/strings.inc svneol=native#text/plain
rtl/x86_64/stringss.inc svneol=native#text/plain
rtl/x86_64/strlen.inc svneol=native#text/plain
rtl/x86_64/sysutilp.inc svneol=native#text/plain
rtl/x86_64/x86_64.inc svneol=native#text/plain
tests/MPWMake -text
tests/Makefile svneol=native#text/plain

30
rtl/arm/arm.inc
View File

@ -19,7 +19,7 @@
procedure fpc_cpuinit;
begin
{$if not(defined(wince)) and not(defined(gba))}
{$if not(defined(wince)) and not(defined(gba))}
asm
rfs r0
and r0,r0,#0xffe0ffff
@ -183,3 +183,31 @@ end;
*)
{ the ARM doesn't know multiprocessor system which would require locking }
function InterLockedDecrement (var Target: longint) : longint;
begin
dec(Target);
result:=target;
end;
function InterLockedIncrement (var Target: longint) : longint;
begin
inc(Target);
result:=target;
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint;
begin
Result:=Target;
Target:=Source;
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
begin
Result:=Target;
inc(Target,Source);
end;

51
rtl/arm/sysutilp.inc
View File

@ -1,51 +0,0 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Florian Klaempfl
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ ---------------------------------------------------------------------
This include contains cpu-specific routines
---------------------------------------------------------------------}
{ the ARM doesn't know multiprocessor system which would require locking }
function InterLockedDecrement (var Target: longint) : longint;
begin
dec(Target);
result:=target;
end;
function InterLockedIncrement (var Target: longint) : longint;
begin
inc(Target);
result:=target;
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint;
begin
Result:=Target;
Target:=Source;
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;
begin
Result:=Target;
inc(Target,Source);
end;

71
rtl/i386/i386.inc
View File

@ -1116,6 +1116,77 @@ begin
end;
function InterLockedDecrement (var Target: longint) : longint; assembler;
asm
{$ifdef REGCALL}
movl $-1,%edx
xchgl %edx,%eax
{$else}
movl Target, %edx
movl $-1, %eax
{$endif}
lock
xaddl %eax, (%edx)
decl %eax
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
asm
{$ifdef REGCALL}
movl $1,%edx
xchgl %edx,%eax
{$else}
movl Target, %edx
movl $1, %eax
{$endif}
lock
xaddl %eax, (%edx)
incl %eax
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef REGCALL}
xchgl (%eax),%edx
movl %edx,%eax
{$else}
movl Target,%ecx
movl Source,%eax
xchgl (%ecx),%eax
{$endif}
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef REGCALL}
xchgl %eax,%edx
{$else}
movl Target,%edx
movl Source,%eax
{$endif}
lock
xaddl %eax, (%edx)
end;
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; assembler;
asm
{$ifdef REGCALL}
xchgl %eax,%edx
{$else}
movl Target,%edx
movl NewValue,%eax
{$endif}
lock
cmpxchgl %eax, (%edx)
end;
{****************************************************************************
FPU
****************************************************************************}

77
rtl/i386/sysutilp.inc
View File

@ -1,77 +0,0 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Florian Klaempfl
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ ---------------------------------------------------------------------
This include contains cpu-specific routines
---------------------------------------------------------------------}
{$ASMMODE ATT}
function InterLockedDecrement (var Target: longint) : longint; assembler;
asm
{$ifdef REGCALL}
movl $-1,%edx
xchgl %edx,%eax
{$else}
movl Target, %edx
movl $-1, %eax
{$endif}
lock
xaddl %eax, (%edx)
decl %eax
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
asm
{$ifdef REGCALL}
movl $1,%edx
xchgl %edx,%eax
{$else}
movl Target, %edx
movl $1, %eax
{$endif}
lock
xaddl %eax, (%edx)
incl %eax
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef REGCALL}
xchgl (%eax),%edx
movl %edx,%eax
{$else}
movl Target,%ecx
movl Source,%eax
xchgl (%ecx),%eax
{$endif}
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef REGCALL}
xchgl %eax,%edx
{$else}
movl Target,%edx
movl Source,%eax
{$endif}
lock
xaddl %eax, (%edx)
end;

27
rtl/inc/systemh.inc
View File

@ -658,6 +658,33 @@ Function Sptr:Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}[internconst:fpc_in_co
Function GetProcessID:SizeUInt;
Function GetThreadID:TThreadID;{$ifdef SYSTEMINLINE}inline;{$endif}
function InterLockedIncrement (var Target: longint) : longint; public name 'FPC_INTERLOCKEDINCREMENT';
function InterLockedDecrement (var Target: longint) : longint; public name 'FPC_INTERLOCKEDDECREMENT';
function InterLockedExchange (var Target: longint;Source : longint) : longint; public name 'FPC_INTERLOCKEDEXCHANGE';
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; public name 'FPC_INTERLOCKEDEXCHANGEADD';
function InterlockedCompareExchange(var Target: longint; NewValue: longint; Comperand: longint): longint; public name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
{$ifdef cpu64}
function InterLockedIncrement64 (var Target: int64) : int64; public name 'FPC_INTERLOCKEDINCREMENT64';
function InterLockedDecrement64 (var Target: int64) : int64; public name 'FPC_INTERLOCKEDDECREMENT64';
function InterLockedExchange64 (var Target: int64;Source : int64) : int64; public name 'FPC_INTERLOCKEDEXCHANGE64';
function InterLockedExchangeAdd64 (var Target: int64;Source : int64) : int64; public name 'FPC_INTERLOCKEDEXCHANGEADD64';
function InterlockedCompareExchange64(var Target: int64; NewValue: int64; Comperand: int64): int64; public name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
{$endif cpu64}
{ Pointer overloads }
{$ifdef cpu64}
function InterLockedIncrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDINCREMENT64';
function InterLockedDecrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDDECREMENT64';
function InterLockedExchange (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGE64';
function InterLockedExchangeAdd (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGEADD64';
function InterlockedCompareExchange(var Target: Pointer; NewValue: Pointer; Comperand: Pointer): Pointer; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE64';
{$else cpu64}
function InterLockedIncrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDINCREMENT';
function InterLockedDecrement (var Target: Pointer) : Pointer; external name 'FPC_INTERLOCKEDDECREMENT';
function InterLockedExchange (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGE';
function InterLockedExchangeAdd (var Target: Pointer;Source : Pointer) : Pointer; external name 'FPC_INTERLOCKEDEXCHANGEADD';
function InterlockedCompareExchange(var Target: Pointer; NewValue: Pointer; Comperand: Pointer): Pointer; external name 'FPC_INTERLOCKEDCOMPAREEXCHANGE';
{$endif cpu64}
{*****************************************************************************
Init / Exit / ExitProc

5
rtl/objpas/sysutils/systhrdh.inc
View File

@ -33,8 +33,3 @@ type
procedure Endread;
end;
function InterLockedIncrement (var Target: longint) : longint;
function InterLockedDecrement (var Target: longint) : longint;
function InterLockedExchange (var Target: longint;Source : longint) : longint;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint;

3
rtl/objpas/sysutils/sysutils.inc
View File

@ -97,9 +97,6 @@
{ threading stuff }
{$i sysuthrd.inc}
{ CPU Specific code }
{$i sysutilp.inc}
{ OS utility code }
{$i osutil.inc}

59
rtl/powerpc/powerpc.inc
View File

@ -1147,6 +1147,61 @@ asm
end;
function InterLockedDecrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target-1 in r3 }
{ side-effect: target := target-1 }
asm
.LInterLockedDecLoop:
lwarx r10,0,r3
subi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedDecLoop
mr r3,r10
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target+1 in r3 }
{ side-effect: target := target+1 }
asm
.LInterLockedIncLoop:
lwarx r10,0,r3
addi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedIncLoop
mr r3,r10
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := source }
asm
.LInterLockedXchgLoop:
lwarx r10,0,r3
stwcx. r4,0,r3
bne .LInterLockedXchgLoop
mr r3,r10
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := target+source }
asm
.LInterLockedXchgAddLoop:
lwarx r10,0,r3
add r10,r10,r4
stwcx. r10,0,r3
bne .LInterLockedXchgAddLoop
sub r3,r10,r4
end;
{$IFDEF MORPHOS}
{ this is only required for MorphOS }
{$define FPC_SYSTEM_HAS_SYSRESETFPU}
@ -1156,8 +1211,8 @@ asm
{ setting fpu to round to nearest mode }
li r3,0
stw r3,8(r1)
stw r3,12(r1)
stw r3,12(r1)
lfd f1,8(r1)
mtfsf 7,f1
mtfsf 7,f1
end;
{$ENDIF}

74
rtl/powerpc/sysutilp.inc
View File

@ -1,74 +0,0 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Jonas Maebe,
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ ---------------------------------------------------------------------
This include contains cpu-specific routines
---------------------------------------------------------------------}
function InterLockedDecrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target-1 in r3 }
{ side-effect: target := target-1 }
asm
.LInterLockedDecLoop:
lwarx r10,0,r3
subi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedDecLoop
mr r3,r10
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target+1 in r3 }
{ side-effect: target := target+1 }
asm
.LInterLockedIncLoop:
lwarx r10,0,r3
addi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedIncLoop
mr r3,r10
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := source }
asm
.LInterLockedXchgLoop:
lwarx r10,0,r3
stwcx. r4,0,r3
bne .LInterLockedXchgLoop
mr r3,r10
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := target+source }
asm
.LInterLockedXchgAddLoop:
lwarx r10,0,r3
add r10,r10,r4
stwcx. r10,0,r3
bne .LInterLockedXchgAddLoop
sub r3,r10,r4
end;

58
rtl/powerpc64/powerpc64.inc
View File

@ -472,8 +472,8 @@ end;
(*
{$define FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
function fpc_shortstr_compare(const dstr, sstr:shortstring): SizeInt; [public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
assembler;
{ TODO: improve, because the main compare loop does an unaligned access everytime.. :(
assembler;
{ TODO: improve, because the main compare loop does an unaligned access everytime.. :(
TODO: needs some additional opcodes not yet known to the compiler :( }
asm
{ load length sstr }
@ -689,3 +689,57 @@ asm
bne- .LIncLockedLoop
end;
function InterLockedDecrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target-1 in r3 }
{ side-effect: target := target-1 }
asm
.LInterLockedDecLoop:
lwarx r10,0,r3
subi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedDecLoop
mr r3,r10
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target+1 in r3 }
{ side-effect: target := target+1 }
asm
.LInterLockedIncLoop:
lwarx r10,0,r3
addi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedIncLoop
mr r3,r10
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := source }
asm
.LInterLockedXchgLoop:
lwarx r10,0,r3
stwcx. r4,0,r3
bne .LInterLockedXchgLoop
mr r3,r10
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := target+source }
asm
.LInterLockedXchgAddLoop:
lwarx r10,0,r3
add r10,r10,r4
stwcx. r10,0,r3
bne .LInterLockedXchgAddLoop
sub r3,r10,r4
end;

73
rtl/powerpc64/sysutilp.inc
View File

@ -1,73 +0,0 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2001 by Jonas Maebe,
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ ---------------------------------------------------------------------
This include contains cpu-specific routines
---------------------------------------------------------------------}
function InterLockedDecrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target-1 in r3 }
{ side-effect: target := target-1 }
asm
.LInterLockedDecLoop:
lwarx r10,0,r3
subi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedDecLoop
mr r3,r10
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
{ input: address of target in r3 }
{ output: target+1 in r3 }
{ side-effect: target := target+1 }
asm
.LInterLockedIncLoop:
lwarx r10,0,r3
addi r10,r10,1
stwcx. r10,0,r3
bne .LInterLockedIncLoop
mr r3,r10
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := source }
asm
.LInterLockedXchgLoop:
lwarx r10,0,r3
stwcx. r4,0,r3
bne .LInterLockedXchgLoop
mr r3,r10
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
{ input: address of target in r3, source in r4 }
{ output: target in r3 }
{ side-effect: target := target+source }
asm
.LInterLockedXchgAddLoop:
lwarx r10,0,r3
add r10,r10,r4
stwcx. r10,0,r3
bne .LInterLockedXchgAddLoop
sub r3,r10,r4
end;

102
rtl/sparc/sparc.inc
View File

@ -359,3 +359,105 @@ asm
end;
function InterLockedDecrement (var Target: longint) : longint; assembler; nostackframe;
asm
{ usually, we shouldn't lock here so saving the stack frame for these extra intructions is
worse the effort, especially while waiting :)
}
.LInterLockedDecrement1:
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
ldstub [%g1],%g1
cmp %g1,0
bne .LInterLockedDecrement1
nop
ld [%o0],%g1
sub %g1,1,%g1
st %g1,[%o0]
mov %g1,%o0
{ unlock }
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
stb %g0,[%g1]
end;
function InterLockedIncrement (var Target: longint) : longint; assembler; nostackframe;
asm
{ usually, we shouldn't lock here so saving the stack frame for these extra intructions is
worse the effort, especially while waiting :)
}
.LInterLockedIncrement1:
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
ldstub [%g1],%g1
cmp %g1,0
bne .LInterLockedIncrement1
nop
ld [%o0],%g1
add %g1,1,%g1
st %g1,[%o0]
mov %g1,%o0
{ unlock }
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
stb %g0,[%g1]
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler; nostackframe;
asm
{ usually, we shouldn't lock here so saving the stack frame for these extra intructions is
worse the effort, especially while waiting :)
}
.LInterLockedExchange1:
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
ldstub [%g1],%g1
cmp %g1,0
bne .LInterLockedExchange1
nop
ld [%o0],%g1
st %o1,[%o0]
mov %g1,%o0
{ unlock }
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
stb %g0,[%g1]
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler; nostackframe;
asm
{ usually, we shouldn't lock here so saving the stack frame for these extra intructions is
worse the effort, especially while waiting :)
}
.LInterLockedExchangeAdd1:
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
ldstub [%g1],%g1
cmp %g1,0
bne .LInterLockedExchangeAdd1
nop
ld [%o0],%g1
add %g1,%o1,%o1
st %o1,[%o0]
mov %g1,%o0
{ unlock }
sethi %hi(fpc_system_lock), %g1
or %g1,%lo(fpc_system_lock), %g1
stb %g0,[%g1]
end;

5
rtl/win/wininc/base.inc
View File

@ -69,14 +69,15 @@
PINTEGER = ^longint;
PBOOL = ^BOOL;
LONGLONG = int64;
PLONGLONG = ^LONGLONG;
LPLONGLONG = ^LONGLONG;
ULONGLONG = qword; // used in AMD64 CONTEXT
PULONGLONG = ^ULONGLONG; //
DWORD64 = qword; //
PDWORD64 = ^DWORD64; //
INT_PTR = PtrInt;
UINT_PTR = PtrUInt;
LONG_PTR = PtrInt;

3
rtl/win/wininc/func.inc
View File

@ -49,9 +49,6 @@
function GetRandomRgn(aHDC: HDC; aHRGN: HRGN; iNum: WINT): WINT; stdcall; external 'gdi32';
function AccessCheck(pSecurityDescriptor:PSECURITY_DESCRIPTOR; ClientToken:HANDLE; DesiredAccess:DWORD; GenericMapping:PGENERIC_MAPPING; PrivilegeSet:PPRIVILEGE_SET;PrivilegeSetLength:LPDWORD;
GrantedAccess:LPDWORD; AccessStatus:LPBOOL):WINBOOL; external 'advapi32' name 'AccessCheck';
function InterlockedIncrement(lpAddend:LPLONG):LONG; external 'kernel32' name 'InterlockedIncrement';
function InterlockedDecrement(lpAddend:LPLONG):LONG; external 'kernel32' name 'InterlockedDecrement';
function InterlockedExchange(Target:LPLONG; Value:LONG):LONG; external 'kernel32' name 'InterlockedExchange';
function FreeResource(hResData:HGLOBAL):WINBOOL; external 'kernel32' name 'FreeResource';
function LockResource(hResData:HGLOBAL):LPVOID; external 'kernel32' name 'LockResource';
{$ifdef Unknown_functions}

6
rtl/win/wininc/redef.inc
View File

@ -611,12 +611,6 @@ function InitializeSid(Sid: Pointer; const pIdentifierAuthority: TSIDIdentifierA
function InsertMenuItem(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfo): BOOL;external 'user32' name 'InsertMenuItemA';
function InsertMenuItemA(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoA): BOOL; external 'user32' name 'InsertMenuItemA';
//function InsertMenuItemW(p1: HMENU; p2: UINT; p3: BOOL; const p4: TMenuItemInfoW): BOOL; external 'user32' name 'InsertMenuItemW';
{$ifdef support_smartlink}
function InterlockedCompareExchange(var Destination: Pointer; Exchange: Pointer; Comperand: Pointer): Pointer;external 'kernel32' name 'InterlockedCompareExchange';
{$endif support_smartlink}
function InterlockedDecrement(var Addend: longint): longint; external 'kernel32' name 'InterlockedDecrement';
function InterlockedExchange(var Target: longint; Value: longint): longint; external 'kernel32' name 'InterlockedExchange';
function InterlockedIncrement(var Addend: longint): longint; external 'kernel32' name 'InterlockedIncrement';
function IntersectRect(var lprcDst: TRect; const lprcSrc1, lprcSrc2: TRect): BOOL; external 'user32' name 'IntersectRect';
//function InvertRect(hDC: HDC; const lprc: TRect): BOOL; external 'user32' name 'InvertRect';
function IsDialogMessage(hDlg: HWND; var lpMsg: TMsg): BOOL;external 'user32' name 'IsDialogMessageA';

1
rtl/win32/windows.pp
View File

@ -20,6 +20,7 @@ unit windows;
{ stuff like array of const is used }
{$mode objfpc}
{$inline on}
{$calling stdcall}
interface

1
rtl/win64/windows.pp
View File

@ -20,6 +20,7 @@ unit windows;
{ stuff like array of const is used }
{$mode objfpc}
{$inline on}
{$calling stdcall}
interface

89
rtl/x86_64/sysutilp.inc
View File

@ -1,89 +0,0 @@
{
This file is part of the Free Pascal run time library.
Copyright (c) 2004 by Florian Klaempfl
member of the Free Pascal development team
See the file COPYING.FPC, included in this distribution,
for details about the copyright.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************}
{ ---------------------------------------------------------------------
This include contains cpu-specific routines
---------------------------------------------------------------------}
function InterLockedDecrement (var Target: longint) : longint; assembler;
asm
{$ifdef win64}
movq %rcx,%rax
{$else win64}
movq %rdi,%rax
{$endif win64}
movl $-1,%edx
xchgq %rdx,%rax
lock
xaddl %eax, (%rdx)
decl %eax
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
asm
{$ifdef win64}
movq %rcx,%rax
{$else win64}
movq %rdi,%rax
{$endif win64}
movl $1,%edx
xchgq %rdx,%rax
lock
xaddl %eax, (%rdx)
incl %eax
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef win64}
xchgl (%rcx),%edx
movl %edx,%eax
{$else win64}
xchgl (%rdi),%esi
movl %esi,%eax
{$endif win64}
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef win64}
xchgq %rcx,%rdx
lock
xaddl %ecx, (%rdx)
movl %ecx,%eax
{$else win64}
xchgq %rdi,%rsi
lock
xaddl %edi, (%rsi)
movl %edi,%eax
{$endif win64}
end;
function InterLockedCompareExchange(var Target: longint; NewValue, Compare : longint): longint; assembler;
asm
{$ifdef win64}
movl %edx,%eax
lock
cmpxchgl %r8d,(%rcx)
{$else win64}
movl %esi,%eax
lock
cmpxchgl %edx,(%rdi)
{$endif win64}
end;

144
rtl/x86_64/x86_64.inc
View File

@ -420,6 +420,150 @@ procedure inclocked(var l : int64);assembler;
end;
function InterLockedDecrement (var Target: longint) : longint; assembler;
asm
{$ifdef win64}
movq %rcx,%rax
{$else win64}
movq %rdi,%rax
{$endif win64}
movl $-1,%edx
xchgq %rdx,%rax
lock
xaddl %eax, (%rdx)
decl %eax
end;
function InterLockedIncrement (var Target: longint) : longint; assembler;
asm
{$ifdef win64}
movq %rcx,%rax
{$else win64}
movq %rdi,%rax
{$endif win64}
movl $1,%edx
xchgq %rdx,%rax
lock
xaddl %eax, (%rdx)
incl %eax
end;
function InterLockedExchange (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef win64}
xchgl (%rcx),%edx
movl %edx,%eax
{$else win64}
xchgl (%rdi),%esi
movl %esi,%eax
{$endif win64}
end;
function InterLockedExchangeAdd (var Target: longint;Source : longint) : longint; assembler;
asm
{$ifdef win64}
xchgq %rcx,%rdx
lock
xaddl %ecx, (%rdx)
movl %ecx,%eax
{$else win64}
xchgq %rdi,%rsi
lock
xaddl %edi, (%rsi)
movl %edi,%eax
{$endif win64}
end;
function InterLockedCompareExchange(var Target: longint; NewValue, Comperand : longint): longint; assembler;
asm
{$ifdef win64}
movl %edx,%eax
lock
cmpxchgl %r8d,(%rcx)
{$else win64}
movl %esi,%eax
lock
cmpxchgl %edx,(%rdi)
{$endif win64}
end;
function InterLockedDecrement64 (var Target: int64) : int64; assembler;
asm
{$ifdef win64}
movq %rcx,%rax
{$else win64}
movq %rdi,%rax
{$endif win64}
movq $-1,%rdx
xchgq %rdx,%rax
lock
xaddq %rax, (%rdx)
decq %rax
end;
function InterLockedIncrement64 (var Target: int64) : int64; assembler;
asm
{$ifdef win64}
movq %rcx,%rax
{$else win64}
movq %rdi,%rax
{$endif win64}
movq $1,%rdx
xchgq %rdx,%rax
lock
xaddq %rax, (%rdx)
incq %rax
end;
function InterLockedExchange64 (var Target: int64;Source : int64) : int64; assembler;
asm
{$ifdef win64}
xchgq (%rcx),%rdx
movq %rdx,%rax
{$else win64}
xchgq (%rdi),%rsi
movq %rsi,%rax
{$endif win64}
end;
function InterLockedExchangeAdd64 (var Target: int64;Source : int64) : int64; assembler;
asm
{$ifdef win64}
xchgq %rcx,%rdx
lock
xaddq %rcx, (%rdx)
movq %rcx,%rax
{$else win64}
xchgq %rdi,%rsi
lock
xaddq %rdi, (%rsi)
movq %rdi,%rax
{$endif win64}
end;
function InterLockedCompareExchange64(var Target: int64; NewValue, Comperand : int64): int64; assembler;
asm
{$ifdef win64}
movq %rdx,%rax
lock
cmpxchgq %r8d,(%rcx)
{$else win64}
movq %rsi,%rax
lock
cmpxchgq %rdx,(%rdi)
{$endif win64}
end;
{****************************************************************************
FPU
****************************************************************************}