summaryrefslogtreecommitdiff
path: root/rtl
diff options
context:
space:
mode:
Diffstat (limited to 'rtl')
-rw-r--r--rtl/arm/arm.inc20
-rw-r--r--rtl/arm/setjump.inc4
-rw-r--r--rtl/go32v2/Makefile31
-rw-r--r--rtl/go32v2/Makefile.fpc68
-rw-r--r--rtl/i386/i386.inc27
-rw-r--r--rtl/inc/charset.pp166
-rw-r--r--rtl/inc/generic.inc9
-rw-r--r--rtl/inc/genmath.inc4
-rw-r--r--rtl/inc/softfpu.pp2
-rw-r--r--rtl/inc/system.inc4
-rw-r--r--rtl/inc/systemh.inc2
-rw-r--r--rtl/linux/arm/syscall.inc4
-rw-r--r--rtl/msdos/classes.pp17
-rw-r--r--rtl/objpas/character.pas130
-rw-r--r--rtl/objpas/classes/classes.inc15
-rw-r--r--rtl/objpas/classes/classesh.inc2
-rw-r--r--rtl/objpas/classes/stringl.inc14
-rw-r--r--rtl/objpas/fpwidestring.pp97
-rw-r--r--rtl/objpas/sysutils/dati.inc9
-rw-r--r--rtl/objpas/sysutils/datih.inc1
-rw-r--r--rtl/objpas/unicodedata.pas1310
-rw-r--r--rtl/os2/pmwsock.pas128
-rw-r--r--rtl/win64/seh64.inc3
-rw-r--r--rtl/x86_64/math.inc23
-rw-r--r--rtl/x86_64/setjumph.inc2
-rw-r--r--rtl/x86_64/x86_64.inc16
26 files changed, 1781 insertions, 327 deletions
diff --git a/rtl/arm/arm.inc b/rtl/arm/arm.inc
index f1d8da6a3f..2f2d544a5f 100644
--- a/rtl/arm/arm.inc
+++ b/rtl/arm/arm.inc
@@ -607,7 +607,11 @@ asm
movs r0, r1
// unlock and return
str r2, [r3]
+{$ifdef CPUARM_HAS_BX}
bx lr
+{$else}
+ mov pc,lr
+{$endif}
.Lfpc_system_lock:
.long fpc_system_lock
@@ -692,7 +696,11 @@ asm
mov r0, r1
// unlock and return
str r2, [r3]
+{$ifdef CPUARM_HAS_BX}
bx lr
+{$else}
+ mov pc,lr
+{$endif}
.Lfpc_system_lock:
.long fpc_system_lock
@@ -752,7 +760,11 @@ asm
// unlock and return
mov r2, #0
str r2, [r3]
+{$ifdef CPUARM_HAS_BX}
bx lr
+{$else}
+ mov pc,lr
+{$endif}
.Lfpc_system_lock:
.long fpc_system_lock
@@ -816,7 +828,11 @@ asm
// unlock and return
mov r2, #0
str r2, [r3]
+{$ifdef CPUARM_HAS_BX}
bx lr
+{$else}
+ mov pc,lr
+{$endif}
.Lfpc_system_lock:
.long fpc_system_lock
@@ -881,7 +897,11 @@ asm
// unlock and return
mov r3, #0
str r3, [r12]
+{$ifdef CPUARM_HAS_BX}
bx lr
+{$else}
+ mov pc,lr
+{$endif}
.Lfpc_system_lock:
.long fpc_system_lock
diff --git a/rtl/arm/setjump.inc b/rtl/arm/setjump.inc
index cc8b729374..bcd66193d1 100644
--- a/rtl/arm/setjump.inc
+++ b/rtl/arm/setjump.inc
@@ -53,7 +53,11 @@ function fpc_setjmp(var S : jmp_buf) : longint;assembler;[Public, alias : 'FPC_S
{$else}
stmia r0,{v1-v6, sl, fp, sp, lr}
mov r0,#0
+ {$ifdef CPUARM_HAS_BX}
bx lr
+ {$else}
+ mov pc,lr
+ {$endif}
{$endif}
end;
diff --git a/rtl/go32v2/Makefile b/rtl/go32v2/Makefile
index 79c8a2fd36..a207dbed5d 100644
--- a/rtl/go32v2/Makefile
+++ b/rtl/go32v2/Makefile
@@ -1,5 +1,5 @@
#
-# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013-04-26 rev 24324]
+# Don't edit, this file is generated by FPCMake Version 2.0.0 [2013/08/13]
#
default: all
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim i386-android m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian arm-android powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android i8086-msdos
@@ -2837,26 +2837,41 @@ prt0$(OEXT) : v2prt0.as
system$(PPUEXT) : system.pp $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp
uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
+ $(COMPILER) $(INC)/uuchar.pp
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
system$(PPUEXT)
+ $(COMPILER) $(INC)/strings.pp
+iso7185$(PPUEXT) : $(INC)/iso7185.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/iso7185.pp
go32$(PPUEXT) : go32.pp system$(PPUEXT)
+ $(COMPILER) go32.pp
dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
$(COMPILER) -Sg dpmiexcp.pp
initc$(PPUEXT) : initc.pp system$(PPUEXT)
+ $(COMPILER) initc.pp
profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
+ $(COMPILER) profile.pp
dxetype$(PPUEXT) : dxetype.pp system$(PPUEXT)
+ $(COMPILER) dxetype.pp
dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) dxeload.pp
emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
dpmiexcp$(PPUEXT)
+ $(COMPILER) emu387.pp
ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) ports.pp
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) dos.pp
crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) crt.pp
objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/objects.pp
printer$(PPUEXT) : printer.pp system$(PPUEXT)
+ $(COMPILER) printer.pp
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) sysconst$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
@@ -2894,16 +2909,30 @@ stdconvs$(PPUEXT) : $(OBJPASDIR)/stdconvs.pp objpas$(PPUEXT) system$(PPUEXT) \
macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
$(COMPILER) $(INC)/macpas.pp $(REDIR)
cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+ $(COMPILER) $(PROCINC)/cpu.pp
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(PROCINC)/mmx.pp
getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/getopts.pp
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
$(COMPILER) -Sg $(INC)/heaptrc.pp
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/lineinfo.pp
lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/lnfodwrf.pp
charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/charset.pp
cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
$(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
+matrix$(PPUEXT) : $(INC)/matrix.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/matrix.pp
ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(INC)/ucomplex.pp
msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+ $(COMPILER) msmouse.pp
callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/callspec.pp
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/cmem.pp
ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/ctypes.pp
diff --git a/rtl/go32v2/Makefile.fpc b/rtl/go32v2/Makefile.fpc
index 674b99b691..d144fd487b 100644
--- a/rtl/go32v2/Makefile.fpc
+++ b/rtl/go32v2/Makefile.fpc
@@ -75,51 +75,87 @@ prt0$(OEXT) : v2prt0.as
#
system$(PPUEXT) : system.pp $(SYSDEPS)
$(COMPILER) -Us -Sg system.pp
+
uuchar$(PPUEXT): $(SYSTEMUNIT)$(PPUEXT) $(INC)/uuchar.pp
+ $(COMPILER) $(INC)/uuchar.pp
+
objpas$(PPUEXT): $(OBJPASDIR)/objpas.pp $(INC)/except.inc system$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/objpas.pp
+
strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc \
$(PROCINC)/strings.inc $(PROCINC)/stringss.inc \
system$(PPUEXT)
+ $(COMPILER) $(INC)/strings.pp
+
+iso7185$(PPUEXT) : $(INC)/iso7185.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/iso7185.pp
#
# System Dependent Units
#
go32$(PPUEXT) : go32.pp system$(PPUEXT)
+ $(COMPILER) go32.pp
+
dpmiexcp$(PPUEXT) : dpmiexcp.pp exceptn$(OEXT) system$(PPUEXT)
$(COMPILER) -Sg dpmiexcp.pp
+
initc$(PPUEXT) : initc.pp system$(PPUEXT)
+ $(COMPILER) initc.pp
+
profile$(PPUEXT) : profile.pp dpmiexcp$(PPUEXT) go32$(PPUEXT)
+ $(COMPILER) profile.pp
+
dxetype$(PPUEXT) : dxetype.pp system$(PPUEXT)
+ $(COMPILER) dxetype.pp
+
dxeload$(PPUEXT) : dxeload.pp dxetype$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) dxeload.pp
+
emu387$(PPUEXT) : emu387.pp fpu$(OEXT) strings$(PPUEXT) dxeload$(PPUEXT) \
dpmiexcp$(PPUEXT)
+ $(COMPILER) emu387.pp
+
ports$(PPUEXT) : ports.pp objpas$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) ports.pp
+
#
# TP7 Compatible RTL Units
#
dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc \
go32$(PPUEXT) strings$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) dos.pp
+
crt$(PPUEXT) : crt.pp $(INC)/textrec.inc go32$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) crt.pp
+
objects$(PPUEXT) : $(INC)/objects.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/objects.pp
+
printer$(PPUEXT) : printer.pp system$(PPUEXT)
+ $(COMPILER) printer.pp
#
# Delphi Compatible Units
#
sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
objpas$(PPUEXT) dos$(PPUEXT) go32$(PPUEXT) sysconst$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp
+
classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) types$(PPUEXT) fgl$(PPUEXT)
$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+
fgl$(PPUEXT) : $(OBJPASDIR)/fgl.pp objpas$(PPUEXT) types$(PPUEXT) system$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/fgl.pp
+
math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/math.pp
+
typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) rtlconst$(PPUEXT)
$(COMPILER) -Sg -Fi$(OBJPASDIR) $(OBJPASDIR)/typinfo.pp
+
varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \
$(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT)
$(COMPILER) -I$(OBJPASDIR) varutils.pp
+
variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT)
$(COMPILER) -Fi$(INC) $(INC)/variants.pp
@@ -128,16 +164,22 @@ fmtbcd$(PPUEXT) : $(OBJPASDIR)/fmtbcd.pp objpas$(PPUEXT) sysutils$(PPUEXT) varia
types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/types.pp
+
rtlconst$(PPUEXT) : $(OBJPASDIR)/rtlconst.pp
$(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/rtlconst.pp
+
sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/sysconst.pp
+
dateutil$(PPUEXT) : $(OBJPASDIR)/dateutil.pp
$(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/dateutil.pp
+
convutil$(PPUEXT) : $(OBJPASDIR)/convutil.pp
$(COMPILER) -Fi$(OBJPASDIR) $(OBJPASDIR)/convutil.pp
+
strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp
$(COMPILER) $(OBJPASDIR)/strutils.pp
+
stdconvs$(PPUEXT) : $(OBJPASDIR)/stdconvs.pp objpas$(PPUEXT) system$(PPUEXT) \
sysutils$(PPUEXT)
$(COMPILER) $(OBJPASDIR)/stdconvs.pp
@@ -150,20 +192,46 @@ macpas$(PPUEXT) : $(INC)/macpas.pp objpas$(PPUEXT) math$(PPUEXT)
# Other system-independent RTL Units
#
cpu$(PPUEXT) : $(PROCINC)/cpu.pp system$(PPUEXT)
+ $(COMPILER) $(PROCINC)/cpu.pp
+
mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(PROCINC)/mmx.pp
+
getopts$(PPUEXT) : $(INC)/getopts.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/getopts.pp
+
heaptrc$(PPUEXT) : $(INC)/heaptrc.pp system$(PPUEXT)
$(COMPILER) -Sg $(INC)/heaptrc.pp
+
lineinfo$(PPUEXT) : $(INC)/lineinfo.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/lineinfo.pp
+
lnfodwrf$(PPUEXT) : $(INC)/lnfodwrf.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/lnfodwrf.pp
+
charset$(PPUEXT) : $(INC)/charset.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/charset.pp
+
cpall$(PPUEXT): $(RTL)/charmaps/cpall.pas system$(PPUEXT) charset$(PPUEXT)
$(COMPILER) -Fu$(INC) -Fi$(RTL)/charmaps $(RTL)/charmaps/cpall.pas
+
+matrix$(PPUEXT) : $(INC)/matrix.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/matrix.pp
+
ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) system$(PPUEXT)
+ $(COMPILER) $(INC)/ucomplex.pp
#
# Other system-dependent RTL Units
#
msmouse$(PPUEXT) : msmouse.pp system$(PPUEXT)
+ $(COMPILER) msmouse.pp
+
callspec$(PPUEXT) : $(INC)/callspec.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/callspec.pp
+
+cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT)
+ $(COMPILER) $(INC)/cmem.pp
+
ctypes$(PPUEXT) : $(INC)/ctypes.pp system$(PPUEXT)
+ $(COMPILER) $(INC)/ctypes.pp
diff --git a/rtl/i386/i386.inc b/rtl/i386/i386.inc
index b931e77d4a..7bd65eecdc 100644
--- a/rtl/i386/i386.inc
+++ b/rtl/i386/i386.inc
@@ -50,9 +50,9 @@ function cpuid_support : boolean;assembler;
{$asmmode ATT}
-function sse_support : boolean;
+procedure check_sse_support;
var
- _edx : longint;
+ _ecx,_edx : longint;
begin
if cpuid_support then
begin
@@ -61,13 +61,20 @@ function sse_support : boolean;
movl $1,%eax
cpuid
movl %edx,_edx
+ movl %ecx,_ecx
popl %ebx
end;
- sse_support:=((_edx and $2000000)<>0) and os_supports_sse;
+ has_sse_support:=((_edx and $2000000)<>0) and os_supports_sse;
+ has_sse2_support:=((_edx and $4000000)<>0) and os_supports_sse;
+ has_sse3_support:=((_ecx and $200)<>0) and os_supports_sse;
end
else
- { a cpu with without cpuid instruction supports never sse }
- sse_support:=false;
+ begin
+ { a cpu with without cpuid instruction supports never sse }
+ has_sse_support:=false;
+ has_sse2_support:=false;
+ has_sse3_support:=false;
+ end;
end;
@@ -1424,7 +1431,8 @@ Procedure SysResetFPU;
procedure fpc_cpucodeinit;
begin
os_supports_sse:=true;
- os_supports_sse:=sse_support;
+ check_sse_support;
+ os_supports_sse:=has_sse_support;
if os_supports_sse then
begin
sse_check:=true;
@@ -1437,6 +1445,11 @@ procedure fpc_cpucodeinit;
sse_check:=false;
end;
has_sse_support:=os_supports_sse;
+ if not(has_sse_support) then
+ begin
+ has_sse2_support:=false;
+ has_sse3_support:=false;
+ end;
{ don't let libraries influence the FPU cw set by the host program }
if has_sse_support and
IsLibrary then
@@ -1611,4 +1624,4 @@ asm
sarl %cl,%eax
.Lexit:
end;
-{$endif FPC_SYSTEM_HAS_SAR_QWORD} \ No newline at end of file
+{$endif FPC_SYSTEM_HAS_SAR_QWORD}
diff --git a/rtl/inc/charset.pp b/rtl/inc/charset.pp
index d8d911009f..07efb7c1eb 100644
--- a/rtl/inc/charset.pp
+++ b/rtl/inc/charset.pp
@@ -15,6 +15,7 @@
**********************************************************************}
{$mode objfpc}
{$pointermath on}
+{$PACKENUM 1}
unit charset;
interface
@@ -31,14 +32,14 @@ unit charset;
umf_unused);
punicodecharmapping = ^tunicodecharmapping;
- tunicodecharmapping = record
+ tunicodecharmapping = packed record
unicode : tunicodechar;
flag : tunicodecharmappingflag;
reserved : byte;
end;
preversecharmapping = ^treversecharmapping;
- treversecharmapping = record
+ treversecharmapping = packed record
unicode : tunicodechar;
char1 : Byte;
char2 : Byte;
@@ -59,8 +60,26 @@ unit charset;
tcp2unicode = class(tcsconvert)
end;
+ TSerializedMapHeader = packed record
+ cpName : string[20];
+ cp : UInt16;
+ mapLength : UInt32;
+ lastChar : Int32;
+ reverseMapLength : UInt32;
+ end;
+
+ const
+ BINARY_MAPPING_FILE_EXT = '.bcm';
+
function loadunicodemapping(const cpname,f : string; cp :word) : punicodemap;
+ function loadbinaryunicodemapping(const directory,cpname : string) : punicodemap;overload;
+ function loadbinaryunicodemapping(const filename : string) : punicodemap;overload;
+ function loadbinaryunicodemapping(
+ const AData : Pointer;
+ const ADataLength : Integer
+ ) : punicodemap;overload;
procedure registermapping(p : punicodemap);
+ function registerbinarymapping(const directory,cpname : string):Boolean;
function getmap(const s : string) : punicodemap;
function getmap(cp : word) : punicodemap;
function mappingavailable(const s : string) : boolean;inline;
@@ -371,6 +390,136 @@ unit charset;
loadunicodemapping:=p;
end;
+
+ function loadbinaryunicodemapping(const directory, cpname : string) : punicodemap;
+ const
+ {$IFDEF ENDIAN_LITTLE}
+ ENDIAN_SUFFIX = 'le';
+ {$ENDIF ENDIAN_LITTLE}
+ {$IFDEF ENDIAN_BIG}
+ ENDIAN_SUFFIX = 'be';
+ {$ENDIF ENDIAN_BIG}
+ var
+ fileName : string;
+ begin
+ fileName := directory;
+ if (fileName <> '') then begin
+ if (fileName[Length(fileName)] <> DirectorySeparator) then
+ fileName := fileName + DirectorySeparator;
+ end;
+ fileName := fileName + cpname + '_' + ENDIAN_SUFFIX + BINARY_MAPPING_FILE_EXT;
+ Result := loadbinaryunicodemapping(fileName);
+ end;
+
+ {$PUSH}
+ {$I-}
+ function loadbinaryunicodemapping(const filename : string) : punicodemap;
+ const
+ BLOCK_SIZE = 16*1024;
+ var
+ f : File of Byte;
+ locSize, locReaded, c : LongInt;
+ locBuffer : PByte;
+ locBlockSize : LongInt;
+ begin
+ Result := nil;
+ if (filename='') then
+ exit;
+ Assign(f,filename);
+ Reset(f);
+ if (IOResult<>0) then
+ begin
+ Close(f);
+ exit;
+ end;
+ locSize:=FileSize(f);
+ if (locSize<SizeOf(TSerializedMapHeader)) then
+ begin
+ Close(f);
+ exit;
+ end;
+ locBuffer:=GetMem(locSize);
+ locBlockSize:=BLOCK_SIZE;
+ locReaded:=0;
+ c := 0;
+ while (locReaded<locSize) do
+ begin
+ if (locBlockSize>(locSize-locReaded)) then
+ locBlockSize:=locSize-locReaded;
+ BlockRead(f,locBuffer[locReaded],locBlockSize,c);
+ if (IOResult<>0) or (c<=0) then
+ begin
+ FreeMem(locBuffer,locSize);
+ Close(f);
+ exit;
+ end;
+ locReaded:=locReaded+c;
+ end;
+ Result:=loadbinaryunicodemapping(locBuffer,locSize);
+ FreeMem(locBuffer,locSize);
+ Close(f);
+ end;
+ {$POP}
+
+ procedure freemapping(amapping : punicodemap);
+ begin
+ if (amapping = nil) then
+ exit;
+ if (amapping^.map <> nil) then
+ freemem(amapping^.map);
+ if (amapping^.reversemap <> nil) then
+ freemem(amapping^.reversemap);
+ dispose(amapping);
+ end;
+
+ function loadbinaryunicodemapping(
+ const AData : Pointer;
+ const ADataLength : Integer
+ ) : punicodemap;
+ var
+ dataPointer : PByte;
+ readedLength : LongInt;
+
+ function ReadBuffer(ADest : Pointer; ALength : LongInt) : Boolean;
+ begin
+ Result := (readedLength + ALength) <= ADataLength;
+ if not result then
+ exit;
+ Move(dataPointer^,ADest^,ALength);
+ Inc(dataPointer,ALength);
+ readedLength := readedLength + ALength;
+ end;
+
+ var
+ h : TSerializedMapHeader;
+ r : punicodemap;
+ begin
+ Result := nil;
+ readedLength := 0;
+ dataPointer := AData;
+ if not ReadBuffer(@h,SizeOf(h)) then
+ exit;
+ New(r);
+ FillChar(r^,SizeOf(tunicodemap),0);
+ r^.cpname := h.cpName;
+ r^.cp := h.cp;
+ r^.map := AllocMem(h.mapLength);
+ if not ReadBuffer(r^.map,h.mapLength) then
+ begin
+ freemapping(r);
+ exit;
+ end;
+ r^.lastchar := h.lastChar;
+ r^.reversemap := AllocMem(h.reverseMapLength);
+ if not ReadBuffer(r^.reversemap,h.reverseMapLength) then
+ begin
+ freemapping(r);
+ exit;
+ end;
+ r^.reversemaplength := (h.reverseMapLength div SizeOf(treversecharmapping));
+ Result := r;
+ end;
+
procedure registermapping(p : punicodemap);
begin
@@ -385,6 +534,19 @@ unit charset;
{$endif FPC_HAS_FEATURE_THREADING}
strmapcache : string;
strmapcachep : punicodemap;
+
+ function registerbinarymapping(const directory, cpname : string) : Boolean;
+ var
+ p : punicodemap;
+ begin
+ Result := False;
+ p := loadbinaryunicodemapping(directory,cpname);
+ if (p = nil) then
+ exit;
+ registermapping(p);
+ Result := True;
+ end;
+
function getmap(const s : string) : punicodemap;
var
diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc
index 4ded841654..d8af3fac1f 100644
--- a/rtl/inc/generic.inc
+++ b/rtl/inc/generic.inc
@@ -358,7 +358,7 @@ begin
if (len < 0) or
(len > high(PtrInt) div 2) or
(psrc+len < psrc) then
- pend:=pdword(high(PtrUInt)-sizeof(dword))
+ pend:=pdword(high(PtrUInt)-PtrUInt(sizeof(dword)))
else
pend:=psrc+len;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -399,7 +399,7 @@ begin
if (len < 0) or
(len > high(PtrInt) div 4) or
(psrc+len < psrc) then
- pend:=pqword(high(PtrUInt)-sizeof(qword))
+ pend:=pqword(high(PtrUInt)-PtrUInt(sizeof(qword)))
else
pend:=psrc+len;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
@@ -548,8 +548,7 @@ begin
inc(pptruint(psrc));
end;
end;
- if (len <= high(ptrint)) and
- (psrc+len >= psrc) then
+ if (psrc+len >= psrc) then
pend:=psrc+len
else
pend:=pword(high(ptruint)-2);
@@ -689,7 +688,7 @@ begin
{ simulate assembler implementations behaviour, which is expected }
{ fpc_pchar_to_ansistr in astrings.inc }
if (len < 0) then
- pend:=pbyte(high(PtrUInt)-sizeof(byte))
+ pend:=pbyte(high(PtrUInt)-PtrUInt(sizeof(byte)))
else
pend:=psrc+len;
while (psrc<pend) and (psrc^<>0) do
diff --git a/rtl/inc/genmath.inc b/rtl/inc/genmath.inc
index ff07f35c90..90f385adf9 100644
--- a/rtl/inc/genmath.inc
+++ b/rtl/inc/genmath.inc
@@ -224,7 +224,7 @@ type
invalid:
float_raise(float_flag_invalid);
if (aSign <> 0) then
- float64_to_int32_round_to_zero:=$80000000
+ float64_to_int32_round_to_zero:=longint($80000000)
else
float64_to_int32_round_to_zero:=$7FFFFFFF;
exit;
@@ -333,7 +333,7 @@ invalid:
exit;
end;
End;
- float32_to_int32_round_to_zero:=$80000000;
+ float32_to_int32_round_to_zero:=longint($80000000);
exit;
End
else
diff --git a/rtl/inc/softfpu.pp b/rtl/inc/softfpu.pp
index e4c9a9d6f1..179292565a 100644
--- a/rtl/inc/softfpu.pp
+++ b/rtl/inc/softfpu.pp
@@ -762,7 +762,7 @@ begin
end
else
begin
- if ( count < 64 ) then
+ if ( count < 128 ) then
z1 := a0 shr ( count and 63 )
else
z1 := 0;
diff --git a/rtl/inc/system.inc b/rtl/inc/system.inc
index a087949aa4..0c4bebc037 100644
--- a/rtl/inc/system.inc
+++ b/rtl/inc/system.inc
@@ -217,10 +217,10 @@ function do_isdevice(handle:thandle):boolean;forward;
{$Error Can't determine processor type !}
{$endif}
{$i armdefines.inc}
- {$if defined(CPUARMV7EM) or defined(CPUARMV7M)}
+ {$if defined(CPUTHUMB2)}
{$i thumb2.inc} { Case dependent, don't change }
{$else}
- {$if defined(CPUARMV6M)}
+ {$if defined(CPUTHUMB)}
{$i thumb.inc} { Case dependent, don't change }
{$else}
{$i arm.inc} { Case dependent, don't change }
diff --git a/rtl/inc/systemh.inc b/rtl/inc/systemh.inc
index db6069c450..3631282117 100644
--- a/rtl/inc/systemh.inc
+++ b/rtl/inc/systemh.inc
@@ -594,6 +594,8 @@ const
Test8087 : byte = 3;
{ will be detected at startup }
has_sse_support : boolean = false;
+ has_sse2_support : boolean = false;
+ has_sse3_support : boolean = false;
has_mmx_support : boolean = false;
{$endif cpui386}
{$ifdef cpui8086}
diff --git a/rtl/linux/arm/syscall.inc b/rtl/linux/arm/syscall.inc
index ccee630598..142cb99761 100644
--- a/rtl/linux/arm/syscall.inc
+++ b/rtl/linux/arm/syscall.inc
@@ -235,6 +235,7 @@ asm
swi #0x0
cmn r0,#126
ldr r7,[sp],#4
+ it ls
movls pc,lr
stmfd sp!,{lr}
rsb r0,r0,#0
@@ -255,6 +256,7 @@ asm
swi #0x0
cmn r0,#126
ldr r7,[sp],#4
+ it ls
movls pc,lr
stmfd sp!,{lr}
rsb r0,r0,#0
@@ -276,6 +278,7 @@ asm
swi #0x0
cmn r0,#126
ldr r7,[sp],#4
+ it ls
movls pc,lr
stmfd sp!,{lr}
rsb r0,r0,#0
@@ -298,6 +301,7 @@ asm
swi #0x0
cmn r0,#126
ldr r7,[sp],#4
+ it ls
movls pc,lr
stmfd sp!,{lr}
rsb r0,r0,#0
diff --git a/rtl/msdos/classes.pp b/rtl/msdos/classes.pp
index cbd5d78c70..95fb6253c4 100644
--- a/rtl/msdos/classes.pp
+++ b/rtl/msdos/classes.pp
@@ -18,6 +18,14 @@
{ determine the type of the resource/form file }
{$define Win16Res}
+{$if defined(FPC_MM_TINY) or defined(FPC_MM_SMALL) or defined(FPC_MM_LARGE) or defined(FPC_MM_HUGE)}
+ { CodePointer = Pointer; nothing to define }
+{$elseif defined(FPC_MM_MEDIUM) or defined(FPC_MM_COMPACT)}
+ {$define FPC_CODEPOINTER_DIFFERENT_THAN_POINTER}
+{$else}
+ {$fatal Unknown i8086 memory model.}
+{$endif}
+
unit Classes;
interface
@@ -26,7 +34,7 @@ uses
typinfo,
rtlconsts,
types,
-{$ifdef FPC_TESTGENERICS}
+{$if defined(FPC_TESTGENERICS) or defined(FPC_CODEPOINTER_DIFFERENT_THAN_POINTER)}
fgl,
{$endif}
sysutils;
@@ -35,6 +43,13 @@ uses
implementation
+type
+{$ifdef FPC_CODEPOINTER_DIFFERENT_THAN_POINTER}
+ TCodePtrList = specialize TFPGList<CodePointer>;
+{$else FPC_CODEPOINTER_DIFFERENT_THAN_POINTER}
+ TCodePtrList = TList;
+{$endif FPC_CODEPOINTER_DIFFERENT_THAN_POINTER}
+
{ OS - independent class implementations are in /inc directory. }
{$i classes.inc}
diff --git a/rtl/objpas/character.pas b/rtl/objpas/character.pas
index b288df12ff..df7df76734 100644
--- a/rtl/objpas/character.pas
+++ b/rtl/objpas/character.pas
@@ -820,64 +820,13 @@ begin
end;
class function TCharacter.ToLower(const AString : UnicodeString; const AOptions : TCharacterOptions) : UnicodeString;
-var
- i, c : SizeInt;
- pp, pr : PUnicodeChar;
- pu : PUC_Prop;
- locIsSurrogate, locIgnoreInvalid : Boolean;
-begin
- c := Length(AString);
- SetLength(Result,2*c);
- if (c > 0) then begin
- locIgnoreInvalid := (TCharacterOption.coIgnoreInvalidSequence in AOptions);
- pp := @AString[1];
- pr := @Result[1];
- i := 1;
- while (i <= c) do begin
- pu := GetProps(Word(pp^));
- locIsSurrogate := (TUnicodeCategory(pu^.Category) = TUnicodeCategory.ucSurrogate);
- if locIsSurrogate then begin
- if locIgnoreInvalid then begin
- if (i = c) or not(IsSurrogatePair(pp[0],pp[1])) then begin
- pr^ := pp^;
- Inc(pp);
- Inc(pr);
- Inc(i);
- Continue;
- end;
- end;
- if not IsSurrogatePair(AString,i) then
- raise EArgumentException.Create(SInvalidUnicodeCodePointSequence);
- pu := GetProps(pp^,AString[i+1]);
- end;
- if (pu^.SimpleLowerCase = 0) then begin
- pr^ := pp^;
- if locIsSurrogate then begin
- Inc(pp);
- Inc(pr);
- Inc(i);
- pr^ := pp^;
- end;
- end else begin
- if (pu^.SimpleLowerCase <= $FFFF) then begin
- pr^ := UnicodeChar(Word(pu^.SimpleLowerCase));
- end else begin
- FromUCS4(UCS4Char(Cardinal(pu^.SimpleLowerCase)),pr^,PUnicodeChar(PtrUInt(pr)+SizeOf(UnicodeChar))^);
- Inc(pr);
- end;
- if locIsSurrogate then begin
- Inc(pp);
- Inc(i);
- end;
- end;
- Inc(pp);
- Inc(pr);
- Inc(i);
- end;
- Dec(pp);
- i := ((PtrUInt(pr) - PtrUInt(@Result[1])) div SizeOf(UnicodeChar));
- SetLength(Result,i)
- end;
+begin
+ if (UnicodeToLower(
+ AString,(TCharacterOption.coIgnoreInvalidSequence in AOptions),Result
+ ) <> 0
+ )
+ then
+ raise EArgumentException.Create(SInvalidUnicodeCodePointSequence);
end;
class function TCharacter.ToUpper(AChar : UnicodeChar) : UnicodeChar;
@@ -893,64 +842,13 @@ begin
end;
class function TCharacter.ToUpper(const AString : UnicodeString; const AOptions : TCharacterOptions) : UnicodeString;
-var
- i, c : SizeInt;
- pp, pr : PUnicodeChar;
- pu : PUC_Prop;
- locIsSurrogate, locIgnoreInvalid : Boolean;
-begin
- c := Length(AString);
- SetLength(Result,2*c);
- if (c > 0) then begin
- locIgnoreInvalid := (TCharacterOption.coIgnoreInvalidSequence in AOptions);
- pp := @AString[1];
- pr := @Result[1];
- i := 1;
- while (i <= c) do begin
- pu := GetProps(Word(pp^));
- locIsSurrogate := (TUnicodeCategory(pu^.Category) = TUnicodeCategory.ucSurrogate);
- if locIsSurrogate then begin
- if locIgnoreInvalid then begin
- if (i = c) or not(IsSurrogatePair(pp[0],pp[1])) then begin
- pr^ := pp^;
- Inc(pp);
- Inc(pr);
- Inc(i);
- Continue;
- end;
- end;
- if not IsSurrogatePair(AString,i) then
- raise EArgumentException.Create(SInvalidUnicodeCodePointSequence);
- pu := GetProps(pp^,AString[i+1]);
- end;
- if (pu^.SimpleUpperCase = 0) then begin
- pr^ := pp^;
- if locIsSurrogate then begin
- Inc(pp);
- Inc(pr);
- Inc(i);
- pr^ := pp^;
- end;
- end else begin
- if (pu^.SimpleUpperCase <= $FFFF) then begin
- pr^ := UnicodeChar(Word(pu^.SimpleUpperCase));
- end else begin
- FromUCS4(UCS4Char(Cardinal(pu^.SimpleUpperCase)),pr^,PUnicodeChar(PtrUInt(pr)+SizeOf(UnicodeChar))^);
- Inc(pr);
- end;
- if locIsSurrogate then begin
- Inc(pp);
- Inc(i);
- end;
- end;
- Inc(pp);
- Inc(pr);
- Inc(i);
- end;
- Dec(pp);
- i := ((PtrUInt(pr) - PtrUInt(@Result[1])) div SizeOf(UnicodeChar));
- SetLength(Result,i)
- end;
+begin
+ if (UnicodeToUpper(
+ AString,(TCharacterOption.coIgnoreInvalidSequence in AOptions),Result
+ ) <> 0
+ )
+ then
+ raise EArgumentException.Create(SInvalidUnicodeCodePointSequence);
end;
{$endif VER2_4}
diff --git a/rtl/objpas/classes/classes.inc b/rtl/objpas/classes/classes.inc
index da6d0d46a9..970dd61dd0 100644
--- a/rtl/objpas/classes/classes.inc
+++ b/rtl/objpas/classes/classes.inc
@@ -881,23 +881,28 @@ Type
AClass : TComponentClass;
end;
+{$ifndef i8086}
+type
+ TCodePtrList = TList;
+{$endif i8086}
+
Var
InitHandlerList : TList;
- FindGlobalComponentList : TList;
+ FindGlobalComponentList : TCodePtrList;
procedure RegisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
begin
if not(assigned(FindGlobalComponentList)) then
- FindGlobalComponentList:=TList.Create;
- if FindGlobalComponentList.IndexOf(Pointer(AFindGlobalComponent))<0 then
- FindGlobalComponentList.Add(Pointer(AFindGlobalComponent));
+ FindGlobalComponentList:=TCodePtrList.Create;
+ if FindGlobalComponentList.IndexOf(CodePointer(AFindGlobalComponent))<0 then
+ FindGlobalComponentList.Add(CodePointer(AFindGlobalComponent));
end;
procedure UnregisterFindGlobalComponentProc(AFindGlobalComponent: TFindGlobalComponent);
begin
if assigned(FindGlobalComponentList) then
- FindGlobalComponentList.Remove(Pointer(AFindGlobalComponent));
+ FindGlobalComponentList.Remove(CodePointer(AFindGlobalComponent));
end;
diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc
index 7148cfc29b..472103c77b 100644
--- a/rtl/objpas/classes/classesh.inc
+++ b/rtl/objpas/classes/classesh.inc
@@ -730,7 +730,7 @@ type
FOwnsObjects : Boolean;
procedure ExchangeItems(Index1, Index2: Integer);
procedure Grow;
- procedure InternalClear;
+ procedure InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
procedure SetSorted(Value: Boolean);
procedure SetCaseSensitive(b : boolean);
diff --git a/rtl/objpas/classes/stringl.inc b/rtl/objpas/classes/stringl.inc
index f7af390a2e..01d222794f 100644
--- a/rtl/objpas/classes/stringl.inc
+++ b/rtl/objpas/classes/stringl.inc
@@ -964,7 +964,7 @@ begin
SetCapacity(NC);
end;
-Procedure TStringList.InternalClear;
+Procedure TStringList.InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
Var
I: Integer;
@@ -972,7 +972,7 @@ Var
begin
if FOwnsObjects then
begin
- For I:=0 to FCount-1 do
+ For I:=FromIndex to FCount-1 do
begin
Flist^[I].FString:='';
freeandnil(Flist^[i].FObject);
@@ -980,11 +980,12 @@ begin
end
else
begin
- For I:=0 to FCount-1 do
+ For I:=FromIndex to FCount-1 do
Flist^[I].FString:='';
end;
- FCount:=0;
- SetCapacity(0);
+ FCount:=FromIndex;
+ if Not ClearOnly then
+ SetCapacity(0);
end;
Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
@@ -1147,7 +1148,7 @@ end;
Procedure TStringList.SetCapacity(NewCapacity: Integer);
Var NewList : Pointer;
- MSize : Longint;
+ I,MSize : Longint;
begin
If (NewCapacity<0) then
@@ -1175,6 +1176,7 @@ begin
FList := nil;
end else
begin
+ InternalClear(NewCapacity,True);
GetMem(NewList, NewCapacity * SizeOf(TStringItem));
System.Move(FList^, NewList^, NewCapacity * SizeOf(TStringItem));
FreeMem(FList);
diff --git a/rtl/objpas/fpwidestring.pp b/rtl/objpas/fpwidestring.pp
index 536e451e5f..5aaf0928be 100644
--- a/rtl/objpas/fpwidestring.pp
+++ b/rtl/objpas/fpwidestring.pp
@@ -23,7 +23,7 @@ uses
{$ifdef Unix}
unixcp,
{$endif}
- sysutils, character, charset;
+ charset;
procedure fpc_rangeerror; [external name 'FPC_RANGEERROR'];
{$ifdef MSWINDOWS}
@@ -31,7 +31,7 @@ procedure fpc_rangeerror; [external name 'FPC_RANGEERROR'];
{$endif MSWINDOWS}
const
- CharacterOptions = [TCharacterOption.coIgnoreInvalidSequence];
+ IgnoreInvalidSequenceFlag = True;
var
OldManager : TUnicodeStringManager;
@@ -90,6 +90,21 @@ begin
current_Map:=nil;
end;
+function FindMap(const cp: TSystemCodePage): punicodemap;inline;
+begin
+ if (cp=DefaultSystemCodePage) then
+ begin
+ { update current_Map in case the DefaultSystemCodePage has been changed }
+ if (current_DefaultSystemCodePage<>DefaultSystemCodePage) or not Assigned(current_Map) then
+ begin
+ FiniThread;
+ InitThread;
+ end;
+ Result:=current_Map;
+ end
+ else
+ Result:=getmap(cp);
+end;
{ return value:
-1 if incomplete or invalid code point
@@ -247,18 +262,7 @@ begin
exit;
end;
- if (cp=DefaultSystemCodePage) then
- begin
- { update current_Map in case the DefaultSystemCodePage has been changed }
- if current_DefaultSystemCodePage<>DefaultSystemCodePage then
- begin
- FiniThread;
- InitThread;
- end;
- locMap:=current_Map;
- end
- else
- locMap:=getmap(cp);
+ locMap:=FindMap(cp);
if (locMap=nil) then
begin
DefaultUnicode2AnsiMove(source,dest,DefaultSystemCodePage,len);
@@ -320,18 +324,7 @@ begin
exit;
end;
- if (cp=DefaultSystemCodePage) then
- begin
- { update current_Map in case the DefaultSystemCodePage has been changed }
- if current_DefaultSystemCodePage<>DefaultSystemCodePage then
- begin
- FiniThread;
- InitThread;
- end;
- locMap:=current_Map;
- end
- else
- locMap:=getmap(cp);
+ locMap:=FindMap(cp);
if (locMap=nil) then
begin
DefaultAnsi2UnicodeMove(source,DefaultSystemCodePage,dest,len);
@@ -355,18 +348,7 @@ begin
exit;
end;
- if (cp=DefaultSystemCodePage) then
- begin
- { update current_Map in case the DefaultSystemCodePage has been changed }
- if current_DefaultSystemCodePage<>DefaultSystemCodePage then
- begin
- FiniThread;
- InitThread;
- end;
- locMap:=current_Map;
- end
- else
- locMap:=getmap(cp);
+ locMap:=FindMap(cp);
if (locMap=nil) then
begin
DefaultAnsi2WideMove(source,DefaultSystemCodePage,dest,len);
@@ -381,7 +363,8 @@ end;
function UpperUnicodeString(const S: UnicodeString): UnicodeString;
begin
- Result:=TCharacter.ToUpper(s,CharacterOptions);
+ if (UnicodeToUpper(S,IgnoreInvalidSequenceFlag,Result) <> 0) then
+ system.error(reRangeError);
end;
function UpperWideString(const S: WideString): WideString;
@@ -394,7 +377,8 @@ end;
function LowerUnicodeString(const S: UnicodeString): UnicodeString;
begin
- Result:=TCharacter.ToLower(s,CharacterOptions);
+ if (UnicodeToLower(S,IgnoreInvalidSequenceFlag,Result) <> 0) then
+ system.error(reRangeError);
end;
function LowerWideString(const S: WideString): WideString;
@@ -405,16 +389,13 @@ begin
Result:=LowerUnicodeString(u);
end;
-function CompareUnicodeStringUCA(p1,p2:PUnicodeChar; l1,l2:PtrInt) : PtrInt;
-var
- k1, k2 : TUCASortKey;
+
+function CompareUnicodeStringUCA(p1,p2:PUnicodeChar; l1,l2:PtrInt) : PtrInt;inline;
begin
- k1 := ComputeSortKey(p1,l1,current_Collation);
- k2 := ComputeSortKey(p2,l2,current_Collation);
- Result := CompareSortKey(k1,k2);
+ Result := IncrementalCompareString(p1,l1,p2,l2,current_Collation);
end;
-function CompareUnicodeString(p1,p2:PUnicodeChar; l1,l2:PtrInt) : PtrInt;
+function CompareUnicodeString(p1,p2:PUnicodeChar; l1,l2:PtrInt) : PtrInt;inline;
begin
if (Pointer(p1)=Pointer(p2)) then
exit(0);
@@ -502,13 +483,8 @@ begin
UnicodeToUtf8(@Result[1],slen,@us[1],ulen);
exit;
end;
-
- if current_DefaultSystemCodePage<>DefaultSystemCodePage then
- begin
- FiniThread;
- InitThread;
- end;
- locMap:=current_Map;
+
+ locMap:=FindMap(DefaultSystemCodePage);
if (locMap=nil) then
exit(System.UpCase(s));
@@ -532,7 +508,7 @@ begin
ulen:=getunicode(p,mblen,locMap,@us[1]);
if (Length(us)<>ulen) then
SetLength(us,ulen);
- usl:=TCharacter.ToUpper(us,CharacterOptions);
+ usl:=UpperUnicodeString(us);
for k:=1 to Length(usl) do
begin
aalen:=getascii(tunicodechar(us[k]),locMap,@aa[Low(aa)],Length(aa));
@@ -574,12 +550,7 @@ begin
UnicodeToUtf8(@Result[1],slen,@us[1],ulen);
exit;
end;
- if current_DefaultSystemCodePage<>DefaultSystemCodePage then
- begin
- FiniThread;
- InitThread;
- end;
- locMap:=current_Map;
+ locMap:=FindMap(DefaultSystemCodePage);
if (locMap=nil) then
exit(System.LowerCase(s));
@@ -603,7 +574,7 @@ begin
ulen:=getunicode(p,mblen,locMap,@us[1]);
if (Length(us)<>ulen) then
SetLength(us,ulen);
- usl:=TCharacter.ToLower(us,CharacterOptions);
+ usl:=LowerUnicodeString(us);
for k:=1 to Length(usl) do
begin
aalen:=getascii(tunicodechar(us[k]),locMap,@aa[Low(aa)],Length(aa));
@@ -717,7 +688,7 @@ end;
function StrCompAnsiString(S1, S2: PChar): PtrInt;
var
- l1,l2,l : PtrInt;
+ l1,l2 : PtrInt;
begin
l1:=strlen(S1);
l2:=strlen(S2);
diff --git a/rtl/objpas/sysutils/dati.inc b/rtl/objpas/sysutils/dati.inc
index 3e0f901f78..832bbc0f48 100644
--- a/rtl/objpas/sysutils/dati.inc
+++ b/rtl/objpas/sysutils/dati.inc
@@ -502,6 +502,15 @@ begin
Raise EConvertError.Create(Msg);
end;
+function StrToDate(const S: string; FormatSettings: TFormatSettings): TDateTime;
+var
+ Msg: AnsiString;
+begin
+ Result:=IntStrToDate(Msg,@S[1],Length(S),FormatSettings.ShortDateFormat,FormatSettings);
+ if Msg<>'' then
+ raise EConvertError.Create(Msg);
+end;
+
function StrToDate(const S: ShortString; const useformat : string; separator : char = #0): TDateTime;
begin
result := StrToDate(@S[1],Length(s),UseFormat,separator);
diff --git a/rtl/objpas/sysutils/datih.inc b/rtl/objpas/sysutils/datih.inc
index 783a427a01..b8dde2ea2b 100644
--- a/rtl/objpas/sysutils/datih.inc
+++ b/rtl/objpas/sysutils/datih.inc
@@ -125,6 +125,7 @@ function StrToDate(const S: ShortString): TDateTime; {$ifdef SY
function StrToDate(const S: Ansistring): TDateTime; {$ifdef SYSUTILSINLINE}inline;{$endif}
function StrToDate(const S: ShortString; separator : char): TDateTime;{$ifdef SYSUTILSINLINE}inline;{$endif}
function StrToDate(const S: AnsiString; separator : char): TDateTime; {$ifdef SYSUTILSINLINE}inline;{$endif}
+function StrToDate(const S: string; FormatSettings : TFormatSettings): TDateTime;
function StrToTime(const S: Shortstring): TDateTime; {$ifdef SYSUTILSINLINE}inline;{$endif}
function StrToTime(const S: Ansistring): TDateTime; {$ifdef SYSUTILSINLINE}inline;{$endif}
function StrToTime(const S: ShortString; separator : char): TDateTime;{$ifdef SYSUTILSINLINE}inline;{$endif}
diff --git a/rtl/objpas/unicodedata.pas b/rtl/objpas/unicodedata.pas
index 2403a9b658..fc39f0ad0a 100644
--- a/rtl/objpas/unicodedata.pas
+++ b/rtl/objpas/unicodedata.pas
@@ -274,6 +274,7 @@ type
Props : PUCA_PropItemRec;
VariableLowLimit : Word;
VariableHighLimit : Word;
+ Dynamic : Boolean;
public
function IsVariable(const AWeight : PUCA_PropWeights) : Boolean; inline;
end;
@@ -283,6 +284,7 @@ type
const
ROOT_COLLATION_NAME = 'DUCET';
+ ERROR_INVALID_CODEPOINT_SEQUENCE = 1;
procedure FromUCS4(const AValue : UCS4Char; var AHighS, ALowS : UnicodeChar);inline;
function ToUCS4(const AHighS, ALowS : UnicodeChar) : UCS4Char;inline;
@@ -292,6 +294,16 @@ const
) : Boolean;inline;
function UnicodeIsHighSurrogate(const AValue : UnicodeChar) : Boolean;inline;
function UnicodeIsLowSurrogate(const AValue : UnicodeChar) : Boolean;inline;
+ function UnicodeToUpper(
+ const AString : UnicodeString;
+ const AIgnoreInvalidSequence : Boolean;
+ out AResultString : UnicodeString
+ ) : Integer;
+ function UnicodeToLower(
+ const AString : UnicodeString;
+ const AIgnoreInvalidSequence : Boolean;
+ out AResultString : UnicodeString
+ ) : Integer;
function GetProps(const ACodePoint : Word) : PUC_Prop;overload;inline;
function GetProps(const AHighS, ALowS : UnicodeChar): PUC_Prop;overload;inline;
@@ -319,9 +331,26 @@ type
) : TUCASortKey;overload;
function CompareSortKey(const A, B : TUCASortKey) : Integer;overload;
function CompareSortKey(const A : TUCASortKey; const B : array of Word) : Integer;overload;
+ function IncrementalCompareString(
+ const AStrA : PUnicodeChar;
+ const ALengthA : SizeInt;
+ const AStrB : PUnicodeChar;
+ const ALengthB : SizeInt;
+ const ACollation : PUCA_DataBook
+ ) : Integer;overload;
+ function IncrementalCompareString(
+ const AStrA,
+ AStrB : UnicodeString;
+ const ACollation : PUCA_DataBook
+ ) : Integer;inline;overload;
- function RegisterCollation(const ACollation : PUCA_DataBook) : Boolean;
+ function RegisterCollation(const ACollation : PUCA_DataBook) : Boolean;overload;
+ function RegisterCollation(
+ const ADirectory,
+ ALanguage : string
+ ) : Boolean;overload;
function UnregisterCollation(const AName : ansistring): Boolean;
+ procedure UnregisterCollations(const AFreeDynamicCollations : Boolean);
function FindCollation(const AName : ansistring): PUCA_DataBook;overload;
function FindCollation(const AIndex : Integer): PUCA_DataBook;overload;
function GetCollationCount() : Integer;
@@ -330,6 +359,29 @@ type
const ABaseName : ansistring;
const AChangedFields : TCollationFields
);
+ function LoadCollation(
+ const AData : Pointer;
+ const ADataLength : Integer
+ ) : PUCA_DataBook;overload;
+ function LoadCollation(const AFileName : string) : PUCA_DataBook;overload;
+ function LoadCollation(
+ const ADirectory,
+ ALanguage : string
+ ) : PUCA_DataBook;overload;
+ procedure FreeCollation(AItem : PUCA_DataBook);
+
+type
+ TEndianKind = (Little, Big);
+const
+ ENDIAN_SUFFIX : array[TEndianKind] of string[2] = ('le','be');
+{$IFDEF ENDIAN_LITTLE}
+ ENDIAN_NATIVE = TEndianKind.Little;
+ ENDIAN_NON_NATIVE = TEndianKind.Big;
+{$ENDIF ENDIAN_LITTLE}
+{$IFDEF ENDIAN_BIG}
+ ENDIAN_NATIVE = TEndianKind.Big;
+ ENDIAN_NON_NATIVE = TEndianKind.Little;
+{$ENDIF ENDIAN_BIG}
resourcestring
SCollationNotFound = 'Collation not found : "%s".';
@@ -535,6 +587,21 @@ begin
Result := a <= Cardinal(b);
end;
+type
+ TBitOrder = 0..7;
+function IsBitON(const AData : Byte; const ABit : TBitOrder) : Boolean ;inline;
+begin
+ Result := ( ( AData and ( 1 shl ABit ) ) <> 0 );
+end;
+
+procedure SetBit(var AData : Byte; const ABit : TBitOrder; const AValue : Boolean);inline;
+begin
+ if AValue then
+ AData := AData or (1 shl (ABit mod 8))
+ else
+ AData := AData and ( not ( 1 shl ( ABit mod 8 ) ) );
+end;
+
var
CollationTable : array of PUCA_DataBook;
function IndexOfCollation(const AName : string) : Integer;
@@ -565,6 +632,23 @@ begin
end;
end;
+function RegisterCollation(const ADirectory, ALanguage : string) : Boolean;
+var
+ cl : PUCA_DataBook;
+begin
+ cl := LoadCollation(ADirectory,ALanguage);
+ if (cl = nil) then
+ exit(False);
+ try
+ Result := RegisterCollation(cl);
+ except
+ FreeCollation(cl);
+ raise;
+ end;
+ if not Result then
+ FreeCollation(cl);
+end;
+
function UnregisterCollation(const AName : ansistring): Boolean;
var
i, c : Integer;
@@ -582,6 +666,23 @@ begin
end;
end;
+procedure UnregisterCollations(const AFreeDynamicCollations : Boolean);
+var
+ i : Integer;
+ cl : PUCA_DataBook;
+begin
+ if AFreeDynamicCollations then begin
+ for i := Low(CollationTable) to High(CollationTable) do begin
+ if CollationTable[i].Dynamic then begin
+ cl := CollationTable[i];
+ CollationTable[i] := nil;
+ FreeCollation(cl);
+ end;
+ end;
+ end;
+ SetLength(CollationTable,0);
+end;
+
function FindCollation(const AName : ansistring): PUCA_DataBook;overload;
var
i : Integer;
@@ -632,6 +733,190 @@ begin
p^.VariableLowLimit := base^.VariableHighLimit;
end;
+type
+ TSerializedCollationHeader = packed record
+ Base : TCollationName;
+ Version : TCollationName;
+ CollationName : TCollationName;
+ VariableWeight : Byte;
+ Backwards : Byte;
+ BMP_Table1Length : DWord;
+ BMP_Table2Length : DWord;
+ OBMP_Table1Length : DWord;
+ OBMP_Table2Length : DWord;
+ PropCount : DWord;
+ VariableLowLimit : Word;
+ VariableHighLimit : Word;
+ ChangedFields : Byte;
+ end;
+ PSerializedCollationHeader = ^TSerializedCollationHeader;
+
+procedure FreeCollation(AItem : PUCA_DataBook);
+var
+ h : PSerializedCollationHeader;
+begin
+ if (AItem = nil) or not(AItem^.Dynamic) then
+ exit;
+ h := PSerializedCollationHeader(PtrUInt(AItem) + SizeOf(TUCA_DataBook));
+ if (AItem^.BMP_Table1 <> nil) then
+ FreeMem(AItem^.BMP_Table1,h^.BMP_Table1Length);
+ if (AItem^.BMP_Table2 <> nil) then
+ FreeMem(AItem^.BMP_Table2,h^.BMP_Table2Length);
+ if (AItem^.OBMP_Table1 <> nil) then
+ FreeMem(AItem^.OBMP_Table1,h^.OBMP_Table1Length);
+ if (AItem^.OBMP_Table2 <> nil) then
+ FreeMem(AItem^.OBMP_Table2,h^.OBMP_Table2Length);
+ if (AItem^.Props <> nil) then
+ FreeMem(AItem^.Props,h^.PropCount);
+ FreeMem(AItem,(SizeOf(TUCA_DataBook)+SizeOf(TSerializedCollationHeader)));
+end;
+
+function LoadCollation(
+ const AData : Pointer;
+ const ADataLength : Integer
+) : PUCA_DataBook;
+var
+ dataPointer : PByte;
+ readedLength : LongInt;
+
+ function ReadBuffer(ADest : Pointer; ALength : LongInt) : Boolean;
+ begin
+ Result := (readedLength + ALength) <= ADataLength;
+ if not result then
+ exit;
+ Move(dataPointer^,ADest^,ALength);
+ Inc(dataPointer,ALength);
+ readedLength := readedLength + ALength;
+ end;
+
+var
+ r : PUCA_DataBook;
+ h : PSerializedCollationHeader;
+ cfs : TCollationFields;
+ i : Integer;
+ baseName : TCollationName;
+begin
+ readedLength := 0;
+ dataPointer := AData;
+ r := AllocMem((SizeOf(TUCA_DataBook)+SizeOf(TSerializedCollationHeader)));
+ try
+ h := PSerializedCollationHeader(PtrUInt(r) + SizeOf(TUCA_DataBook));
+ if not ReadBuffer(h,SizeOf(TSerializedCollationHeader)) then
+ exit;
+ r^.Version := h^.Version;
+ r^.CollationName := h^.CollationName;
+ r^.VariableWeight := TUCA_VariableKind(h^.VariableWeight);
+ r^.Backwards[0] := IsBitON(h^.Backwards,0);
+ r^.Backwards[1] := IsBitON(h^.Backwards,1);
+ r^.Backwards[2] := IsBitON(h^.Backwards,2);
+ r^.Backwards[3] := IsBitON(h^.Backwards,3);
+ if (h^.BMP_Table1Length > 0) then begin
+ r^.BMP_Table1 := GetMem(h^.BMP_Table1Length);
+ if not ReadBuffer(r^.BMP_Table1,h^.BMP_Table1Length) then
+ exit;
+ end;
+ if (h^.BMP_Table2Length > 0) then begin
+ r^.BMP_Table2 := GetMem(h^.BMP_Table2Length);
+ if not ReadBuffer(r^.BMP_Table2,h^.BMP_Table2Length) then
+ exit;
+ end;
+ if (h^.OBMP_Table1Length > 0) then begin
+ r^.OBMP_Table1 := GetMem(h^.OBMP_Table1Length);
+ if not ReadBuffer(r^.OBMP_Table1,h^.OBMP_Table1Length) then
+ exit;
+ end;
+ if (h^.OBMP_Table2Length > 0) then begin
+ r^.OBMP_Table2 := GetMem(h^.OBMP_Table2Length);
+ if not ReadBuffer(r^.OBMP_Table2,h^.OBMP_Table2Length) then
+ exit;
+ end;
+ r^.PropCount := h^.PropCount;
+ if (h^.PropCount > 0) then begin
+ r^.Props := GetMem(h^.PropCount);
+ if not ReadBuffer(r^.Props,h^.PropCount) then
+ exit;
+ end;
+ r^.VariableLowLimit := h^.VariableLowLimit;
+ r^.VariableHighLimit := h^.VariableHighLimit;
+
+ cfs := [];
+ for i := Ord(Low(TCollationField)) to Ord(High(TCollationField)) do begin
+ if IsBitON(h^.ChangedFields,i) then
+ cfs := cfs + [TCollationField(i)];
+ end;
+ if (h^.Base <> '') then
+ baseName := h^.Base
+ else if (h^.CollationName <> ROOT_COLLATION_NAME) then
+ baseName := ROOT_COLLATION_NAME
+ else
+ baseName := '';
+ if (baseName <> '') then
+ PrepareCollation(r,baseName,cfs);
+ r^.Dynamic := True;
+ Result := r;
+ except
+ FreeCollation(r);
+ raise;
+ end;
+end;
+
+{$PUSH}
+function LoadCollation(const AFileName : string) : PUCA_DataBook;
+const
+ BLOCK_SIZE = 16*1024;
+var
+ f : File of Byte;
+ locSize, locReaded, c : LongInt;
+ locBuffer : PByte;
+ locBlockSize : LongInt;
+begin
+ Result := nil;
+{$I-}
+ if (AFileName = '') then
+ exit;
+ Assign(f,AFileName);
+ Reset(f);
+ try
+ if (IOResult <> 0) then
+ exit;
+ locSize := FileSize(f);
+ if (locSize < SizeOf(TSerializedCollationHeader)) then
+ exit;
+ locBuffer := GetMem(locSize);
+ try
+ locBlockSize := BLOCK_SIZE;
+ locReaded := 0;
+ while (locReaded < locSize) do begin
+ if (locBlockSize > (locSize-locReaded)) then
+ locBlockSize := locSize-locReaded;
+ BlockRead(f,locBuffer[locReaded],locBlockSize,c);
+ if (IOResult <> 0) or (c <= 0) then
+ exit;
+ locReaded := locReaded + c;
+ end;
+ Result := LoadCollation(locBuffer,locSize);
+ finally
+ FreeMem(locBuffer,locSize);
+ end;
+ finally
+ Close(f);
+ end;
+end;
+{$POP}
+
+function LoadCollation(const ADirectory, ALanguage : string) : PUCA_DataBook;
+var
+ fileName : string;
+begin
+ fileName := ADirectory;
+ if (fileName <> '') then begin
+ if (fileName[Length(fileName)] <> DirectorySeparator) then
+ fileName := fileName + DirectorySeparator;
+ end;
+ fileName := fileName + 'collation_' + ALanguage + '_' + ENDIAN_SUFFIX[ENDIAN_NATIVE] + '.bco';
+ Result := LoadCollation(fileName);
+end;
+
{$INCLUDE unicodedata.inc}
{$IFDEF ENDIAN_LITTLE}
{$INCLUDE unicodedata_le.inc}
@@ -723,7 +1008,137 @@ begin
Result := GetProps(h,l);
end;
+function UnicodeToUpper(
+ const AString : UnicodeString;
+ const AIgnoreInvalidSequence : Boolean;
+ out AResultString : UnicodeString
+) : Integer;
+var
+ i, c : SizeInt;
+ pp, pr : PUnicodeChar;
+ pu : PUC_Prop;
+ locIsSurrogate : Boolean;
+ r : UnicodeString;
+begin
+ c := Length(AString);
+ SetLength(r,2*c);
+ if (c > 0) then begin
+ pp := @AString[1];
+ pr := @r[1];
+ i := 1;
+ while (i <= c) do begin
+ pu := GetProps(Word(pp^));
+ locIsSurrogate := (pu^.Category = UGC_Surrogate);
+ if locIsSurrogate then begin
+ if (i = c) or not(UnicodeIsSurrogatePair(pp[0],pp[1])) then begin
+ if AIgnoreInvalidSequence then begin
+ pr^ := pp^;
+ Inc(pp);
+ Inc(pr);
+ Inc(i);
+ Continue;
+ end;
+ exit(ERROR_INVALID_CODEPOINT_SEQUENCE);
+ end;
+ pu := GetProps(pp^,AString[i+1]);
+ end;
+ if (pu^.SimpleUpperCase = 0) then begin
+ pr^ := pp^;
+ if locIsSurrogate then begin
+ Inc(pp);
+ Inc(pr);
+ Inc(i);
+ pr^ := pp^;
+ end;
+ end else begin
+ if (pu^.SimpleUpperCase <= $FFFF) then begin
+ pr^ := UnicodeChar(Word(pu^.SimpleUpperCase));
+ end else begin
+ FromUCS4(UCS4Char(Cardinal(pu^.SimpleUpperCase)),pr^,PUnicodeChar(PtrUInt(pr)+SizeOf(UnicodeChar))^);
+ Inc(pr);
+ end;
+ if locIsSurrogate then begin
+ Inc(pp);
+ Inc(i);
+ end;
+ end;
+ Inc(pp);
+ Inc(pr);
+ Inc(i);
+ end;
+ Dec(pp);
+ i := ((PtrUInt(pr) - PtrUInt(@r[1])) div SizeOf(UnicodeChar));
+ SetLength(r,i);
+ AResultString := r;
+ end;
+ Result := 0;
+end;
+function UnicodeToLower(
+ const AString : UnicodeString;
+ const AIgnoreInvalidSequence : Boolean;
+ out AResultString : UnicodeString
+) : Integer;
+var
+ i, c : SizeInt;
+ pp, pr : PUnicodeChar;
+ pu : PUC_Prop;
+ locIsSurrogate : Boolean;
+ r : UnicodeString;
+begin
+ c := Length(AString);
+ SetLength(r,2*c);
+ if (c > 0) then begin
+ pp := @AString[1];
+ pr := @r[1];
+ i := 1;
+ while (i <= c) do begin
+ pu := GetProps(Word(pp^));
+ locIsSurrogate := (pu^.Category = UGC_Surrogate);
+ if locIsSurrogate then begin
+ if (i = c) or not(UnicodeIsSurrogatePair(pp[0],pp[1])) then begin
+ if AIgnoreInvalidSequence then begin
+ pr^ := pp^;
+ Inc(pp);
+ Inc(pr);
+ Inc(i);
+ Continue;
+ end;
+ exit(ERROR_INVALID_CODEPOINT_SEQUENCE);
+ end;
+ pu := GetProps(pp^,AString[i+1]);
+ end;
+ if (pu^.SimpleLowerCase = 0) then begin
+ pr^ := pp^;
+ if locIsSurrogate then begin
+ Inc(pp);
+ Inc(pr);
+ Inc(i);
+ pr^ := pp^;
+ end;
+ end else begin
+ if (pu^.SimpleLowerCase <= $FFFF) then begin
+ pr^ := UnicodeChar(Word(pu^.SimpleLowerCase));
+ end else begin
+ FromUCS4(UCS4Char(Cardinal(pu^.SimpleLowerCase)),pr^,PUnicodeChar(PtrUInt(pr)+SizeOf(UnicodeChar))^);
+ Inc(pr);
+ end;
+ if locIsSurrogate then begin
+ Inc(pp);
+ Inc(i);
+ end;
+ end;
+ Inc(pp);
+ Inc(pr);
+ Inc(i);
+ end;
+ Dec(pp);
+ i := ((PtrUInt(pr) - PtrUInt(@r[1])) div SizeOf(UnicodeChar));
+ SetLength(r,i);
+ AResultString := r;
+ end;
+ Result := 0;
+end;
//----------------------------------------------------------------------
function DecomposeHangul(const AChar : Cardinal; ABuffer : PCardinal) : Integer;
@@ -1026,21 +1441,6 @@ begin
end;
end;
-type
- TBitOrder = 0..7;
-function IsBitON(const AData : Byte; const ABit : TBitOrder) : Boolean ;inline;
-begin
- Result := ( ( AData and ( 1 shl ABit ) ) <> 0 );
-end;
-
-procedure SetBit(var AData : Byte; const ABit : TBitOrder; const AValue : Boolean);inline;
-begin
- if AValue then
- AData := AData or (1 shl (ABit mod 8))
- else
- AData := AData and ( not ( 1 shl ( ABit mod 8 ) ) );
-end;
-
{ TUCA_PropItemContextTreeNodeRec }
function TUCA_PropItemContextTreeNodeRec.GetLeftNode: PUCA_PropItemContextTreeNodeRec;
@@ -2134,6 +2534,875 @@ begin
Result := r;
end;
+type
+ TComputeKeyContext = record
+ Collation : PUCA_DataBook;
+ r : TUCA_PropWeightsArray;
+ ral {used length of "r"}: Integer;
+ rl {capacity of "r"} : Integer;
+ i : Integer;
+ s : UnicodeString;
+ ps : PUnicodeChar;
+ cp : Cardinal;
+ cl : PUCA_DataBook;
+ pp : PUCA_PropItemRec;
+ ppLevel : Byte;
+ removedCharIndex : array of DWord;
+ removedCharIndexLength : DWord;
+ locHistoryTop : Integer;
+ locHistory : array[0..24] of record
+ i : Integer;
+ cl : PUCA_DataBook;
+ pp : PUCA_PropItemRec;
+ ppLevel : Byte;
+ cp : Cardinal;
+ removedCharIndexLength : DWord;
+ end;
+ suppressState : record
+ cl : PUCA_DataBook;
+ CharCount : Integer;
+ end;
+ LastKeyOwner : record
+ Length : Integer;
+ Chars : array[0..24] of UInt24;
+ end;
+ c : Integer;
+ lastUnblockedNonstarterCCC : Byte;
+ surrogateState : Boolean;
+ Finished : Boolean;
+ end;
+ PComputeKeyContext = ^TComputeKeyContext;
+
+procedure ClearPP(AContext : PComputeKeyContext; const AClearSuppressInfo : Boolean = True);inline;
+begin
+ AContext^.cl := nil;
+ AContext^.pp := nil;
+ AContext^.ppLevel := 0;
+ if AClearSuppressInfo then begin
+ AContext^.suppressState.cl := nil;
+ AContext^.suppressState.CharCount := 0;
+ end;
+end;
+
+procedure InitContext(
+ AContext : PComputeKeyContext;
+ const AStr : PUnicodeChar;
+ const ALength : SizeInt;
+ const ACollation : PUCA_DataBook
+);
+begin
+ AContext^.Collation := ACollation;
+ AContext^.c := ALength;
+ AContext^.s := NormalizeNFD(AStr,AContext^.c);
+ AContext^.c := Length(AContext^.s);
+ AContext^.rl := 3*AContext^.c;
+ SetLength(AContext^.r,AContext^.rl);
+ AContext^.ral := 0;
+ AContext^.ps := @AContext^.s[1];
+ ClearPP(AContext);
+ AContext^.locHistoryTop := -1;
+ AContext^.removedCharIndexLength := 0;
+ FillByte(AContext^.suppressState,SizeOf(AContext^.suppressState),0);
+ AContext^.LastKeyOwner.Length := 0;
+ AContext^.i := 1;
+ AContext^.Finished := False;
+end;
+
+function FormKey(
+ const AWeightArray : TUCA_PropWeightsArray;
+ const ACollation : PUCA_DataBook
+) : TUCASortKey;inline;
+begin
+ case ACollation.VariableWeight of
+ TUCA_VariableKind.ucaShifted : Result := FormKeyShifted(AWeightArray,ACollation);
+ TUCA_VariableKind.ucaBlanked : Result := FormKeyBlanked(AWeightArray,ACollation);
+ TUCA_VariableKind.ucaNonIgnorable : Result := FormKeyNonIgnorable(AWeightArray,ACollation);
+ TUCA_VariableKind.ucaShiftedTrimmed : Result := FormKeyShiftedTrimmed(AWeightArray,ACollation);
+ else
+ Result := FormKeyShifted(AWeightArray,ACollation);
+ end;
+end;
+
+function ComputeRawSortKeyNextItem(
+ const AContext : PComputeKeyContext
+) : Boolean;forward;
+function IncrementalCompareString_NonIgnorable(
+ const AStrA : PUnicodeChar;
+ const ALengthA : SizeInt;
+ const AStrB : PUnicodeChar;
+ const ALengthB : SizeInt;
+ const ACollation : PUCA_DataBook
+) : Integer;
+var
+ ctxA, ctxB : TComputeKeyContext;
+ lastKeyIndexA, keyIndexA, lengthMaxA : Integer;
+ keyIndexB : Integer;
+ keyA, keyB : TUCASortKey;
+begin
+ if ( (ALengthA = 0) and (ALengthB = 0) ) or
+ ( (PtrUInt(AStrA) = PtrUInt(AStrB)) and
+ (ALengthA = ALengthB)
+ )
+ then
+ exit(0);
+ if (ALengthA = 0) then
+ exit(-1);
+ if (ALengthB = 0) then
+ exit(1);
+
+ InitContext(@ctxA,AStrA,ALengthA,ACollation);
+ InitContext(@ctxB,AStrB,ALengthB,ACollation);
+ lastKeyIndexA := -1;
+ keyIndexA := -1;
+ lengthMaxA := 0;
+ keyIndexB := -1;
+ while True do begin
+ if not ComputeRawSortKeyNextItem(@ctxA) then
+ Break;
+ if (ctxA.ral = lengthMaxA) then
+ Continue;
+ lengthMaxA := ctxA.ral;
+ keyIndexA := lastKeyIndexA + 1;
+ while (keyIndexA < lengthMaxA) and (ctxA.r[keyIndexA].Weights[0] = 0) do begin
+ Inc(keyIndexA);
+ end;
+ if (keyIndexA = lengthMaxA) then begin
+ lastKeyIndexA := keyIndexA-1;
+ Continue;
+ end;
+
+ while (keyIndexA < lengthMaxA) do begin
+ if (ctxA.r[keyIndexA].Weights[0] = 0) then begin
+ Inc(keyIndexA);
+ Continue;
+ end;
+ Inc(keyIndexB);
+ while (ctxB.ral <= keyIndexB) or (ctxB.r[keyIndexB].Weights[0] = 0) do begin
+ if (ctxB.ral <= keyIndexB) then begin
+ if not ComputeRawSortKeyNextItem(@ctxB) then
+ Break;
+ Continue;
+ end;
+ Inc(keyIndexB);
+ end;
+ if (ctxB.ral <= keyIndexB) then
+ exit(1);
+ if (ctxA.r[keyIndexA].Weights[0] > ctxB.r[keyIndexB].Weights[0]) then
+ exit(1);
+ if (ctxA.r[keyIndexA].Weights[0] < ctxB.r[keyIndexB].Weights[0]) then
+ exit(-1);
+ Inc(keyIndexA);
+ end;
+ lastKeyIndexA := keyIndexA - 1;
+ end;
+ //Key(A) is completed !
+ Inc(keyIndexB);
+ while (ctxB.ral <= keyIndexB) or (ctxB.r[keyIndexB].Weights[0] = 0) do begin
+ if (ctxB.ral <= keyIndexB) then begin
+ if not ComputeRawSortKeyNextItem(@ctxB) then
+ Break;
+ Continue;
+ end;
+ Inc(keyIndexB);
+ end;
+ if (ctxB.ral > keyIndexB) then begin
+ //B has at least one more primary weight that A
+ exit(-1);
+ end;
+ while ComputeRawSortKeyNextItem(@ctxB) do begin
+ //
+ end;
+ //Key(B) is completed !
+ keyA := FormKey(ctxA.r,ctxA.Collation);
+ keyB := FormKey(ctxB.r,ctxB.Collation);
+ Result := CompareSortKey(keyA,keyB);
+end;
+
+function IncrementalCompareString_Shift(
+ const AStrA : PUnicodeChar;
+ const ALengthA : SizeInt;
+ const AStrB : PUnicodeChar;
+ const ALengthB : SizeInt;
+ const ACollation : PUCA_DataBook
+) : Integer;
+var
+ ctxA, ctxB : TComputeKeyContext;
+ lastKeyIndexA, keyIndexA, lengthMaxA : Integer;
+ keyIndexB : Integer;
+ keyA, keyB : TUCASortKey;
+begin
+ if ( (ALengthA = 0) and (ALengthB = 0) ) or
+ ( (PtrUInt(AStrA) = PtrUInt(AStrB)) and
+ (ALengthA = ALengthB)
+ )
+ then
+ exit(0);
+ if (ALengthA = 0) then
+ exit(-1);
+ if (ALengthB = 0) then
+ exit(1);
+
+ InitContext(@ctxA,AStrA,ALengthA,ACollation);
+ InitContext(@ctxB,AStrB,ALengthB,ACollation);
+ lastKeyIndexA := -1;
+ keyIndexA := -1;
+ lengthMaxA := 0;
+ keyIndexB := -1;
+ while True do begin
+ if not ComputeRawSortKeyNextItem(@ctxA) then
+ Break;
+ if (ctxA.ral = lengthMaxA) then
+ Continue;
+ lengthMaxA := ctxA.ral;
+ keyIndexA := lastKeyIndexA + 1;
+ while (keyIndexA < lengthMaxA) and
+ ( (ctxA.r[keyIndexA].Weights[0] = 0) or
+ ctxA.Collation^.IsVariable(@ctxA.r[keyIndexA].Weights)
+ )
+ do begin
+ Inc(keyIndexA);
+ end;
+ if (keyIndexA = lengthMaxA) then begin
+ lastKeyIndexA := keyIndexA-1;
+ Continue;
+ end;
+
+ while (keyIndexA < lengthMaxA) do begin
+ if (ctxA.r[keyIndexA].Weights[0] = 0) or
+ ctxA.Collation^.IsVariable(@ctxA.r[keyIndexA].Weights)
+ then begin
+ Inc(keyIndexA);
+ Continue;
+ end;
+ Inc(keyIndexB);
+ while (ctxB.ral <= keyIndexB) or
+ (ctxB.r[keyIndexB].Weights[0] = 0) or
+ ctxB.Collation^.IsVariable(@ctxB.r[keyIndexB].Weights)
+ do begin
+ if (ctxB.ral <= keyIndexB) then begin
+ if not ComputeRawSortKeyNextItem(@ctxB) then
+ Break;
+ Continue;
+ end;
+ Inc(keyIndexB);
+ end;
+ if (ctxB.ral <= keyIndexB) then
+ exit(1);
+ if (ctxA.r[keyIndexA].Weights[0] > ctxB.r[keyIndexB].Weights[0]) then
+ exit(1);
+ if (ctxA.r[keyIndexA].Weights[0] < ctxB.r[keyIndexB].Weights[0]) then
+ exit(-1);
+ Inc(keyIndexA);
+ end;
+ lastKeyIndexA := keyIndexA - 1;
+ end;
+ //Key(A) is completed !
+ Inc(keyIndexB);
+ while (ctxB.ral <= keyIndexB) or
+ (ctxB.r[keyIndexB].Weights[0] = 0) or
+ ctxB.Collation^.IsVariable(@ctxB.r[keyIndexB].Weights)
+ do begin
+ if (ctxB.ral <= keyIndexB) then begin
+ if not ComputeRawSortKeyNextItem(@ctxB) then
+ Break;
+ Continue;
+ end;
+ Inc(keyIndexB);
+ end;
+ if (ctxB.ral > keyIndexB) then begin
+ //B has at least one more primary weight that A
+ exit(-1);
+ end;
+ while ComputeRawSortKeyNextItem(@ctxB) do begin
+ //
+ end;
+ //Key(B) is completed !
+ keyA := FormKey(ctxA.r,ctxA.Collation);
+ keyB := FormKey(ctxB.r,ctxB.Collation);
+ Result := CompareSortKey(keyA,keyB);
+end;
+
+function IncrementalCompareString(
+ const AStrA : PUnicodeChar;
+ const ALengthA : SizeInt;
+ const AStrB : PUnicodeChar;
+ const ALengthB : SizeInt;
+ const ACollation : PUCA_DataBook
+) : Integer;
+begin
+ case ACollation^.VariableWeight of
+ TUCA_VariableKind.ucaNonIgnorable :
+ begin
+ Result := IncrementalCompareString_NonIgnorable(
+ AStrA,ALengthA,AStrB,ALengthB,ACollation
+ );
+ end;
+ TUCA_VariableKind.ucaBlanked,
+ TUCA_VariableKind.ucaShiftedTrimmed,
+ TUCA_VariableKind.ucaIgnoreSP,
+ TUCA_VariableKind.ucaShifted:
+ begin
+ Result := IncrementalCompareString_Shift(
+ AStrA,ALengthA,AStrB,ALengthB,ACollation
+ );
+ end;
+ else
+ begin
+ Result := IncrementalCompareString_Shift(
+ AStrA,ALengthA,AStrB,ALengthB,ACollation
+ );
+ end;
+ end;
+end;
+
+function IncrementalCompareString(
+ const AStrA,
+ AStrB : UnicodeString;
+ const ACollation : PUCA_DataBook
+) : Integer;
+begin
+ Result := IncrementalCompareString(
+ Pointer(AStrA),Length(AStrA),Pointer(AStrB),Length(AStrB),
+ ACollation
+ );
+end;
+
+function ComputeRawSortKeyNextItem(
+ const AContext : PComputeKeyContext
+) : Boolean;
+var
+ ctx : PComputeKeyContext;
+
+ procedure GrowKey(const AMinGrow : Integer = 0);inline;
+ begin
+ if (ctx^.rl < AMinGrow) then
+ ctx^.rl := ctx^.rl + AMinGrow
+ else
+ ctx^.rl := 2 * ctx^.rl;
+ SetLength(ctx^.r,ctx^.rl);
+ end;
+
+ procedure SaveKeyOwner();
+ var
+ k : Integer;
+ kppLevel : Byte;
+ begin
+ k := 0;
+ kppLevel := High(Byte);
+ while (k <= ctx^.locHistoryTop) do begin
+ if (kppLevel <> ctx^.locHistory[k].ppLevel) then begin
+ ctx^.LastKeyOwner.Chars[k] := ctx^.locHistory[k].cp;
+ kppLevel := ctx^.locHistory[k].ppLevel;
+ end;
+ k := k + 1;
+ end;
+ if (k = 0) or (kppLevel <> ctx^.ppLevel) then begin
+ ctx^.LastKeyOwner.Chars[k] := ctx^.cp;
+ k := k + 1;
+ end;
+ ctx^.LastKeyOwner.Length := k;
+ end;
+
+ procedure AddWeights(AItem : PUCA_PropItemRec);inline;
+ begin
+ SaveKeyOwner();
+ if ((ctx^.ral + AItem^.WeightLength) > ctx^.rl) then
+ GrowKey(AItem^.WeightLength);
+ AItem^.GetWeightArray(@ctx^.r[ctx^.ral]);
+ ctx^.ral := ctx^.ral + AItem^.WeightLength;
+ end;
+
+ procedure AddContextWeights(AItem : PUCA_PropItemContextRec);inline;
+ begin
+ if ((ctx^.ral + AItem^.WeightCount) > ctx^.rl) then
+ GrowKey(AItem^.WeightCount);
+ Move(AItem^.GetWeights()^,ctx^.r[ctx^.ral],(AItem^.WeightCount*SizeOf(ctx^.r[0])));
+ ctx^.ral := ctx^.ral + AItem^.WeightCount;
+ end;
+
+ procedure AddComputedWeights(ACodePoint : Cardinal);inline;
+ begin
+ SaveKeyOwner();
+ if ((ctx^.ral + 2) > ctx^.rl) then
+ GrowKey();
+ DeriveWeight(ACodePoint,@ctx^.r[ctx^.ral]);
+ ctx^.ral := ctx^.ral + 2;
+ end;
+
+ procedure RecordDeletion();inline;
+ begin
+ if ctx^.pp^.IsValid() and ctx^.pp^.IsDeleted() (*pp^.GetWeightLength() = 0*) then begin
+ if (ctx^.suppressState.cl = nil) or
+ (ctx^.suppressState.CharCount > ctx^.ppLevel)
+ then begin
+ ctx^.suppressState.cl := ctx^.cl;
+ ctx^.suppressState.CharCount := ctx^.ppLevel;
+ end;
+ end;
+ end;
+
+ procedure RecordStep();inline;
+ begin
+ Inc(ctx^.locHistoryTop);
+ ctx^.locHistory[ctx^.locHistoryTop].i := ctx^.i;
+ ctx^.locHistory[ctx^.locHistoryTop].cl := ctx^.cl;
+ ctx^.locHistory[ctx^.locHistoryTop].pp := ctx^.pp;
+ ctx^.locHistory[ctx^.locHistoryTop].ppLevel := ctx^.ppLevel;
+ ctx^.locHistory[ctx^.locHistoryTop].cp := ctx^.cp;
+ ctx^.locHistory[ctx^.locHistoryTop].removedCharIndexLength := ctx^.removedCharIndexLength;
+ RecordDeletion();
+ end;
+
+ procedure ClearHistory();inline;
+ begin
+ ctx^.locHistoryTop := -1;
+ end;
+
+ function HasHistory() : Boolean;inline;
+ begin
+ Result := (ctx^.locHistoryTop >= 0);
+ end;
+
+ function GetHistoryLength() : Integer;inline;
+ begin
+ Result := (ctx^.locHistoryTop + 1);
+ end;
+
+ procedure GoBack();inline;
+ begin
+ Assert(ctx^.locHistoryTop >= 0);
+ ctx^.i := ctx^.locHistory[ctx^.locHistoryTop].i;
+ ctx^.cp := ctx^.locHistory[ctx^.locHistoryTop].cp;
+ ctx^.cl := ctx^.locHistory[ctx^.locHistoryTop].cl;
+ ctx^.pp := ctx^.locHistory[ctx^.locHistoryTop].pp;
+ ctx^.ppLevel := ctx^.locHistory[ctx^.locHistoryTop].ppLevel;
+ ctx^.removedCharIndexLength := ctx^.locHistory[ctx^.locHistoryTop].removedCharIndexLength;
+ ctx^.ps := @ctx^.s[ctx^.i];
+ Dec(ctx^.locHistoryTop);
+ end;
+
+ function IsUnblockedNonstarter(const AStartFrom : Integer) : Boolean;
+ var
+ k : DWord;
+ pk : PUnicodeChar;
+ puk : PUC_Prop;
+ begin
+ k := AStartFrom;
+ if (k > ctx^.c) then
+ exit(False);
+ if (ctx^.removedCharIndexLength>0) and
+ (IndexDWord(ctx^.removedCharIndex[0],ctx^.removedCharIndexLength,k) >= 0)
+ then begin
+ exit(False);
+ end;
+ {if (k = (i+1)) or
+ ( (k = (i+2)) and UnicodeIsHighSurrogate(s[i]) )
+ then
+ lastUnblockedNonstarterCCC := 0;}
+ pk := @ctx^.s[k];
+ if UnicodeIsHighSurrogate(pk^) then begin
+ if (k = ctx^.c) then
+ exit(False);
+ if UnicodeIsLowSurrogate(pk[1]) then
+ puk := GetProps(pk[0],pk[1])
+ else
+ puk := GetProps(Word(pk^));
+ end else begin
+ puk := GetProps(Word(pk^));
+ end;
+ if (puk^.CCC = 0) or (ctx^.lastUnblockedNonstarterCCC >= puk^.CCC) then
+ exit(False);
+ ctx^.lastUnblockedNonstarterCCC := puk^.CCC;
+ Result := True;
+ end;
+
+ procedure RemoveChar(APos : Integer);inline;
+ begin
+ if (ctx^.removedCharIndexLength >= Length(ctx^.removedCharIndex)) then
+ SetLength(ctx^.removedCharIndex,(2*ctx^.removedCharIndexLength + 2));
+ ctx^.removedCharIndex[ctx^.removedCharIndexLength] := APos;
+ Inc(ctx^.removedCharIndexLength);
+ if UnicodeIsHighSurrogate(ctx^.s[APos]) and (APos < ctx^.c) and UnicodeIsLowSurrogate(ctx^.s[APos+1]) then begin
+ if (ctx^.removedCharIndexLength >= Length(ctx^.removedCharIndex)) then
+ SetLength(ctx^.removedCharIndex,(2*ctx^.removedCharIndexLength + 2));
+ ctx^.removedCharIndex[ctx^.removedCharIndexLength] := APos+1;
+ Inc(ctx^.removedCharIndexLength);
+ end;
+ end;
+
+ procedure Inc_I();inline;
+ begin
+ if (ctx^.removedCharIndexLength = 0) then begin
+ Inc(ctx^.i);
+ Inc(ctx^.ps);
+ exit;
+ end;
+ while True do begin
+ Inc(ctx^.i);
+ Inc(ctx^.ps);
+ if (IndexDWord(ctx^.removedCharIndex[0],ctx^.removedCharIndexLength,ctx^.i) = -1) then
+ Break;
+ end;
+ end;
+
+ function MoveToNextChar() : Boolean;inline;
+ begin
+ Result := True;
+ if UnicodeIsHighSurrogate(ctx^.ps[0]) then begin
+ if (ctx^.i = ctx^.c) then
+ exit(False);
+ if UnicodeIsLowSurrogate(ctx^.ps[1]) then begin
+ ctx^.surrogateState := True;
+ ctx^.cp := ToUCS4(ctx^.ps[0],ctx^.ps[1]);
+ end else begin
+ ctx^.surrogateState := False;
+ ctx^.cp := Word(ctx^.ps[0]);
+ end;
+ end else begin
+ ctx^.surrogateState := False;
+ ctx^.cp := Word(ctx^.ps[0]);
+ end;
+ end;
+
+ function FindPropUCA() : Boolean;
+ var
+ candidateCL : PUCA_DataBook;
+ begin
+ ctx^.pp := nil;
+ if (ctx^.cl = nil) then
+ candidateCL := ctx^.Collation
+ else
+ candidateCL := ctx^.cl;
+ if ctx^.surrogateState then begin
+ while (candidateCL <> nil) do begin
+ ctx^.pp := GetPropUCA(ctx^.ps[0],ctx^.ps[1],candidateCL);
+ if (ctx^.pp <> nil) then
+ break;
+ candidateCL := candidateCL^.Base;
+ end;
+ end else begin
+ while (candidateCL <> nil) do begin
+ ctx^.pp := GetPropUCA(ctx^.ps[0],candidateCL);
+ if (ctx^.pp <> nil) then
+ break;
+ candidateCL := candidateCL^.Base;
+ end;
+ end;
+ ctx^.cl := candidateCL;
+ Result := (ctx^.pp <> nil);
+ end;
+
+ procedure AddWeightsAndClear();inline;
+ var
+ ctxNode : PUCA_PropItemContextTreeNodeRec;
+ begin
+ if (ctx^.pp^.WeightLength > 0) then begin
+ AddWeights(ctx^.pp);
+ end else
+ if (ctx^.LastKeyOwner.Length > 0) and ctx^.pp^.Contextual and
+ ctx^.pp^.GetContext()^.Find(@ctx^.LastKeyOwner.Chars[0],ctx^.LastKeyOwner.Length,ctxNode) and
+ (ctxNode^.Data.WeightCount > 0)
+ then begin
+ AddContextWeights(@ctxNode^.Data);
+ end;
+ //AddWeights(pp);
+ ClearHistory();
+ ClearPP(ctx);
+ end;
+
+ function StartMatch() : Boolean;
+
+ procedure HandleLastChar();
+ var
+ ctxNode : PUCA_PropItemContextTreeNodeRec;
+ begin
+ while True do begin
+ if ctx^.pp^.IsValid() then begin
+ if (ctx^.pp^.WeightLength > 0) then
+ AddWeights(ctx^.pp)
+ else
+ if (ctx^.LastKeyOwner.Length > 0) and ctx^.pp^.Contextual and
+ ctx^.pp^.GetContext()^.Find(@ctx^.LastKeyOwner.Chars[0],ctx^.LastKeyOwner.Length,ctxNode) and
+ (ctxNode^.Data.WeightCount > 0)
+ then
+ AddContextWeights(@ctxNode^.Data)
+ else
+ AddComputedWeights(ctx^.cp){handle deletion of code point};
+ break;
+ end;
+ if (ctx^.cl^.Base = nil) then begin
+ AddComputedWeights(ctx^.cp);
+ break;
+ end;
+ ctx^.cl := ctx^.cl^.Base;
+ if not FindPropUCA() then begin
+ AddComputedWeights(ctx^.cp);
+ break;
+ end;
+ end;
+ end;
+ var
+ tmpCtxNode : PUCA_PropItemContextTreeNodeRec;
+ begin
+ Result := False;
+ ctx^.ppLevel := 0;
+ if not FindPropUCA() then begin
+ AddComputedWeights(ctx^.cp);
+ ClearHistory();
+ ClearPP(ctx);
+ Result := True;
+ end else begin
+ if (ctx^.i = ctx^.c) then begin
+ HandleLastChar();
+ Result := True;
+ end else begin
+ if ctx^.pp^.IsValid()then begin
+ if (ctx^.pp^.ChildCount = 0) then begin
+ if (ctx^.pp^.WeightLength > 0) then
+ AddWeights(ctx^.pp)
+ else
+ if (ctx^.LastKeyOwner.Length > 0) and ctx^.pp^.Contextual and
+ ctx^.pp^.GetContext()^.Find(@ctx^.LastKeyOwner.Chars[0],ctx^.LastKeyOwner.Length,tmpCtxNode) and
+ (tmpCtxNode^.Data.WeightCount > 0)
+ then
+ AddContextWeights(@tmpCtxNode^.Data)
+ else
+ AddComputedWeights(ctx^.cp){handle deletion of code point};
+ ClearPP(ctx);
+ ClearHistory();
+ Result := True;
+ end else begin
+ RecordStep();
+ end
+ end else begin
+ if (ctx^.pp^.ChildCount = 0) then begin
+ AddComputedWeights(ctx^.cp);
+ ClearPP(ctx);
+ ClearHistory();
+ Result := True;
+ end else begin
+ RecordStep();
+ end;
+ end;
+ end;
+ end;
+ end;
+
+ function TryPermutation() : Boolean;
+ var
+ kk : Integer;
+ b : Boolean;
+ puk : PUC_Prop;
+ ppk : PUCA_PropItemRec;
+ begin
+ Result := False;
+ puk := GetProps(ctx^.cp);
+ if (puk^.CCC = 0) then
+ exit;
+ ctx^.lastUnblockedNonstarterCCC := puk^.CCC;
+ if ctx^.surrogateState then
+ kk := ctx^.i + 2
+ else
+ kk := ctx^.i + 1;
+ while IsUnblockedNonstarter(kk) do begin
+ b := UnicodeIsHighSurrogate(ctx^.s[kk]) and (kk<ctx^.c) and UnicodeIsLowSurrogate(ctx^.s[kk+1]);
+ if b then
+ ppk := FindChild(ToUCS4(ctx^.s[kk],ctx^.s[kk+1]),ctx^.pp)
+ else
+ ppk := FindChild(Word(ctx^.s[kk]),ctx^.pp);
+ if (ppk <> nil) then begin
+ ctx^.pp := ppk;
+ RemoveChar(kk);
+ Inc(ctx^.ppLevel);
+ RecordStep();
+ Result := True;
+ if (ctx^.pp^.ChildCount = 0 ) then
+ Break;
+ end;
+ if b then
+ Inc(kk);
+ Inc(kk);
+ end;
+ end;
+
+ procedure AdvanceCharPos();inline;
+ begin
+ if UnicodeIsHighSurrogate(ctx^.ps[0]) and (ctx^.i<ctx^.c) and UnicodeIsLowSurrogate(ctx^.ps[1]) then begin
+ Inc(ctx^.i);
+ Inc(ctx^.ps);
+ end;
+ Inc_I();
+ end;
+
+var
+ ok : Boolean;
+ pp1 : PUCA_PropItemRec;
+ cltemp : PUCA_DataBook;
+ ctxNode : PUCA_PropItemContextTreeNodeRec;
+begin
+ if AContext^.Finished then
+ exit(False);
+ ctx := AContext;
+ while (ctx^.i <= ctx^.c) and MoveToNextChar() do begin
+ ok := False;
+ if (ctx^.pp = nil) then begin // Start Matching
+ ok := StartMatch();
+ end else begin
+ pp1 := FindChild(ctx^.cp,ctx^.pp);
+ if (pp1 <> nil) then begin
+ Inc(ctx^.ppLevel);
+ ctx^.pp := pp1;
+ if (ctx^.pp^.ChildCount = 0) or (ctx^.i = ctx^.c) then begin
+ ok := False;
+ if ctx^.pp^.IsValid() and (ctx^.suppressState.CharCount = 0) then begin
+ if (ctx^.pp^.WeightLength > 0) then begin
+ AddWeightsAndClear();
+ ok := True;
+ end else
+ if (ctx^.LastKeyOwner.Length > 0) and ctx^.pp^.Contextual and
+ ctx^.pp^.GetContext()^.Find(@ctx^.LastKeyOwner.Chars[0],ctx^.LastKeyOwner.Length,ctxNode) and
+ (ctxNode^.Data.WeightCount > 0)
+ then begin
+ AddContextWeights(@ctxNode^.Data);
+ ClearHistory();
+ ClearPP(ctx);
+ ok := True;
+ end
+ end;
+ if not ok then begin
+ RecordDeletion();
+ while HasHistory() do begin
+ GoBack();
+ if ctx^.pp^.IsValid() and
+ ( ( (ctx^.cl = ctx^.suppressState.cl) and (ctx^.ppLevel <> ctx^.suppressState.CharCount) ) or
+ ( (ctx^.cl <> ctx^.suppressState.cl) and (ctx^.ppLevel < ctx^.suppressState.CharCount) )
+ )
+ then begin
+ AddWeightsAndClear();
+ ok := True;
+ Break;
+ end;
+ end;
+ if not ok then begin
+ cltemp := ctx^.cl^.Base;
+ if (cltemp <> nil) then begin
+ ClearPP(ctx,False);
+ ctx^.cl := cltemp;
+ Continue;
+ end;
+ end;
+
+ if not ok then begin
+ AddComputedWeights(ctx^.cp);
+ ClearHistory();
+ ClearPP(ctx);
+ ok := True;
+ end;
+ end;
+ end else begin
+ RecordStep();
+ end;
+ end else begin
+ // permutations !
+ ok := False;
+ if TryPermutation() and ctx^.pp^.IsValid() then begin
+ if (ctx^.suppressState.CharCount = 0) then begin
+ AddWeightsAndClear();
+ ok := True;
+ exit(True);// Continue;
+ end;
+ while True do begin
+ if ctx^.pp^.IsValid() and
+ (ctx^.pp^.WeightLength > 0) and
+ ( ( (ctx^.cl = ctx^.suppressState.cl) and (ctx^.ppLevel <> ctx^.suppressState.CharCount) ) or
+ ( (ctx^.cl <> ctx^.suppressState.cl) and (ctx^.ppLevel < ctx^.suppressState.CharCount) )
+ )
+ then begin
+ AddWeightsAndClear();
+ ok := True;
+ break;
+ end;
+ if not HasHistory() then
+ break;
+ GoBack();
+ if (ctx^.pp = nil) then
+ break;
+ end;
+ end;
+ if not ok then begin
+ if ctx^.pp^.IsValid() and (ctx^.suppressState.CharCount = 0) then begin
+ if (ctx^.pp^.WeightLength > 0) then begin
+ AddWeightsAndClear();
+ ok := True;
+ end else
+ if (ctx^.LastKeyOwner.Length > 0) and ctx^.pp^.Contextual and
+ ctx^.pp^.GetContext()^.Find(@ctx^.LastKeyOwner.Chars[0],ctx^.LastKeyOwner.Length,ctxNode) and
+ (ctxNode^.Data.WeightCount > 0)
+ then begin
+ AddContextWeights(@ctxNode^.Data);
+ ClearHistory();
+ ClearPP(ctx);
+ ok := True;
+ end
+ end;
+ if ok then
+ exit(True);// Continue;
+ end;
+ if not ok then begin
+ if (ctx^.cl^.Base <> nil) then begin
+ cltemp := ctx^.cl^.Base;
+ while HasHistory() do
+ GoBack();
+ ctx^.pp := nil;
+ ctx^.ppLevel := 0;
+ ctx^.cl := cltemp;
+ Continue;
+ end;
+
+ //walk back
+ ok := False;
+ while HasHistory() do begin
+ GoBack();
+ if ctx^.pp^.IsValid() and
+ (ctx^.pp^.WeightLength > 0) and
+ ( (ctx^.suppressState.CharCount = 0) or
+ ( ( (ctx^.cl = ctx^.suppressState.cl) and (ctx^.ppLevel <> ctx^.suppressState.CharCount) ) or
+ ( (ctx^.cl <> ctx^.suppressState.cl) and (ctx^.ppLevel < ctx^.suppressState.CharCount) )
+ )
+ )
+ then begin
+ AddWeightsAndClear();
+ ok := True;
+ Break;
+ end;
+ end;
+ if ok then begin
+ AdvanceCharPos();
+ exit(True);// Continue;
+ end;
+ if (ctx^.pp <> nil) then begin
+ AddComputedWeights(ctx^.cp);
+ ClearHistory();
+ ClearPP(ctx);
+ ok := True;
+ end;
+ end;
+ end;
+ end;
+ if ctx^.surrogateState then begin
+ Inc(ctx^.ps);
+ Inc(ctx^.i);
+ end;
+ //
+ Inc_I();
+ if ok then
+ exit(True);
+ end;
+ SetLength(ctx^.r,ctx^.ral);
+ ctx^.Finished := True;
+ Result := True;
+end;
+
function ComputeSortKey(
const AStr : PUnicodeChar;
const ALength : SizeInt;
@@ -2143,14 +3412,7 @@ var
r : TUCA_PropWeightsArray;
begin
r := ComputeRawSortKey(AStr,ALength,ACollation);
- case ACollation^.VariableWeight of
- TUCA_VariableKind.ucaShifted : Result := FormKeyShifted(r,ACollation);
- TUCA_VariableKind.ucaBlanked : Result := FormKeyBlanked(r,ACollation);
- TUCA_VariableKind.ucaNonIgnorable : Result := FormKeyNonIgnorable(r,ACollation);
- TUCA_VariableKind.ucaShiftedTrimmed : Result := FormKeyShiftedTrimmed(r,ACollation);
- else
- Result := FormKeyShifted(r,ACollation);
- end;
+ Result := FormKey(r,ACollation);
end;
end.
diff --git a/rtl/os2/pmwsock.pas b/rtl/os2/pmwsock.pas
index 5a12f6f549..9891f2443f 100644
--- a/rtl/os2/pmwsock.pas
+++ b/rtl/os2/pmwsock.pas
@@ -52,17 +52,17 @@ type
Function __WSAFDIsSet(a: TSocket;var b: fdset): Longint; cdecl;
- external 'PMWSock' name '__WSAFDIsSet';
+ external 'PMWSock' index 151;
Function __WSAFDIsSet_(s:TSocket; var FDSet:TFDSet): Longint; cdecl;
- external 'PMWSock' name '__WSAFDIsSet';
+ external 'PMWSock' index 151;
Function __WSAFDIsSet2_(s:TSocket; var FDSet:TFDSet): boolean; cdecl;
- external 'PMWSock' name '__WSAFDIsSet';
+ external 'PMWSock' index 151;
Function FD_ISSET2(a: TSocket;var b: fdset): Longint; cdecl;
- external 'PMWSock' name '__WSAFDIsSet';
+ external 'PMWSock' index 151;
Function FD_ISSET(a: TSocket;var b: fdset): boolean; cdecl;
- external 'PMWSock' name '__WSAFDIsSet';
+ external 'PMWSock' index 151;
Procedure FD_CLR(ASocket: TSocket; var aset: fdset);
Procedure FD_SET(Socket:TSocket; var FDSet:TFDSet);
@@ -708,195 +708,195 @@ Const
// Socket function prototypes
Function accept(s: TSocket; Var addr; Var addrlen: LongInt): TSocket; cdecl;
- external 'PMWSock' name 'accept';
+ external 'PMWSock' index 1;
Function accept(s:TSocket; addr: PSockAddr; addrlen : PLongint) : TSocket; cdecl;
- external 'PMWSock' name 'accept';
+ external 'PMWSock' index 1;
Function accept(s:TSocket; addr: PSockAddr; var addrlen : Longint) : TSocket; cdecl;
- external 'PMWSock' name 'accept';
+ external 'PMWSock' index 1;
Function bind(s: TSocket; Const addr; namelen: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'bind';
+ external 'PMWSock' index 2;
Function bind(s:TSocket; addr: PSockaddr;namelen: Longint): Longint; cdecl;
- external 'PMWSock' name 'bind';
+ external 'PMWSock' index 2;
Function closesocket(s: TSocket): LongInt; cdecl;
- external 'PMWSock' name 'closesocket';
+ external 'PMWSock' index 3;
Function connect(s: TSocket; Const name: sockaddr; namelen: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'connect';
+ external 'PMWSock' index 4;
Function connect(s:TSocket; addr:PSockAddr; namelen: Longint): Longint; cdecl;
- external 'PMWSock' name 'connect';
+ external 'PMWSock' index 4;
Function ioctlsocket(s: TSocket; cmd: LongInt; Var argp: Cardinal): LongInt; cdecl;
- external 'PMWSock' name 'ioctlsocket';
+ external 'PMWSock' index 12;
Function ioctlsocket(s: TSocket; cmd: longint; var arg:longint): Longint; cdecl;
- external 'PMWSock' name 'ioctlsocket';
+ external 'PMWSock' index 12;
Function ioctlsocket(s: TSocket; cmd: longint; argp: PCardinal): Longint; cdecl;
- external 'PMWSock' name 'ioctlsocket';
+ external 'PMWSock' index 12;
Function getpeername(s: TSocket; Var name: sockaddr; Var nameLen: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'getpeername';
+ external 'PMWSock' index 5;
Function getsockname(s: TSocket;Var name: sockaddr; Var namelen: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'getsockname';
+ external 'PMWSock' index 6;
Function getsockopt(s: TSocket; level, optname: LongInt;Var optval; Var optlen: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'getsockopt';
+ external 'PMWSock' index 7;
Function getsockopt(s: TSocket; level: Longint; optname: Longint; optval:pchar;var optlen: Longint): Longint; cdecl;
- external 'PMWSock' name 'getsockopt';
+ external 'PMWSock' index 7;
Function htonl(hostlong: Cardinal): Cardinal; cdecl;
- external 'PMWSock' name 'htonl';
+ external 'PMWSock' index 8;
Function htons(hostshort: Word): Word; cdecl;
- external 'PMWSock' name 'htons';
+ external 'PMWSock' index 9;
Function inet_addr(cp: pchar): Cardinal; cdecl;
- external 'PMWSock' name 'inet_addr';
+ external 'PMWSock' index 10;
Function inet_ntoa(Var _in: in_addr): PChar; cdecl;
- external 'PMWSock' name 'inet_ntoa';
+ external 'PMWSock' index 11;
Function inet_ntoa(i: PInAddr): pchar; cdecl;
- external 'PMWSock' name 'inet_ntoa';
+ external 'PMWSock' index 11;
Function listen(s: TSocket; backlog: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'listen';
+ external 'PMWSock' index 13;
Function ntohl(netlong: Cardinal): Cardinal; cdecl;
- external 'PMWSock' name 'ntohl';
+ external 'PMWSock' index 14;
Function ntohs(netshort: Word): Word; cdecl;
- external 'PMWSock' name 'ntohs';
+ external 'PMWSock' index 15;
Function recv(s: TSocket;Var Buf; len, flags: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'recv';
+ external 'PMWSock' index 16;
Function recv(s: TSocket; buf:pchar; len: Longint; flags: Longint): Longint; cdecl;
- external 'PMWSock' name 'recv';
+ external 'PMWSock' index 16;
Function recvfrom(s: TSocket; Var Buf: PChar; len, flags:LongInt;
Var from: sockaddr; Var fromLen: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'recvfrom';
+ external 'PMWSock' index 17;
Function recvfrom(s: TSocket; buf:pchar; len: Longint; flags: Longint;
from: PSockAddr; fromlen: Longint): Longint; cdecl;
- external 'PMWSock' name 'recvfrom';
+ external 'PMWSock' index 17;
Function recvfrom(s: TSocket; var buf; len: Longint; flags: Longint;
Const from: TSockAddr; var fromlen: Longint): Longint; cdecl;
- external 'PMWSock' name 'recvfrom';
+ external 'PMWSock' index 17;
Function select(nfds: LongInt; Var readfds, writefds, exceptfds: fdset;
Const timeout: timeval): LongInt; cdecl;
- external 'PMWSock' name 'select';
+ external 'PMWSock' index 18;
Function select(nfds: Longint; readfds, writefds, exceptfds : PFDSet;
timeout: PTimeVal): Longint; cdecl;
- external 'PMWSock' name 'select';
+ external 'PMWSock' index 18;
Function send(s: TSocket; Const Buf: PChar; len, flags: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'send';
+ external 'PMWSock' index 19;
Function sendto(s: TSocket; Const Buf: PChar; len, flags: LongInt;
Const _to: sockaddr; tolen: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'sendto';
+ external 'PMWSock' index 20;
Function sendto(s: TSocket; buf: pchar; len: Longint; flags: Longint;
toaddr: PSockAddr; tolen: Longint): Longint; cdecl;
- external 'PMWSock' name 'sendto';
+ external 'PMWSock' index 20;
Function setsockopt(s: TSocket; level: Longint; optname: Longint;
optval: pchar; optlen: Longint): Longint; cdecl;
- external 'PMWSock' name 'setsockopt';
+ external 'PMWSock' index 21;
Function shutdown(s: TSocket; how: LongInt): LongInt; cdecl;
- external 'PMWSock' name 'shutdown';
+ external 'PMWSock' index 22;
Function socket(af, typ, protocol: LongInt): TSocket; cdecl;
- external 'PMWSock' name 'socket';
+ external 'PMWSock' index 23;
// Database function prototypes
Function gethostbyaddr(addr: pchar; len: Longint; t: Longint): PHostEnt; cdecl;
- external 'PMWSock' name 'gethostbyaddr';
+ external 'PMWSock' index 51;
Function gethostbyname(name: pchar): PHostEnt; cdecl;
- external 'PMWSock' name 'gethostbyname';
+ external 'PMWSock' index 52;
Function gethostname(name: pchar; namelen: Longint): Longint; cdecl;
- external 'PMWSock' name 'gethostname';
+ external 'PMWSock' index 57;
Function getservbyport(port: Longint; proto: pchar): PServEnt; cdecl;
- external 'PMWSock' name 'getservbyport';
+ external 'PMWSock' index 56;
Function getservbyname(name: pchar; proto: pchar): PServEnt; cdecl;
- external 'PMWSock' name 'getservbyname';
+ external 'PMWSock' index 55;
Function getprotobynumber(proto: LongInt): pprotoent; cdecl;
- external 'PMWSock' name 'getprotobynumber';
+ external 'PMWSock' index 54;
Function getprotobyname(name: pchar): PProtoEnt; cdecl;
- external 'PMWSock' name 'getprotobyname';
+ external 'PMWSock' index 53;
// Microsoft Windows Extension function prototypes
Function WSAStartup(wVersionRequired: Word;Var aWSAData: WSAData): LongInt; cdecl;
- external 'PMWSock' name 'WSAStartup';
+ external 'PMWSock' index 115;
Function WSACleanup: LongInt; cdecl;
- external 'PMWSock' name 'WSACleanup';
+ external 'PMWSock' index 116;
Procedure WSASetLastError(iError: LongInt); cdecl;
- external 'PMWSock' name 'WSASetLastError';
+ external 'PMWSock' index 112;
Function WSAGetLastError: LongInt; cdecl;
- external 'PMWSock' name 'WSAGetLastError';
+ external 'PMWSock' index 111;
Function WSAIsBlocking: Longbool; cdecl;
- external 'PMWSock' name 'WSAIsBlocking';
+ external 'PMWSock' index 114;
Function WSAUnhookBlockingHook: LongInt; cdecl;
- external 'PMWSock' name 'WSAUnhookBlockingHook';
+ external 'PMWSock' index 110;
Function WSASetBlockingHook(lpBlockFunc: Pointer): Pointer; cdecl;
- external 'PMWSock' name 'WSASetBlockingHook';
+ external 'PMWSock' index 109;
Function WSACancelBlockingCall: LongInt; cdecl;
- external 'PMWSock' name 'WSACancelBlockingCall';
+ external 'PMWSock' index 113;
Function WSAAsyncGetServByName(hWnd: HWND; wMsg: Cardinal;
name: pchar; proto: pchar;
buf: pchar;
buflen: Longint): Cardinal; cdecl;
- external 'PMWSock' name 'WSAAsyncGetServByName';
+ external 'PMWSock' index 107;
Function WSAAsyncGetServByPort(hWnd: HWND; wMsg: Cardinal;
port: Longint;
proto: pchar; buf: pchar;
buflen: Longint): Cardinal; cdecl;
- external 'PMWSock' name 'WSAAsyncGetServByPort';
+ external 'PMWSock' index 106;
Function WSAAsyncGetProtoByName(hWnd: HWND; wMsg: Cardinal;
name: pchar; buf: pchar;
buflen: Longint): Cardinal; cdecl;
- external 'PMWSock' name 'WSAAsyncGetProtoByName';
+ external 'PMWSock' index 105;
Function WSAAsyncGetProtoByNumber(hWnd: HWND; wMsg: Cardinal;
number: Longint;
buf: pchar;
buflen: Longint): Cardinal; cdecl;
- external 'PMWSock' name 'WSAAsyncGetProtoByNumber';
+ external 'PMWSock' index 104;
Function WSAAsyncGetHostByName(hWnd: HWND; wMsg: Cardinal;
name: pchar; buf: pchar;
buflen: Longint): Cardinal; cdecl;
- external 'PMWSock' name 'WSAAsyncGetHostByName';
+ external 'PMWSock' index 103;
Function WSAAsyncGetHostByAddr(hWnd: HWND; wMsg: Cardinal;
addr: pchar; len: Longint; t: Longint;
buf: pchar; buflen: Longint): Cardinal; cdecl;
- external 'PMWSock' name 'WSAAsyncGetHostByAddr';
+ external 'PMWSock' index 102;
Function WSACancelAsyncRequest(hAsyncTaskHandle: Cardinal): LongInt; cdecl;
- external 'PMWSock' name 'WSACancelAsyncRequest';
+ external 'PMWSock' index 108;
Function WSAAsyncSelect(s: TSocket; ahWnd: HWND; wMsg: Cardinal; lEvent: LongInt): Cardinal; cdecl;
- external 'PMWSock' name 'WSAAsyncSelect';
+ external 'PMWSock' index 101;
// Windows message parameter composition and decomposition
// macros.
diff --git a/rtl/win64/seh64.inc b/rtl/win64/seh64.inc
index c25e7cfbeb..c4411d6b44 100644
--- a/rtl/win64/seh64.inc
+++ b/rtl/win64/seh64.inc
@@ -304,6 +304,7 @@ begin
args[1]:=PtrUint(Obj);
args[2]:=GetBacktrace(ctx,AFrame,PPointer(args[3]));
RaiseException(FPC_EXCEPTION_CODE,EXCEPTION_NONCONTINUABLE,4,@args[0]);
+ result:=nil;
end;
procedure _fpc_local_unwind(frame,target: Pointer);[public,alias:'_FPC_local_unwind'];compilerproc;
@@ -429,7 +430,7 @@ var
begin
Adr:=rec.ExceptionInformation[0];
Obj:=TObject(rec.ExceptionInformation[1]);
- Framecount:=Longint(rec.ExceptionInformation[2]);
+ Framecount:=Longint(PtrUInt(rec.ExceptionInformation[2]));
Frames:=rec.ExceptionInformation[3];
if rec.ExceptionCode<>FPC_EXCEPTION_CODE then
diff --git a/rtl/x86_64/math.inc b/rtl/x86_64/math.inc
index f910dcd763..e88764cb8e 100644
--- a/rtl/x86_64/math.inc
+++ b/rtl/x86_64/math.inc
@@ -13,24 +13,13 @@
**********************************************************************}
-label
- FPC_ABSMASK_DOUBLE,
- FPC_ABSMASK_SINGLE;
-procedure dummyproc;assembler;nostackframe;
- asm
- .data
- .balign 16
- .globl FPC_ABSMASK_SINGLE
-FPC_ABSMASK_SINGLE:
- .quad 0x7FFFFFFF7FFFFFFF
- .quad 0x7FFFFFFF7FFFFFFF
- .globl FPC_ABSMASK_DOUBLE
-FPC_ABSMASK_DOUBLE:
- .quad 0x7FFFFFFFFFFFFFFF
- .quad 0x7FFFFFFFFFFFFFFF
- .text
- end;
+{$push}
+{$codealign constmin=16}
+const
+ FPC_ABSMASK_SINGLE: array[0..1] of qword=($7fffffff7fffffff,$7fffffff7fffffff); cvar; public;
+ FPC_ABSMASK_DOUBLE: array[0..1] of qword=($7fffffffffffffff,$7fffffffffffffff); cvar; public;
+{$pop}
{****************************************************************************
FPU Control word
diff --git a/rtl/x86_64/setjumph.inc b/rtl/x86_64/setjumph.inc
index c988185d0b..28e2bf258d 100644
--- a/rtl/x86_64/setjumph.inc
+++ b/rtl/x86_64/setjumph.inc
@@ -19,7 +19,7 @@ type
rbx,rbp,r12,r13,r14,r15,rsp,rip : qword;
{$ifdef win64}
rsi,rdi : qword;
- xmm6,xmm7,xmm8,xmm9,xmm10,xmm11,xmm12,xmm13,xmm14,xmm15: array [boolean] of qword;
+ xmm6,xmm7,xmm8,xmm9,xmm10,xmm11,xmm12,xmm13,xmm14,xmm15: record m1,m2: qword; end;
mxcsr: longword;
fpucw: word;
padding: word;
diff --git a/rtl/x86_64/x86_64.inc b/rtl/x86_64/x86_64.inc
index cfa0f5dfde..d75e2383db 100644
--- a/rtl/x86_64/x86_64.inc
+++ b/rtl/x86_64/x86_64.inc
@@ -673,9 +673,9 @@ function declocked(var l : longint) : boolean;assembler; nostackframe;
{ of time! }
{$ifdef FPC_PIC}
movq IsMultithread@GOTPCREL(%rip),%rax
- cmpb $0,(%rax)
+ cmpl $0,(%rax)
{$else FPC_PIC}
- cmpb $0,IsMultithread(%rip)
+ cmpl $0,IsMultithread(%rip)
{$endif FPC_PIC}
{$ifndef win64}
mov %rdi, %rcx
@@ -698,9 +698,9 @@ function declocked(var l : int64) : boolean;assembler; nostackframe;
{ of time! }
{$ifdef FPC_PIC}
movq IsMultithread@GOTPCREL(%rip),%rax
- cmpb $0,(%rax)
+ cmpl $0,(%rax)
{$else FPC_PIC}
- cmpb $0,IsMultithread(%rip)
+ cmpl $0,IsMultithread(%rip)
{$endif FPC_PIC}
{$ifndef win64}
mov %rdi, %rcx
@@ -724,9 +724,9 @@ procedure inclocked(var l : longint);assembler; nostackframe;
{ of time! }
{$ifdef FPC_PIC}
movq IsMultithread@GOTPCREL(%rip),%rax
- cmpb $0,(%rax)
+ cmpl $0,(%rax)
{$else FPC_PIC}
- cmpb $0,IsMultithread(%rip)
+ cmpl $0,IsMultithread(%rip)
{$endif FPC_PIC}
{$ifndef win64}
mov %rdi, %rcx
@@ -749,9 +749,9 @@ procedure inclocked(var l : int64);assembler; nostackframe;
{ of time! }
{$ifdef FPC_PIC}
movq IsMultithread@GOTPCREL(%rip),%rax
- cmpb $0,(%rax)
+ cmpl $0,(%rax)
{$else FPC_PIC}
- cmpb $0,IsMultithread(%rip)
+ cmpl $0,IsMultithread(%rip)
{$endif FPC_PIC}
{$ifndef win64}
mov %rdi, %rcx
View Lorry Controller Status