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

fix(incremental): make cached-interface rebuild lossless and coherent

Browse source 
Incremental compilation (per-unit .o + embedded .bif, the default) produced
silently corrupt binaries when rebuilding into a populated --unit-cache: the
clean build worked, but any rebuild that loaded a unit from its cached .bif
instead of source dropped or mishandled state the in-memory path carried.
Root cause is uniform across every symptom: the .bif round-trip was not a
complete projection of the unit interface, and the cached-load path in the
loader/driver diverged from the source-load path.

.bif format bumped to version 3 (IFACE_VERSION; CompilerId +bif tag) so stale
caches are cleanly rejected and recompiled from source.

Fixes (each was a field/decision present on the source path, absent on the
cached path):

- Loader: a unit's implementation-section `uses` were never recorded in the
  .bif, so on rebuild the impl-only dependency's object was dropped from the
  link (undefined symbol). Record ImplUsedUnits in the .bif and collect those
  objects for LINK ONLY (CollectLinkOnlyObject) — not semantic import, which
  would break the leaf-first iface import on interface/impl-use cycles.

- Native codegen: a global var owned by a cached unit was re-defined by the
  recompiled top program (`multiple definition of GTarget`). The program now
  references imported-unit globals as external (FImportedUnits / IsImportedGlobal
  gate in EmitDataSection); NoteDepInitUnit records every imported unit.

- Unit initialization: <Unit>_init calls for cached deps were never emitted, so
  initialization sections silently never ran. Record HasInitialization in the
  .bif and note prebuilt-iface inits in dependency order at program codegen.

- SynthesiseMethodDecl dropped VTableSlot/IsVirtual/IsOverride from cached
  method imports, degrading virtual dispatch to direct calls into the abstract
  base (SIGABRT at run time). Propagate them.

- Generic-instance field/param types now resolve via the analyser's generic-
  aware resolver on import (ResolveImportedTypeName); generic instantiation
  during import no longer nil-derefs FProg/FCurrentUnit (pending-instance flush).

- .bif round-trip completeness: serialise block-local var decls, Exit(value)
  return values, parameter default values, free-routine ResolvedQbeName,
  generic-class template properties, and fix implements-interface name
  stripping (strip to the last dot, not the first).

Adds TestIncrementalRebuild_ImplOnlyUses_LinksDependency (e2e) and updates the
magic/version assertion. Full suite OK (3722 tests); QBE, native, and
internal-assembler fixpoints pass; clean and warm-cache rebuilds both produce
correct binaries.
This commit is contained in:
Graeme Geldenhuys 2026-06-22 12:23:28 +01:00
parent baf5079d6d
commit 915077d7c8
12 changed files with 578 additions and 77 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
compiler/src/main/pascal/Blaise.pas
View file

@ -860,24 +860,45 @@ begin
CG.AppendUnit(TUnit(Units.Items[I]));
CG.AppendUnit(TopUnit);
end
else if (Units <> nil) and (Units.Count > 0) then
else if ((Units <> nil) and (Units.Count > 0)) or
((Loader <> nil) and (Loader.PrebuiltIfaces.Count > 0)) then
begin
CG.SetSymbolTable(Prog.SymbolTable);
{ Prebuilt (cached) ifaces are ALWAYS compiled into their own objects —
their bodies are never appended here, regardless of SkipDepCodegen.
So they must be noted as imported units unconditionally: the program
startup must call each one's <Unit>_init (if it has an initialization
section), and the backend must treat globals owned by these units as
external references rather than re-defining them (otherwise the link
step reports a multiple definition — the cached .o owns the symbol).
They are loaded leaf-first and any source units depend on them, so
their inits must run before the source deps' inits. On a full rebuild
every dep is cached, so this is the only loop that fires. }
if Loader <> nil then
for I := 0 to Loader.PrebuiltIfaces.Count - 1 do
CG.NoteDepInitUnit(
TUnitInterface(Loader.PrebuiltIfaces.Items[I]).Name,
TUnitInterface(Loader.PrebuiltIfaces.Items[I]).HasInitialization);
if not SkipDepCodegen then
for I := 0 to Units.Count - 1 do
CG.AppendUnit(TUnit(Units.Items[I]))
begin
{ Source-loaded deps are compiled inline into this object — append
their bodies; they are not imported, so do not note them. }
if Units <> nil then
for I := 0 to Units.Count - 1 do
CG.AppendUnit(TUnit(Units.Items[I]));
end
else
{ Incremental / separate-compilation: dep bodies are compiled into
their own objects, so AppendUnit is skipped here. But the program
startup must still call each dep unit's <Unit>_init if it has an
initialization section, in dependency order — otherwise unit
initialization silently never runs. Register the init-unit names
so AppendProgram's $main emits the calls (they resolve against the
<Unit>_init symbols exported by the per-unit objects). }
for I := 0 to Units.Count - 1 do
CG.NoteDepInitUnit(TUnit(Units.Items[I]).Name,
(TUnit(Units.Items[I]).InitStmts <> nil) and
(TUnit(Units.Items[I]).InitStmts.Count > 0));
begin
{ Incremental / separate-compilation: source dep bodies are compiled
into their own objects (skipped here). Note each so $main calls its
<Unit>_init and the backend references its globals externally. }
if Units <> nil then
for I := 0 to Units.Count - 1 do
CG.NoteDepInitUnit(TUnit(Units.Items[I]).Name,
(TUnit(Units.Items[I]).InitStmts <> nil) and
(TUnit(Units.Items[I]).InitStmts.Count > 0));
end;
CG.AppendProgram(Prog);
end
else
@ -934,8 +955,14 @@ begin
Loader.Free wipes them — needed by the link-step dispatch
below the finally block. }
if Loader <> nil then
begin
for I := 0 to Loader.PrebuiltObjectPaths.Count - 1 do
PrebuiltObjPaths.Add(Loader.PrebuiltObjectPaths.Strings[I]);
{ Impl-only dependency objects: linked but not semantically imported. }
for I := 0 to Loader.LinkOnlyObjects.Count - 1 do
if PrebuiltObjPaths.IndexOf(Loader.LinkOnlyObjects.Strings[I]) < 0 then
PrebuiltObjPaths.Add(Loader.LinkOnlyObjects.Strings[I]);
end;
Units.Free();
Loader.Free();
SearchPaths.Free();

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

@ -173,6 +173,14 @@ type
AppendUnit order. $main calls <Unit>_init for each, in order, after
_SetArgs — mirrors the QBE backend's EmitMainHeader loop. }
FUnitInitNames: TStringList;
{ Names of dependency units imported from cached .bif/.o in incremental /
separate-compilation mode (SkipDepCodegen). A global whose owning unit
is in this set is DEFINED by that unit's own object — this program/unit
object must only REFERENCE it (no .globl/label definition), otherwise the
linker reports a multiple definition. Recorded by NoteDepInitUnit for
every imported unit regardless of whether it has an initialization
section. Stores raw (unmangled) unit names, matching TSymbol.OwningUnit. }
FImportedUnits: TStringList;
FCurrentUnitName: string;
FProgramName: string; { set by EmitProgram — program-scope classes keep
bare symbol names (no unit prefix), matching
@ -192,6 +200,10 @@ type
procedure MarkWeakGlobal(const AName: string);
function IsThreadVarGlobal(const AName: string): Boolean;
function IsWeakGlobal(const AName: string): Boolean;
{ True when the global's owning unit was imported from a cached .bif/.o
(SkipDepCodegen): the cached object DEFINES the global, so this object
must reference it only — emitting a definition here would clash at link. }
function IsImportedGlobal(const AName: string): Boolean;
{ The static type of a frame-local slot, or nil if AName is not a local. }
function LocalType(const AName: string): TTypeDesc;
{ The static type of a program global, or nil if AName is not registered. }
@ -794,6 +806,10 @@ begin
FProgExcFrameCount := 0;
FSystemDefsEmitted := False;
FUnitInitNames := TStringList.Create();
FImportedUnits := TStringList.Create();
FImportedUnits.CaseSensitive := False;
FImportedUnits.Sorted := True;
FImportedUnits.Duplicates := dupIgnore;
FConstArgUnsafe := TStringList.Create();
FConstArgUnsafe.CaseSensitive := True;
FConstArgUnsafe.Sorted := True;
@ -804,6 +820,7 @@ destructor TX86_64Backend.Destroy;
begin
Self.ClearFrame();
FConstArgUnsafe.Free();
FImportedUnits.Free();
FUnitInitNames.Free();
FOALFrames.Free();
FFinallyStack.Free();
@ -869,6 +886,24 @@ begin
Result := nil;
end;
function TX86_64Backend.IsImportedGlobal(const AName: string): Boolean;
var
Sym: TSymbol;
begin
{ A global whose owning unit was imported from a cached .bif/.o (incremental /
separate compilation) is DEFINED by that unit's own object. This object must
only reference it (no .globl/label here), or the linker reports a multiple
definition. References (leaq Name(%rip)) resolve against the cached object's
exported symbol. }
Result := False;
if FImportedUnits.Count = 0 then Exit;
if FSymTable = nil then Exit;
Sym := FSymTable.Lookup(AName);
if Sym = nil then Exit;
if Sym.OwningUnit = '' then Exit;
Result := FImportedUnits.IndexOf(Sym.OwningUnit) >= 0;
end;
procedure TX86_64Backend.EmitDataSection;
var
I, Sz: Integer;
@ -888,6 +923,8 @@ begin
HasTbss := False;
for I := 0 to FDataGlobals.Count - 1 do
begin
if Self.IsImportedGlobal(FDataGlobals.Keys[I]) then
Continue;
if Self.IsThreadVarGlobal(FDataGlobals.Keys[I]) then
HasTbss := True
else
@ -901,6 +938,7 @@ begin
for I := 0 to FDataGlobals.Count - 1 do
begin
Name := FDataGlobals.Keys[I];
if Self.IsImportedGlobal(Name) then Continue;
IsTls := Self.IsThreadVarGlobal(Name);
if IsTls then Continue;
{ Initialised global (var G: T = value): emit the folded value. threadvars
@ -1008,6 +1046,7 @@ begin
for I := 0 to FDataGlobals.Count - 1 do
begin
Name := FDataGlobals.Keys[I];
if Self.IsImportedGlobal(Name) then Continue;
if not Self.IsThreadVarGlobal(Name) then Continue;
if (Self.GlobalType(Name) <> nil) and
(IsJumboSet(Self.GlobalType(Name)) or
@ -15963,6 +16002,10 @@ begin
matches EmitUnit's FUnitInitNames.Add(NativeMangle(AUnit.Name)). }
if AHasInit then
FUnitInitNames.Add(NativeMangle(AUnitName));
{ Record the imported unit (raw name, matching TSymbol.OwningUnit) so
EmitDataSection emits globals owned by it as references, not definitions —
the cached object owns the definition. }
FImportedUnits.Add(AUnitName);
end;
procedure TX86_64Backend.FinalizeEmit;

6
compiler/src/main/pascal/uAST.pas
View file

@ -773,6 +773,11 @@ type
DefaultValue: TASTExpr; { owned — non-nil when the param has a default value
('= expr' after the type); restricted to literal forms
(int/float/string/nil) and named-constant idents. }
HasDefault: Boolean; { set when this param has a default value but the value
AST itself is unavailable — e.g. a method imported
from a cached .bif, which records only that a default
exists (so MinArity/overload resolution accept fewer
args) without serialising the default expression. }
destructor Destroy; override;
end;
@ -2313,6 +2318,7 @@ begin
Result.IsOutParam := ASrc.IsOutParam;
Result.IsOpenArray := ASrc.IsOpenArray;
Result.DefaultValue := CloneExpr(ASrc.DefaultValue);
Result.HasDefault := ASrc.HasDefault;
end;
function CloneMethodDecl(ASrc: TMethodDecl): TMethodDecl;

2
compiler/src/main/pascal/uCompilerId.pas
View file

@ -24,7 +24,7 @@ unit uCompilerId;
interface
const
COMPILER_ID = 'blaise-0.11.0-SNAPSHOT+bif1';
COMPILER_ID = 'blaise-0.12.0-SNAPSHOT+bif2';
implementation

121
compiler/src/main/pascal/uSemantic.pas
View file

@ -49,6 +49,16 @@ type
AddGroupEntry is also added here, which retains it for the analyser's
lifetime; the destructor frees this list, releasing the groups. }
FGroupKeepAlive: TObjectList;
{ Generic instances created while no program/unit is being analysed —
i.e. when ImportUnitInterface triggers FindTypeOrInstantiate to resolve
a cached iface's generic-instance field type (e.g. 'TList<TFoo>') before
Analyse/AnalyseUnit has set FProg/FCurrentUnit. Holding them here (non-
owning) avoids a nil-deref on FProg.GenericInstances.Add; FlushPending
GenericInstances moves them into the real owner once analysis begins so
codegen still emits the instance's methods. }
FPendingGenericInstances: TObjectList; { TGenericInstance — not owned }
FPendingGenericRecordInstances: TObjectList; { TGenericRecordInstance — not owned }
FPendingGenericIntfInstances: TObjectList; { TGenericInterfaceInstance — not owned }
FGenericFuncTemplates: TStringList; { base name → TMethodDecl template (not owned) }
FGenericMethodTemplates: TStringList; { 'OwnerType.Method' → TMethodDecl template (not owned) — generic methods with method-level <T> }
FLoopDepth: Integer; { depth of enclosing while/for — Break only legal if > 0 }
@ -186,6 +196,10 @@ type
procedure LinkClassMethodImpls(ABlock: TBlock);
procedure LinkGenericClassMethodImpls(ABlock: TBlock);
procedure RepairEarlyGenericInstances;
{ Move any generic instances parked at import time (FProg/FCurrentUnit
both nil) into the now-current program or unit, so codegen emits their
method bodies. Called at the start of Analyse / AnalyseUnit. }
procedure FlushPendingGenericInstances;
procedure AnalyseMethodBodies(ABlock: TBlock);
procedure AnalyseMethodDecl(AMethod: TMethodDecl; AClassType: TRecordTypeDesc);
procedure AnalyseStandaloneDecls(ABlock: TBlock);
@ -375,6 +389,15 @@ type
procedure RegisterImportedMethod(const ATypeName: string;
ADecl: TMethodDecl);
{ Public entry to the on-demand type resolver used by the source
compile path. uSemanticImport calls this to resolve a cached
iface's type-name string (e.g. a field type 'TList<TFoo>' or an
'array of TFoo') that is not a plain registered symbol — the
import path otherwise has no way to instantiate generics, so a
generic-instance field type from a .bif fails to resolve. Mirrors
what AnalyseUnitForExport does for the same field in source form. }
function ResolveImportedTypeName(const AName: string): TTypeDesc;
{ Register a TUnitInterface in FUnitIfaces, keyed by AIface.Name.
AIface is NOT owned — caller (Blaise.pas) retains lifetime.
Subsequent registrations of the same name replace the entry
@ -524,11 +547,17 @@ begin
FUnitSymbols.CaseSensitive := False;
FActiveTypeParams := TStringList.Create();
FActiveTypeParams.CaseSensitive := False;
FPendingGenericInstances := TObjectList.Create(False);
FPendingGenericRecordInstances := TObjectList.Create(False);
FPendingGenericIntfInstances := TObjectList.Create(False);
FLoopDepth := 0;
end;
destructor TSemanticAnalyser.Destroy;
begin
FPendingGenericIntfInstances.Free();
FPendingGenericRecordInstances.Free();
FPendingGenericInstances.Free();
FActiveTypeParams.Free();
FUnitSymbols.Free();
FUnitIfaces.Free();
@ -1039,6 +1068,7 @@ var
I: Integer;
begin
FProg := AProg;
FlushPendingGenericInstances;
FCurrentUnitName := AProg.Name;
BuildUsesChain(AProg.UsedUnits);
FTable.UsesChainProvider := Self;
@ -1072,6 +1102,7 @@ var
begin
FCurrentUnitName := AUnit.Name;
FCurrentUnit := AUnit;
FlushPendingGenericInstances;
FTable.PushScope();
try
{ The unit's own name and the names of directly used units are
@ -1396,6 +1427,7 @@ var
begin
FCurrentUnitName := AUnit.Name;
FCurrentUnit := AUnit;
FlushPendingGenericInstances;
BuildUsesChain(AUnit.UsedUnits);
FTable.UsesChainProvider := Self;
{ Auto-tag every global Define within this unit's analysis with the
@ -1704,6 +1736,11 @@ begin
AddGroupEntry(FMethodGroups, ATypeName + '.' + ADecl.Name, ADecl);
end;
function TSemanticAnalyser.ResolveImportedTypeName(const AName: string): TTypeDesc;
begin
Result := Self.FindTypeOrInstantiate(AName);
end;
procedure TSemanticAnalyser.RegisterUnitIface(AIface: TUnitInterface);
var
Idx, I: Integer;
@ -2005,6 +2042,39 @@ begin
end;
end;
procedure TSemanticAnalyser.FlushPendingGenericInstances;
var
I: Integer;
begin
if FCurrentUnit <> nil then
begin
for I := 0 to FPendingGenericInstances.Count - 1 do
FCurrentUnit.GenericInstances.Add(FPendingGenericInstances.Items[I]);
for I := 0 to FPendingGenericRecordInstances.Count - 1 do
FCurrentUnit.GenericRecordInstances.Add(
FPendingGenericRecordInstances.Items[I]);
for I := 0 to FPendingGenericIntfInstances.Count - 1 do
FCurrentUnit.GenericIntfInstances.Add(
FPendingGenericIntfInstances.Items[I]);
end
else if FProg <> nil then
begin
for I := 0 to FPendingGenericInstances.Count - 1 do
FProg.GenericInstances.Add(FPendingGenericInstances.Items[I]);
for I := 0 to FPendingGenericRecordInstances.Count - 1 do
FProg.GenericRecordInstances.Add(
FPendingGenericRecordInstances.Items[I]);
for I := 0 to FPendingGenericIntfInstances.Count - 1 do
FProg.GenericIntfInstances.Add(
FPendingGenericIntfInstances.Items[I]);
end
else
Exit;
FPendingGenericInstances.Clear();
FPendingGenericRecordInstances.Clear();
FPendingGenericIntfInstances.Clear();
end;
procedure TSemanticAnalyser.RepairEarlyGenericInstances;
var
Instances: TObjectList;
@ -2685,8 +2755,16 @@ var
ParentSym: TSymbol;
ParentRT: TRecordTypeDesc;
FldInfo: TFieldInfo;
DeferBodies: Boolean;
begin
Result := nil;
{ No program/unit context yet (ImportUnitInterface resolving a cached
iface's generic-instance field type). Build the type descriptor +
fields now, but leave method bodies nil and park the instance — once
Analyse/AnalyseUnit sets a context, RepairEarlyGenericInstances clones
and analyses the bodies. Analysing them here would deref nil FProg/
FCurrentUnit deep in the body walk. }
DeferBodies := (FProg = nil) and (FCurrentUnit = nil);
{ Parse 'BaseName<Arg1,Arg2>' }
BracPos := StrPos('<', ATypeName);
@ -2777,13 +2855,16 @@ begin
NewMDecl.OwnerTypeName := ATypeName;
NewMDecl.IsVirtual := MDecl.IsVirtual;
NewMDecl.IsOverride := MDecl.IsOverride;
if MDecl.Body <> nil then
if (MDecl.Body <> nil) and (not DeferBodies) then
begin
NewMDecl.Body := CloneBlock(MDecl.Body);
NewMDecl.OwnBody := True;
end
else
begin
{ Body left nil — either the template is signature-only, or we are
deferring body analysis to RepairEarlyGenericInstances (which only
repairs methods whose Body is still nil). }
NewMDecl.Body := nil;
NewMDecl.OwnBody := False;
end;
@ -3028,8 +3109,13 @@ begin
GI.DefUnitName := Templ.DefUnitName;
if FCurrentUnit <> nil then
FCurrentUnit.GenericInstances.Add(GI)
else if FProg <> nil then
FProg.GenericInstances.Add(GI)
else
FProg.GenericInstances.Add(GI);
{ Instantiated during ImportUnitInterface, before Analyse/AnalyseUnit
has set a program/unit owner. Park it; FlushPendingGenericInstances
hands it to the real owner once analysis starts. }
FPendingGenericInstances.Add(GI);
Result := RT;
finally
@ -3060,8 +3146,13 @@ var
RT: TRecordTypeDesc;
GRI: TGenericRecordInstance;
ConcrType: TTypeDesc;
DeferBodies: Boolean;
begin
Result := nil;
{ See InstantiateGeneric — defer body clone+analysis when there is no
program/unit context (import-time resolution of a cached field type).
RepairEarlyGenericInstances re-clones and analyses the bodies later. }
DeferBodies := (FProg = nil) and (FCurrentUnit = nil);
BracPos := StrPos('<', ATypeName);
if BracPos < 0 then Exit;
@ -3120,13 +3211,15 @@ begin
NewMDecl.Name := MDecl.Name;
NewMDecl.OwnerTypeName := ATypeName;
NewMDecl.IsRecordMethod := True;
if MDecl.Body <> nil then
if (MDecl.Body <> nil) and (not DeferBodies) then
begin
NewMDecl.Body := CloneBlock(MDecl.Body);
NewMDecl.OwnBody := True;
end
else
begin
{ Body left nil — signature-only template, or deferred to
RepairEarlyGenericInstances (import-time, no program context). }
NewMDecl.Body := nil;
NewMDecl.OwnBody := False;
end;
@ -3228,8 +3321,10 @@ begin
GRI.TypeDesc := RT;
if FCurrentUnit <> nil then
FCurrentUnit.GenericRecordInstances.Add(GRI)
else if FProg <> nil then
FProg.GenericRecordInstances.Add(GRI)
else
FProg.GenericRecordInstances.Add(GRI);
FPendingGenericRecordInstances.Add(GRI);
Result := RT;
finally
@ -3329,8 +3424,10 @@ begin
GII.TypeDesc := Result;
if FCurrentUnit <> nil then
FCurrentUnit.GenericIntfInstances.Add(GII)
else if FProg <> nil then
FProg.GenericIntfInstances.Add(GII)
else
FProg.GenericIntfInstances.Add(GII);
FPendingGenericIntfInstances.Add(GII);
finally
Args.Free();
end;
@ -7935,7 +8032,8 @@ var
I: Integer;
begin
for I := 0 to ADecl.Params.Count - 1 do
if TMethodParam(ADecl.Params.Items[I]).DefaultValue <> nil then
if (TMethodParam(ADecl.Params.Items[I]).DefaultValue <> nil) or
(TMethodParam(ADecl.Params.Items[I]).HasDefault) then
begin
Exit(I);
end;
@ -7955,10 +8053,13 @@ begin
PSrc := TMethodParam(AFrom.Params.Items[I]);
PDst := TMethodParam(AInto.Params.Items[I]);
if (PSrc.DefaultValue <> nil) and (PDst.DefaultValue = nil) then
begin
PDst.DefaultValue := PSrc.DefaultValue;
PSrc.DefaultValue := nil; { ownership transferred }
end;
{ Clone rather than move: the source is the interface forward decl,
which uSemanticExport later serialises into the unit's .bif. Moving
(nil-ing PSrc) stripped the default from the exported signature, so a
caller in a SEPARATE compilation that loaded the unit from its cached
.bif could not omit the defaulted trailing arguments. Both decls now
keep their own copy. }
PDst.DefaultValue := CloneExpr(PSrc.DefaultValue);
end;
end;

11
compiler/src/main/pascal/uSemanticExport.pas
View file

@ -465,9 +465,14 @@ procedure CopyUsedUnits(AUnit: TUnit; AIface: TUnitInterface);
var
I: Integer;
begin
if AUnit.UsedUnits = nil then Exit;
for I := 0 to AUnit.UsedUnits.Count - 1 do
AIface.UsedUnits.Add(AUnit.UsedUnits.Strings[I]);
if AUnit.UsedUnits <> nil then
for I := 0 to AUnit.UsedUnits.Count - 1 do
AIface.UsedUnits.Add(AUnit.UsedUnits.Strings[I]);
if AUnit.ImplUsedUnits <> nil then
for I := 0 to AUnit.ImplUsedUnits.Count - 1 do
AIface.ImplUsedUnits.Add(AUnit.ImplUsedUnits.Strings[I]);
AIface.HasInitialization :=
(AUnit.InitStmts <> nil) and (AUnit.InitStmts.Count > 0);
end;
{ ----- Top-level ------------------------------------------------- }

131
compiler/src/main/pascal/uSemanticImport.pas
View file

@ -62,6 +62,24 @@ implementation
{ ----- Type-ref resolution -------------------------------------- }
{ Return the bare type name from a possibly unit-qualified name. The
unit qualifier may itself be dotted (e.g. 'blaise.codegen.ICodeGen'),
so everything up to and including the LAST '.' is removed. Names with
no '.' are returned unchanged. Uses StrAt (0-based) per house style. }
function StripUnitQualifier(const AName: string): string;
var
I, LastDot: Integer;
begin
LastDot := -1;
for I := 0 to Length(AName) - 1 do
if StrAt(AName, I) = Ord('.') then
LastDot := I;
if LastDot < 0 then
Result := AName
else
Result := StrCopyTail(AName, LastDot + 1);
end;
{ Resolve a TQualTypeRef to a TTypeDesc by name lookup. After topo-
order import, every referenced symbol is already in ATable. }
function ResolveTypeName(const ATypeName: string; ATable: TSymbolTable): TTypeDesc;
@ -135,6 +153,34 @@ begin
end;
end;
{ Resolve a type-name string from a cached iface entry to a TTypeDesc,
trying every avenue the source-compile path has: a registered symbol,
an inline type pattern ('^T', 'array of T', etc.), and finally the
semantic analyser's on-demand resolver, which instantiates generics
('TList<TFoo>') and synthesises anonymous array/set types. The last
step is only available when ASemantic is non-nil (the Blaise.pas
prebuilt-iface path always passes it); without it generic-instance
field types from a .bif cannot be resolved. }
function ResolveImportTypeName(const ATypeName: string;
ATable: TSymbolTable;
ASemantic: TSemanticAnalyser): TTypeDesc;
var
Sym: TSymbol;
begin
Result := nil;
if ATypeName = '' then Exit;
Sym := ATable.Lookup(ATypeName);
if (Sym <> nil) and (Sym.Kind = skType) then
begin
Result := Sym.TypeDesc;
Exit;
end;
Result := ResolveInlineTypeName(ATypeName, ATable);
if Result <> nil then Exit;
if ASemantic <> nil then
Result := ASemantic.ResolveImportedTypeName(ATypeName);
end;
{ ----- Type-entry registration ---------------------------------- }
procedure RegisterEnum(AEntry: TTypeEntry; ATable: TSymbolTable;
@ -415,12 +461,7 @@ begin
for I := 0 to ClassDef.Fields.Count - 1 do
begin
FldDecl := TFieldDecl(ClassDef.Fields.Items[I]);
FldType := nil;
FldSym := ATable.Lookup(FldDecl.TypeName);
if (FldSym <> nil) and (FldSym.Kind = skType) then
FldType := FldSym.TypeDesc
else
FldType := ResolveInlineTypeName(FldDecl.TypeName, ATable);
FldType := ResolveImportTypeName(FldDecl.TypeName, ATable, ASemantic);
if FldType = nil then
raise EImportError.CreateFmt(
'Class %s field type %s unresolved',
@ -442,7 +483,7 @@ begin
if ASemantic <> nil then
begin
MDecl := SynthesiseMethodDecl(
TRoutineSig(AEntry.Methods.Items[I]), AUnitName, ATable);
TRoutineSig(AEntry.Methods.Items[I]), AUnitName, ATable, ASemantic);
ATable.OwnImportedDecl(MDecl);
ASemantic.RegisterImportedMethod(AEntry.Name, MDecl);
end;
@ -454,8 +495,11 @@ begin
for I := 0 to AEntry.Implements.Count - 1 do
begin
ParentName := AEntry.Implements.Strings[I];
J := Pos('.', ParentName);
if J > 0 then ParentName := Copy(ParentName, J + 1, Length(ParentName) - J);
{ Strip any 'Unit.' qualifier — the unit name may itself be dotted
(e.g. 'blaise.codegen.ICodeGen'), so take the segment after the
LAST '.' as the type name. The flat symbol-table namespace carries
no unit qualification. }
ParentName := StripUnitQualifier(ParentName);
Sym := ATable.Lookup(ParentName);
if (Sym <> nil) and (Sym.TypeDesc is TInterfaceTypeDesc) then
RT.AddImplements(TInterfaceTypeDesc(Sym.TypeDesc));
@ -522,11 +566,12 @@ begin
end;
procedure RegisterRecord(AEntry: TTypeEntry; ATable: TSymbolTable;
const AUnitName: string);
const AUnitName: string;
ASemantic: TSemanticAnalyser = nil);
var
RecDef: TRecordTypeDef;
RecDesc: TRecordTypeDesc;
Sym, FldSym: TSymbol;
Sym: TSymbol;
I, J: Integer;
FldDecl: TFieldDecl;
FldType: TTypeDesc;
@ -552,12 +597,7 @@ begin
for I := 0 to RecDef.Fields.Count - 1 do
begin
FldDecl := TFieldDecl(RecDef.Fields.Items[I]);
FldType := nil;
FldSym := ATable.Lookup(FldDecl.TypeName);
if (FldSym <> nil) and (FldSym.Kind = skType) then
FldType := FldSym.TypeDesc
else
FldType := ResolveInlineTypeName(FldDecl.TypeName, ATable);
FldType := ResolveImportTypeName(FldDecl.TypeName, ATable, ASemantic);
if FldType = nil then
raise EImportError.CreateFmt(
'Record %s field type %s unresolved',
@ -696,7 +736,7 @@ begin
else if Entry.Def is TClassTypeDef then
RegisterClass(Entry, ATable, AIface.Name, ASemantic)
else if Entry.Def is TRecordTypeDef then
RegisterRecord(Entry, ATable, AIface.Name)
RegisterRecord(Entry, ATable, AIface.Name, ASemantic)
else if Entry.Def is TProceduralTypeDef then
RegisterProcType(Entry, ATable, AIface.Name)
else
@ -772,20 +812,16 @@ end;
{ Build a TParamDesc for the symbol table from a cloned TMethodParam.
Param types must already be registered in ATable (caller imported
the dep, or it's a builtin). }
function BuildParamDesc(AParam: TMethodParam; ATable: TSymbolTable): TParamDesc;
var
Sym: TSymbol;
function BuildParamDesc(AParam: TMethodParam; ATable: TSymbolTable;
ASemantic: TSemanticAnalyser = nil): TParamDesc;
begin
Result := TParamDesc.Create();
Result.Name := AParam.ParamName;
Result.IsConst := AParam.IsConstParam;
Result.IsVar := AParam.IsVarParam;
Sym := ATable.Lookup(AParam.TypeName);
if (Sym <> nil) and (Sym.Kind = skType) then
Result.TypeDesc := Sym.TypeDesc;
{ Unresolved param type leaves TypeDesc nil; downstream call-site
resolution would catch this — but for the cases in 6c-A scope we
expect all param types to resolve. }
{ Generic-aware resolution so an instance param type (e.g.
'TList<TArchiveMember>') resolves rather than leaving TypeDesc nil. }
Result.TypeDesc := ResolveImportTypeName(AParam.TypeName, ATable, ASemantic);
end;
{ Synthesise a TMethodDecl from a TRoutineSig + its return-type
@ -797,20 +833,32 @@ end;
symbol the exporting unit defines. }
function SynthesiseMethodDecl(ASig: TRoutineSig;
const AOwningUnit: string;
ATable: TSymbolTable): TMethodDecl;
ATable: TSymbolTable;
ASemantic: TSemanticAnalyser = nil): TMethodDecl;
var
J: Integer;
Param: TMethodParam;
PSyn: TMethodParam;
Sym: TSymbol;
begin
Result := TMethodDecl.Create();
Result.Name := ASig.Name;
Result.OwningUnit := AOwningUnit;
Result.ReturnTypeName := ASig.ReturnType.TypeName;
Result.ResolvedReturnType :=
ResolveTypeName(ASig.ReturnType.TypeName, ATable);
Result.ResolvedQbeName := MangleUnitPrefix(AOwningUnit) + ASig.Name;
ResolveImportTypeName(ASig.ReturnType.TypeName, ATable, ASemantic);
if ASig.ResolvedQbeName <> '' then
Result.ResolvedQbeName := ASig.ResolvedQbeName
else
Result.ResolvedQbeName := MangleUnitPrefix(AOwningUnit) + ASig.Name;
{ Propagate the vtable-dispatch facts. Without these, a call to a virtual
method resolved from a cached .bif keeps VTableSlot = -1 (the TMethodDecl
default) and codegen emits a DIRECT call to the base/abstract symbol
instead of a vtable dispatch — e.g. an incremental rebuild miscompiles
Driver.CreateUnitCodeGen into a call to the abstract TBackendDriver stub,
aborting at run time. The .bif already carries these (EncodeMethodSig). }
Result.VTableSlot := ASig.VTableSlot;
Result.IsVirtual := ASig.IsVirtual;
Result.IsOverride := ASig.IsOverride;
for J := 0 to ASig.Params.Count - 1 do
begin
Param := TMethodParam(ASig.Params.Items[J]);
@ -820,9 +868,18 @@ begin
PSyn.IsVarParam := Param.IsVarParam;
PSyn.IsConstParam := Param.IsConstParam;
PSyn.IsOpenArray := Param.IsOpenArray;
Sym := ATable.Lookup(Param.TypeName);
if (Sym <> nil) and (Sym.Kind = skType) then
PSyn.ResolvedType := Sym.TypeDesc;
PSyn.HasDefault := Param.HasDefault;
{ Carry the default-value expression through so call sites that omit
the trailing arguments can synthesise them (AppendDefaultArgs). The
.bif round-trips the literal/ident default expression; ownership of
the cloned node passes to PSyn. }
PSyn.DefaultValue := Param.DefaultValue;
Param.DefaultValue := nil;
{ Resolve the param type, including generic instances such as
'TList<TArchiveMember>' — a plain symbol Lookup cannot, so without the
generic-aware resolver the param's ResolvedType stays nil and the
call-site overload scorer rejects every candidate. }
PSyn.ResolvedType := ResolveImportTypeName(Param.TypeName, ATable, ASemantic);
Result.Params.Add(PSyn);
end;
end;
@ -844,7 +901,7 @@ begin
if Sig.IsFunction then
begin
RetType := ResolveTypeName(Sig.ReturnType.TypeName, ATable);
RetType := ResolveImportTypeName(Sig.ReturnType.TypeName, ATable, ASemantic);
Sym := TSymbol.Create(Sig.Name, skFunction, RetType);
end
else
@ -855,7 +912,7 @@ begin
for J := 0 to Sig.Params.Count - 1 do
begin
Param := TMethodParam(Sig.Params.Items[J]);
PDesc := BuildParamDesc(Param, ATable);
PDesc := BuildParamDesc(Param, ATable, ASemantic);
Sym.Params.Add(PDesc);
end;
@ -863,7 +920,7 @@ begin
via FProcIndex. Owned by the symbol table to outlive imports. }
if ASemantic <> nil then
begin
MDecl := SynthesiseMethodDecl(Sig, AIface.Name, ATable);
MDecl := SynthesiseMethodDecl(Sig, AIface.Name, ATable, ASemantic);
ATable.OwnImportedDecl(MDecl);
Sym.Decl := MDecl;
ASemantic.RegisterImportedRoutine(Sig.Name, MDecl);

12
compiler/src/main/pascal/uUnitInterface.pas
View file

@ -187,6 +187,16 @@ type
that the iface is safe to trust. }
UsedUnits: TStringList; { owned — interface-section uses, in order }
ImplUsedUnits: TStringList; { owned — implementation-section uses, in
order. Needed so an incremental rebuild
that loads this unit from its cached .bif
still pulls in (and links) impl-only
dependencies. }
HasInitialization: Boolean; { unit has a non-empty initialization
section. An incremental rebuild loads this
unit from its cached .bif and must still
emit a call to <Unit>_init at program
startup, or the init section never runs. }
Types: TObjectList; { owned TTypeEntry }
Consts: TObjectList; { owned TConstEntry }
@ -372,6 +382,7 @@ begin
inherited Create();
Name := AName;
UsedUnits := TStringList.Create();
ImplUsedUnits := TStringList.Create();
Types := TObjectList.Create(True);
Consts := TObjectList.Create(True);
@ -402,6 +413,7 @@ begin
Consts.Free();
Types.Free();
ImplUsedUnits.Free();
UsedUnits.Free();
inherited Destroy();
end;

113
compiler/src/main/pascal/uUnitInterfaceIO.pas
View file

@ -53,7 +53,11 @@ uses
const
IFACE_MAGIC = 'BLAISE-IFACE';
IFACE_VERSION = 1;
IFACE_VERSION = 3; { v2: META block carries ImplUsedUnits + HasInitialization
v3: EncodeBlock carries local var declarations so generic
template method bodies round-trip with their locals
(e.g. 'var Ptr: ^T'); without this an instantiation
from a cached .bif fails with 'Undeclared variable'. }
type
EIfaceFormatError = class(Exception);
@ -77,6 +81,11 @@ function ContentHashFnv1a64(const AContent: string): string;
implementation
{ Forward — EncodeExpr is defined far below (with the statement/expression
serialiser) but the method-signature writers need it to emit parameter
default values. }
function EncodeExpr(AE: TASTExpr): string; forward;
{ ----- Writer ----------------------------------------------------- }
{ Length-prefixed string: "<len>:bytes". Lets the reader consume
@ -274,7 +283,8 @@ begin
Result := Result +
EncodeLpstr(P.ParamName) +
EncodeLpstr(P.TypeName) +
EncodeParamFlags(P);
EncodeParamFlags(P) +
EncodeExpr(P.DefaultValue);
end;
end;
@ -357,7 +367,8 @@ begin
Result := Result +
EncodeLpstr(P.ParamName) +
EncodeLpstr(P.TypeName) +
EncodeParamFlags(P);
EncodeParamFlags(P) +
EncodeExpr(P.DefaultValue);
end;
end;
@ -422,6 +433,10 @@ begin
M := TMethodDecl(ClassDef.Methods.Items[J]);
Result := Result + EncodeBlock(M.Body);
end;
{ Property declarations — needed so a cached template instantiates with
its properties (e.g. TList<T>.Count, TDictionary<K,V>.Count). Without
these the instance has no properties and 'D.Count' fails to resolve. }
Result := Result + EncodePropertyList(ClassDef.Properties);
end
else
{ Defensive: encode "has-body" flag = false so the reader can
@ -430,7 +445,8 @@ begin
EncodeQualRefParts('', '') +
EncodeLpstr('0') +
EncodeCount(0) + EncodeCount(0) +
EncodeCount(0) + EncodeCount(0);
EncodeCount(0) + EncodeCount(0) +
EncodeCount(0);
end;
function WriteGenericInterfacePayload(AEntry: TTypeEntry): string;
@ -562,6 +578,10 @@ begin
if AParam.IsConstParam then B := B or 2;
if AParam.IsOpenArray then B := B or 4;
if AParam.IsOutParam then B := B or 8;
{ Bit 16: this param has a default value. The default expression itself
is not serialised; the flag is enough for MinArity / overload resolution
to accept calls that omit the trailing defaulted arguments. }
if (AParam.DefaultValue <> nil) or AParam.HasDefault then B := B or 16;
Result := EncodeLpstr(IntToStr(B));
end;
@ -590,9 +610,16 @@ begin
Line := Line +
EncodeLpstr(P.ParamName) +
EncodeLpstr(P.TypeName) +
EncodeParamFlags(P);
EncodeParamFlags(P) +
EncodeExpr(P.DefaultValue);
end;
Line := Line + EncodeLpstr(R.CallingConv);
{ ResolvedQbeName — the mangled link symbol. Required for overloaded
free routines (e.g. GCHashOf): each overload has a distinct mangled
name ('..._GCHashOf_D_S' etc.). Without it the importer falls back
to the unmangled 'Unit_Name' for every overload, so a call site emits
a reference to a symbol that does not exist in the cached .o. }
Line := Line + EncodeLpstr(R.ResolvedQbeName);
SB.AppendLine(Line);
end;
SB.AppendLine('END');
@ -613,7 +640,9 @@ begin
EncodeLpstr(AIface.SourceHash) +
EncodeLpstr(AIface.CompilerId) +
EncodeInt64(AIface.SourceModTime) +
EncodeStringList(AIface.UsedUnits));
EncodeStringList(AIface.UsedUnits) +
EncodeStringList(AIface.ImplUsedUnits) +
EncodeBool(AIface.HasInitialization));
SB.AppendLine('END');
Result := SB.ToString();
finally
@ -634,7 +663,6 @@ end;
format-error fallback at read time — a structural change in the
AST needs a matching version bump in the wire format. }
function EncodeExpr(AE: TASTExpr): string; forward;
function EncodeStmt(AStmt: TASTStmt): string; forward;
function EncodeBlock(AB: TBlock): string; forward;
@ -814,7 +842,12 @@ begin
Result := EncodeLpstr('raise') +
EncodeExpr(TRaiseStmt(AStmt).Expr)
else if AStmt is TExitStmt then
Result := EncodeLpstr('exit')
{ Carry the optional return value — 'Exit(expr)'. Without it a cached
generic-template body's 'Exit(-1)' round-trips as a bare 'Exit',
leaving Result uninitialised (e.g. TDictionary.FindKey returns 0 not
-1, so every key appears found at slot 0). }
Result := EncodeLpstr('exit') +
EncodeExpr(TExitStmt(AStmt).Value)
else if AStmt is TBreakStmt then
Result := EncodeLpstr('brk')
else if AStmt is TContinueStmt then
@ -871,11 +904,36 @@ end;
nested types, and the importer doesn't currently re-emit nested
proc decls. Add as needed; nil ABlock encodes as a single
'nil' lpstr. }
{ Encode a block's local var declarations (names + type name). Only
the facts a downstream instantiation needs to declare the local into
scope are emitted — initialisers and attributes are not required for
generic template bodies (e.g. 'var Ptr: ^T') and are omitted. Each
TVarDecl is emitted flattened: one record per name. }
function EncodeBlockVarDecls(AB: TBlock): string;
var
I, J: Integer;
VD: TVarDecl;
Total: Integer;
begin
Total := 0;
for I := 0 to AB.Decls.Count - 1 do
Total := Total + TVarDecl(AB.Decls.Items[I]).Names.Count;
Result := EncodeCount(Total);
for I := 0 to AB.Decls.Count - 1 do
begin
VD := TVarDecl(AB.Decls.Items[I]);
for J := 0 to VD.Names.Count - 1 do
Result := Result + EncodeLpstr(VD.Names.Strings[J]) +
EncodeLpstr(VD.TypeName);
end;
end;
function EncodeBlock(AB: TBlock): string;
begin
if AB = nil then
begin Result := EncodeLpstr('nil'); Exit; end;
Result := EncodeLpstr('block') + EncodeStmtList(AB.Stmts);
Result := EncodeLpstr('block') + EncodeStmtList(AB.Stmts) +
EncodeBlockVarDecls(AB);
end;
{ Emit only generic free routines. Generic class/interface
@ -1450,6 +1508,7 @@ var
TFSn: TTryFinallyStmt;
TESn: TTryExceptStmt;
RaSn: TRaiseStmt;
ESn: TExitStmt;
CSSn: TCaseStmt;
FASn: TFieldAssignment;
SSAn: TStaticSubscriptAssign;
@ -1557,7 +1616,12 @@ begin
RaSn.Expr := ReadExpr(AText, APos);
Result := RaSn;
end
else if Kind = 'exit' then Result := TExitStmt.Create()
else if Kind = 'exit' then
begin
ESn := TExitStmt.Create();
ESn.Value := ReadExpr(AText, APos); { nil for bare 'Exit' }
Result := ESn;
end
else if Kind = 'brk' then Result := TBreakStmt.Create()
else if Kind = 'cont' then Result := TContinueStmt.Create()
else if Kind = 'case' then
@ -1626,7 +1690,11 @@ end;
function ReadBlock(const AText: string; var APos: Integer): TBlock;
var
Kind: string;
Kind: string;
C, I: Integer;
VarName: string;
VarType: string;
VD: TVarDecl;
begin
Kind := ReadLpstrAt(AText, APos);
if Kind = 'nil' then begin Result := nil; Exit; end;
@ -1634,6 +1702,17 @@ begin
raise EIfaceFormatError.Create('ReadBlock: expected ''block'' got ''' + Kind + '''');
Result := TBlock.Create();
ReadStmtList(AText, APos, Result.Stmts);
{ Local var declarations (v3+): one flattened record per name. }
C := DecodeCount(AText, APos);
for I := 1 to C do
begin
VarName := ReadLpstrAt(AText, APos);
VarType := ReadLpstrAt(AText, APos);
VD := TVarDecl.Create();
VD.Names.Add(VarName);
VD.TypeName := VarType;
Result.Decls.Add(VD);
end;
end;
function DecodeCount(const AText: string; var APos: Integer): Integer;
@ -1710,6 +1789,7 @@ begin
Param.TypeName := ReadLpstrAt(AText, APos);
FlagsStr := ReadLpstrAt(AText, APos);
DecodeParamFlags(StrToInt(FlagsStr), Param);
Param.DefaultValue := ReadExpr(AText, APos);
Result.Params.Add(Param);
end;
end;
@ -1779,6 +1859,7 @@ begin
Param.TypeName := ReadLpstrAt(AText, APos);
FlagsStr := ReadLpstrAt(AText, APos);
DecodeParamFlags(StrToInt(FlagsStr), Param);
Param.DefaultValue := ReadExpr(AText, APos);
Result.Params.Add(Param);
end;
end;
@ -1876,6 +1957,10 @@ begin
C := DecodeCount(AText, APos);
for I := 1 to C do
AIface.UsedUnits.Add(ReadLpstrAt(AText, APos));
C := DecodeCount(AText, APos);
for I := 1 to C do
AIface.ImplUsedUnits.Add(ReadLpstrAt(AText, APos));
AIface.HasInitialization := ReadLpstrAt(AText, APos) = '1';
if ReadTag(AText, APos) <> 'END' then
raise EIfaceFormatError.Create('META block: missing END marker');
end;
@ -1954,6 +2039,9 @@ begin
ClassDef.Methods.Add(MD);
end;
{ Property declarations (parallel to WriteGenericClassPayload). }
ReadPropertyList(AText, APos, ClassDef.Properties);
AEntry.IsGeneric := True;
AEntry.Def := Def;
end;
@ -2085,6 +2173,7 @@ begin
AParam.IsConstParam := (AFlags and 2) <> 0;
AParam.IsOpenArray := (AFlags and 4) <> 0;
AParam.IsOutParam := (AFlags and 8) <> 0;
AParam.HasDefault := (AFlags and 16) <> 0;
end;
procedure ReadRoutines(const AText: string; var APos: Integer;
@ -2119,9 +2208,11 @@ begin
Param.TypeName := ReadLpstrAt(AText, APos);
FlagsStr := ReadLpstrAt(AText, APos);
DecodeParamFlags(StrToInt(FlagsStr), Param);
Param.DefaultValue := ReadExpr(AText, APos);
R.Params.Add(Param);
end;
R.CallingConv := ReadLpstrAt(AText, APos);
R.ResolvedQbeName := ReadLpstrAt(AText, APos);
AIface.AddRoutine(R);
end;
if ReadTag(AText, APos) <> 'END' then

62
compiler/src/main/pascal/uUnitLoader.pas
View file

@ -53,6 +53,10 @@ type
ifaces. Caller links against these alongside the main
program's object. }
property PrebuiltObjectPaths: TStringList read FPrebuiltObjectPaths;
{ Object paths for impl-only dependencies that must be linked but were
not semantically imported (and thus are absent from PrebuiltObjectPaths
and the source-compiled unit set). Caller links these too. }
property LinkOnlyObjects: TStringList read FLinkOnlyObjects;
private
FSearchPaths: TStringList; { not owned }
FDefines: TStringList; { not owned — conditional symbols for each unit's lexer }
@ -61,6 +65,11 @@ type
FResult: TObjectList; { the in-progress output list (not owned here) }
FPrebuiltIfaces: TObjectList; { owned TUnitInterface }
FPrebuiltObjectPaths: TStringList;
FLinkOnlyObjects: TStringList; { .o paths for impl-only deps that
must be linked but NOT semantically
imported (see CollectLinkOnlyObject) }
FLinkOnlySeen: TStringList; { unit names already visited by the
link-only collector — cycle guard }
function IsBuiltin(const AName: string): Boolean;
function Locate(const AName: string): string;
{ Look for '<AName>.o' on the search paths (lowercase or as-cased).
@ -71,6 +80,11 @@ type
function LoadIfaceFromObject(const APath: string): TUnitInterface;
function LoadOne(const APath: string): TUnit;
procedure LoadTransitive(const AName: string);
{ Collect the .o for an impl-only dependency (and its transitive
dependencies) for linking, without parsing source or importing its
iface. Units already loaded normally are skipped — they are linked
via FPrebuiltObjectPaths / the source-compiled worker objects. }
procedure CollectLinkOnlyObject(const AName: string);
{ Decide whether to trust a freshly-loaded .bif. Hash-compares
against the source .pas if present on the search path; falls
back to a CompilerId match when source is unavailable. }
@ -243,6 +257,37 @@ begin
end;
end;
procedure TUnitLoader.CollectLinkOnlyObject(const AName: string);
var
ObjPath: string;
Iface: TUnitInterface;
I: Integer;
begin
if IsBuiltin(AName) then Exit;
{ Already loaded the normal way → its object is already linked. }
if FLoadedNames.IndexOf(AName) >= 0 then Exit;
if FLinkOnlySeen.IndexOf(AName) >= 0 then Exit;
FLinkOnlySeen.Add(AName);
ObjPath := LocateObject(AName);
if ObjPath = '' then Exit; { no cached object — nothing to link }
Iface := LoadIfaceFromObject(ObjPath);
if Iface = nil then Exit; { unreadable iface — the source-load path
elsewhere will have handled this unit }
try
if not ValidateIface(Iface, AName) then Exit;
if FLinkOnlyObjects.IndexOf(ObjPath) < 0 then
FLinkOnlyObjects.Add(ObjPath);
{ Recurse so this dep's own dependencies are linked too. }
for I := 0 to Iface.UsedUnits.Count - 1 do
CollectLinkOnlyObject(Iface.UsedUnits.Strings[I]);
for I := 0 to Iface.ImplUsedUnits.Count - 1 do
CollectLinkOnlyObject(Iface.ImplUsedUnits.Strings[I]);
finally
Iface.Free();
end;
end;
procedure TUnitLoader.LoadTransitive(const AName: string);
var
Path: string;
@ -290,6 +335,17 @@ begin
FPrebuiltIfaces.Add(Iface);
FPrebuiltObjectPaths.Add(ObjPath);
FLoadedNames.Add(AName);
{ Impl-only dependencies are not reachable via the interface uses,
but their objects must still be linked or the program loses their
code (an incremental rebuild that loads this unit from its cached
.bif would otherwise drop them). They are collected for LINK ONLY
— not semantically imported — because the consuming unit never
references their symbols, and importing their ifaces early would
break the dependency-ordered import (impl/interface-use cycles, e.g.
a backend unit whose interface a peer impl-uses, cannot be resolved
by the leaf-first iface import). }
for I := 0 to Iface.ImplUsedUnits.Count - 1 do
CollectLinkOnlyObject(Iface.ImplUsedUnits.Strings[I]);
finally
FLoading.Delete(FLoading.IndexOf(AName));
end;
@ -337,10 +393,16 @@ begin
FPrebuiltIfaces := TObjectList.Create(True);
FPrebuiltObjectPaths := TStringList.Create();
FPrebuiltObjectPaths.CaseSensitive := False;
FLinkOnlyObjects := TStringList.Create();
FLinkOnlyObjects.CaseSensitive := False;
FLinkOnlySeen := TStringList.Create();
FLinkOnlySeen.CaseSensitive := False;
end;
destructor TUnitLoader.Destroy;
begin
FLinkOnlySeen.Free();
FLinkOnlyObjects.Free();
FPrebuiltObjectPaths.Free();
FPrebuiltIfaces.Free();
FLoadedNames.Free();

97
compiler/src/test/pascal/cp.test.e2e.sepcompile.pas
View file

@ -56,6 +56,16 @@ type
runtime Makefile drives (every RTL unit is compiled `--source X.pas
--output X.o`), so it broke `make` in runtime/. }
procedure TestNativeIncremental_UnitUsesUnit_Compiles;
{ Regression: a unit that USES another unit only in its IMPLEMENTATION
section. On a clean build all units are parsed, so the impl-only
dependency's object is linked. But on an incremental REBUILD, the
consuming unit is loaded from its cached .o/.bif — and the .bif only
recorded the INTERFACE uses, so the impl-only dependency was never
loaded and its .o was dropped from the link → undefined symbol at
run time. This is exactly what broke a second `pasbuild test-compile`
(the compiler rebuilt itself incrementally into a populated cache and
lost ~880 KB of impl-only-dependency code). }
procedure TestIncrementalRebuild_ImplOnlyUses_LinksDependency;
end;
implementation
@ -670,6 +680,93 @@ begin
AssertEquals('use_derived stdout', '42' + #10, Captured)
end;
procedure TSepCompileTests.TestIncrementalRebuild_ImplOnlyUses_LinksDependency;
const
HelperSrc =
'''
unit HelperU;
interface
function HelperVal: Integer;
implementation
function HelperVal: Integer;
begin Result := 42 end;
end.
''';
{ MidU uses HelperU only in its IMPLEMENTATION section — HelperU does not
appear in MidU's interface, so MidU's .bif must still record it as an
implementation-section dependency. }
MidSrc =
'''
unit MidU;
interface
function MidVal: Integer;
implementation
uses HelperU;
function MidVal: Integer;
begin Result := HelperVal() + 1 end;
end.
''';
ProgSrc =
'''
program UseMid;
uses MidU;
begin
WriteLn(MidVal())
end.
''';
var
HelperPas, MidPas, ProgPas, ProgBin, CacheDir: string;
Captured: string;
Rc: Integer;
begin
if not ToolchainAvailable() then
begin
Fail('toolchain missing — qbe or RTL not found');
Exit
end;
if not FileExists(BlaisePath()) then
begin
Fail('blaise binary missing at ' + BlaisePath());
Exit
end;
HelperPas := FScratch + '/HelperU.pas';
MidPas := FScratch + '/MidU.pas';
ProgPas := FScratch + '/use_mid.pas';
ProgBin := FScratch + '/use_mid';
CacheDir := FScratch + '/units-impl';
WriteFile(HelperPas, HelperSrc);
WriteFile(MidPas, MidSrc);
WriteFile(ProgPas, ProgSrc);
ForceDirectories(CacheDir);
{ Build 1 (clean cache): every unit is parsed from source, so HelperU's
object is linked. This populates the cache with .o/.bif for MidU and
HelperU. }
Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin,
'--unit-cache', CacheDir,
'--unit-path', FScratch], Captured);
AssertEquals('build1 exit code (out: ' + Captured + ')', 0, Rc);
Rc := RunBinary(ProgBin, Captured);
AssertEquals('build1 run exit code', 0, Rc);
AssertEquals('build1 stdout', '43' + #10, Captured);
{ Build 2 (populated cache): MidU is now loaded from its cached iface.
The loader must still pull in HelperU (MidU's impl-only dependency) and
link helperu.o — otherwise the link drops it and the program aborts at
run time with an undefined symbol. }
Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin,
'--unit-cache', CacheDir,
'--unit-path', FScratch], Captured);
AssertEquals('build2 exit code (out: ' + Captured + ')', 0, Rc);
AssertTrue('use_mid exists after rebuild', FileExists(ProgBin));
Rc := RunBinary(ProgBin, Captured);
AssertEquals('build2 run exit code (impl-only dep must be linked)', 0, Rc);
AssertEquals('build2 stdout', '43' + #10, Captured)
end;
initialization
RegisterTest(TSepCompileTests);

2
compiler/src/test/pascal/cp.test.unitinterface.pas
View file

@ -2683,7 +2683,7 @@ begin
Buf := WriteUnitInterface(Iface);
{ Blaise Pos is 0-based; match-at-start returns 0. }
AssertTrue('starts with magic',
Pos('BLAISE-IFACE 1', Buf) = 0);
Pos('BLAISE-IFACE 3', Buf) = 0);
finally
Iface.Free();
end;