Skip to content

Commit

Permalink
update
Browse files Browse the repository at this point in the history
  • Loading branch information
paule32 committed Oct 17, 2024
1 parent 9fdbef5 commit 28f7584
Show file tree
Hide file tree
Showing 16 changed files with 596 additions and 790 deletions.
463 changes: 52 additions & 411 deletions build.bat

Large diffs are not rendered by default.

1 change: 0 additions & 1 deletion src/sources/fpc-qt/symbols.asm
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,6 @@

extern QString_Create_PChar

section .data
global VMT_$SYSTEM_$$_QSTRING
VMT_$SYSTEM_$$_QSTRING:
dq 0
Expand Down
18 changes: 18 additions & 0 deletions src/sources/fpc-rtl/RTL_List.pas
Original file line number Diff line number Diff line change
@@ -0,0 +1,18 @@
// ---------------------------------------------------------------------------
// File: FPC_List.pas
// Author: Jens Kallup - paule32
//
// This file is part of RTL.
//
// (c) Copyright 2024 Jens Kallup - paule32
// only for non-profit usage !!!
// ---------------------------------------------------------------------------
{$ifdef windows_header}
type
TList = class
end;

{$endif}

{$ifdef windows_source}
{$endif}
301 changes: 32 additions & 269 deletions src/sources/fpc-rtl/RTL_Memory.pas
Original file line number Diff line number Diff line change
@@ -1,272 +1,35 @@
unit RTL_Memory;
interface
procedure move(const source; var dest; count: DWord); stdcall; export;
implementation

procedure move(const source; var dest; count: DWord); [public, alias:'FPC_move']; assembler; nostackframe; stdcall;
asm
mov %r8, %rax
sub %rdx, %rcx { rcx = src - dest }
jz .Lquit { exit if src=dest }
jnb .L1 { src>dest => forward move }

add %rcx, %rax { rcx is negative => r8+rcx > 0 if regions overlap }
jb .Lback { if no overlap, still do forward move }

.L1:
cmp $8, %r8
jl .Lless8f { signed compare, negative count not allowed }
test $7, %dl
je .Ldestaligned

test $1, %dl { align dest by moving first 1+2+4 bytes }
je .L2f
mov (%rcx,%rdx,1),%al
dec %r8
mov %al, (%rdx)
add $1, %rdx
.L2f:
test $2, %dl
je .L4f
mov (%rcx,%rdx,1),%ax
sub $2, %r8
mov %ax, (%rdx)
add $2, %rdx
.L4f:
test $4, %dl
je .Ldestaligned
mov (%rcx,%rdx,1),%eax
sub $4, %r8
mov %eax, (%rdx)
add $4, %rdx

.Ldestaligned:
mov %r8, %r9
shr $5, %r9
jne .Lmore32

.Ltail:
mov %r8, %r9
shr $3, %r9
je .Lless8f

.balign 16
.Lloop8f: { max. 8 iterations }
mov (%rcx,%rdx,1),%rax
mov %rax, (%rdx)
add $8, %rdx
dec %r9
jne .Lloop8f
and $7, %r8

.Lless8f:
test %r8, %r8
jle .Lquit

.balign 16
.Lloop1f:
mov (%rcx,%rdx,1),%al
mov %al,(%rdx)
inc %rdx
dec %r8
jne .Lloop1f
.Lquit:
retq


.Lmore32:
cmp $0x2000, %r9 { this limit must be processor-specific (1/2 L2 cache size) }
jnae .Lloop32
cmp $0x1000, %rcx { but don't bother bypassing cache if src and dest }
jnb .Lntloopf { are close to each other}

.balign 16
.Lloop32:
add $32,%rdx
mov -32(%rcx,%rdx,1),%rax
mov -24(%rcx,%rdx,1),%r10
mov %rax,-32(%rdx)
mov %r10,-24(%rdx)
dec %r9
mov -16(%rcx,%rdx,1),%rax
mov -8(%rcx,%rdx,1),%r10
mov %rax,-16(%rdx)
mov %r10,-8(%rdx)
jne .Lloop32

and $0x1f, %r8
jmpq .Ltail

.Lntloopf:
mov $32, %eax

.balign 16
.Lpref:
prefetchnta (%rcx,%rdx,1)
prefetchnta 0x40(%rcx,%rdx,1)
add $0x80, %rdx
dec %eax
jne .Lpref

sub $0x1000, %rdx
mov $64, %eax

.balign 16
.Loop64:
add $64, %rdx
mov -64(%rcx,%rdx,1), %r9
mov -56(%rcx,%rdx,1), %r10
movnti %r9, -64(%rdx)
movnti %r10, -56(%rdx)

mov -48(%rcx,%rdx,1), %r9
mov -40(%rcx,%rdx,1), %r10
movnti %r9, -48(%rdx)
movnti %r10, -40(%rdx)
dec %eax
mov -32(%rcx,%rdx,1), %r9
mov -24(%rcx,%rdx,1), %r10
movnti %r9, -32(%rdx)
movnti %r10, -24(%rdx)

mov -16(%rcx,%rdx,1), %r9
mov -8(%rcx,%rdx,1), %r10
movnti %r9, -16(%rdx)
movnti %r10, -8(%rdx)
jne .Loop64

sub $0x1000, %r8
cmp $0x1000, %r8
jae .Lntloopf

mfence
jmpq .Ldestaligned { go handle remaining bytes }

{ backwards move }
.Lback:
add %r8, %rdx { points to the end of dest }
cmp $8, %r8
jl .Lless8b { signed compare, negative count not allowed }
test $7, %dl
je .Ldestalignedb
test $1, %dl
je .L2b
dec %rdx
mov (%rcx,%rdx,1), %al
dec %r8
mov %al, (%rdx)
.L2b:
test $2, %dl
je .L4b
sub $2, %rdx
mov (%rcx,%rdx,1), %ax
sub $2, %r8
mov %ax, (%rdx)
.L4b:
test $4, %dl
je .Ldestalignedb
sub $4, %rdx
mov (%rcx,%rdx,1), %eax
sub $4, %r8
mov %eax, (%rdx)

.Ldestalignedb:
mov %r8, %r9
shr $5, %r9
jne .Lmore32b

.Ltailb:
mov %r8, %r9
shr $3, %r9
je .Lless8b

.Lloop8b:
sub $8, %rdx
mov (%rcx,%rdx,1), %rax
dec %r9
mov %rax, (%rdx)
jne .Lloop8b
and $7, %r8

.Lless8b:
test %r8, %r8
jle .Lquit2

.balign 16
.Lsmallb:
dec %rdx
mov (%rcx,%rdx,1), %al
dec %r8
mov %al,(%rdx)
jnz .Lsmallb
.Lquit2:
retq

.Lmore32b:
cmp $0x2000, %r9
jnae .Lloop32b
cmp $0xfffffffffffff000,%rcx
jb .Lntloopb

.balign 16
.Lloop32b:
sub $32, %rdx
mov 24(%rcx,%rdx,1), %rax
mov 16(%rcx,%rdx,1), %r10
mov %rax, 24(%rdx)
mov %r10, 16(%rdx)
dec %r9
mov 8(%rcx,%rdx,1),%rax
mov (%rcx,%rdx,1), %r10
mov %rax, 8(%rdx)
mov %r10, (%rdx)
jne .Lloop32b
and $0x1f, %r8
jmpq .Ltailb

.Lntloopb:
mov $32, %eax

.balign 16
.Lprefb:
sub $0x80, %rdx
prefetchnta (%rcx,%rdx,1)
prefetchnta 0x40(%rcx,%rdx,1)
dec %eax
jnz .Lprefb

add $0x1000, %rdx
mov $0x40, %eax

.balign 16
.Lloop64b:
sub $64, %rdx
mov 56(%rcx,%rdx,1), %r9
mov 48(%rcx,%rdx,1), %r10
movnti %r9, 56(%rdx)
movnti %r10, 48(%rdx)

mov 40(%rcx,%rdx,1), %r9
mov 32(%rcx,%rdx,1), %r10
movnti %r9, 40(%rdx)
movnti %r10, 32(%rdx)
dec %eax
mov 24(%rcx,%rdx,1), %r9
mov 16(%rcx,%rdx,1), %r10
movnti %r9, 24(%rdx)
movnti %r10, 16(%rdx)

mov 8(%rcx,%rdx,1), %r9
mov (%rcx,%rdx,1), %r10
movnti %r9, 8(%rdx)
movnti %r10, (%rdx)
jne .Lloop64b
// ---------------------------------------------------------------------------
// File: FPC_Memory.pas
// Author: Jens Kallup - paule32
//
// This file is part of RTL.
//
// (c) Copyright 2024 Jens Kallup - paule32
// only for non-profit usage !!!
// ---------------------------------------------------------------------------
{$ifdef windows_header}
TAnsiStringMemoryManager = class
private
FMemoryPool: TList;
public
constructor Create;
destructor Destroy;
end;
{$endif}

{$ifdef windows_source}
constructor TAnsiStringMemoryManager.Create;
begin
MessageBox(0,'AnsiManager create','info',0);
inherited Create;
FMemoryPool := TList.Create;
end;

sub $0x1000, %r8
cmp $0x1000, %r8
jae .Lntloopb
mfence
jmpq .Ldestalignedb
destructor TAnsiStringMemoryManager.Destroy;
begin
MessageBox(0,'AnsiManager destroy','info',0);
FMemoryPool.Free;
inherited Destroy;
end;

end.
{$endif}
6 changes: 6 additions & 0 deletions src/sources/fpc-rtl/RTL_Object.pas
Original file line number Diff line number Diff line change
Expand Up @@ -35,10 +35,12 @@ TObject = class
// ---------------------------------------------------------------------------
constructor TObject.Create;
begin
MessageBox(0,'tobject create','info',0);
end;

destructor TObject.Destroy;
begin
MessageBox(0,'tobject destroy','info',0);
end;
procedure TObject.AfterConstruction;
begin
Expand All @@ -61,6 +63,10 @@ procedure TObject.FreeInstance;
begin
end;

function SafeCallException( obj: codepointer; exceptaddr: codepointer ): HResult;
begin
end;

function TObject.SafeCallException(exceptobject : tobject; exceptaddr : codepointer) : HResult;
begin
result := 1;
Expand Down
33 changes: 33 additions & 0 deletions src/sources/fpc-rtl/vmt.asm
Original file line number Diff line number Diff line change
@@ -0,0 +1,33 @@
; ---------------------------------------------------------------------------
; File: vmt.asm
; Author: Jens Kallup - paule32
;
; This file is part of Qt RTL.
;
; (c) Copyright 2024 Jens Kallup - paule32
; only for non-profit usage !!!
; ---------------------------------------------------------------------------

section .data

;global VMT_$SYSTEM_$$_TLIST
;VMT_$SYSTEM_$$_TLIST:
; dq 0

global VMT_$QT_STRING_$$_QSTRING
VMT_$QT_STRING_$$_QSTRING:
dq 0
;global VMT_$SYSTEM_$$_TANSISTRINGMEMORYMANAGER
;VMT_$SYSTEM_$$_TANSISTRINGMEMORYMANAGER:
; dq 0


section .code
global QT_STRING$_$QSTRING_$__$$_CREATE$PCHAR$$QSTRING
QT_STRING$_$QSTRING_$__$$_CREATE$PCHAR$$QSTRING:
ret
;global SYSTEM$_$TANSISTRINGMEMORYMANAGER_$__$$_CREATE$$TANSISTRINGMEMORYMANAGER
;SYSTEM$_$TANSISTRINGMEMORYMANAGER_$__$$_CREATE$$TANSISTRINGMEMORYMANAGER:
; ret
Loading

0 comments on commit 28f7584

Please sign in to comment.