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

fix(codegen): unit-prefix mangling for module-scope global variables

Browse source 
Module-scope global variables are now emitted under a unit-prefixed
symbol (GlobalVarUnitPrefix), so same-named globals in different units
(e.g. GRegistry in two units) do not collide at link.  The definition
(EmitGlobalVarData) and every reference (VarRef) run the identical
owner-resolution + allowlist, so they always agree.

A static class-var (e.g. RegModU.TReg.FCount) is already emitted under
its fully unit+class-qualified symbol RegModU_TReg_FCount.  That name is
passed to GlobalVarUnitPrefix verbatim; Lookup does not find it, so the
owner fell back to the current unit and the prefix was applied a SECOND
time (RegModU_RegModU_TReg_FCount), so the reference no longer matched
the definition and the link failed.  Add an idempotence guard: if the
name already starts with the resolved prefix it is carried through
unchanged rather than re-prefixed.
This commit is contained in:
Andrew Haines 2026-06-29 03:04:00 -04:00 committed by Graeme Geldenhuys
parent c7f264acec
commit 9aa44911b0
3 changed files with 123 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -157,6 +157,10 @@ type
FInlineResultTemps: TStringList; { one temp per frame }
FInlineEndLabels: TStringList; { one label per frame }
FInlineResultQTypes: TStringList; { one QBE type per frame }
FInlineSrcUnits: TStringList; { OwningUnit of the inlined body per frame —
so a global referenced inside a foreign
inline body is mangled with ITS unit, not
the consumer's (see GlobalVarUnitPrefix) }
FInlineDepth: Integer; { active inline depth; cap to prevent runaway }
function ExportPrefix(): string;
@ -241,7 +245,7 @@ type
function InlineResultTemp(): string;
function InlineEndLabel(): string;
function InlineResultQType(): string;
procedure PushInlineFrame(const AParamCsv, ATempCsv, AResultTemp,
procedure PushInlineFrame(const ASrcUnit, AParamCsv, ATempCsv, AResultTemp,
AEndLabel, AResultQType: string);
procedure PopInlineFrame;
function InsideInlineFrame(): Boolean;
@ -528,6 +532,7 @@ type
for the class's TSymbol.OwningUnit, then applies the same
allowlist semantics as uSemantic.MangleUnitPrefix. }
function ClassUnitPrefix(const AClassName: string): string;
function GlobalVarUnitPrefix(const AName: string): string;
{ Compute the QBE call target for a property accessor. When AVSlot >= 0
the accessor is virtual: emit the vptr+slot loads and return the
function-pointer temp. Otherwise return the static mangled symbol
@ -706,6 +711,7 @@ begin
FInlineResultTemps := TStringList.Create();
FInlineEndLabels := TStringList.Create();
FInlineResultQTypes := TStringList.Create();
FInlineSrcUnits := TStringList.Create();
FInlineDepth := 0;
FTempCount := 0;
FStrLitsEmitted := 0;
@ -732,6 +738,7 @@ begin
FInlineResultTemps.Free();
FInlineEndLabels.Free();
FInlineResultQTypes.Free();
FInlineSrcUnits.Free();
FOutput.Free();
FStrLits.Free();
inherited Destroy();
@ -1482,7 +1489,7 @@ begin
end;
end;
procedure TCodeGenQBE.PushInlineFrame(const AParamCsv, ATempCsv,
procedure TCodeGenQBE.PushInlineFrame(const ASrcUnit, AParamCsv, ATempCsv,
AResultTemp, AEndLabel,
AResultQType: string);
begin
@ -1491,6 +1498,7 @@ begin
FInlineResultTemps.Add(AResultTemp);
FInlineEndLabels.Add(AEndLabel);
FInlineResultQTypes.Add(AResultQType);
FInlineSrcUnits.Add(ASrcUnit);
Inc(FInlineDepth);
end;
@ -1502,6 +1510,7 @@ begin
FInlineResultTemps.Delete(FInlineDepth - 1);
FInlineEndLabels.Delete(FInlineDepth - 1);
FInlineResultQTypes.Delete(FInlineDepth - 1);
FInlineSrcUnits.Delete(FInlineDepth - 1);
Dec(FInlineDepth);
end;
@ -1622,7 +1631,8 @@ begin
ArgTemps.Free();
end;
PushInlineFrame(ParamCsv, TempCsv, ResultTemp, EndLabel, ResultQType);
PushInlineFrame(Callee.OwningUnit, ParamCsv, TempCsv, ResultTemp, EndLabel,
ResultQType);
try
{ Emit the callee body's statements. EmitStmt / EmitExpr consult the
inline frame stack to remap parameter ident reads and to redirect
@ -1999,7 +2009,13 @@ begin
begin
VarName := Decl.Names.Strings[J];
if Decl.IsThreadVar then
FThreadVarNames.Add(VarName);
FThreadVarNames.Add(VarName); { keyed on the bare name — VarRef's
threadvar test sees the bare ident }
{ Mangle the emitted symbol with the owning unit (here always the unit
being compiled) so same-named globals across units don't collide; VarRef
applies the identical prefix at every reference. Bare name kept above
for the threadvar lookup key. }
VarName := GlobalVarUnitPrefix(VarName) + VarName;
{ Initialised global: emit the folded value into the data section instead
of a zero slot. threadvars cannot carry a non-zero static initialiser
(they live in .tbss), so the parser/semantic restrict initialisers to
@ -5078,14 +5094,62 @@ begin
end;
end;
{ Unit-prefix for a module-scope global VARIABLE symbol, so same-named globals in
different units (e.g. GRegistry in two units) don't collide at link. The owning
unit is resolved in priority order:
1. the symbol table — covers imported and own-INTERFACE globals (OwningUnit);
2. the inlined body's source unit — a global referenced inside a foreign
inline body belongs to THAT unit, but is impl-private there so it is not in
the consumer's table (codegen has no impl-private symbols, same reason an
impl-section class gets no vtable);
3. the unit currently being compiled — own impl-private globals.
The CANONICAL MangleUnitPrefix allowlist (System, rtl.*, runtime.*, blaise_*
stay bare — RTL globals are referenced unmangled) and the program-scope
exclusion (program-scope symbols are unprefixed — see uSemantic.CurrentUnitPrefix)
then map the owner to a prefix. Definition (EmitGlobalVarData) and every
reference (VarRef) run the identical resolution, so they always agree. }
function TCodeGenQBE.GlobalVarUnitPrefix(const AName: string): string;
var
Sym: TSymbol;
Owner: string;
begin
Result := '';
if FSymTable <> nil then
begin
Sym := FSymTable.Lookup(AName);
if (Sym <> nil) and (Sym.OwningUnit <> '') then
Owner := Sym.OwningUnit
else if FInlineDepth > 0 then
Owner := FInlineSrcUnits.Strings[FInlineDepth - 1]
else
Owner := FCurrentUnitName;
end
else if FInlineDepth > 0 then
Owner := FInlineSrcUnits.Strings[FInlineDepth - 1]
else
Owner := FCurrentUnitName;
if Owner = '' then Exit;
if (FProgramName <> '') and SameText(Owner, FProgramName) then Exit;
Result := MangleUnitPrefix(Owner);
{ Idempotence guard: a static class-var (e.g. RegModU.TReg.FCount) is emitted
under its already unit+class-qualified symbol RegModU_TReg_FCount. Such a
name is passed here verbatim and Lookup does not find it, so Owner falls back
to the current unit and the prefix would be applied a SECOND time
(RegModU_RegModU_TReg_FCount), breaking the def/ref match at link. If AName
already starts with the prefix, it is carried — don't re-prefix it. }
if (Result <> '') and (Length(AName) >= Length(Result)) and
SameText(Copy(AName, 0, Length(Result)), Result) then
Result := '';
end;
function TCodeGenQBE.VarRef(const AName: string; AIsGlobal: Boolean): string;
begin
if AIsGlobal then
begin
if FThreadVarNames.IndexOf(AName) >= 0 then
Result := 'thread $' + AName
Result := 'thread $' + GlobalVarUnitPrefix(AName) + AName
else
Result := '$' + AName;
Result := '$' + GlobalVarUnitPrefix(AName) + AName;
end
{ A variable captured from an enclosing proc is reached through the hidden
%_cap_<Name> pointer parameter, which holds the address of the enclosing

51
compiler/src/test/pascal/cp.test.e2e.useschain.pas
View file

@ -45,6 +45,10 @@ type
{ Unit-qualified ancestor in a class declaration: class(Unit.TParent)
binds to that unit's type so inheritance works across units. }
procedure TestRun_QualifiedInheritance;
{ Two units each declare an impl-private global of the SAME name; with
unit-prefix mangling on module-scope globals they no longer collide at
link, so a program using both links and runs. }
procedure TestRun_SameNamedGlobals_NoLinkCollision;
end;
implementation
@ -319,6 +323,53 @@ begin
AssertEquals('inherited Base + 1', '42' + LE, Output);
end;
procedure TE2EUsesChainTests.TestRun_SameNamedGlobals_NoLinkCollision;
const
UnitOne = '''
unit uone;
interface
function GetOne: Integer;
implementation
var G: Integer;
function GetOne: Integer;
begin
G := 11;
Result := G
end;
end.
''';
UnitTwo = '''
unit utwo;
interface
function GetTwo: Integer;
implementation
var G: Integer;
function GetTwo: Integer;
begin
G := 22;
Result := G
end;
end.
''';
DrvSrc = '''
program P;
uses uone, utwo;
begin
WriteLn(GetOne() + GetTwo())
end.
''';
var Output: string; RCode: Integer;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end;
{ Both units emit a global named G; without unit-prefix mangling the two
'$G' definitions collide at link. Mangling makes them distinct, so the
program links and prints 11 + 22 = 33. }
AssertTrue('compile+link+run',
CompileAndRunWithUnits(UnitOne, UnitTwo, DrvSrc, Output, RCode));
AssertEquals('exit 0', 0, RCode);
AssertEquals('GetOne + GetTwo', '33' + LE, Output);
end;
initialization
RegisterTest(TE2EUsesChainTests);

4
compiler/src/test/pascal/cp.test.generics.pas
View file

@ -736,8 +736,8 @@ var
IR: string;
begin
IR := GenUnitIR(SrcUnitIntfGenericVar);
AssertTrue('global data slot for G emitted',
Pos('data $G', IR) > 0);
AssertTrue('global data slot for G emitted (unit-prefix mangled)',
Pos('data $U_G', IR) > 0);
AssertTrue('typeinfo for TBox_Integer emitted',
Pos('$typeinfo_TBox_Integer', IR) > 0);
end;