diff --git a/compiler/src/main/pascal/blaise.assembler.x86_64.pas b/compiler/src/main/pascal/blaise.assembler.x86_64.pas index dd54e01..2212518 100644 --- a/compiler/src/main/pascal/blaise.assembler.x86_64.pas +++ b/compiler/src/main/pascal/blaise.assembler.x86_64.pas @@ -650,7 +650,7 @@ end; function ParseLine(const ALine: string; ALineNum: Integer): TParsedLine; var S: string; - P, OpEnd: Integer; + P, Q, OpEnd: Integer; Mnemonic: string; TmpOp: TOperand; begin @@ -659,6 +659,7 @@ begin Result.NumOps := 0; Result.RawLine := ALine; Result.LineNum := ALineNum; + Result.HasLock := False; Result.Op1.Kind := opNone; Result.Op2.Kind := opNone; Result.Op3.Kind := opNone; @@ -666,6 +667,28 @@ begin S := TrimStr(ALine); if (Length(S) = 0) or (S[0]= Ord('#')) then Exit; + { Strip a brace comment (open/close = ASCII 123/125) that survived the lexer: + a whole-line or trailing comment inside an asm block. Single line only; + remove the span from the open brace to the matching close brace, or to end + of line when unterminated. } + P := 0; + while P < Length(S) do + begin + if S[P] = 123 then + begin + Q := P + 1; + while (Q < Length(S)) and (S[Q] <> 125) do + Q := Q + 1; + if Q < Length(S) then + S := TrimStr(Copy(S, 0, P) + ' ' + Copy(S, Q + 1, Length(S))) + else + S := TrimStr(Copy(S, 0, P)); + end + else + P := P + 1; + end; + if Length(S) = 0 then Exit; + { Strip trailing comment, but skip over quoted strings so that '#' inside .ascii "..." is not mistaken for a comment start. } P := 0; @@ -1014,6 +1037,9 @@ function EncodeALU(var ACB: TCodeBuf; var ACtx: TEncodeContext; function EncodeIMul(var ACB: TCodeBuf; var ACtx: TEncodeContext; const ASrc, ADst: TOperand): string; forward; +function EncodeXchg(var ACB: TCodeBuf; var ACtx: TEncodeContext; + const AMnem: string; const ASrc, ADst: TOperand): string; forward; + function EncodeShift(var ACB: TCodeBuf; var ACtx: TEncodeContext; const AMnem: string; const ASrc, ADst: TOperand): string; forward; @@ -1655,6 +1681,17 @@ begin Exit; end; + { ---- xchg / cmpxchg (atomic primitives) ---- + AT&T order is `reg, r/m`. xchg has an implicit lock when r/m is memory; + cmpxchg compares r/m against %eax/%rax and conditionally swaps in reg. + Both take the `reg, mem` and `reg, reg` forms the futex mutex needs. } + if (Mnem = 'xchgl') or (Mnem = 'xchgq') + or (Mnem = 'cmpxchgl') or (Mnem = 'cmpxchgq') then + begin + Result := EncodeXchg(CB, ACtx, Mnem, Op1, Op2); + Exit; + end; + { ---- imulq ---- } if Mnem = 'imulq' then begin @@ -2089,6 +2126,59 @@ begin raise EAssembler.Create(AMnem + ': unsupported operand combination'); end; +{ ---- XCHG / CMPXCHG encoder ------------------------------------------- } + +{ Atomic exchange and compare-exchange. AT&T operand order is `reg, r/m` + (ASrc = the register, ADst = the register or memory target): + xchg %reg, r/m -> 87 /r (mem form is implicitly atomic) + cmpxchg %reg, r/m -> 0F B1 /r + Only the forms the futex mutex needs (reg->reg, reg->mem) are encoded. } +function EncodeXchg(var ACB: TCodeBuf; var ACtx: TEncodeContext; + const AMnem: string; const ASrc, ADst: TOperand): string; +var + W64, IsCmpxchg: Boolean; +begin + W64 := AMnem[Length(AMnem)] = Ord('q'); + IsCmpxchg := (AMnem = 'cmpxchgl') or (AMnem = 'cmpxchgq'); + + if ASrc.Kind <> opReg then + raise EAssembler.Create(AMnem + ': source must be a register'); + + { reg, reg } + if ADst.Kind = opReg then + begin + EmitRexIfNeeded(ACB, W64, ASrc.Reg, ADst.Reg, False); + if IsCmpxchg then + begin + CBEmit(ACB, $0F); + CBEmit(ACB, $B1); + end + else + CBEmit(ACB, $87); + CBEmit(ACB, MakeModRM(3, ASrc.Reg, ADst.Reg)); + Result := ACB.Data; + Exit; + end; + + { reg, mem/rip } + if IsMemLike(ADst) then + begin + EmitRexForMem(ACB, W64, ASrc.Reg, ADst, False); + if IsCmpxchg then + begin + CBEmit(ACB, $0F); + CBEmit(ACB, $B1); + end + else + CBEmit(ACB, $87); + EncodeMemOperand(ACB, ACtx, ADst, ASrc.Reg and 7); + Result := ACB.Data; + Exit; + end; + + raise EAssembler.Create(AMnem + ': unsupported operand combination'); +end; + { ---- IMUL encoder ----------------------------------------------------- } function EncodeIMul(var ACB: TCodeBuf; var ACtx: TEncodeContext; diff --git a/compiler/src/main/pascal/runtime.start.static.linux.pas b/compiler/src/main/pascal/runtime.start.static.linux.pas index 28b6aa9..f6004db 100644 --- a/compiler/src/main/pascal/runtime.start.static.linux.pas +++ b/compiler/src/main/pascal/runtime.start.static.linux.pas @@ -35,6 +35,20 @@ uses 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.linux uses these via clone + + CLONE_SETTLS). 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 to load into %fs). 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; + implementation type @@ -117,6 +131,12 @@ begin 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) + 8 (TCB self-pointer). mmap zero-fills. } BlockSize := AlignUp(TlsMemSz, TlsAlign) + 16; Block := mmap(nil, BlockSize, PROT_RW, MAP_PRIVANON, -1, 0); @@ -140,6 +160,36 @@ begin arch_prctl(ARCH_SET_FS, 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). The caller installs + the returned TP into %fs (clone's CLONE_SETTLS does that for a new thread). } +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; + { 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. } diff --git a/compiler/src/main/pascal/runtime.syscall.linux.pas b/compiler/src/main/pascal/runtime.syscall.linux.pas index d7b1cab..6b10880 100644 --- a/compiler/src/main/pascal/runtime.syscall.linux.pas +++ b/compiler/src/main/pascal/runtime.syscall.linux.pas @@ -81,6 +81,11 @@ function wait4(Pid: Integer; Status: Pointer; Options: Integer; Rusage: Pointer): Integer; function sched_getaffinity(Pid: Integer; CpuSetSize: Int64; Mask: Pointer): Integer; +{ futex(2): the kernel primitive the threads leaf builds mutexes and join on. + 6-arg syscall; arg4 (Timeout) arrives in %rcx -> moved to %r10. Returns 0 or + a count on success, -errno on error. Op = FUTEX_WAIT(0) / FUTEX_WAKE(1). } +function futex(Uaddr: Pointer; Op, Val: Integer; Timeout: Pointer; + Uaddr2: Pointer; Val3: Integer): Integer; function getrandom(Buf: Pointer; Count: Int64; Flags: Integer): Int64; function arch_prctl(Code: Integer; Addr: Pointer): Integer; function kill(Pid, Sig: Integer): Integer; @@ -135,6 +140,7 @@ const SYS_kill = 62; SYS_getcwd = 79; SYS_sched_getaffinity = 204; + SYS_futex = 202; SYS_arch_prctl = 158; SYS_time = 201; SYS_getrandom = 318; @@ -346,6 +352,17 @@ asm ret end; +{ futex has 6 args; arg4 (Timeout) arrives in %rcx -> move to %r10. } +function futex(Uaddr: Pointer; Op, Val: Integer; Timeout: Pointer; + Uaddr2: Pointer; Val3: Integer): Integer; + assembler; nostackframe; +asm + movq %rcx, %r10 + movq $202, %rax { SYS_futex } + syscall + ret +end; + function getrandom(Buf: Pointer; Count: Int64; Flags: Integer): Int64; assembler; nostackframe; asm diff --git a/compiler/src/main/pascal/runtime.thread.static.linux.pas b/compiler/src/main/pascal/runtime.thread.static.linux.pas index c293086..3219f46 100644 --- a/compiler/src/main/pascal/runtime.thread.static.linux.pas +++ b/compiler/src/main/pascal/runtime.thread.static.linux.pas @@ -8,40 +8,157 @@ unit runtime.thread.static.linux; -// Single-threaded mutex stubs for the --static (libc-free) build. Real threads -// (pthread_create via clone + futex-based mutexes) are deferred to the threads -// step of the migration (docs/linux-syscall-migration.adoc); until then a -// static program is single-threaded, so the locks are uncontended and these -// no-op stubs are correct. pthread_create itself is intentionally NOT provided: -// a static program that spawns a thread will fail to link, which is the honest -// signal that the threads leaf is not done yet. +// Real POSIX threads for the --static (libc-free) build, implemented directly on +// the clone(2) and futex(2) syscalls (docs/linux-syscall-migration.adoc). This +// is the threads leaf that lets a static binary spawn worker threads - the last +// piece needed for the compiler to self-host as a libc-free static ET_EXEC. // -// DEFINES the bare pthread_mutex_* names that runtime.weak / runtime.thread -// import via `external name`. +// DEFINES the bare pthread_* / sysconf names that runtime.weak, runtime.thread +// and classes.pas import via `external name`. The non-static build resolves the +// same names from libc.so; the --static link swaps in this unit instead. +// +// Mutex: a 3-state futex mutex (Drepper, "Futexes Are Tricky"). The caller's +// 48-byte pthread_mutex_t buffer is reused as the futex word (first Integer): +// 0 = unlocked, 1 = locked (no waiters), 2 = locked (waiters present). +// +// Thread: clone(2) with CLONE_VM|FS|FILES|SIGHAND|THREAD|SYSVSEM|SETTLS plus +// CLONE_PARENT_SETTID|CHILD_CLEARTID. Each thread gets a fresh mmap'd stack +// and its own TLS block (variant II) built from the startup template, so +// threadvar access (exception frames, the allocator) is per-thread. The +// kernel clears the child-tid futex word on thread exit; pthread_join +// futex-waits on it. +// +// Known limitation: a joined thread's TLS block (mmap'd by BuildThreadTLS) is +// not unmapped - freeing it from the exiting thread is unsafe (the thread runs +// on it until exit) and the join side cannot know its address. This is a small +// bounded per-thread leak, acceptable for the finite worker pools the compiler +// spawns; a thread-registry sweep can reclaim it later if needed. interface +uses + runtime.syscall.linux, { mmap, futex, clone numbers } + runtime.start.static.linux; { BuildThreadTLS - the per-thread TLS template } + +{ Mutex - the buffer's first Integer is the futex 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; + +{ sysconf is provided by runtime.libc.linux (sched_getaffinity + popcount); it is + not redefined here. } + implementation -{ All no-ops returning success: a single-threaded process never contends. } +type + PInteger = ^Integer; + PInt64 = ^Int64; + +const + { Mutex futex states. } + MX_UNLOCKED = 0; + MX_LOCKED = 1; + MX_CONTENDED = 2; + + { futex ops. } + FUTEX_WAIT = 0; + FUTEX_WAKE = 1; + + { clone(2) flags for a thread sharing the address space. } + CLONE_VM = $00000100; + CLONE_FS = $00000200; + CLONE_FILES = $00000400; + CLONE_SIGHAND = $00000800; + CLONE_THREAD = $00010000; + CLONE_SYSVSEM = $00040000; + CLONE_SETTLS = $00080000; + CLONE_PARENT_SETTID = $00100000; + CLONE_CHILD_CLEARTID = $00200000; + THREAD_CLONE_FLAGS = + CLONE_VM or CLONE_FS or CLONE_FILES or CLONE_SIGHAND or + CLONE_THREAD or CLONE_SYSVSEM or CLONE_SETTLS or + CLONE_PARENT_SETTID or CLONE_CHILD_CLEARTID; + + PROT_RW = 3; { PROT_READ or PROT_WRITE } + MAP_PRIVANON = $22; { MAP_PRIVATE or MAP_ANONYMOUS } + STACK_SIZE = 1024 * 1024; { 1 MiB per worker thread } + +{ The per-thread control block lives at the base of the mmap'd region. TidWord + is the CLONE_CHILD_CLEARTID / CLONE_PARENT_SETTID futex word (the kernel writes + the new TID here on create and clears it on exit); MapBase/MapSize record the + region for munmap after join. } +type + PThreadCB = ^TThreadCB; + TThreadCB = record + TidWord: Integer; + Pad: Integer; + MapBase: Pointer; + MapSize: Int64; + end; + +{ ------------------------------------------------------------------ } +{ Mutex - 3-state futex } +{ ------------------------------------------------------------------ } + +{ 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 + futex(Mutex, FUTEX_WAIT, MX_CONTENDED, nil, nil, 0); + 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 + futex(Mutex, FUTEX_WAKE, 1, nil, nil, 0); Result := 0; end; @@ -50,4 +167,117 @@ begin Result := 0; end; +{ ------------------------------------------------------------------ } +{ Thread create / join - clone(2) + futex(2) } +{ ------------------------------------------------------------------ } + +{ Raw clone of a thread. Returns the child TID in the parent, 0 in the child. + The child resumes here on its own stack (ChildStack) with %rax = 0, then this + routine, in the child branch, calls Entry(EntryArg) and exits the thread. + + Args (SysV): %rdi=Flags, %rsi=ChildStack(top), %rdx=ParentTid, + %rcx=ChildTid, %r8=Tls, %r9=Entry, [stack]=EntryArg. + + The new stack is pre-seeded by the caller with Entry and EntryArg so the child + can reach them after clone (the syscall does not propagate registers reliably + to a freshly cloned stack across all kernels - we read them from the stack). + Here we instead pass them through callee-saved regs that survive the syscall. } +function _clone_thread(Flags: Int64; ChildStack, ParentTid, ChildTid, + Tls, Entry, EntryArg: Pointer): Int64; + assembler; nostackframe; +asm + { Seed Entry and EntryArg onto the child stack; the 7th arg EntryArg } + { arrived on our stack at 8(%rsp) (return addr at 0(%rsp)). } + movq 8(%rsp), %rax { %rax = EntryArg } + subq $16, %rsi { %rsi = ChildStack top; grow down for the seeds } + movq %r9, 0(%rsi) { [child_sp+0] = Entry } + movq %rax, 8(%rsi) { [child_sp+8] = EntryArg } + + { clone kernel ABI: arg4 (ChildTid) came in %rcx -> move to %r10. } + movq %rcx, %r10 + movq $56, %rax { SYS_clone } + syscall + + testq %rax, %rax + jnz .Lparent { parent: %rax = child tid } + + { child: on the new stack, %rsp = seeded child_sp. } + popq %rax { %rax = Entry } + popq %rdi { %rdi = EntryArg (1st arg to Entry) } + xorq %rbp, %rbp { terminate the call chain for unwinders } + call *%rax { Entry(EntryArg) } + + { Thread done: exit(0) this thread only (NOT exit_group). } + xorl %edi, %edi + movq $60, %rax { SYS_exit } + syscall + hlt + +.Lparent: + ret +end; + +function pthread_create(Thread, Attr, StartRoutine, Arg: Pointer): Integer; +var + Region: Pointer; + CB: PThreadCB; + StackTop: Pointer; + Tls: Pointer; + Tid: Int64; + HandleSlot: PInt64; +begin + { One mapping holds the control block (at the base) and the thread stack + (above it). mmap zero-fills, so TidWord 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^.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(); + + Tid := _clone_thread(THREAD_CLONE_FLAGS, StackTop, + @CB^.TidWord, { CLONE_PARENT_SETTID -> our TidWord } + @CB^.TidWord, { CLONE_CHILD_CLEARTID -> same word } + Tls, StartRoutine, Arg); + if Tid < 0 then + begin + munmap(Region, STACK_SIZE); + 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; + Tid: Integer; +begin + CB := PThreadCB(Pointer(Thread)); + { The kernel clears TidWord (CLONE_CHILD_CLEARTID) and futex-wakes it when the + thread exits. Wait until it reads 0. } + Tid := CB^.TidWord; + while Tid <> 0 do + begin + futex(@CB^.TidWord, FUTEX_WAIT, Tid, nil, nil, 0); + Tid := CB^.TidWord; + end; + munmap(CB^.MapBase, CB^.MapSize); + Result := 0; +end; + end.