diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index e7653a9..b6ce74a 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -386,8 +386,19 @@ type function EmitInstancePtr(AExpr: TASTExpr): string; function FieldPtr(const ARecordVar: string; AOffset: Integer; AIsGlobal: Boolean = False): string; { Returns the QBE address token for a variable: '$Name' for globals, - '%_var_Name' for locals. } - function VarRef(const AName: string; AIsGlobal: Boolean): string; + '%_var_Name' for locals. The AOwner overload mangles a global's + storage symbol with an explicit owning unit (from the resolved + symbol's OwningUnit) rather than re-looking-up the bare name, so a + reference to a cross-unit last-wins var reaches the correct slot. + AOwner = '' falls back to the bare-name resolution. } + function VarRef(const AName: string; AIsGlobal: Boolean): string; overload; + function VarRef(const AName: string; AIsGlobal: Boolean; + const AOwner: string): string; overload; + { Owning unit to mangle a global-var reference with: the semantic-stamped + ResolvedOwnerUnit, falling back to the explicit QualifierUnit (the latter + survives .bif round-trips for an inlined qualified reference where the + former, deliberately not serialised, is absent). } + function IdentVarOwner(AIdent: TIdentExpr): string; { Returns a QBE temp (or address token) that holds the address to pass as a var-param actual argument. When the actual argument is itself a var param its local slot contains a pointer — emit loadl to obtain the original @@ -533,6 +544,12 @@ type allowlist semantics as uSemantic.MangleUnitPrefix. } function ClassUnitPrefix(const AClassName: string): string; function GlobalVarUnitPrefix(const AName: string): string; + { Map an owning unit to its global-var mangle prefix (program-scope and + the RTL allowlist stay bare). The shared core of GlobalVarUnitPrefix + (name-based owner resolution) and the AOwner VarRef overload, so a + definition site (keyed on the unit being compiled) and a reference + site (keyed on the resolved symbol's owner) always agree. } + function MangleGlobalOwner(const AOwner: 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 @@ -2011,11 +2028,14 @@ begin if Decl.IsThreadVar then 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; + { Mangle the emitted symbol with the unit currently being compiled so + same-named globals across units don't collide; VarRef applies the + identical prefix (via the resolved symbol's owner) at every reference. + Keyed on FCurrentUnitName, not a name re-lookup, so a cross-unit + last-wins loser still defines its own slot (the flat table holds only + the winner after extraction). Bare name kept above for the threadvar + lookup key. } + VarName := MangleGlobalOwner(FCurrentUnitName) + 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 @@ -4613,14 +4633,14 @@ begin whole bitmap into the destination slot. } ValTemp := EmitExpr(AAssign.Expr); EmitLine(Format(' call $memcpy(l %s, l %s, l %d)', - [VarRef(AAssign.Name, AAssign.IsGlobal), ValTemp, + [VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit), ValTemp, TSetTypeDesc(AAssign.ResolvedLhsType).RawSize()])); end else if (AAssign.ResolvedLhsType <> nil) and (AAssign.ResolvedLhsType.Kind = tyStaticArray) and IsRecordCall(AAssign.Expr) then begin - EmitRecordCallSret(AAssign.Expr, VarRef(AAssign.Name, AAssign.IsGlobal)); + EmitRecordCallSret(AAssign.Expr, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)); end else if (AAssign.ResolvedLhsType <> nil) and (AAssign.ResolvedLhsType.Kind = tyRecord) then @@ -4642,21 +4662,21 @@ begin EmitLine(Format(' call $memset(l %s, w 0, l %d)', [SretBuf, ClassRT.TotalSize()])); EmitRecordCallSret(AAssign.Expr, SretBuf); - EmitRecordReleaseFields(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal)); + EmitRecordReleaseFields(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)); EmitLine(Format(' call $memcpy(l %s, l %s, l %d)', - [VarRef(AAssign.Name, AAssign.IsGlobal), SretBuf, ClassRT.TotalSize()])); + [VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit), SretBuf, ClassRT.TotalSize()])); end else if IsRecordCall(AAssign.Expr) then begin - EmitRecordReleaseFields(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal)); + EmitRecordReleaseFields(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)); EmitLine(Format(' call $memset(l %s, w 0, l %d)', - [VarRef(AAssign.Name, AAssign.IsGlobal), ClassRT.TotalSize()])); - EmitRecordCallSret(AAssign.Expr, VarRef(AAssign.Name, AAssign.IsGlobal)); + [VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit), ClassRT.TotalSize()])); + EmitRecordCallSret(AAssign.Expr, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)); end else begin ValTemp := EmitExpr(AAssign.Expr); - EmitRecordCopy(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal), ValTemp); + EmitRecordCopy(ClassRT, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit), ValTemp); end; end else if (AAssign.ResolvedLhsType <> nil) and @@ -4668,7 +4688,7 @@ begin another method-pointer var or a TMethod record (same layout). } ValTemp := EmitExpr(AAssign.Expr); EmitLine(Format(' call $memcpy(l %s, l %s, l 16)', - [VarRef(AAssign.Name, AAssign.IsGlobal), ValTemp])); + [VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit), ValTemp])); end else if AAssign.Expr.ResolvedType.IsString() then begin @@ -4677,7 +4697,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %s =l copy %%_var_%s', [OldTemp, AAssign.Name])) else - EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); ValTemp := EmitExpr(AAssign.Expr); if not ExprOwnsRef(AAssign.Expr) then EmitLine(Format(' call $_StringAddRef(l %s)', [ValTemp])); @@ -4685,7 +4705,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy %s', [AAssign.Name, ValTemp])) else - EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); end else if (AAssign.ResolvedLhsType <> nil) and (AAssign.ResolvedLhsType.Kind = tyDynArray) then @@ -4697,7 +4717,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %s =l copy %%_var_%s', [OldTemp, AAssign.Name])) else - EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); ValTemp := EmitExpr(AAssign.Expr); if not ExprOwnsRef(AAssign.Expr) then EmitLine(Format(' call $_DynArrayAddRef(l %s)', [ValTemp])); @@ -4705,7 +4725,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy %s', [AAssign.Name, ValTemp])) else - EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); end else if (AAssign.ResolvedLhsType <> nil) and (AAssign.ResolvedLhsType.Kind = tyClass) and @@ -4713,19 +4733,19 @@ begin begin if AAssign.IsWeakLhs then EmitLine(Format(' call $_WeakClear(l %s)', - [VarRef(AAssign.Name, AAssign.IsGlobal)])) + [VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])) else begin OldTemp := AllocTemp(); if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %s =l copy %%_var_%s', [OldTemp, AAssign.Name])) else - EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); EmitLine(Format(' call $_ClassRelease(l %s)', [OldTemp])); if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy 0', [AAssign.Name])) else - EmitLine(Format(' storel 0, %s', [VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' storel 0, %s', [VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); end; end else if AAssign.IsWeakLhs and (AAssign.Expr.ResolvedType.Kind = tyClass) then @@ -4736,7 +4756,7 @@ begin any prior registration for this slot. } ValTemp := EmitExpr(AAssign.Expr); EmitLine(Format(' call $_WeakAssign(l %s, l %s)', - [VarRef(AAssign.Name, AAssign.IsGlobal), ValTemp])); + [VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit), ValTemp])); end else if AAssign.Expr.ResolvedType.Kind = tyClass then begin @@ -4758,7 +4778,7 @@ begin if not ExprOwnsRef(AAssign.Expr) then EmitLine(Format(' call $_ClassAddRef(l %s)', [ValTemp])); EmitLine(Format(' storel %s, %s', - [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); MarkArcSlotWritten(AAssign.Name); end else @@ -4767,7 +4787,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %s =l copy %%_var_%s', [OldTemp, AAssign.Name])) else - EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); ValTemp := EmitExpr(AAssign.Expr); if not ExprOwnsRef(AAssign.Expr) then EmitLine(Format(' call $_ClassAddRef(l %s)', [ValTemp])); @@ -4775,7 +4795,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy %s', [AAssign.Name, ValTemp])) else - EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); MarkArcSlotWritten(AAssign.Name); end; end @@ -4797,7 +4817,7 @@ begin ValTemp := EmitExpr(AAssign.Expr); EmitLine(Format(' call $_ClassAddRef(l %s)', [ValTemp])); EmitLine(Format(' storel %s, %s', - [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); MarkArcSlotWritten(AAssign.Name); end else @@ -4806,14 +4826,14 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %s =l copy %%_var_%s', [OldTemp, AAssign.Name])) else - EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' %s =l loadl %s', [OldTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); ValTemp := EmitExpr(AAssign.Expr); EmitLine(Format(' call $_ClassAddRef(l %s)', [ValTemp])); EmitLine(Format(' call $_ClassRelease(l %s)', [OldTemp])); if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy %s', [AAssign.Name, ValTemp])) else - EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); MarkArcSlotWritten(AAssign.Name); end; end @@ -4851,7 +4871,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =d copy %s', [AAssign.Name, ValTemp])) else - EmitLine(Format(' stored %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' stored %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); end else if (AAssign.ResolvedLhsType <> nil) and (AAssign.ResolvedLhsType.Kind = tySingle) then @@ -4883,7 +4903,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =s copy %s', [AAssign.Name, ValTemp])) else - EmitLine(Format(' stores %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' stores %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); end else if (AAssign.ResolvedLhsType <> nil) and (QbeTypeOf(AAssign.ResolvedLhsType) = 'l') then @@ -4898,7 +4918,7 @@ begin if not AAssign.IsGlobal and IsPromoted(AAssign.Name) then EmitLine(Format(' %%_var_%s =l copy %s', [AAssign.Name, ValTemp])) else - EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' storel %s, %s', [ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); end else begin @@ -4916,7 +4936,7 @@ begin 's': StoreInstr := 'stores'; else StoreInstr := 'storel'; end; - EmitLine(Format(' %s %s, %s', [StoreInstr, ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal)])); + EmitLine(Format(' %s %s, %s', [StoreInstr, ValTemp, VarRef(AAssign.Name, AAssign.IsGlobal, AAssign.ResolvedOwnerUnit)])); end; end; end; @@ -4954,7 +4974,7 @@ begin if (AExpr.ResolvedType <> nil) and (AExpr.ResolvedType.Kind = tyClass) then begin Loaded := AllocTemp(); - EmitLine(Format(' %s =l loadl %s', [Loaded, VarRef(Id.Name, Id.IsGlobal)])); + EmitLine(Format(' %s =l loadl %s', [Loaded, VarRef(Id.Name, Id.IsGlobal, IdentVarOwner(Id))])); if Id.ParamMode <> pmNone then begin { var-param class ident: slot -> caller var -> instance. } @@ -4969,11 +4989,11 @@ begin { Var-record param: dereference the param slot to get the actual record address. } Loaded := AllocTemp(); - EmitLine(Format(' %s =l loadl %s', [Loaded, VarRef(Id.Name, Id.IsGlobal)])); + EmitLine(Format(' %s =l loadl %s', [Loaded, VarRef(Id.Name, Id.IsGlobal, IdentVarOwner(Id))])); Result := Loaded; end else - Result := VarRef(Id.Name, Id.IsGlobal); { inline record } + Result := VarRef(Id.Name, Id.IsGlobal, IdentVarOwner(Id)); { inline record } Exit; end; @@ -5128,28 +5148,52 @@ begin 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 := ''; + Result := MangleGlobalOwner(Owner); +end; + +function TCodeGenQBE.MangleGlobalOwner(const AOwner: string): string; +begin + Result := ''; + if AOwner = '' then Exit; + { Sentinel: the global's name is ALREADY a fully-mangled symbol (e.g. a static + class var's ClassVarEmitName, which master computes as + CurrentUnitPrefix()+Class+'_'+Field — its class qualifier is more + comprehensive than the module-var prefix, so use it verbatim and add no + further prefix). } + if AOwner = PreMangledGlobalOwner then Exit; + if (FProgramName <> '') and SameText(AOwner, FProgramName) then Exit; + Result := MangleUnitPrefix(AOwner); end; function TCodeGenQBE.VarRef(const AName: string; AIsGlobal: Boolean): string; + overload; +begin + Result := VarRef(AName, AIsGlobal, ''); +end; + +function TCodeGenQBE.IdentVarOwner(AIdent: TIdentExpr): string; +begin + Result := AIdent.ResolvedOwnerUnit; + if Result = '' then Result := AIdent.QualifierUnit; +end; + +function TCodeGenQBE.VarRef(const AName: string; AIsGlobal: Boolean; + const AOwner: string): string; overload; +var + Prefix: string; begin if AIsGlobal then begin - if FThreadVarNames.IndexOf(AName) >= 0 then - Result := 'thread $' + GlobalVarUnitPrefix(AName) + AName + { An explicit owner (the resolved symbol's OwningUnit) mangles directly; + otherwise fall back to resolving the owner from the bare name. } + if AOwner <> '' then + Prefix := MangleGlobalOwner(AOwner) else - Result := '$' + GlobalVarUnitPrefix(AName) + AName; + Prefix := GlobalVarUnitPrefix(AName); + if FThreadVarNames.IndexOf(AName) >= 0 then + Result := 'thread $' + Prefix + AName + else + Result := '$' + Prefix + AName; end { A variable captured from an enclosing proc is reached through the hidden %_cap_ pointer parameter, which holds the address of the enclosing @@ -5180,7 +5224,7 @@ begin { Interface variable: the fat pointer lives in one contiguous 16-byte block (locals: one alloc; globals: one 16-byte data item) whose base is the _obj slot — that base IS the var-arg address. } - Result := VarRef(AIdent.Name, AIdent.IsGlobal) + '_obj'; + Result := VarRef(AIdent.Name, AIdent.IsGlobal, IdentVarOwner(AIdent)) + '_obj'; end else if AIdent.IsImplicitSelf then begin @@ -5197,7 +5241,7 @@ begin Result := SelfT; end else - Result := VarRef(AIdent.Name, AIdent.IsGlobal); + Result := VarRef(AIdent.Name, AIdent.IsGlobal, IdentVarOwner(AIdent)); end; function TCodeGenQBE.EmitLValueAddr(AExpr: TASTExpr): string; @@ -6470,6 +6514,9 @@ begin try CVStore.Name := AAssign.ClassVarEmitName; CVStore.IsGlobal := True; + { ClassVarEmitName is already the fully-mangled static-var symbol; flag it + so VarRef's module-var unit-prefixing does not double-apply. } + CVStore.ResolvedOwnerUnit := PreMangledGlobalOwner; CVStore.ResolvedLhsType := AAssign.ClassVarLhsType; CVStore.Expr := AAssign.Expr; EmitAssignment(CVStore); @@ -13088,7 +13135,7 @@ begin { Jumbo set value param: the QBE backend spills it into a local inline bitmap slot (value semantics), so %_var_X IS the bitmap address — return it directly without a load. } - Exit(VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal)); + Exit(VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal, IdentVarOwner(TIdentExpr(AExpr)))); end else if (TIdentExpr(AExpr).ParamMode <> pmNone) and (AExpr.ResolvedType <> nil) and @@ -13120,7 +13167,7 @@ begin IsAggregateAddrType(AExpr.ResolvedType) then begin { Aggregate variable — return its storage address directly (no load). } - Exit(VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal)); + Exit(VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal, IdentVarOwner(TIdentExpr(AExpr)))); end else if (AExpr.ResolvedType <> nil) and (AExpr.ResolvedType.Kind = tyInterface) then @@ -13145,14 +13192,14 @@ begin QType := QbeTypeOf(AExpr.ResolvedType); case QType of 'w': EmitLine(Format(' %s =w loadw %s', - [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal)])); + [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal, IdentVarOwner(TIdentExpr(AExpr)))])); 'd': EmitLine(Format(' %s =d loadd %s', - [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal)])); + [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal, IdentVarOwner(TIdentExpr(AExpr)))])); 's': EmitLine(Format(' %s =s loads %s', - [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal)])); + [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal, IdentVarOwner(TIdentExpr(AExpr)))])); else EmitLine(Format(' %s =l loadl %s', - [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal)])); + [T, VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal, IdentVarOwner(TIdentExpr(AExpr)))])); end; end; Result := T; diff --git a/compiler/src/main/pascal/uAST.pas b/compiler/src/main/pascal/uAST.pas index 286b361..7b65471 100644 --- a/compiler/src/main/pascal/uAST.pas +++ b/compiler/src/main/pascal/uAST.pas @@ -122,6 +122,14 @@ type resolves the name against this specific unit's exports (per-unit cache) instead of the uses chain, so a same-named const in another unit can't shadow it. } + ResolvedOwnerUnit: string; { set by uSemantic — for a module-scope global var, + the owning unit of the symbol actually resolved (the + uses-chain last-wins winner for a bare ref, or the + named unit for a qualified ref). Codegen mangles the + global's storage symbol with this owner so two used + units exporting the same var name reference distinct + slots. Not serialised — recomputed at analysis time; + empty falls back to the bare-name resolution. } end; TFieldAccessExpr = class(TASTExpr) @@ -247,6 +255,10 @@ type _WeakAssign in place of the strong addref/release pattern. } ImplicitSelfField: TObject; { TFieldInfo — non-nil when LHS is bare field (implicit Self) } + ResolvedOwnerUnit: string; { set by uSemantic — owning unit of a module-scope global + var target; codegen mangles the store address with it so + same-named cross-unit globals write distinct slots. See + the matching field on TIdentExpr. } destructor Destroy; override; end; diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index c1db521..581b901 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -504,6 +504,15 @@ type harvested into the cache. } function ResolveQualified(const AUnit, AName: string): TSymbol; + { Define a module-scope global (interface var) with cross-unit + last-in-uses-wins semantics, mirroring AnalyseConstDecls. On a + clean Define the symbol is registered in the per-unit cache; on a + cross-unit collision the prior unit's symbol is detached (kept alive + in the per-unit cache so a qualified Unit.Var reference still reaches + it) and this unit's symbol is installed as the flat winner. Same-unit + redeclaration and module-name markers stay hard errors. } + procedure DefineGlobalLastWins(ASym: TSymbol; ALine, ACol: Integer); + { Record one enum member in the reverse index (FEnumMemberIndex). Called once per member as its enum type is analysed. Enum members are NOT registered as bare global symbols any more — a bare member @@ -1991,12 +2000,7 @@ begin Sym := TSymbol.Create(VDecl.Names.Strings[J], skVariable, ParType); Sym.IsGlobal := True; Sym.IsThreadVar := VDecl.IsThreadVar; - if not FTable.Define(Sym) then - begin - Sym.Free(); - SemanticError(Format('Duplicate identifier ''%s''', - [VDecl.Names.Strings[J]]), VDecl.Line, VDecl.Col); - end; + DefineGlobalLastWins(Sym, VDecl.Line, VDecl.Col); end; end; @@ -5272,6 +5276,44 @@ begin end; end; +procedure TSemanticAnalyser.DefineGlobalLastWins(ASym: TSymbol; + ALine, ACol: Integer); +var + RefSym: TSymbol; + Prev: TSymbol; +begin + if not FTable.Define(ASym) then + begin + RefSym := FTable.CurrentScope.LookupLocal(ASym.Name); + { A module-name marker (issue #84), a non-unit symbol (builtin / + program-scope, OwningUnit = ''), or a same-unit redeclaration + blocking the Define is a hard error — only a genuine cross-unit + collision (two used units exporting the same name) gets last-wins. } + if (RefSym = nil) or (RefSym.Kind = skModule) or + (RefSym.OwningUnit = '') or + SameText(RefSym.OwningUnit, ASym.OwningUnit) then + begin + ASym.Free(); + SemanticError(Format('Duplicate identifier ''%s''', [ASym.Name]), + ALine, ACol); + Exit; + end; + { Cross-unit collision: last-in-uses wins. Detach the prior unit's + var and stash it in the per-unit cache so a qualified reference + (Unit.Var) can still reach the shadowed slot; install this unit's + var as the flat winner. Mirrors AnalyseConstDecls and RegisterVars. } + Prev := FTable.ExtractLocal(ASym.Name); + if (Prev <> nil) and (Prev.OwningUnit <> '') then + RegisterUnitSymbol(Prev.OwningUnit, Prev); + FTable.Define(ASym); + end; + { Register every interface var in the per-unit cache keyed by its owning + unit, so a qualified reference resolves against the declaring unit's own + slot regardless of which unit won the bare (flat) slot. } + if ASym.OwningUnit <> '' then + RegisterUnitSymbol(ASym.OwningUnit, ASym); +end; + function TSemanticAnalyser.NewArrayConstLabel(const AName: string): string; begin Inc(FArrayConstCounter); @@ -8629,6 +8671,18 @@ begin AAssign.IsWeakLhs := VarSym.IsWeak; AAssign.IsGlobal := VarSym.IsGlobal; AAssign.IsThreadVar := VarSym.IsThreadVar; + { Owning unit of a module-scope global target, so the store address is + mangled with the unit that won resolution — keeps a bare write to a + cross-unit last-wins var hitting the same slot a bare read sees. A static + class/record var's name is its already fully-mangled GlobalEmitName, so flag + it pre-mangled to keep codegen's module-var prefixing from double-applying. } + if VarSym.IsGlobal and (VarSym.Kind = skVariable) then + begin + if VarSym.IsClassVar then + AAssign.ResolvedOwnerUnit := PreMangledGlobalOwner + else + AAssign.ResolvedOwnerUnit := VarSym.OwningUnit; + end; ResolveDiamond(AAssign.Expr, VarSym.TypeDesc); @@ -11742,6 +11796,22 @@ begin TIdentExpr(AExpr).ParamMode := pmNone; TIdentExpr(AExpr).IsGlobal := Sym.IsGlobal; TIdentExpr(AExpr).IsThreadVar := Sym.IsThreadVar; + { Record the owning unit of a module-scope global so codegen mangles + the storage symbol with the unit that actually won resolution (the + uses-chain last-wins winner for a bare ref, the named unit for a + qualified ref). Without this, two used units exporting the same var + name both resolve to one slot. } + if Sym.IsGlobal and (Sym.Kind = skVariable) then + begin + { A static class/record var's Name was rewritten above to its already + fully-mangled GlobalEmitName (Unit_Class_Field); flag it so codegen's + module-var prefixing does not double-apply. Plain module globals carry + their owning unit for owner-based mangling. } + if Sym.IsClassVar then + TIdentExpr(AExpr).ResolvedOwnerUnit := PreMangledGlobalOwner + else + TIdentExpr(AExpr).ResolvedOwnerUnit := Sym.OwningUnit; + end; if Sym.Kind = skConstant then begin TIdentExpr(AExpr).IsConstant := True; diff --git a/compiler/src/main/pascal/uSemanticImport.pas b/compiler/src/main/pascal/uSemanticImport.pas index 45929a8..32069fb 100644 --- a/compiler/src/main/pascal/uSemanticImport.pas +++ b/compiler/src/main/pascal/uSemanticImport.pas @@ -928,7 +928,14 @@ begin Sym.IsThreadVar := Entry.IsThreadVar; Sym.OwningUnit := AIface.Name; if not ATable.Define(Sym) then - Sym.Free(); + begin + { Cross-unit collision (last-wins): detach the slot the table already + holds — kept alive via the per-unit cache (RegisterUnitIface) for + qualified access — and store this later unit's symbol instead. + Mirrors RegisterConsts and the source-path DefineGlobalLastWins. } + ATable.ExtractLocal(Entry.Name); + ATable.Define(Sym); + end; end; end; diff --git a/compiler/src/main/pascal/uSymbolTable.pas b/compiler/src/main/pascal/uSymbolTable.pas index 07ba347..bf40934 100644 --- a/compiler/src/main/pascal/uSymbolTable.pas +++ b/compiler/src/main/pascal/uSymbolTable.pas @@ -711,6 +711,14 @@ function IsUnmangledUnit(const AUnitName: string): Boolean; agree on the QBE global name. } function MangleUnitPrefix(const AUnitName: string): string; +const + { Sentinel owning-unit value meaning "this global's emit name is ALREADY a + fully-mangled symbol — codegen must add no further unit prefix". Used for + static class/record vars, whose label (Unit_Class_Field) is class-qualified + and complete; the module-var prefixing must not double-apply. The leading + control byte can never collide with a real unit name. } + PreMangledGlobalOwner = #1'premangled'; + implementation uses diff --git a/compiler/src/test/pascal/cp.test.e2e.useschain.pas b/compiler/src/test/pascal/cp.test.e2e.useschain.pas index 443d4db..9bce7c9 100644 --- a/compiler/src/test/pascal/cp.test.e2e.useschain.pas +++ b/compiler/src/test/pascal/cp.test.e2e.useschain.pas @@ -49,6 +49,15 @@ type 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; + { Cross-unit interface VAR shadowing: two used units export the same var + name; the unit later in `uses` wins a bare reference (last-in-uses), and + reversing the order flips the winner — mirrors the const last-wins rule. } + procedure TestRun_CrossUnitVar_LastWins; + procedure TestRun_CrossUnitVar_LastWins_Reversed; + { Unit-qualified VAR disambiguation: 'Unit.V' references that specific + unit's own slot (distinct storage), independent of the bare last-wins + winner, so both values are readable side by side. } + procedure TestRun_CrossUnitVar_QualifiedDisambig; end; implementation @@ -370,6 +379,82 @@ begin AssertEquals('GetOne + GetTwo', '33' + LE, Output); end; +const + UVA_Var = ''' + unit uva; + interface + var V: Integer = 7; + implementation + end. + '''; + UVB_Var = ''' + unit uvb; + interface + var V: Integer = 9; + implementation + end. + '''; + +procedure TE2EUsesChainTests.TestRun_CrossUnitVar_LastWins; +const + DrvSrc = ''' + program P; + uses uva, uvb; + begin + WriteLn(V) + end. + '''; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + { Both uva and uvb export `V`; uvb is later in `uses`, so bare V = 9. + The shadowed uva.V keeps its own slot (no link collision). } + AssertTrue('compile+link+run', + CompileAndRunWithUnits(UVA_Var, UVB_Var, DrvSrc, Output, RCode)); + AssertEquals('exit 0', 0, RCode); + AssertEquals('last-in-uses (uvb) wins', '9' + LE, Output); +end; + +procedure TE2EUsesChainTests.TestRun_CrossUnitVar_LastWins_Reversed; +const + DrvSrc = ''' + program P; + uses uvb, uva; + begin + WriteLn(V) + end. + '''; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + { Reversed `uses` order: uva is now later, so bare V = 7. } + AssertTrue('compile+link+run', + CompileAndRunWithUnits(UVA_Var, UVB_Var, DrvSrc, Output, RCode)); + AssertEquals('exit 0', 0, RCode); + AssertEquals('last-in-uses (uva) wins', '7' + LE, Output); +end; + +procedure TE2EUsesChainTests.TestRun_CrossUnitVar_QualifiedDisambig; +const + DrvSrc = ''' + program P; + uses uva, uvb; + begin + WriteLn(uva.V); + WriteLn(uvb.V) + end. + '''; +var Output: string; RCode: Integer; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + { Qualified references pick each unit's own slot (uva.V = 7, uvb.V = 9) + regardless of the bare last-wins rule — distinct storage per unit. } + AssertTrue('compile+link+run', + CompileAndRunWithUnits(UVA_Var, UVB_Var, DrvSrc, Output, RCode)); + AssertEquals('exit 0', 0, RCode); + AssertEquals('uva.V then uvb.V', '7' + LE + '9' + LE, Output); +end; + initialization RegisterTest(TE2EUsesChainTests); diff --git a/compiler/src/test/pascal/cp.test.multifile.pas b/compiler/src/test/pascal/cp.test.multifile.pas index 4540bfc..4e29868 100644 --- a/compiler/src/test/pascal/cp.test.multifile.pas +++ b/compiler/src/test/pascal/cp.test.multifile.pas @@ -56,6 +56,10 @@ type { ------------------------------------------------------------------ } procedure TestCodegen_TwoFileCompile_UnitFuncExported; procedure TestCodegen_TwoFileCompile_MainPresent; + { Two used units export the same global var name; a qualified reference + 'Unit.V' must emit each unit's own owner-prefixed storage symbol so the + two refer to distinct slots rather than colliding on a bare '$V'. } + procedure TestCodegen_CrossUnitQualifiedVar_DistinctSymbols; end; implementation @@ -733,6 +737,67 @@ begin end; end; +procedure TMultifileTests.TestCodegen_CrossUnitQualifiedVar_DistinctSymbols; +const + UnitA = + ''' + unit uva; + interface + var V: Integer = 7; + implementation + end. + '''; + UnitB = + ''' + unit uvb; + interface + var V: Integer = 9; + implementation + end. + '''; + ProgSrc = + ''' + program TestP; + uses uva, uvb; + var r: Integer; + begin + r := uva.V; + r := uvb.V + end. + '''; +var + UA, UB: TUnit; + Prog: TProgram; + SA: TSemanticAnalyser; + CG: TCodeGenQBE; + IR: string; +begin + UA := ParseUnitSrc(UnitA); + UB := ParseUnitSrc(UnitB); + Prog := ParseProg(ProgSrc); + SA := TSemanticAnalyser.Create(); + CG := TCodeGenQBE.Create(); + try + SA.AnalyseUnitForExport(UA); + SA.AnalyseUnitForExport(UB); + SA.Analyse(Prog); + CG.AppendUnit(UA); + CG.AppendUnit(UB); + CG.AppendProgram(Prog); + IR := CG.GetOutput(); + { Each unit defines its own owner-prefixed slot, and the qualified loads + reference both — proving the two same-named vars do not collapse. } + AssertTrue('uva.V slot referenced', Pos('$uva_V', IR) > 0); + AssertTrue('uvb.V slot referenced', Pos('$uvb_V', IR) > 0); + finally + CG.Free(); + SA.Free(); + Prog.Free(); + UB.Free(); + UA.Free(); + end; +end; + initialization RegisterTest(TMultifileTests); end.