administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

feat(freebsd): drive static/freestanding link + per-target layout by --target (Step 6)

Browse source 
Complete the end-to-end FreeBSD cross-compile: `blaise --target freebsd-x86_64`
now emits a static, freestanding FreeBSD ET_EXEC on a Linux host with no
external tools.

Target selection through the linker:
  * TargetIsFreestanding(target) — FreeBSD (Strategy B: direct syscalls, no
    libc) is always a static ET_EXEC.  LinkViaInternalLinker sets dynamic mode
    to `not (AOpts.Static or freestanding)`, and EnsureRTLObjects selects the
    freestanding kernel-leaf unit list the same way — so a FreeBSD target links
    the syscall/libc-shim/thread leaves and no libc, regardless of --static.

Per-target platform layout (dependency injection off --target):
  * The concrete TPlatformLayout adapter (rtl.platform.layout.<os>) is selected
    and linked by the driver (BuildRTLUnitList), and the compiler injects a
    direct call to that unit's initialiser — PlatformLayoutInitSym(target) =
    rtl.platform.layout.<os>_init — into main, first, for the compile-time
    --target.  rtl.platform.posix no longer `uses` a concrete layout, so the
    shared POSIX code is OS-agnostic and a FreeBSD build carries no Linux layout.
  * Bootstrap fallback: each layout unit also defines a WEAK _BlaisePlatformInit
    trampoline that _SetArgs calls, so a binary built by an older codegen (which
    does not emit main's by-name call) still initialises GPlatformLayout.  Weak
    binding lets both layout units coexist in one link (e.g. the TestRunner,
    which imports the FreeBSD layout via cp.test.platformlayout.freebsd) without
    a duplicate-symbol error — the linker keeps the first-seen (host) copy.

FreeBSD libc-shaped leaf:
  * New runtime.libc.freebsd (sibling of runtime.libc.linux): getcwd/getenv/
    time/waitpid/execvp/sysconf on the FreeBSD syscall leaf.  time() reads
    CLOCK_REALTIME (no SYS_time on FreeBSD); sysconf(CPU count) uses
    sysctl(hw.ncpu) — new SYS___sysctl=202 leaf, MIB {CTL_HW=6, HW_NCPU=3}.

Tests:
  * TTargetToolkitTests.TestTargetIsFreestanding_{FreeBSD_True,Linux_False}.
  * TInternalLinkerE2ETests.TestCompile_FreeBSDTarget_EmitsStaticFreeBSDExe —
    a full compiler-CLI cross-compile asserting EI_OSABI=9, ET_EXEC, no
    PT_INTERP (the binary cannot run on the Linux host, so shape only).

Verified: all four fixpoints green; full suite passes under QBE-built and
native-built test runner (4029 tests); the previously latent TestRunner
GPlatformLayout crash is resolved.
This commit is contained in:
Graeme Geldenhuys 2026-07-01 13:53:54 +01:00
parent 9bbcfd8b77
commit 0014c157a0
12 changed files with 435 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

12
compiler/src/main/pascal/blaise.codegen.driver.pas
View file

@ -553,11 +553,13 @@ begin
BlaiseBin := ParamStr(0);
{ The unit list to build/link, in leaf-first order. Selection is driven off
the target (AOpts.Target.OS) and link mode (AOpts.Static): the platform
layout adapter follows the target, and a --static link swaps in the
freestanding per-OS kernel leaf (start / syscall / libc shims / thread) in
place of libc. See BuildRTLUnitList. }
Units := BuildRTLUnitList(AOpts.Static, AOpts.Target.OS);
the target (AOpts.Target.OS) and link mode: the platform layout adapter
follows the target, and a static link swaps in the freestanding per-OS
kernel leaf (start / syscall / libc shims / thread) in place of libc. A
freestanding target (FreeBSD, Strategy B) has no libc, so it is static
regardless of the --static flag. See BuildRTLUnitList. }
Units := BuildRTLUnitList(
AOpts.Static or TargetIsFreestanding(AOpts.Target), AOpts.Target.OS);
for I := 0 to Units.Count - 1 do
begin

6
compiler/src/main/pascal/blaise.codegen.native.driver.pas
View file

@ -240,8 +240,10 @@ begin
try
{ --static: freestanding non-PIE ET_EXEC, no libc/PT_INTERP (the kernel
leaf supplies open/read/write/... + _start). Default: dynamic PIE
linked against libc. }
Lk.SetDynamic(not AOpts.Static);
linked against libc. A freestanding target (FreeBSD, Strategy B) has
no libc to link against, so it is ALWAYS static regardless of the
--static flag — the kernel leaf is the only libc it gets. }
Lk.SetDynamic(not (AOpts.Static or TargetIsFreestanding(AOpts.Target)));
Obj := ReadElfObjectFile(AObjFile);
Lk.AddOwnedObject(Obj);

7
compiler/src/main/pascal/blaise.codegen.native.x86_64.pas
View file

@ -17552,6 +17552,13 @@ begin
{ RTL one-time setup the per-unit init dispatch below misses for archive
units (e.g. blaise_weak's WeakMutex — see _BlaiseInit). }
Self.Emit(#9'callq _BlaiseInit');
{ Assign GPlatformLayout for the compile-time --target by calling the host
layout unit's init BY NAME (rtl.platform.layout.<os>_init). The layout unit
is linked by the driver (BuildRTLUnitList) but not imported by posix, so it
is not in the per-unit init dispatch below; calling it here — first, before
any other unit init — makes the target's layout win deterministically even
if a unit (e.g. a test) imported a non-host layout whose init also runs. }
Self.Emit(#9'callq ' + PlatformLayoutInitSym(FTarget));
{ Call initialization sections of imported units in order. }
for I := 0 to FUnitInitNames.Count - 1 do
Self.Emit(#9'callq ' + FUnitInitNames.Strings[I] + '_init');

7
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -1024,6 +1024,13 @@ begin
{ RTL one-time setup the per-unit init dispatch below misses for archive
units (e.g. blaise_weak's WeakMutex — see _BlaiseInit). }
EmitLine(' call $_BlaiseInit()');
{ Assign GPlatformLayout for the compile-time --target by calling the host
layout unit's init BY NAME (rtl.platform.layout.<os>_init). The layout unit
is linked by the driver (BuildRTLUnitList) but not imported by posix, so it
is not in the per-unit init dispatch below; calling it here — first, before
any other unit init — makes the target's layout win deterministically even
if a unit (e.g. a test) imported a non-host layout whose init also runs. }
EmitLine(' call $' + PlatformLayoutInitSym(GTarget) + '()');
{ Call initialization sections of imported units in order }
for I := 0 to FUnitInitNames.Count - 1 do
EmitLine(' call $' + FUnitInitNames.Strings[I] + '_init()');

45
compiler/src/main/pascal/blaise.codegen.target.pas
View file

@ -61,6 +61,26 @@ function TargetName(const ATarget: TTargetDesc): string;
{ True when the native backend can actually generate code for this target. }
function TargetHasNativeBackend(const ATarget: TTargetDesc): Boolean;
{ True when the target is FREESTANDING — reached via direct syscalls with no
libc, so it is always linked as a static ET_EXEC with a self-supplied _start
and no PT_INTERP / libc NEEDED (Strategy B, see
docs/freebsd-x86_64-backend-design.adoc). FreeBSD is freestanding; Linux
links dynamic libc by default. Drives both the RTL unit-list selection
(the kernel leaf is always pulled in) and the internal linker's static mode. }
function TargetIsFreestanding(const ATarget: TTargetDesc): Boolean;
{ Lower-case OS token used in the OS-specific RTL unit names, e.g.
'linux' / 'freebsd' in rtl.platform.layout.<os>, runtime.syscall.<os>.
The single source of truth for the OS suffix, shared by the driver's RTL
unit-list selection and the codegen backends' platform-layout-init call. }
function TargetOSName(const ATarget: TTargetDesc): string;
{ Assembler symbol of the target's platform-layout unit initialiser
(rtl.platform.layout.<os>_init). The compiler emits a direct call to this
from main so the compile-time --target's layout assigns GPlatformLayout first,
regardless of the program's import graph. }
function PlatformLayoutInitSym(const ATarget: TTargetDesc): string;
{ Platform constants derived from the target OS. }
function TargetLineEnding(const ATarget: TTargetDesc): string;
function TargetDirectorySeparator(const ATarget: TTargetDesc): string;
@ -157,6 +177,31 @@ begin
Result := (ATarget.OS = osLinux) and (ATarget.CPU = cpuX86_64);
end;
function TargetIsFreestanding(const ATarget: TTargetDesc): Boolean;
begin
{ FreeBSD uses Strategy B — direct syscalls, no libc — so it is always a
static, freestanding ET_EXEC. Other OSes link dynamic libc by default. }
Result := (ATarget.OS = osFreeBSD);
end;
function TargetOSName(const ATarget: TTargetDesc): string;
begin
case ATarget.OS of
osFreeBSD: Result := 'freebsd';
osWindows: Result := 'windows';
osMacOS: Result := 'macos';
else
Result := 'linux';
end;
end;
function PlatformLayoutInitSym(const ATarget: TTargetDesc): string;
begin
{ NativeMangle/QBE mangling of an rtl.* unit keeps the dotted name verbatim
and appends '_init'; the layout unit is rtl.platform.layout.<os>. }
Result := 'rtl.platform.layout.' + TargetOSName(ATarget) + '_init';
end;
function TargetLineEnding(const ATarget: TTargetDesc): string;
begin
case ATarget.OS of

21
compiler/src/main/pascal/rtl.platform.layout.freebsd.pas
View file

@ -117,8 +117,27 @@ begin
Result := P^;
end;
initialization
{ Assign GPlatformLayout to the FreeBSD layout, once. Called from this unit's
initialization (rtl.platform.layout.freebsd_init, which main invokes by-name
for a FreeBSD --target) and from the weak _BlaisePlatformInit trampoline. The
nil-guard keeps it a no-op on a host build that merely imports this unit (e.g.
cp.test.platformlayout.freebsd), so it never clobbers the host layout. }
procedure AssignLayoutFreeBSD;
begin
if GPlatformLayout = nil then
GPlatformLayout := TPlatformLayoutFreeBSDX86_64.Create();
end;
{ Weak bootstrap-fallback trampoline — see the twin in rtl.platform.layout.linux
for the full rationale. Defined WEAK so the linker keeps the first-seen (host)
layout's copy when both units are linked. }
procedure _BlaisePlatformInit; assembler; nostackframe;
asm
.weak _BlaisePlatformInit
jmp AssignLayoutFreeBSD
end;
initialization
AssignLayoutFreeBSD();
end.

24
compiler/src/main/pascal/rtl.platform.layout.linux.pas
View file

@ -107,8 +107,30 @@ begin
Result := P^;
end;
initialization
{ Assign GPlatformLayout to this target's layout, once. Called both from this
unit's initialization (rtl.platform.layout.linux_init, which main invokes
by-name for a Linux --target) and from the weak _BlaisePlatformInit trampoline
below. }
procedure AssignLayoutLinux;
begin
if GPlatformLayout = nil then
GPlatformLayout := TPlatformLayoutLinuxX86_64.Create();
end;
{ Bootstrap fallback: a binary built by a codegen that does not yet emit main's
direct, strong, by-name call to rtl.platform.layout.<os>_init reaches the
layout through _SetArgs -> _BlaisePlatformInit instead. Emitted WEAK so that
every concrete layout unit can define it without a duplicate-symbol link error
when more than one is linked (e.g. a test that imports a non-host layout): the
linker keeps the first-seen weak, which is the host layout BuildRTLUnitList
links first. A tiny asm trampoline that tail-calls AssignLayout. }
procedure _BlaisePlatformInit; assembler; nostackframe;
asm
.weak _BlaisePlatformInit
jmp AssignLayoutLinux
end;
initialization
AssignLayoutLinux();
end.

29
compiler/src/main/pascal/rtl.platform.posix.pas
View file

@ -28,12 +28,13 @@ unit rtl.platform.posix;
interface
uses
rtl.platform,
{ The concrete TPlatformLayout for this archive's target. This is the ONE
per-target wire in the otherwise OS-agnostic POSIX unit: the Linux RTL
archive composes the Linux layout, the FreeBSD archive its own. Its
initialization assigns GPlatformLayout. }
rtl.platform.layout.linux;
rtl.platform;
{ NOTE: the concrete TPlatformLayout adapter (rtl.platform.layout.<os>) is
deliberately NOT imported here. It is selected and linked by the driver
for the runtime --target (BuildRTLUnitList), and its GPlatformLayout
assignment runs via the bare `_BlaisePlatformInit` symbol that `main` calls
at startup — a link-time swap, not a compile-time `uses`. Importing a
concrete layout would hard-wire one OS into this shared POSIX unit. }
type
TRtlPlatformPosix = class(TRtlPlatform)
@ -147,6 +148,13 @@ type
{ Memory }
function _BlaiseGetMem(Size: Integer): Pointer; external name '_BlaiseGetMem';
procedure _BlaiseFreeMem(Ptr: Pointer); external name '_BlaiseFreeMem';
{ Bootstrap fallback for GPlatformLayout: defined WEAK by the linked target's
concrete layout unit (rtl.platform.layout.<os>). The current codegen assigns
GPlatformLayout by calling that unit's init directly from main, so this call
is redundant then (idempotent). It only matters for a binary built by an
older codegen that does not yet emit the direct main-call — there it is the
sole path that initialises the layout. }
procedure _BlaisePlatformInit; external name '_BlaisePlatformInit';
{ String ARC }
function _IntToStr(N: Integer): Pointer; external name '_IntToStr';
@ -1149,8 +1157,13 @@ procedure _SetArgs(Argc: Integer; Argv: Pointer);
begin
GArgC := Argc;
GArgV := TPCharArray(Argv);
if GPlatformLayout = nil then
GPlatformLayout := TPlatformLayoutLinuxX86_64.Create();
{ GPlatformLayout is assigned by the target's concrete layout unit
(rtl.platform.layout.<os>). The current codegen calls that unit's init
directly from main (by-name, for the compile-time --target); this weak
_BlaisePlatformInit call is the bootstrap fallback for an older codegen that
does not. Idempotent. This shared POSIX unit references no concrete layout
class, so it stays OS-agnostic. }
_BlaisePlatformInit();
if GRtlPlatform = nil then
GRtlPlatform := TRtlPlatformPosix.Create();
end;

188
compiler/src/main/pascal/runtime.libc.freebsd.pas Normal file
View file

@ -0,0 +1,188 @@
{
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.libc.freebsd;
// libc-shaped leaves that are MORE than a raw syscall - they need logic the
// kernel does not provide: env lookup, the libc-style return shapes, the
// hw.ncpu sysctl. Built on the raw syscalls in runtime.syscall.freebsd.
// Linked only in a static (libc-free) FreeBSD build
// (docs/freebsd-x86_64-backend-design.adoc). The FreeBSD sibling of
// runtime.libc.linux.
//
// These DEFINE the bare POSIX names (getcwd, getenv, time, waitpid, execvp,
// sysconf) that rtl.platform.posix / runtime.thread import via `external name`,
// so they resolve here instead of FreeBSD's libc.
//
// Deltas from the Linux sibling:
// * time() has no SYS_time on FreeBSD; it reads CLOCK_REALTIME via
// clock_gettime and returns tv_sec.
// * sysconf(CPU count) uses sysctl(hw.ncpu) — FreeBSD has no
// sched_getaffinity.
// getcwd / getenv / waitpid / execvp are structurally identical (the syscall
// leaf provides sys_getcwd / wait4 / execve / environ on both targets).
interface
uses
runtime.syscall.freebsd; { provides `environ`, captured by _start }
{ libc-shaped getcwd: returns Buf on success, nil on error (the raw syscall
returns 0 / -errno). }
function getcwd(Buf: PChar; Size: Int64): PChar;
{ getenv: linear scan of `environ` for "Name=" returns a pointer to the value
(just past '='), or nil if not present. }
function getenv(Name: PChar): PChar;
{ time(2): FreeBSD has no SYS_time — read CLOCK_REALTIME and return tv_sec. If
T is non-nil the same value is written there (libc's optional out-param). }
function time(T: Pointer): Int64;
{ waitpid via wait4 with a NULL rusage. }
function waitpid(Pid: Integer; Status: Pointer; Options: Integer): Integer;
{ execvp: execve the name with the current `environ` as envp. No $PATH search
yet (matches the Linux sibling — the RTL only execs explicit paths). }
function execvp(File_: PChar; Argv: Pointer): Integer;
{ sysconf for the few names the RTL queries - currently only the online CPU
count (_SC_NPROCESSORS_ONLN, passed as 84 by runtime.thread on every target),
via sysctl(hw.ncpu). }
function sysconf(Name: Integer): Int64;
implementation
type
PPointer = ^Pointer;
PInt64 = ^Int64;
const
{ The token runtime.thread passes for the CPU-count query. It is an internal
RTL contract value (runtime.thread hardcodes 84 on every target), NOT
FreeBSD's libc _SC_NPROCESSORS_ONLN (58) — we never reach FreeBSD's libc. }
_SC_NPROCESSORS_ONLN = 84;
CLOCK_REALTIME = 0;
{ sysctl MIB for hw.ncpu (FreeBSD sys/sysctl.h): CTL_HW=6, HW_NCPU=3. }
CTL_HW = 6;
HW_NCPU = 3;
{ --- small freestanding string helpers (no dependency on runtime.str) --- }
function CStrLen(S: PChar): Int64;
var I: Int64;
begin
I := 0;
while (S[I] and $FF) <> 0 do I := I + 1;
Result := I;
end;
{ Compare the "KEY=" prefix of an environ entry against Name (length NLen).
Returns True when Entry starts with Name immediately followed by '='. }
function EnvKeyMatches(Entry, Name: PChar; NLen: Int64): Boolean;
var I: Int64;
begin
I := 0;
while I < NLen do
begin
if (Entry[I] and $FF) <> (Name[I] and $FF) then Exit(False);
if (Entry[I] and $FF) = 0 then Exit(False);
I := I + 1;
end;
Result := (Entry[NLen] and $FF) = Ord('=');
end;
function getcwd(Buf: PChar; Size: Int64): PChar;
var Rc: Int64;
begin
Rc := sys_getcwd(Buf, Size);
if Rc < 0 then
Result := nil
else
Result := Buf;
end;
function getenv(Name: PChar): PChar;
var
Entry: PChar;
NLen, Off: Int64;
begin
Result := nil;
if environ = nil then Exit;
NLen := CStrLen(Name);
{ environ is a NULL-terminated array of PChar; read the I-th slot as a
Pointer at environ + I*8 (PPointer deref, the RTL idiom - no [] on a typed
pointer). }
Off := 0;
Entry := PChar(PPointer(Pointer(PChar(environ) + Off))^);
while Entry <> nil do
begin
if EnvKeyMatches(Entry, Name, NLen) then
begin
Result := PChar(Pointer(PChar(Entry) + NLen + 1)); { just past '=' }
Exit;
end;
Off := Off + 8;
Entry := PChar(PPointer(Pointer(PChar(environ) + Off))^);
end;
end;
function time(T: Pointer): Int64;
var
Ts: array[0..1] of Int64; { struct timespec: tv_sec (Int64), tv_nsec (long) }
Rc: Integer;
Out_: PInt64;
begin
Rc := clock_gettime(CLOCK_REALTIME, @Ts[0]);
if Rc <> 0 then
Result := -1
else
Result := Ts[0]; { tv_sec }
if (T <> nil) and (Result >= 0) then
begin
Out_ := PInt64(T);
Out_^ := Result; { libc's optional out-param: *T = tv_sec }
end;
end;
function waitpid(Pid: Integer; Status: Pointer; Options: Integer): Integer;
begin
Result := wait4(Pid, Status, Options, nil);
end;
function execvp(File_: PChar; Argv: Pointer): Integer;
begin
{ No PATH search yet: execve the name directly (matches runtime.libc.linux —
the RTL only execs explicit paths, e.g. system() builds "/bin/sh"). }
Result := execve(File_, Argv, environ);
end;
function sysconf(Name: Integer): Int64;
var
Mib: array[0..1] of Integer; { the two-element MIB: CTL_HW, HW_NCPU }
NCpu: Integer;
OldLen: Int64; { size_t }
Rc: Integer;
begin
if Name = _SC_NPROCESSORS_ONLN then
begin
Mib[0] := CTL_HW;
Mib[1] := HW_NCPU;
NCpu := 0;
OldLen := SizeOf(NCpu); { 4 }
Rc := sysctl(@Mib[0], 2, @NCpu, @OldLen, nil, 0);
if (Rc <> 0) or (NCpu < 1) then
Result := 1 { fall back to single CPU on error }
else
Result := NCpu;
end
else
Result := -1;
end;
end.

23
compiler/src/main/pascal/runtime.syscall.freebsd.pas
View file

@ -111,6 +111,13 @@ 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;
{ Raw __sysctl(2) — SYS 202. FreeBSD's structured kernel-state query; the
freestanding sysconf (runtime.libc.freebsd) reads hw.ncpu through it since
FreeBSD has no sched_getaffinity. 6-arg syscall (arg4 %rcx -> %r10); returns
0 on success or -errno (CF-translated). }
function sysctl(Name: Pointer; NameLen: Integer; OldP: Pointer;
OldLenP: Pointer; NewP: Pointer; NewLen: Int64): Integer;
{ 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. }
@ -174,6 +181,7 @@ const
SYS_mkdir = 136;
SYS_rmdir = 137;
SYS_getcwd = 326; { __getcwd }
SYS_sysctl = 202; { __sysctl (hw.ncpu for sysconf) }
SYS_getrandom = 563;
SYS_clock_gettime = 232;
SYS_nanosleep = 240;
@ -504,6 +512,21 @@ asm
ret
end;
{ __sysctl(name, namelen, oldp, oldlenp, newp, newlen) — 6 args; SYS 202. arg4
(oldlenp) arrives in %rcx and must move to %r10 (syscall clobbers %rcx). }
function sysctl(Name: Pointer; NameLen: Integer; OldP: Pointer;
OldLenP: Pointer; NewP: Pointer; NewLen: Int64): Integer;
assembler; nostackframe;
asm
movq %rcx, %r10
movq $202, %rax { SYS___sysctl }
syscall
jae .Lok_sysctl
negq %rax
.Lok_sysctl:
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;

74
compiler/src/test/pascal/cp.test.linker.pas
View file

@ -146,6 +146,12 @@ type
procedure TestRun_ExceptionHandling;
procedure TestRun_ClassAndVirtual;
procedure TestLink_MissingRTL_FailsLoudly;
{ Step 6: a full compiler-CLI cross-compile with --target freebsd-x86_64
selects the FreeBSD RTL adapter set (BuildRTLUnitList) and emits a static,
freestanding FreeBSD ET_EXEC — EI_OSABI = 9, no PT_INTERP, entry _start —
with no external tools. The binary cannot run on the Linux host, so this
asserts the emitted ELF shape only. }
procedure TestCompile_FreeBSDTarget_EmitsStaticFreeBSDExe;
end;
implementation
@ -1887,6 +1893,74 @@ begin
FileExists(OutFile));
end;
procedure TInternalLinkerE2ETests.TestCompile_FreeBSDTarget_EmitsStaticFreeBSDExe;
var
SrcFile, OutFile, CompOut, Bytes: string;
Rc, PhOff, PhEntSz, PhCount, J, PType: Integer;
FoundInterp: Boolean;
begin
if not Self.CompilerAvailable() then
begin
Ignore('<toolchain-missing>');
Exit;
end;
FCounter := FCounter + 1;
SrcFile := FScratch + 'test_fbsd_' + IntToStr(FCounter) + '.pas';
OutFile := FScratch + 'test_fbsd_' + IntToStr(FCounter);
WriteFile(SrcFile,
'program test_fbsd;' + LineEnding +
'begin' + LineEnding +
' WriteLn(''Hello'')' + LineEnding +
'end.');
{ Full compiler-CLI cross-compile. --target freebsd-x86_64 must select the
FreeBSD RTL adapter set and drive the static, freestanding link with no
external tools (internal assembler + linker). }
Rc := Self.RunProc(FCompiler, [
'--source', SrcFile,
'--unit-path', FRTLPath,
'--unit-path', FStdlibPath,
'--output', OutFile,
'--backend', 'native',
'--assembler', 'internal',
'--linker', 'internal',
'--target', 'freebsd-x86_64'
], CompOut);
if Rc <> 0 then
Fail('--target freebsd-x86_64 compile failed (rc=' + IntToStr(Rc) + '): ' +
CompOut);
AssertTrue('FreeBSD binary was produced', FileExists(OutFile));
{ The FreeBSD binary cannot run on the Linux host — assert its ELF shape.
ReadWholeFile is NUL-safe (unlike the RTL ReadFile, which stops at the
first NUL — an ELF header hits one at byte 8). }
Bytes := ReadWholeFile(OutFile);
AssertTrue('output too small to be an ELF', Length(Bytes) >= 64);
{ EI_OSABI byte 7 = ELFOSABI_FREEBSD (9). }
AssertEquals('EI_OSABI FreeBSD', 9, OrdAt(Bytes, 7));
{ e_type at offset 16 = ET_EXEC (2) — static, non-PIE. }
AssertEquals('e_type ET_EXEC', 2, OrdAt(Bytes, 16) or (OrdAt(Bytes, 17) shl 8));
{ No PT_INTERP (program-header type 3): a freestanding binary has no dynamic
loader. }
PhOff := OrdAt(Bytes, 32) or (OrdAt(Bytes, 33) shl 8) or
(OrdAt(Bytes, 34) shl 16) or (OrdAt(Bytes, 35) shl 24);
PhEntSz := OrdAt(Bytes, 54) or (OrdAt(Bytes, 55) shl 8);
PhCount := OrdAt(Bytes, 56) or (OrdAt(Bytes, 57) shl 8);
FoundInterp := False;
for J := 0 to PhCount - 1 do
begin
PType := OrdAt(Bytes, PhOff + J * PhEntSz) or
(OrdAt(Bytes, PhOff + J * PhEntSz + 1) shl 8) or
(OrdAt(Bytes, PhOff + J * PhEntSz + 2) shl 16) or
(OrdAt(Bytes, PhOff + J * PhEntSz + 3) shl 24);
if PType = 3 then FoundInterp := True;
end;
AssertFalse('freestanding FreeBSD exe must have no PT_INTERP', FoundInterp);
end;
initialization
RegisterTest(TElfReaderTests);
RegisterTest(TSectionMergerTests);

16
compiler/src/test/pascal/cp.test.targettoolkit.pas
View file

@ -45,6 +45,10 @@ type
procedure TestResolve_FreeBSDX86_64_ReturnsToolkit;
{ FreeBSD toolkit produces a FreeBSD-OSABI link target (OSABI 9). }
procedure TestFreeBSDToolkit_MakeLinkTarget_IsFreeBSDOSABI;
{ Strategy-B: FreeBSD is freestanding (no libc, always static ET_EXEC);
Linux is not (dynamic libc by default). }
procedure TestTargetIsFreestanding_FreeBSD_True;
procedure TestTargetIsFreestanding_Linux_False;
end;
implementation
@ -135,6 +139,18 @@ begin
end;
end;
procedure TTargetToolkitTests.TestTargetIsFreestanding_FreeBSD_True;
begin
AssertTrue('FreeBSD is a freestanding (Strategy-B, static, no-libc) target',
TargetIsFreestanding(Self.FreeBSDTarget()));
end;
procedure TTargetToolkitTests.TestTargetIsFreestanding_Linux_False;
begin
AssertFalse('Linux links dynamic libc by default, not freestanding',
TargetIsFreestanding(Self.LinuxTarget()));
end;
initialization
RegisterTest(TTargetToolkitTests);