diff --git a/compiler/src/main/pascal/blaise.codegen.driver.pas b/compiler/src/main/pascal/blaise.codegen.driver.pas index 8734c71..da1074f 100644 --- a/compiler/src/main/pascal/blaise.codegen.driver.pas +++ b/compiler/src/main/pascal/blaise.codegen.driver.pas @@ -247,6 +247,22 @@ type function RunProcess(const AExe: string; AArgs: TStringList; out AOutput: string): Integer; +{ Build the leaf-first RTL unit list for a target. The base list is shared; + the OS-specific bits are selected from AOS: + + * the platform-layout adapter (rtl.platform.layout.), and + * for a --static (freestanding, no-libc) link, the kernel leaf that + replaces libc — the freestanding runtime.start.static. in place of + the libc runtime.start, plus runtime.syscall. / runtime.libc. / + runtime.libc2. / runtime.thread.static. and the OS-invariant + runtime.cstub. + + A dynamic (libc) link keeps the plain list with only the layout adapter + swapped. Exposed for unit testing; EnsureRTLObjects drives it off + AOpts.Static and AOpts.Target.OS. Caller owns and frees the result. } +function BuildRTLUnitList(AStatic: Boolean; + AOS: TTargetOS): TStringList; + { Format one --help flag line with the shared 2-space indent and flag column. Single source of truth for the column width so the common usage block (Blaise.pas PrintUsage) and each driver's DescribeOptions @@ -433,6 +449,50 @@ const 'runtime.weak', 'runtime.float', 'runtime.thread', 'runtime.exc', 'rtl.platform.layout.linux', 'rtl.platform.posix'); +{ Lower-case OS suffix used in the OS-specific RTL unit names + (rtl.platform.layout., runtime.syscall., …). } +function RTLOSSuffix(AOS: TTargetOS): string; +begin + case AOS of + osFreeBSD: Result := 'freebsd'; + else + { Linux is the default host leaf; other OSes gain their own suffix as + their adapter set lands. } + Result := 'linux'; + end; +end; + +function BuildRTLUnitList(AStatic: Boolean; AOS: TTargetOS): TStringList; +var + I: Integer; + OS: string; +begin + OS := RTLOSSuffix(AOS); + Result := TStringList.Create(); + { The base list, in leaf-first order. Two OS-specific substitutions: + the platform-layout adapter always follows the target, and for a --static + link the libc entry point (runtime.start) is replaced by the freestanding + per-OS start. A dynamic link keeps runtime.start. } + for I := 0 to High(RTL_UNITS) do + if SameText(RTL_UNITS[I], 'rtl.platform.layout.linux') then + Result.Add('rtl.platform.layout.' + OS) + else if AStatic and SameText(RTL_UNITS[I], 'runtime.start') then + Result.Add('runtime.start.static.' + OS) + else + Result.Add(RTL_UNITS[I]); + { The freestanding kernel leaf that replaces libc under --static: the raw + syscall stubs, the OS-invariant freestanding C functions (runtime.cstub), + the libc-shim layers, and the static-TLS thread leaf. } + if AStatic then + begin + Result.Add('runtime.syscall.' + OS); + Result.Add('runtime.cstub'); + Result.Add('runtime.libc.' + OS); + Result.Add('runtime.libc2.' + OS); + Result.Add('runtime.thread.static.' + OS); + end; +end; + function TBackendDriver.EnsureRTLObjects(AOpts: TBackendOpts; AIncludeStartup: Boolean; AAlreadyProvided, AObjPaths: TStringList): string; var @@ -492,25 +552,12 @@ begin ForceDirectories(BuildDir); BlaiseBin := ParamStr(0); - { The unit list to build/link, in leaf-first order. For a --static link the - kernel leaf replaces libc: drop runtime.start (libc/__libc_start_main entry) - in favour of the freestanding runtime.start.static., and add the raw - syscall stubs (runtime.syscall.) + the freestanding C functions - (runtime.cstub). A dynamic (libc) link uses the plain RTL_UNITS. } - Units := TStringList.Create(); - for I := 0 to High(RTL_UNITS) do - if AOpts.Static and SameText(RTL_UNITS[I], 'runtime.start') then - Units.Add('runtime.start.static.linux') - else - Units.Add(RTL_UNITS[I]); - if AOpts.Static then - begin - Units.Add('runtime.syscall.linux'); - Units.Add('runtime.cstub'); - Units.Add('runtime.libc.linux'); - Units.Add('runtime.libc2.linux'); - Units.Add('runtime.thread.static.linux'); - end; + { 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); for I := 0 to Units.Count - 1 do begin diff --git a/compiler/src/test/pascal/cp.test.driver.pas b/compiler/src/test/pascal/cp.test.driver.pas index 3bfe0bb..a84fee7 100644 --- a/compiler/src/test/pascal/cp.test.driver.pas +++ b/compiler/src/test/pascal/cp.test.driver.pas @@ -22,12 +22,24 @@ interface uses SysUtils, Classes, blaise.testing, blaise.codegen.driver, + blaise.codegen.target, { TTargetOS: osLinux / osFreeBSD } blaise.codegen.qbe.driver, { registers the QBE driver } blaise.codegen.native.driver; { registers the native driver } type TBackendDriverContractTests = class(TTestCase) + private + function ListContains(AList: TStringList; const AName: string): Boolean; published + { Per-target RTL unit-list selection (FreeBSD Step 5). BuildRTLUnitList is + the pure selection helper EnsureRTLObjects drives off AOpts.Static + + AOpts.Target.OS; these assert Linux vs FreeBSD swaps without invoking the + whole compile+link pipeline. } + procedure TestRTLUnits_LinuxDynamic_UsesLinuxLayout; + procedure TestRTLUnits_LinuxStatic_SwapsLinuxLeaf; + procedure TestRTLUnits_FreeBSDStatic_SwapsFreeBSDLeaf; + procedure TestRTLUnits_FreeBSDStatic_NoLinuxLeaf; + { ClaimsEmitIR selection policy. } procedure TestQBE_ClaimsEmitIR_True; procedure TestNative_ClaimsEmitIR_False; @@ -54,6 +66,107 @@ type implementation +function TBackendDriverContractTests.ListContains(AList: TStringList; + const AName: string): Boolean; +var + I: Integer; +begin + Result := False; + for I := 0 to AList.Count - 1 do + if SameText(AList.Strings[I], AName) then + Exit(True); +end; + +procedure TBackendDriverContractTests.TestRTLUnits_LinuxDynamic_UsesLinuxLayout; +var + U: TStringList; +begin + { A dynamic (libc) Linux link keeps the plain RTL list: the Linux layout + adapter is present and no freestanding kernel leaf is pulled in. } + U := BuildRTLUnitList(False, osLinux); + try + AssertTrue('linux layout present', + ListContains(U, 'rtl.platform.layout.linux')); + AssertFalse('no static start in dynamic mode', + ListContains(U, 'runtime.start.static.linux')); + AssertFalse('no syscall leaf in dynamic mode', + ListContains(U, 'runtime.syscall.linux')); + finally + U.Free(); + end; +end; + +procedure TBackendDriverContractTests.TestRTLUnits_LinuxStatic_SwapsLinuxLeaf; +var + U: TStringList; +begin + { A --static Linux link swaps runtime.start for the freestanding + runtime.start.static.linux and adds the Linux syscall/cstub/libc leaf. } + U := BuildRTLUnitList(True, osLinux); + try + AssertTrue('freestanding start present', + ListContains(U, 'runtime.start.static.linux')); + AssertFalse('libc start dropped', + ListContains(U, 'runtime.start')); + AssertTrue('linux syscall leaf present', + ListContains(U, 'runtime.syscall.linux')); + AssertTrue('linux libc2 present', + ListContains(U, 'runtime.libc2.linux')); + AssertTrue('linux static thread leaf present', + ListContains(U, 'runtime.thread.static.linux')); + AssertTrue('linux layout present', + ListContains(U, 'rtl.platform.layout.linux')); + finally + U.Free(); + end; +end; + +procedure TBackendDriverContractTests.TestRTLUnits_FreeBSDStatic_SwapsFreeBSDLeaf; +var + U: TStringList; +begin + { A --static FreeBSD link selects the FreeBSD adapter set: the FreeBSD + layout, freestanding start, syscall leaf, libc2 and static thread leaf. } + U := BuildRTLUnitList(True, osFreeBSD); + try + AssertTrue('freebsd layout present', + ListContains(U, 'rtl.platform.layout.freebsd')); + AssertTrue('freebsd freestanding start present', + ListContains(U, 'runtime.start.static.freebsd')); + AssertTrue('freebsd syscall leaf present', + ListContains(U, 'runtime.syscall.freebsd')); + AssertTrue('freebsd libc2 present', + ListContains(U, 'runtime.libc2.freebsd')); + AssertTrue('freebsd static thread leaf present', + ListContains(U, 'runtime.thread.static.freebsd')); + finally + U.Free(); + end; +end; + +procedure TBackendDriverContractTests.TestRTLUnits_FreeBSDStatic_NoLinuxLeaf; +var + U: TStringList; +begin + { The FreeBSD list must contain NO Linux-specific RTL unit — the whole point + of the per-target swap. } + U := BuildRTLUnitList(True, osFreeBSD); + try + AssertFalse('no linux layout', + ListContains(U, 'rtl.platform.layout.linux')); + AssertFalse('no linux start', + ListContains(U, 'runtime.start.static.linux')); + AssertFalse('no linux syscall leaf', + ListContains(U, 'runtime.syscall.linux')); + AssertFalse('no linux libc2', + ListContains(U, 'runtime.libc2.linux')); + AssertFalse('no linux static thread leaf', + ListContains(U, 'runtime.thread.static.linux')); + finally + U.Free(); + end; +end; + procedure TBackendDriverContractTests.TestQBE_ClaimsEmitIR_True; begin AssertTrue('QBE must claim --emit-ir',