From 0a9b79dd30a7117627a88f2cf4534a213427bf27 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Wed, 1 Jul 2026 09:49:30 +0100 Subject: [PATCH] feat(rtl): FreeBSD libc-free threads + TLS (Step 4c) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit The last Step-4 slice: real POSIX threads for a static FreeBSD build, plus the TLS setup Step 3 deferred (threads need per-thread %fs TLS, and the main thread needs it too for threadvar access). runtime.syscall.freebsd gains four FreeBSD-specific leaves (all numbers verified against release/14.0.0 sys/sys/syscall.h): sysarch=165 (set the %fs base for TLS via AMD64_SET_FSBASE=129, passing a POINTER to the base value), _umtx_op=454 (the futex analogue), thr_new=455 (the clone analogue), thr_exit=431 (terminate ONE thread — NOT exit(2)/SYS_exit, which kills the process). runtime.start.static.freebsd gains the full TLS machinery from its Linux sibling: the auxv PT_TLS walk (AT_PHDR/PHENT/PHNUM and PT_TLS are the same values on FreeBSD as Linux), the variant-II block build, BuildThreadTLS/ FreeThreadTLS, and _BlaiseStartC now calls SetupTLS(auxv) before main. The one difference from Linux: the %fs base is set via sysarch(AMD64_SET_FSBASE, @base) rather than arch_prctl(ARCH_SET_FS, base). runtime.thread.static.freebsd (new) is the FreeBSD sibling of runtime.thread.static.linux — it DEFINES the bare pthread_* names the RTL imports. The 3-state Drepper mutex (CAS/Xchg) is target-invariant and copied verbatim; only the wait/wake primitive is swapped futex -> _umtx_op(UMTX_OP_WAIT_UINT_PRIVATE=15 / WAKE_PRIVATE=16). Thread create fills a 104-byte struct thr_param at the amd64 offsets (start_func@0 arg@8 stack_base@16 stack_size@24 tls_base@32 tls_size@40 child_tid@48 parent_tid@56 flags@64 rtp@72), memset-zeroed first so flags/ rtp/spare are 0, and calls thr_new. child_tid/parent_tid point at an Int64 (FreeBSD long*, not Linux's 4-byte). FreeBSD has no CLONE_CHILD_CLEARTID, so join uses a dedicated JoinWord: the child trampoline runs StartRoutine, sets JoinWord:=1, _umtx_op-wakes it, then thr_exit(nil); pthread_join _umtx_op-waits while JoinWord=0. Both new/edited units are standalone (nothing in the Linux build graph uses them), so the Linux self-host is untouched. Test TestLink_FreeBSDThreadLeaf_SyscallNumbers asserts thr_new(455)/_umtx_op (454)/thr_exit(431) bytes are present and Linux's clone(56)/futex(202) are absent. Step 4 (the FreeBSD syscall leaf) is now complete. --- .../pascal/runtime.start.static.freebsd.pas | 236 ++++++++++++- .../main/pascal/runtime.syscall.freebsd.pas | 78 +++++ .../pascal/runtime.thread.static.freebsd.pas | 312 ++++++++++++++++++ compiler/src/test/pascal/cp.test.linker.pas | 81 +++++ 4 files changed, 696 insertions(+), 11 deletions(-) create mode 100644 compiler/src/main/pascal/runtime.thread.static.freebsd.pas diff --git a/compiler/src/main/pascal/runtime.start.static.freebsd.pas b/compiler/src/main/pascal/runtime.start.static.freebsd.pas index 00e2700..b5902e4 100644 --- a/compiler/src/main/pascal/runtime.start.static.freebsd.pas +++ b/compiler/src/main/pascal/runtime.start.static.freebsd.pas @@ -9,38 +9,243 @@ unit runtime.start.static.freebsd; // Freestanding _start for a static, libc-free FreeBSD ET_EXEC (the FreeBSD -// kernel-leaf swap; docs/freebsd-x86_64-backend-design.adoc, Step 3). +// kernel-leaf swap; docs/freebsd-x86_64-backend-design.adoc, Step 3/4c). // // The FreeBSD sibling of runtime.start.static.linux. A tiny asm trampoline // captures the initial stack pointer and tail-calls the Pascal _BlaiseStartC, -// which parses argc / argv / envp off the kernel's initial stack, captures -// `environ`, calls main(argc, argv), and exits via the FreeBSD `exit` syscall. +// which: +// 1. parses argc / argv / envp / the auxv (the kernel's initial stack); +// 2. sets up the static TLS block and the thread pointer (%fs) — required +// before any threadvar (%fs-relative) access, which a static binary's +// kernel does NOT do for us; +// 3. captures `environ`; +// 4. calls main(argc, argv); +// 5. exits via the FreeBSD `exit` syscall (main itself calls exit, so this +// is a guard). // // FreeBSD's process entry stack has the SAME shape as Linux: %rsp points at // argc, followed by argv[0..argc-1], a NULL, envp[], a NULL, then the ELF auxv. // (FreeBSD additionally passes an rtld cleanup pointer in %rdx for dynamic // binaries; it is 0 for a static ET_EXEC and we ignore it.) // -// Step 3 is deliberately minimal: it does NOT set up TLS / the thread pointer. -// A trivial program performs no threadvar (%fs-relative) access, so this start -// runs hello-world and file I/O. TLS-block construction + the auxv PT_TLS walk -// (whose FreeBSD AT_* tags differ from Linux) arrive with the threads leaf in -// Step 4, mirroring how runtime.start.static.linux gained TLS alongside its -// threads work. +// The ELF auxv PT_TLS walk is PORTABLE: the AT_* tags (AT_PHDR=3, AT_PHENT=4, +// AT_PHNUM=5, AT_NULL=0) and PT_TLS=7 are identical on FreeBSD 14 (elf_common.h) +// and Linux, and x86-64 TLS is variant II on both. The ONE FreeBSD difference +// is how the %fs base is installed: Linux uses arch_prctl(ARCH_SET_FS, tp); +// FreeBSD uses sysarch(AMD64_SET_FSBASE, &tp) — note it takes a POINTER to the +// base value, not the value itself. +// +// x86-64 TLS (variant II): the thread pointer points at the TCB, which sits +// ABOVE the TLS block; threadvars are at negative offsets from the TP. %fs:0 +// must hold the TP value itself (the TCB self-pointer). Layout we build: +// [ TLS block: memsz bytes ][ TCB: 8-byte self-pointer ] +// tp = block + memsz_aligned ; %fs = tp ; *(void**)tp = tp. interface uses - runtime.syscall.freebsd; { _exit + the `environ` global } + runtime.syscall.freebsd; { _exit, sysarch, mmap/munmap + the `environ` global } procedure _start; +{ The static TLS template, captured from PT_TLS at startup so each spawned thread + can build its own TLS block (runtime.thread.static.freebsd uses these via + thr_new's tls_base parameter). Zero TlsMemSz means the program has no + thread-local storage. } +var + GTlsInitAddr: Pointer; { .tdata init image (= PT_TLS p_vaddr) } + GTlsFileSz: Int64; { bytes to copy from the init image } + GTlsMemSz: Int64; { total TLS size (.tdata + .tbss) } + GTlsAlign: Int64; { PT_TLS alignment } + +{ Build a fresh TLS block for a new thread and return its thread pointer (the + value thr_new installs as the new thread's %fs base via tls_base). Layout + matches _start's SetupTLS: aligned TLS data followed by the TCB self-pointer. + Returns nil when the program has no TLS. } +function BuildThreadTLS: Pointer; + +{ Unmap a TLS block created by BuildThreadTLS, given the thread pointer it + returned. Used to reclaim the block when thread creation fails after the TLS + was built (the offset from TP back to the mmap base is the same alignment math + BuildThreadTLS used, kept here so both sides agree). } +procedure FreeThreadTLS(ATp: Pointer); + +{ The total size of a per-thread TLS block (aligned memsz + the TCB slot), which + thr_new wants as tls_size. Returns 0 when the program has no TLS. } +function ThreadTLSSize: Int64; + implementation type PPointer = ^Pointer; PInt64 = ^Int64; +const + AMD64_SET_FSBASE = 129; { sysarch op — install the %fs base (verified vs + FreeBSD 14 x86/include/sysarch.h) } + PROT_RW = 3; { PROT_READ or PROT_WRITE } + MAP_PRIVANON = $1002; { FreeBSD MAP_PRIVATE ($0002) or MAP_ANON ($1000) } + AT_NULL = 0; + AT_PHDR = 3; + AT_PHENT = 4; + AT_PHNUM = 5; + PT_TLS = 7; + +{ ELF64 Phdr field offsets. } + PH_TYPE = 0; { p_type (u32) } + PH_OFFSET = 8; { p_offset (u64) - file offset; == vaddr-base in our images } + PH_VADDR = 16; { p_vaddr (u64) } + PH_FILESZ = 32; { p_filesz (u64) } + PH_MEMSZ = 40; { p_memsz (u64) } + PH_ALIGN = 48; { p_align (u64) } + +{ Round X up to the next multiple of A (A a power of two, >= 1). } +function AlignUp(X, A: Int64): Int64; +begin + if A < 1 then A := 1; + Result := (X + A - 1) and (not (A - 1)); +end; + +{ Install the %fs base to Tp. FreeBSD: sysarch(AMD64_SET_FSBASE, &Tp) — the + syscall takes the ADDRESS of the base value, not the value. } +procedure SetFsBase(Tp: Pointer); +var + Base: Pointer; +begin + Base := Tp; + sysarch(AMD64_SET_FSBASE, @Base); +end; + +{ Walk the auxv for PT_TLS via AT_PHDR/AT_PHENT/AT_PHNUM, then build the static + TLS block and set the thread pointer. Auxv is an array of (Int64 tag, Int64 + val) pairs terminated by AT_NULL. No-op when the program has no TLS. } +procedure SetupTLS(Auxv: Pointer); +var + P: PInt64; + PhdrAddr, PhEnt, PhNum: Int64; + I, Tag, Val: Int64; + Ph: PChar; + TlsVaddr, TlsFileSz, TlsMemSz, TlsAlign: Int64; + PType: ^Integer; + Block, Tp: Pointer; + BlockSize: Int64; + J: Int64; + Src, Dst: PChar; + TpSlot: PPointer; +begin + PhdrAddr := 0; PhEnt := 56; PhNum := 0; + P := PInt64(Auxv); + while True do + begin + Tag := P^; + P := PInt64(Pointer(PChar(P) + 8)); + Val := P^; + P := PInt64(Pointer(PChar(P) + 8)); + if Tag = AT_NULL then Break; + if Tag = AT_PHDR then PhdrAddr := Val; + if Tag = AT_PHENT then PhEnt := Val; + if Tag = AT_PHNUM then PhNum := Val; + end; + if PhdrAddr = 0 then Exit; + + { Find PT_TLS among the program headers. } + TlsVaddr := 0; TlsFileSz := 0; TlsMemSz := 0; TlsAlign := 8; + I := 0; + while I < PhNum do + begin + Ph := PChar(Pointer(PhdrAddr + I * PhEnt)); + PType := Pointer(Ph + PH_TYPE); + if PType^ = PT_TLS then + begin + TlsVaddr := PInt64(Pointer(Ph + PH_VADDR))^; + TlsFileSz := PInt64(Pointer(Ph + PH_FILESZ))^; + TlsMemSz := PInt64(Pointer(Ph + PH_MEMSZ))^; + TlsAlign := PInt64(Pointer(Ph + PH_ALIGN))^; + Break; + end; + I := I + 1; + end; + if TlsMemSz = 0 then Exit; + + { Stash the template so BuildThreadTLS can reproduce this block per thread. } + GTlsInitAddr := Pointer(TlsVaddr); + GTlsFileSz := TlsFileSz; + GTlsMemSz := TlsMemSz; + GTlsAlign := TlsAlign; + + { Allocate block = aligned(memsz) + 16 (TCB self-pointer + slack). mmap + zero-fills. } + BlockSize := AlignUp(TlsMemSz, TlsAlign) + 16; + Block := mmap(nil, BlockSize, PROT_RW, MAP_PRIVANON, -1, 0); + if Int64(Block) < 0 then Exit; + + { Copy the .tdata init image to the start of the block; .tbss stays zero. } + Src := PChar(Pointer(TlsVaddr)); + Dst := PChar(Block); + J := 0; + while J < TlsFileSz do + begin + Dst[J] := Src[J]; + J := J + 1; + end; + + { Thread pointer sits just past the TLS data (variant II); store the TCB + self-pointer at *tp and set %fs. } + Tp := Pointer(PChar(Block) + AlignUp(TlsMemSz, TlsAlign)); + TpSlot := PPointer(Tp); + TpSlot^ := Tp; + SetFsBase(Tp); +end; + +{ Build a per-thread TLS block from the template captured at startup and return + its thread pointer. Mirrors SetupTLS's block construction (variant II: TLS + data, then the TCB self-pointer at the thread pointer). On FreeBSD the caller + installs the returned TP as the new thread's %fs base via thr_new's tls_base. } +function BuildThreadTLS: Pointer; +var + Block, Tp: Pointer; + BlockSize, J: Int64; + Src, Dst: PChar; + TpSlot: PPointer; +begin + Result := nil; + if GTlsMemSz = 0 then Exit; + BlockSize := AlignUp(GTlsMemSz, GTlsAlign) + 16; + Block := mmap(nil, BlockSize, PROT_RW, MAP_PRIVANON, -1, 0); + if Int64(Block) < 0 then Exit; + Src := PChar(GTlsInitAddr); + Dst := PChar(Block); + J := 0; + while J < GTlsFileSz do + begin + Dst[J] := Src[J]; + J := J + 1; + end; + Tp := Pointer(PChar(Block) + AlignUp(GTlsMemSz, GTlsAlign)); + TpSlot := PPointer(Tp); + TpSlot^ := Tp; + Result := Tp; +end; + +procedure FreeThreadTLS(ATp: Pointer); +var + Block: Pointer; + BlockSize: Int64; +begin + if (ATp = nil) or (GTlsMemSz = 0) then Exit; + Block := Pointer(PChar(ATp) - AlignUp(GTlsMemSz, GTlsAlign)); + BlockSize := AlignUp(GTlsMemSz, GTlsAlign) + 16; + munmap(Block, BlockSize); +end; + +function ThreadTLSSize: Int64; +begin + if GTlsMemSz = 0 then + Result := 0 + else + Result := AlignUp(GTlsMemSz, GTlsAlign) + 16; +end; + { Call the program's `main(argc, argv)` (emitted by the backend) and return its result. The asm thunk tail-jumps to the bare `main` symbol; argc/argv are already in %edi/%rsi (SysV), exactly what main expects. } @@ -54,7 +259,8 @@ end; procedure _BlaiseStartC(SP: Pointer); var Argc: Int64; - Argv, Envp: Pointer; + Argv, Envp, Auxv: Pointer; + I: Int64; Ret: Integer; begin Argc := PInt64(SP)^; @@ -62,6 +268,14 @@ begin { envp = &argv[argc+1] } Envp := Pointer(PChar(Argv) + (Argc + 1) * 8); environ := Envp; + { auxv follows envp's NULL terminator. } + Auxv := Envp; + I := 0; + while PPointer(Pointer(PChar(Auxv) + I * 8))^ <> nil do + I := I + 1; + Auxv := Pointer(PChar(Auxv) + (I + 1) * 8); + + SetupTLS(Auxv); Ret := MainTrampoline(Integer(Argc), Argv); _exit(Ret); diff --git a/compiler/src/main/pascal/runtime.syscall.freebsd.pas b/compiler/src/main/pascal/runtime.syscall.freebsd.pas index fa8527a..2fc0dfd 100644 --- a/compiler/src/main/pascal/runtime.syscall.freebsd.pas +++ b/compiler/src/main/pascal/runtime.syscall.freebsd.pas @@ -111,6 +111,32 @@ function getrandom(Buf: Pointer; Count: Int64; Flags: Integer): Int64; wrapper in the posix layer adapts that to libc's buffer-pointer contract. } function sys_getcwd(Buf: PChar; Size: Int64): Int64; +{ Threads + TLS (Step 4c) — the FreeBSD primitives runtime.thread.static.freebsd + and runtime.start.static.freebsd build on. These have no Linux equivalents + (Linux uses clone/futex/arch_prctl); the numbers are FreeBSD-specific. } + +{ sysarch(op, parms) — SYS 165. The FreeBSD way to set the %fs base for TLS: + op = AMD64_SET_FSBASE (129), parms = a POINTER to the base value (NOT the value + itself). Returns 0 on success or -errno (CF-translated). } +function sysarch(Op: Integer; Parms: Pointer): Integer; + +{ _umtx_op(obj, op, val, uaddr, uaddr2) — SYS 454. The FreeBSD futex analogue. + op = UMTX_OP_WAIT_UINT_PRIVATE (15) blocks while obj^ = val (returns at once if + obj^ <> val, like futex); op = UMTX_OP_WAKE_PRIVATE (16) wakes up to val waiters + on obj. 5-arg syscall: arg4 (uaddr) arrives in %rcx -> moved to %r10. } +function _umtx_op(Obj: Pointer; Op, Val: Integer; Uaddr, Uaddr2: Pointer): Integer; + +{ thr_new(param, param_size) — SYS 455. Creates a new thread from a filled-in + `struct thr_param` (param_size = sizeof = 104 on amd64). The FreeBSD analogue + of clone(2). Returns 0 on success or -errno. } +function thr_new(Param: Pointer; ParamSize: Integer): Integer; + +{ thr_exit(state) — SYS 431. Terminates JUST the calling thread (NOT the whole + process — that is exit(2)/SYS_exit). If state is non-nil the kernel writes 1 + there and _umtx_op-wakes it; we clear/wake the join word ourselves and pass nil. + Never returns. } +procedure thr_exit(State: Pointer); + { _exit(2) — SYS_exit = 1. Terminates the process; never returns. The unit-level routine name `_exit` already emits the unmangled `_exit` symbol that satisfies posix's `external name '_exit'`. } @@ -157,6 +183,10 @@ const SYS_fstatat = 552; { ino64 (legacy freebsd11_fstatat = 493) } SYS_pipe2 = 542; { pipe(2) legacy 42 deprecated } SYS_execve = 59; + SYS_sysarch = 165; { %fs-base setup for TLS (AMD64_SET_FSBASE) } + SYS_thr_exit = 431; { terminate ONE thread (NOT exit(2)) } + SYS_umtx_op = 454; { the FreeBSD futex analogue } + SYS_thr_new = 455; { the FreeBSD clone(2) analogue } AT_FDCWD = -100; { dirfd for path-relative *at() syscalls at cwd } { The asm bodies use literal immediates (the assembler needs a literal, not a symbol); the const block above documents the number-to-name mapping. } @@ -474,6 +504,54 @@ asm ret end; +{ sysarch(op, parms) — 2 args, both in %rdi/%rsi already; SYS 165. Used with + AMD64_SET_FSBASE to set the %fs base to the thread pointer. } +function sysarch(Op: Integer; Parms: Pointer): Integer; + assembler; nostackframe; +asm + movq $165, %rax { SYS_sysarch } + syscall + jae .Lok_sysarch + negq %rax +.Lok_sysarch: + ret +end; + +{ _umtx_op(obj, op, val, uaddr, uaddr2) — 5 args; arg4 (uaddr) arrives in %rcx + (C ABI) but the kernel wants it in %r10. Move it before the syscall. SYS 454. } +function _umtx_op(Obj: Pointer; Op, Val: Integer; Uaddr, Uaddr2: Pointer): Integer; + assembler; nostackframe; +asm + movq %rcx, %r10 + movq $454, %rax { SYS__umtx_op } + syscall + jae .Lok_umtx + negq %rax +.Lok_umtx: + ret +end; + +{ thr_new(param, param_size) — 2 args, both in %rdi/%rsi already; SYS 455. } +function thr_new(Param: Pointer; ParamSize: Integer): Integer; + assembler; nostackframe; +asm + movq $455, %rax { SYS_thr_new } + syscall + jae .Lok_thr_new + negq %rax +.Lok_thr_new: + ret +end; + +{ thr_exit(state) — SYS 431. Terminates JUST this thread; never returns, so no + CF translation is needed. State arrives in %rdi (nil in our use). } +procedure thr_exit(State: Pointer); assembler; nostackframe; +asm + movq $431, %rax { SYS_thr_exit } + syscall + ret +end; + { _exit(code) — SYS_exit = 1. Terminates the process; never returns, so no CF translation is needed. } procedure _exit(Code: Integer); assembler; nostackframe; diff --git a/compiler/src/main/pascal/runtime.thread.static.freebsd.pas b/compiler/src/main/pascal/runtime.thread.static.freebsd.pas new file mode 100644 index 0000000..d52b92b --- /dev/null +++ b/compiler/src/main/pascal/runtime.thread.static.freebsd.pas @@ -0,0 +1,312 @@ +{ + Blaise - An Object Pascal Compiler + Copyright (c) 2026 Graeme Geldenhuys + SPDX-License-Identifier: Apache-2.0 WITH Swift-exception + Licensed under the Apache License v2.0 with Runtime Library Exception. + See LICENSE file in the project root for full license terms. +} + +unit runtime.thread.static.freebsd; + +// Real POSIX threads for the FreeBSD --static (libc-free) build, implemented +// directly on the thr_new(2) and _umtx_op(2) syscalls +// (docs/freebsd-x86_64-backend-design.adoc, Step 4c). The FreeBSD sibling of +// runtime.thread.static.linux — the threads leaf that lets a static FreeBSD +// binary spawn worker threads (the compiler's TCompileWorker = class(TThread)). +// +// DEFINES the bare pthread_* names that runtime.weak, runtime.thread and +// classes.pas import via `external name`. The FreeBSD RTL composition links +// this unit (the link-time swap) in place of the Linux thread leaf / libc. +// +// Mutex: TARGET-INVARIANT — a 3-state futex mutex (Drepper, "Futexes Are +// Tricky"), copied verbatim from the Linux unit. The caller's mutex buffer is +// reused as the wait word (first Integer): 0 = unlocked, 1 = locked (no +// waiters), 2 = locked (waiters present). ONLY the kernel wait/wake primitive +// differs: Linux futex(WAIT/WAKE) -> FreeBSD _umtx_op(WAIT_UINT_PRIVATE=15 / +// WAKE_PRIVATE=16). WAIT_UINT returns at once if *word <> val (like futex), so +// the loop structure is identical. +// +// Thread: thr_new(2) with a filled `struct thr_param` (amd64 sizeof = 104). Each +// thread gets a fresh mmap'd stack + its own variant-II TLS block (built from +// the startup template; installed as the new thread's %fs base via thr_param's +// tls_base) so threadvar access (exception frames, the allocator) is per-thread. +// +// JOIN — the key FreeBSD difference from Linux. thr_new provides NO +// CLONE_CHILD_CLEARTID-style "clear-and-wake the tid word on exit"; child_tid is +// only written ONCE, on create, and never cleared on exit. So we use a dedicated +// JOIN word in the control block: the child's exit trampoline sets JoinWord = 1 +// and _umtx_op-WAKEs it as its LAST act before thr_exit; pthread_join +// _umtx_op-WAITs on it while it reads 0. thr_exit (SYS 431) terminates JUST the +// thread — NOT exit(2)/SYS_exit, which would kill the whole process. +// +// Known limitation (same as the Linux leaf): a joined thread's TLS block is not +// unmapped — freeing it from the exiting thread is unsafe (the thread runs on it +// until thr_exit) and the join side cannot know its address. A small bounded +// per-thread leak, acceptable for the finite worker pools the compiler spawns. + +interface + +uses + runtime.syscall.freebsd, { mmap, _umtx_op, thr_new, thr_exit numbers } + runtime.start.static.freebsd; { BuildThreadTLS - the per-thread TLS template } + +{ Mutex - the buffer's first Integer is the wait word. } +function pthread_mutex_init(Mutex, Attr: Pointer): Integer; +function pthread_mutex_lock(Mutex: Pointer): Integer; +function pthread_mutex_unlock(Mutex: Pointer): Integer; +function pthread_mutex_destroy(Mutex: Pointer): Integer; + +{ Thread create / join. *Thread receives an opaque handle (a control-block + pointer); pthread_join consumes it. } +function pthread_create(Thread, Attr, StartRoutine, Arg: Pointer): Integer; +function pthread_join(Thread: Int64; RetVal: Pointer): Integer; + +implementation + +type + PInteger = ^Integer; + PInt64 = ^Int64; + +const + { Mutex wait-word states. } + MX_UNLOCKED = 0; + MX_LOCKED = 1; + MX_CONTENDED = 2; + + { _umtx_op operations (FreeBSD 14 sys/sys/umtx.h; verified). } + UMTX_OP_WAIT_UINT_PRIVATE = 15; { block while *obj = val } + UMTX_OP_WAKE_PRIVATE = 16; { wake up to `val` waiters on obj } + + PROT_RW = 3; { PROT_READ or PROT_WRITE } + MAP_PRIVANON = $1002; { FreeBSD MAP_PRIVATE ($0002) or MAP_ANON ($1000) } + STACK_SIZE = 1024 * 1024; { 1 MiB per worker thread } + + { struct thr_param amd64 field offsets (FreeBSD 14 sys/sys/thr.h; verified). } + TP_START_FUNC = 0; { void (*)(void*) } + TP_ARG = 8; { void* } + TP_STACK_BASE = 16; { char* } + TP_STACK_SIZE = 24; { size_t } + TP_TLS_BASE = 32; { char* } + TP_TLS_SIZE = 40; { size_t } + TP_CHILD_TID = 48; { long* } + TP_PARENT_TID = 56; { long* } + TP_FLAGS = 64; { int (+ 4 bytes pad) } + TP_RTP = 72; { struct rtprio* } + TP_SPARE0 = 80; { void*[3] -> 80,88,96 } + THR_PARAM_SIZE = 104; { sizeof(struct thr_param) on amd64 } + +{ The per-thread control block lives at the base of the mmap'd region. + StartRoutine/Arg are the real entry the trampoline calls; JoinWord is the + _umtx_op join word (child sets 1 + WAKEs on exit, parent WAITs while it reads 0); + TidWord is thr_new's child_tid (LONG* = 8 bytes on FreeBSD, so Int64 — the + kernel writes the 8-byte TID here on create; unlike Linux it is NOT cleared on + exit, hence the separate JoinWord). MapBase/MapSize record the region for + munmap after join. } +type + PThreadCB = ^TThreadCB; + TThreadCB = record + StartRoutine: Pointer; + Arg: Pointer; + JoinWord: Integer; + Pad: Integer; + TidWord: Int64; + MapBase: Pointer; + MapSize: Int64; + end; + +{ ------------------------------------------------------------------ } +{ Mutex - 3-state futex (TARGET-INVARIANT; copied from the Linux leaf) } +{ ------------------------------------------------------------------ } + +{ Atomic compare-and-swap on an Integer: if Ptr^ = Expected set it to NewVal; + returns the value that was in Ptr^ before the attempt. } +function CAS(Ptr: Pointer; Expected, NewVal: Integer): Integer; + assembler; nostackframe; +asm + movl %esi, %eax { %eax = Expected (cmpxchg compares against %eax) } + lock cmpxchgl %edx, (%rdi) + ret +end; + +{ Atomic exchange: store NewVal into Ptr^, return the previous value. } +function Xchg(Ptr: Pointer; NewVal: Integer): Integer; + assembler; nostackframe; +asm + movl %esi, %eax + xchgl %eax, (%rdi) + ret +end; + +function pthread_mutex_init(Mutex, Attr: Pointer): Integer; +var + P: PInteger; +begin + P := PInteger(Mutex); + P^ := MX_UNLOCKED; + Result := 0; +end; + +function pthread_mutex_lock(Mutex: Pointer): Integer; +var + C: Integer; +begin + { Fast path: uncontended acquire. } + C := CAS(Mutex, MX_UNLOCKED, MX_LOCKED); + if C <> MX_UNLOCKED then + begin + { Contended. Mark the lock contended and sleep until it is free. } + if C <> MX_CONTENDED then + C := Xchg(Mutex, MX_CONTENDED); + while C <> MX_UNLOCKED do + begin + { WAIT_UINT_PRIVATE blocks while *Mutex = MX_CONTENDED (returns at once if + it already changed) — the FreeBSD analogue of FUTEX_WAIT. } + _umtx_op(Mutex, UMTX_OP_WAIT_UINT_PRIVATE, MX_CONTENDED, nil, nil); + C := Xchg(Mutex, MX_CONTENDED); + end; + end; + Result := 0; +end; + +function pthread_mutex_unlock(Mutex: Pointer): Integer; +begin + { If there were waiters (state 2), wake one after releasing. } + if Xchg(Mutex, MX_UNLOCKED) = MX_CONTENDED then + _umtx_op(Mutex, UMTX_OP_WAKE_PRIVATE, 1, nil, nil); + Result := 0; +end; + +function pthread_mutex_destroy(Mutex: Pointer): Integer; +begin + Result := 0; +end; + +{ ------------------------------------------------------------------ } +{ Thread create / join - thr_new(2) + _umtx_op(2) } +{ ------------------------------------------------------------------ } + +{ Call Entry(Arg) — a raw indirect call so the trampoline can invoke the + caller-supplied StartRoutine held only as a Pointer. Entry arrives in %rdi, + Arg in %rsi; shuffle Arg to %rdi and call Entry. } +procedure CallEntry(Entry, Arg: Pointer); assembler; nostackframe; +asm + movq %rdi, %r11 { Entry } + movq %rsi, %rdi { Arg -> first arg } + call *%r11 { Entry(Arg) } + ret +end; + +{ The thread's entry point (thr_param.start_func). The kernel starts the new + thread here with %rdi = thr_param.arg (our control-block pointer), on the fresh + stack, with the thread's own %fs already installed (tls_base). We call the real + StartRoutine(Arg), then set JoinWord = 1 and _umtx_op-WAKE it so pthread_join + unblocks, then thr_exit(nil) to terminate JUST this thread. } +procedure _thr_trampoline(CBPtr: Pointer); +var + CB: PThreadCB; + Entry: Pointer; +begin + CB := PThreadCB(CBPtr); + Entry := CB^.StartRoutine; + CallEntry(Entry, CB^.Arg); + { Signal completion to any joiner, then terminate this thread only. } + CB^.JoinWord := 1; + _umtx_op(@CB^.JoinWord, UMTX_OP_WAKE_PRIVATE, 1, nil, nil); + thr_exit(nil); +end; + +{ Store an 8-byte value at Base + Offset (used to fill struct thr_param). } +procedure PokeQ(Base: Pointer; Offset: Integer; Value: Int64); +var + Slot: PInt64; +begin + Slot := PInt64(Pointer(PChar(Base) + Offset)); + Slot^ := Value; +end; + +function pthread_create(Thread, Attr, StartRoutine, Arg: Pointer): Integer; +var + Region: Pointer; + CB: PThreadCB; + StackTop: Pointer; + Tls: Pointer; + Param: array[0..THR_PARAM_SIZE - 1] of Byte; + ParamP: Pointer; + R: Integer; + HandleSlot: PInt64; +begin + { One mapping holds the control block (at the base) and the thread stack + (above it). mmap zero-fills, so JoinWord starts at 0. } + Region := mmap(nil, STACK_SIZE, PROT_RW, MAP_PRIVANON, -1, 0); + if Int64(Region) < 0 then + begin + Result := 11; { EAGAIN } + Exit; + end; + CB := PThreadCB(Region); + CB^.StartRoutine := StartRoutine; + CB^.Arg := Arg; + CB^.JoinWord := 0; + CB^.TidWord := 0; + CB^.MapBase := Region; + CB^.MapSize := STACK_SIZE; + + { Stack grows down from the top of the region; keep it 16-byte aligned. } + StackTop := Pointer(PChar(Region) + STACK_SIZE); + StackTop := Pointer(Int64(StackTop) and (not Int64(15))); + + { Each thread needs its own TLS block for threadvar access. } + Tls := BuildThreadTLS(); + + { Fill struct thr_param on the stack (zero-init first so flags/rtp/spare = 0). } + ParamP := @Param[0]; + PokeQ(ParamP, TP_START_FUNC, Int64(Pointer(@_thr_trampoline))); + PokeQ(ParamP, TP_ARG, Int64(CB)); + PokeQ(ParamP, TP_STACK_BASE, Int64(Region)); + { stack_size = distance from the region base to the aligned stack top. } + PokeQ(ParamP, TP_STACK_SIZE, Int64(StackTop) - Int64(Region)); + PokeQ(ParamP, TP_TLS_BASE, Int64(Tls)); + PokeQ(ParamP, TP_TLS_SIZE, ThreadTLSSize()); + PokeQ(ParamP, TP_CHILD_TID, Int64(@CB^.TidWord)); + PokeQ(ParamP, TP_PARENT_TID, Int64(@CB^.TidWord)); + PokeQ(ParamP, TP_FLAGS, 0); { flags = 0 (+ pad) } + PokeQ(ParamP, TP_RTP, 0); { rtp = nil -> default scheduling } + PokeQ(ParamP, TP_SPARE0, 0); + PokeQ(ParamP, TP_SPARE0 + 8, 0); + PokeQ(ParamP, TP_SPARE0 + 16, 0); + + R := thr_new(ParamP, THR_PARAM_SIZE); + if R < 0 then + begin + munmap(Region, STACK_SIZE); + FreeThreadTLS(Tls); { reclaim the per-thread TLS block too } + Result := 11; { EAGAIN } + Exit; + end; + + { Hand the caller the control-block pointer as the opaque thread handle. } + HandleSlot := PInt64(Thread); + HandleSlot^ := Int64(CB); + Result := 0; +end; + +function pthread_join(Thread: Int64; RetVal: Pointer): Integer; +var + CB: PThreadCB; + W: Integer; +begin + CB := PThreadCB(Pointer(Thread)); + { The child sets JoinWord = 1 and _umtx_op-WAKEs it as its last act before + thr_exit. WAIT while it still reads 0. WAIT_UINT returns at once if the word + already changed, so no wake can be missed. } + W := CB^.JoinWord; + while W = 0 do + begin + _umtx_op(@CB^.JoinWord, UMTX_OP_WAIT_UINT_PRIVATE, 0, nil, nil); + W := CB^.JoinWord; + end; + munmap(CB^.MapBase, CB^.MapSize); + Result := 0; +end; + +end. diff --git a/compiler/src/test/pascal/cp.test.linker.pas b/compiler/src/test/pascal/cp.test.linker.pas index 2580b77..303be4d 100644 --- a/compiler/src/test/pascal/cp.test.linker.pas +++ b/compiler/src/test/pascal/cp.test.linker.pas @@ -97,6 +97,11 @@ type MAP_FAILED (-1) so runtime.mem takes its alloc-copy-free grow fallback (no in-place remap syscall on FreeBSD). Standalone byte/symbol shape. } procedure TestLink_FreeBSDSyscallLeaf_GetrandomAndMremapStub; + { Step 4c: the FreeBSD threads/TLS leaf — thr_new (455), _umtx_op (454) and + thr_exit (431) link under the FreeBSD target with their FreeBSD syscall + numbers present in the linked .text, and NOT Linux's clone (56) / futex + (202). Standalone byte/symbol shape. } + procedure TestLink_FreeBSDThreadLeaf_SyscallNumbers; end; TDynLinkerTests = class(TTestCase) @@ -1270,6 +1275,82 @@ begin AssertTrue('mremap stub returns -1 (MAP_FAILED)', Pos(MovRaxImm4b(-1), Bytes) >= 0); end; +procedure TLinkerE2ETests.TestLink_FreeBSDThreadLeaf_SyscallNumbers; +const + { Mirrors the runtime.syscall.freebsd threads/TLS leaf bodies: thr_new (455), + _umtx_op (454, with its arg4 %rcx->%r10 shuffle) and thr_exit (431). These + are the FreeBSD analogues of Linux's clone (56) / futex (202) / exit (60); + the numbers MUST be FreeBSD's, not Linux's. A leading _start keeps the + linker's entry resolvable. } + FixtureAsm = + '.text' + LineEnding + + '.globl _start' + LineEnding + + '_start:' + LineEnding + + ' callq thr_new' + LineEnding + + ' callq _umtx_op' + LineEnding + + ' callq thr_exit' + LineEnding + + ' xorl %edi, %edi' + LineEnding + + ' movq $1, %rax' + LineEnding + { SYS_exit } + ' syscall' + LineEnding + + ' hlt' + LineEnding + + '.globl thr_new' + LineEnding + + 'thr_new:' + LineEnding + + ' movq $455, %rax' + LineEnding + { SYS_thr_new } + ' syscall' + LineEnding + + ' jae .Lok_thr_new' + LineEnding + + ' negq %rax' + LineEnding + + '.Lok_thr_new:' + LineEnding + + ' ret' + LineEnding + + '.globl _umtx_op' + LineEnding + + '_umtx_op:' + LineEnding + + ' movq %rcx, %r10' + LineEnding + + ' movq $454, %rax' + LineEnding + { SYS__umtx_op } + ' syscall' + LineEnding + + ' jae .Lok_umtx' + LineEnding + + ' negq %rax' + LineEnding + + '.Lok_umtx:' + LineEnding + + ' ret' + LineEnding + + '.globl thr_exit' + LineEnding + + 'thr_exit:' + LineEnding + + ' movq $431, %rax' + LineEnding + { SYS_thr_exit } + ' syscall' + LineEnding + + ' ret' + LineEnding; + { Encoded `movq $imm32, %rax` = 48 C7 C0 . } + function MovRaxImm4c(AImm: Integer): string; + begin + Result := Chr($48) + Chr($C7) + Chr($C0) + + Chr(AImm and $FF) + Chr((AImm shr 8) and $FF) + + Chr((AImm shr 16) and $FF) + Chr((AImm shr 24) and $FF); + end; +var + Lk: TLinker; + Obj: TElfObjectFile; + Bytes: string; +begin + Lk := TLinker.Create(FreeBSDX86_64Target()); + try + Obj := ParseElfObject(AssembleToBytes(FixtureAsm), 'fbthr.o'); + Lk.AddOwnedObject(Obj); + Bytes := Lk.LinkToBytes('_start'); + { The bare thread-primitive symbols must be DEFINED (non-zero address). } + AssertTrue('thr_new defined', Lk.AddrOfSymbol('thr_new') > 0); + AssertTrue('_umtx_op defined', Lk.AddrOfSymbol('_umtx_op') > 0); + AssertTrue('thr_exit defined', Lk.AddrOfSymbol('thr_exit') > 0); + finally + Lk.Free(); + end; + { FreeBSD thread syscall NUMBERS present in the linked .text. } + AssertTrue('SYS_thr_new=455 movq imm present', Pos(MovRaxImm4c(455), Bytes) >= 0); + AssertTrue('SYS__umtx_op=454 movq imm present', Pos(MovRaxImm4c(454), Bytes) >= 0); + AssertTrue('SYS_thr_exit=431 movq imm present', Pos(MovRaxImm4c(431), Bytes) >= 0); + { NOT Linux's clone (56) / futex (202) — those numbers must be absent. } + AssertTrue('Linux SYS_clone=56 NOT present', Pos(MovRaxImm4c(56), Bytes) < 0); + AssertTrue('Linux SYS_futex=202 NOT present', Pos(MovRaxImm4c(202), Bytes) < 0); + { _umtx_op's arg4 shuffle: movq %rcx, %r10 (49 89 CA). } + AssertTrue('movq %rcx,%r10 (_umtx_op arg4) present', + Pos(Chr($49) + Chr($89) + Chr($CA), Bytes) >= 0); +end; + { ---- TDynLinkerTests ---- } function TDynLinkerTests.ProjectRoot: string;