From 0d47c5f9965b1d5e4239fd1f19579248fd8000ff Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Fri, 19 Jun 2026 04:27:41 +0100 Subject: [PATCH] feat(backend): default to native backend; fix codegen bugs exposed by the switch The native x86-64 backend is now the default (bkNative). QBE remains available via --backend qbe. Several codegen bugs that were invisible while QBE was the default are fixed in this commit: Native backend fixes: - EmitLeaqGlobal helper: threadvar globals now emit the correct fs:0 + @tpoff TLS sequence instead of bare %rip-relative leaq. Fixes static array write (FreeLists), string subscript assignment, EmitExprAddr, record memcpy, method-ptr cast, and open-array push paths that all used raw leaq %s(%rip). - EmitIncDec: unified local/global paths through VarOperand so threadvar scalar Inc/Dec (e.g. LargeFreeCount) gets TLS addressing. - EmitIncDec FAE.Base: Inc(P^.Field) where P is a pointer now evaluates the base expression instead of leaq on the stack slot. - FinalizeEmit: data section (.data/.bss/.rodata) now emits once at the end of unit compilation via FinalizeEmit, not inside each EmitUnit call. Fixes duplicate/missing string literals in sep-compile. - EmitFunctionDef AExported: implementation-only helpers in monolithic mode stay file-local (.globl suppressed) to avoid symbol collisions with the RTL archive. QBE backend fixes: - AppendUnit typeinfo: export prefix added to data $typeinfo_TObject, $typeinfo_TCustomAttribute, $vtable_TObject, $vtable_TCustomAttribute so native-built RTL can resolve them. - FSuppressSystemDefs: decoupled from FExportAll so CreateUnitCodeGen can export all symbols without suppressing system defs. Infrastructure: - runtime/Makefile: BLAISE_FLAGS variable for passing extra compiler flags (e.g. --backend qbe) from build scripts. - fixpoint.sh: make clean before RTL rebuild to pick up backend change. --- compiler/src/main/pascal/Blaise.pas | 7 +- .../pascal/blaise.codegen.native.backend.pas | 17 +- .../src/main/pascal/blaise.codegen.native.pas | 10 +- .../pascal/blaise.codegen.native.x86_64.pas | 161 +++++++++--------- .../main/pascal/blaise.codegen.qbe.driver.pas | 1 + .../src/main/pascal/blaise.codegen.qbe.pas | 25 ++- runtime/Makefile | 19 ++- scripts/fixpoint.sh | 3 +- 8 files changed, 135 insertions(+), 108 deletions(-) diff --git a/compiler/src/main/pascal/Blaise.pas b/compiler/src/main/pascal/Blaise.pas index abc61b0..638c02f 100644 --- a/compiler/src/main/pascal/Blaise.pas +++ b/compiler/src/main/pascal/Blaise.pas @@ -150,7 +150,7 @@ begin AFront.EmitIR := False; AFront.EmitAsm := False; AFront.DumpAST := False; - AFront.Backend := bkQBE; + AFront.Backend := bkNative; AFront.BackendExplicit := False; AFront.SkipDepCodegen := False; AFront.EmitIfaceDir := ''; @@ -812,7 +812,10 @@ begin QBE for fixpoint / RTL Makefile compatibility; --emit-asm implies native); the per-backend construction details — class to instantiate, knobs to wire — live behind Driver.CreateCodeGen. } - CG := Driver.CreateCodeGen(Opts); + if IsUnitMode then + CG := Driver.CreateUnitCodeGen(Opts) + else + CG := Driver.CreateCodeGen(Opts); if IsUnitMode then begin { Unit-as-top-level: emit just the unit's bodies, no program wrapping, no @main. } diff --git a/compiler/src/main/pascal/blaise.codegen.native.backend.pas b/compiler/src/main/pascal/blaise.codegen.native.backend.pas index 3746b2a..0d7ccb7 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.backend.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.backend.pas @@ -47,6 +47,7 @@ type TObject/TCustomAttribute system defs, which the program object provides — emitting them in each unit object would collide at link time. } FSeparateCompile: Boolean; + FFinalized: Boolean; { Assembly text is built append-only and read once at the end, so a TStringBuilder (single growable buffer, no per-line heap string and no O(N^2) final concat) is the right structure — the same approach the QBE @@ -73,6 +74,11 @@ type { Emit a dependency unit's bodies + data (no $main) into the shared buffer for the whole-program multi-unit model. } procedure EmitUnit(AUnit: TUnit); virtual; abstract; + { Emit accumulated data (.data/.bss/.rodata) after all units have been + processed. Called once from GenerateUnit or GetOutput — never from + EmitUnit itself, because in unit-mode the driver appends dep units + first and the data section must materialise only once at the end. } + procedure FinalizeEmit; virtual; public constructor Create(const ATarget: TTargetDesc); virtual; destructor Destroy; override; @@ -108,6 +114,10 @@ begin { Default: backend does not collect debug facts. } end; +procedure TNativeBackend.FinalizeEmit; +begin +end; + constructor TNativeBackend.Create(const ATarget: TTargetDesc); begin inherited Create(); @@ -316,13 +326,10 @@ end; function TNativeBackend.GenerateUnit(AUnit: TUnit): string; begin - { Single-unit-in-isolation: emit just this unit's object (its globals, class - methods, procs, init section and class data) into a fresh buffer. EmitUnit - is self-contained and prefers the unit's own symbol table when it was - analysed standalone (AUnit.SymbolTable <> nil). } FAsm.Clear(); FSeparateCompile := True; Self.EmitUnit(AUnit); + Self.FinalizeEmit(); Result := FAsm.ToString(); end; @@ -340,6 +347,8 @@ end; function TNativeBackend.GetOutput: string; begin + if FSeparateCompile and (not FFinalized) then + Self.FinalizeEmit(); Result := FAsm.ToString(); end; diff --git a/compiler/src/main/pascal/blaise.codegen.native.pas b/compiler/src/main/pascal/blaise.codegen.native.pas index ee4fd9f..4c0fca4 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.pas @@ -43,7 +43,6 @@ type FDebugMode: Boolean; FSeparateCompile: Boolean; FBackend: TNativeBackend; - FOutput: string; FDbgFacts: TDbgFacts; { owned; created by SetOpdfMode(True) } procedure EnsureBackend; public @@ -103,7 +102,6 @@ begin FDebugMode := False; FSeparateCompile := False; FBackend := nil; - FOutput := ''; end; destructor TCodeGenNative.Destroy; @@ -158,7 +156,7 @@ begin FBackend.SetSymbolTable(FSymTable); FBackend.SetDebugMode(FDebugMode); FBackend.SetDebugFacts(FDbgFacts); - FOutput := FBackend.GenerateProgram(AProg); + FBackend.GenerateProgram(AProg); end; procedure TCodeGenNative.GenerateUnit(AUnit: TUnit); @@ -167,7 +165,7 @@ begin FBackend.SetSymbolTable(FSymTable); FBackend.SetDebugMode(FDebugMode); FBackend.SetDebugFacts(FDbgFacts); - FOutput := FBackend.GenerateUnit(AUnit); + FBackend.GenerateUnit(AUnit); end; procedure TCodeGenNative.AppendUnit(AUnit: TUnit); @@ -178,7 +176,6 @@ begin FBackend.SetSeparateCompile(FSeparateCompile); FBackend.SetDebugFacts(FDbgFacts); FBackend.AppendUnit(AUnit); - FOutput := FBackend.GetOutput(); end; procedure TCodeGenNative.AppendProgram(AProg: TProgram); @@ -188,12 +185,11 @@ begin FBackend.SetDebugMode(FDebugMode); FBackend.SetDebugFacts(FDbgFacts); FBackend.AppendProgram(AProg); - FOutput := FBackend.GetOutput(); end; function TCodeGenNative.GetOutput: string; begin - Result := FOutput; + Result := FBackend.GetOutput(); end; end. diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index e28fa0f..2ea3f18 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -271,6 +271,7 @@ type { The AT&T operand addressing AName: "-N(%rbp)" for a frame local, "name(%rip)" for a global. } function VarOperand(const AName: string): string; + procedure EmitLeaqGlobal(const AName: string; const ADstReg: string); { Operands for the two halves of an interface fat pointer. Locals occupy a contiguous 16-byte slot (obj at the slot base, itab 8 bytes above); globals are two separate .data labels, AName + '_obj'/'_itab'. } @@ -352,8 +353,12 @@ type procedure EmitProgram(AProg: TProgram); override; procedure EmitUnit(AUnit: TUnit); override; - { Emit a standalone procedure/function definition. } - procedure EmitFunctionDef(ADecl: TMethodDecl); + procedure FinalizeEmit; override; + { Emit a standalone procedure/function definition. AExported controls + whether the symbol gets .globl visibility (True by default). In + monolithic compilation, implementation-section helpers pass False so + their labels stay local and do not collide with the RTL archive. } + procedure EmitFunctionDef(ADecl: TMethodDecl; AExported: Boolean); { Spill incoming arg register AIdx into a param slot at AType's width. } procedure EmitSpillArg(AIdx: Integer; const AOperand: string; AType: TTypeDesc); @@ -3273,7 +3278,7 @@ begin else if Self.IsLocal(AFA.RecordName) then Self.Emit(Format(#9'leaq %s, %s', [Self.VarOperand(AFA.RecordName), ADstReg])) else - Self.Emit(Format(#9'leaq %s(%%rip), %s', [AFA.RecordName, ADstReg])); + Self.EmitLeaqGlobal(AFA.RecordName, ADstReg); { Add the field offset to reach the fat pointer's obj slot. } if AFA.FieldInfo.Offset > 0 then Self.Emit(Format(#9'addq $%d, %s', [AFA.FieldInfo.Offset, ADstReg])); @@ -3310,7 +3315,7 @@ begin Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(TIdentExpr(ASub.StrExpr).Name)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rcx', [TIdentExpr(ASub.StrExpr).Name])); + Self.EmitLeaqGlobal(TIdentExpr(ASub.StrExpr).Name, '%rcx'); end else raise ENativeCodeGenError.Create( @@ -3346,7 +3351,7 @@ begin if Decl.Body = nil then Continue; { Generic-method templates emit per instantiation, not as a template. } if Decl.TypeParams <> nil then Continue; - Self.EmitFunctionDef(Decl); + Self.EmitFunctionDef(Decl, True); end; end else if TD.Def is TRecordTypeDef then @@ -3357,7 +3362,7 @@ begin Decl := TMethodDecl(RD.Methods.Items[J]); if Decl.Body = nil then Continue; if Decl.TypeParams <> nil then Continue; - Self.EmitFunctionDef(Decl); + Self.EmitFunctionDef(Decl, True); end; end; end; @@ -3377,7 +3382,7 @@ begin begin Decl := TMethodDecl(GI.ClassDef.Methods.Items[J]); if Decl.Body = nil then Continue; - Self.EmitFunctionDef(Decl); + Self.EmitFunctionDef(Decl, True); end; end; FCurrentUnitName := SavedUnit; @@ -3389,7 +3394,7 @@ begin begin Decl := TMethodDecl(GRI.RecordDef.Methods.Items[J]); if Decl.Body = nil then Continue; - Self.EmitFunctionDef(Decl); + Self.EmitFunctionDef(Decl, True); end; end; @@ -3400,7 +3405,7 @@ begin begin GMI := TGenericMethodInstance(AGenericMethodInstances.Items[I]); if GMI.MethodDecl.Body <> nil then - Self.EmitFunctionDef(GMI.MethodDecl); + Self.EmitFunctionDef(GMI.MethodDecl, True); end; end; @@ -3436,6 +3441,17 @@ begin Result := AName + '(%rip)'; end; +procedure TX86_64Backend.EmitLeaqGlobal(const AName: string; const ADstReg: string); +begin + if Self.IsThreadVarGlobal(AName) then + begin + Self.Emit(Format(#9'movq %%fs:0, %s', [ADstReg])); + Self.Emit(Format(#9'leaq %s@tpoff(%s), %s', [AName, ADstReg, ADstReg])); + end + else + Self.Emit(Format(#9'leaq %s(%%rip), %s', [AName, ADstReg])); +end; + function TX86_64Backend.LocalType(const AName: string): TTypeDesc; begin if (FFrameTypes = nil) or (not FFrameTypes.TryGetValue(AName, Result)) then @@ -3933,7 +3949,7 @@ begin else if Self.IsLocal(IE.Name) then Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(IE.Name)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rdx', [IE.Name])); + Self.EmitLeaqGlobal(IE.Name, '%rdx'); Exit; end; if AExpr is TFieldAccessExpr then @@ -3974,7 +3990,7 @@ begin address of the pointer slot instead of to the pointed-to record. } Self.EmitLocalRecordBase(FAE.RecordName, '%rdx') else - Self.Emit(Format(#9'leaq %s(%%rip), %%rdx', [FAE.RecordName])); + Self.EmitLeaqGlobal(FAE.RecordName, '%rdx'); if FAE.FieldInfo.Offset > 0 then Self.Emit(Format(#9'addq $%d, %%rdx', [FAE.FieldInfo.Offset])); Exit; @@ -4237,19 +4253,9 @@ begin else begin if IsWide then - begin - if Self.IsLocal(IE.Name) then - Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(IE.Name)])) - else - Self.Emit(Format(#9'movq %s(%%rip), %%rax', [IE.Name])); - end + Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(IE.Name)])) else - begin - if Self.IsLocal(IE.Name) then - Self.Emit(Format(#9'movl %s, %%eax', [Self.VarOperand(IE.Name)])) - else - Self.Emit(Format(#9'movl %s(%%rip), %%eax', [IE.Name])); - end; + Self.Emit(Format(#9'movl %s, %%eax', [Self.VarOperand(IE.Name)])); if HasStep then begin if IsWide then @@ -4277,25 +4283,21 @@ begin end; end; if IsWide then - begin - if Self.IsLocal(IE.Name) then - Self.Emit(Format(#9'movq %%rax, %s', [Self.VarOperand(IE.Name)])) - else - Self.Emit(Format(#9'movq %%rax, %s(%%rip)', [IE.Name])); - end + Self.Emit(Format(#9'movq %%rax, %s', [Self.VarOperand(IE.Name)])) else - begin - if Self.IsLocal(IE.Name) then - Self.Emit(Format(#9'movl %%eax, %s', [Self.VarOperand(IE.Name)])) - else - Self.Emit(Format(#9'movl %%eax, %s(%%rip)', [IE.Name])); - end; + Self.Emit(Format(#9'movl %%eax, %s', [Self.VarOperand(IE.Name)])); + end; end else if Arg0 is TFieldAccessExpr then begin FAE := TFieldAccessExpr(Arg0); - if FAE.IsImplicitSelf then + if FAE.Base <> nil then + begin + Self.EmitExprToEax(FAE.Base); + Self.Emit(#9'movq %rax, %rdx'); + end + else if FAE.IsImplicitSelf then begin Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand('Self')])); if (FAE.ImplicitBaseInfo <> nil) and (FAE.ImplicitBaseInfo.Offset > 0) then @@ -4303,17 +4305,14 @@ begin end else if FAE.IsVarParam then begin - if Self.IsLocal(FAE.RecordName) then - Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand(FAE.RecordName)])) - else - Self.Emit(Format(#9'movq %s(%%rip), %%rdx', [FAE.RecordName])); + Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand(FAE.RecordName)])); end else begin if Self.IsLocal(FAE.RecordName) then Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(FAE.RecordName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rdx', [FAE.RecordName])); + Self.EmitLeaqGlobal(FAE.RecordName, '%rdx'); end; if FAE.FieldInfo.Offset > 0 then Self.Emit(Format(#9'addq $%d, %%rdx', [FAE.FieldInfo.Offset])); @@ -5061,7 +5060,7 @@ begin Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [NativeMangle(TIdentExpr(AExpr).ConstArraySymbol)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [TIdentExpr(AExpr).Name])); + Self.EmitLeaqGlobal(TIdentExpr(AExpr).Name, '%rax'); Exit; end; if TIdentExpr(AExpr).IsConstant then @@ -7063,7 +7062,7 @@ begin if Self.IsLocal(FAE.RecordName) then Self.Emit(Format(#9'leaq %s, %%rdi', [Self.VarOperand(FAE.RecordName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rdi', [FAE.RecordName])); + Self.EmitLeaqGlobal(FAE.RecordName, '%rdi'); end else if FAE.IsVarParam then begin @@ -7879,7 +7878,7 @@ begin if Self.IsLocal(ACall.ObjectName) then Self.Emit(Format(#9'leaq %s, %%rax', [Self.VarOperand(ACall.ObjectName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [ACall.ObjectName])); + Self.EmitLeaqGlobal(ACall.ObjectName, '%rax'); end else if ACall.IsVarParam then begin @@ -7950,7 +7949,7 @@ begin pointer block starts at the Name_obj label. } Self.Emit(Format(#9'leaq %s_obj(%%rip), %%rax', [TIdentExpr(AArg).Name])) else if AArg is TIdentExpr then - Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [TIdentExpr(AArg).Name])) + Self.EmitLeaqGlobal(TIdentExpr(AArg).Name, '%rax') else if AArg is TFieldAccessExpr then begin { Record/class field as var argument (including fields of the sret @@ -8130,8 +8129,7 @@ begin Self.Emit(Format(#9'leaq %s(%%rip), %%rax', [NativeMangle(TIdentExpr(AArg).ConstArraySymbol)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rax', - [TIdentExpr(AArg).Name])); + Self.EmitLeaqGlobal(TIdentExpr(AArg).Name, '%rax'); Self.Emit(#9'pushq %rax'); Self.Emit(Format(#9'pushq $%d', [TStaticArrayTypeDesc(TIdentExpr(AArg).ResolvedType).HighBound - @@ -10153,7 +10151,7 @@ begin if Self.IsLocal(Asgn.Name) then Self.Emit(Format(#9'leaq %s, %%rdi', [Self.VarOperand(Asgn.Name)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rdi', [Asgn.Name])); + Self.EmitLeaqGlobal(Asgn.Name, '%rdi'); { Source address: the cast argument (a TMethod record or another method ptr). } if TASTExpr(TFuncCallExpr(Asgn.Expr).Args.Items[0]) is TIdentExpr then begin @@ -10454,7 +10452,7 @@ begin begin Self.AddGlobal(Asgn.Name, Asgn.ResolvedLhsType); if Asgn.IsThreadVar then Self.MarkThreadVar(Asgn.Name); - Self.Emit(Format(#9'leaq %s(%%rip), %%rdi', [Asgn.Name])); + Self.EmitLeaqGlobal(Asgn.Name, '%rdi'); end; Self.Emit(Format(#9'movq $%d, %%rdx', [Asgn.ResolvedLhsType.RawSize()])); Self.Emit(#9'callq memcpy'); @@ -11875,7 +11873,7 @@ begin if Self.IsLocal(SSA.ArrayName) then Self.Emit(Format(#9'leaq %s, %%rbx', [Self.VarOperand(SSA.ArrayName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rbx', [SSA.ArrayName])); + Self.EmitLeaqGlobal(SSA.ArrayName, '%rbx'); if SSA.IsVarParam then { var/out param: slot holds the caller variable's address; that is where the string pointer actually lives. } @@ -12101,7 +12099,7 @@ begin else if Self.IsLocal(SSA.ArrayName) then Self.Emit(Format(#9'leaq %s, %%r14', [Self.VarOperand(SSA.ArrayName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%r14', [SSA.ArrayName])); + Self.EmitLeaqGlobal(SSA.ArrayName, '%r14'); Self.Emit(#9'addq %rax, %r14'); { %r14 = element address } Self.EmitInterfaceToFieldSlotsAt(SSA.ValueExpr, '%r14', 0, DAElemType); Self.Emit(#9'popq %r14'); @@ -12129,7 +12127,7 @@ begin else if Self.IsLocal(SSA.ArrayName) then Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(SSA.ArrayName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rcx', [SSA.ArrayName])); + Self.EmitLeaqGlobal(SSA.ArrayName, '%rcx'); Self.Emit(#9'addq %rcx, %rax'); Self.Emit(#9'movq %rax, %rbx'); Self.EmitRecordFieldReleases(TRecordTypeDesc(DAElemType), '%rbx'); @@ -12185,7 +12183,7 @@ begin else if Self.IsLocal(SSA.ArrayName) then Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(SSA.ArrayName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rcx', [SSA.ArrayName])); + Self.EmitLeaqGlobal(SSA.ArrayName, '%rcx'); Self.Emit(#9'addq %rcx, %rax'); Self.Emit(#9'movq %rax, %rcx'); if IsFloatFamily(DAElemType) then @@ -13864,7 +13862,7 @@ begin if Self.IsLocal(ACall.ObjectName) then Self.Emit(Format(#9'leaq %s, %%rdi', [Self.VarOperand(ACall.ObjectName)])) else - Self.Emit(Format(#9'leaq %s(%%rip), %%rdi', [ACall.ObjectName])); + Self.EmitLeaqGlobal(ACall.ObjectName, '%rdi'); end else if ACall.IsVarParam then begin @@ -14606,7 +14604,7 @@ end; the body runs through the slots; a function returns its Result slot (64-bit-extended) in %rax/%eax. M5 supports integer-family value parameters and integer-family/void return. } -procedure TX86_64Backend.EmitFunctionDef(ADecl: TMethodDecl); +procedure TX86_64Backend.EmitFunctionDef(ADecl: TMethodDecl; AExported: Boolean); var I, J: Integer; P: TMethodParam; @@ -14632,7 +14630,7 @@ begin if NestedDecl.Body = nil then Continue; NestedDecl.ResolvedQbeName := ADecl.Name + '_' + NestedDecl.Name; FDbgOuterDecl := ADecl; - Self.EmitFunctionDef(NestedDecl); + Self.EmitFunctionDef(NestedDecl, False); end; FDbgOuterDecl := SavedOuterDecl; end; @@ -14689,7 +14687,8 @@ begin Self.DbgMarkParams(ADecl); Self.Emit('.text'); - Self.Emit('.globl ' + Sym); + if AExported then + Self.Emit('.globl ' + Sym); Self.Emit(Sym + ':'); Self.Emit(#9'pushq %rbp'); Self.Emit(#9'movq %rsp, %rbp'); @@ -15205,13 +15204,13 @@ begin if Decl.TypeParams <> nil then Continue; { generic templates: skip } if Decl.Body = nil then Continue; { forward decls } if Decl.IsExternal then Continue; { external: later } - Self.EmitFunctionDef(Decl); + Self.EmitFunctionDef(Decl, True); end; { Concrete generic function instances. } for I := 0 to AProg.GenericFuncInstances.Count - 1 do Self.EmitFunctionDef( - TGenericFuncInstance(AProg.GenericFuncInstances.Items[I]).MethodDecl); + TGenericFuncInstance(AProg.GenericFuncInstances.Items[I]).MethodDecl, True); { Pre-count try stmts in the program body so VarOperand resolves _exc_frame_N as globals (FFrame is nil in main, so the global path is @@ -15294,6 +15293,7 @@ var ImplDecl: TMethodDecl; VD: TVarDecl; UnitSym: TSymbolTable; + IntfNames: TStringList; begin FCurrentUnitName := AUnit.Name; FDbgSrcFile := AUnit.SourceFile; @@ -15347,21 +15347,30 @@ begin { Standalone procedures/functions from the implementation block. Skip class method stubs (OwnerTypeName <> '': their bodies were transferred to the class definition and emitted above), generic templates, forward decls, and - externals. } - for I := 0 to AUnit.ImplBlock.ProcDecls.Count - 1 do - begin - ImplDecl := TMethodDecl(AUnit.ImplBlock.ProcDecls.Items[I]); - if ImplDecl.OwnerTypeName <> '' then Continue; - if ImplDecl.TypeParams <> nil then Continue; - if ImplDecl.Body = nil then Continue; - if ImplDecl.IsExternal then Continue; - Self.EmitFunctionDef(ImplDecl); + externals. In monolithic mode, only interface-exported functions need + .globl — implementation-only helpers stay local to avoid collisions with + the same symbols in the RTL archive. } + IntfNames := TStringList.Create(); + try + for I := 0 to AUnit.IntfBlock.ProcDecls.Count - 1 do + IntfNames.Add(TMethodDecl(AUnit.IntfBlock.ProcDecls.Items[I]).Name); + for I := 0 to AUnit.ImplBlock.ProcDecls.Count - 1 do + begin + ImplDecl := TMethodDecl(AUnit.ImplBlock.ProcDecls.Items[I]); + if ImplDecl.OwnerTypeName <> '' then Continue; + if ImplDecl.TypeParams <> nil then Continue; + if ImplDecl.Body = nil then Continue; + if ImplDecl.IsExternal then Continue; + Self.EmitFunctionDef(ImplDecl, IntfNames.IndexOf(ImplDecl.Name) >= 0); + end; + finally + IntfNames.Free(); end; { Concrete generic function instances declared in this unit. } for I := 0 to AUnit.GenericFuncInstances.Count - 1 do Self.EmitFunctionDef( - TGenericFuncInstance(AUnit.GenericFuncInstances.Items[I]).MethodDecl); + TGenericFuncInstance(AUnit.GenericFuncInstances.Items[I]).MethodDecl, True); { Initialization section: emit as a function _init that the program's $main calls before the program body. (Finalization is not yet wired into @@ -15405,13 +15414,13 @@ begin Self.Emit('.data'); Self.EmitInterfaceDefs(AUnit.IntfBlock.TypeDecls, AUnit.GenericInstances, AUnit.GenericIntfInstances, UnitSym); - { Separate-compilation: emit this unit's string-literal blobs into its own - object. The __sN labels are file-local, so each unit object carries the - literals its own code references — without this a unit method referencing a - string literal links with an undefined __sN. In the whole-program (program) - path the literals are emitted once by EmitDataSection instead. } - if FSeparateCompile then - Self.EmitStrLitSection(); +end; + +procedure TX86_64Backend.FinalizeEmit; +begin + if FFinalized then Exit; + FFinalized := True; + Self.EmitDataSection(); end; end. diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.driver.pas b/compiler/src/main/pascal/blaise.codegen.qbe.driver.pas index 5288e45..8c1677f 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.driver.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.driver.pas @@ -113,6 +113,7 @@ begin CG.SetDebugMode(AOpts.DebugMode); CG.SetOpdfMode(AOpts.OPDFEnabled); CG.SetExportAll(True); + CG.SetSuppressSystemDefs(True); Result := CG; end; diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index f69db25..4ebfcff 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -495,6 +495,7 @@ type public FDebugMode: Boolean; FExportAll: Boolean; + FSuppressSystemDefs: Boolean; FOpdfMode: Boolean; constructor Create; destructor Destroy; override; @@ -512,6 +513,7 @@ type procedure SetOpdfMode(AEnabled: Boolean); function GetDebugFacts: TDbgFacts; procedure SetExportAll(AEnabled: Boolean); + procedure SetSuppressSystemDefs(AEnabled: Boolean); procedure AppendUnit(AUnit: TUnit); { Append program IR to existing output (companion to AppendUnit). Emits any remaining string literals and the $main function. } @@ -13371,6 +13373,11 @@ begin FExportAll := AEnabled; end; +procedure TCodeGenQBE.SetSuppressSystemDefs(AEnabled: Boolean); +begin + FSuppressSystemDefs := AEnabled; +end; + procedure TCodeGenQBE.AppendUnit(AUnit: TUnit); var I, J, K, S: Integer; @@ -13481,10 +13488,10 @@ begin Emitted once per codegen pass when this unit declares any class. In monolithic mode QBE emits these as local symbols (no .globl), so each .o gets its own private copy. In - separate-compilation mode (FExportAll) they would collide - across per-unit .o files, so skip them here — the main + separate-compilation mode (FSuppressSystemDefs) they would + collide across per-unit .o files, so skip them here — the main program's AppendProgram emits the authoritative copies. } - if (not FExportAll) and (not FSystemDefsEmitted) and (FSymTable <> nil) then + if (not FSuppressSystemDefs) and (not FSystemDefsEmitted) and (FSymTable <> nil) then for I := 0 to AUnit.IntfBlock.TypeDecls.Count - 1 do begin TD := TTypeDecl(AUnit.IntfBlock.TypeDecls.Items[I]); @@ -13560,24 +13567,24 @@ begin { System-unit (TObject / TCustomAttribute) typeinfo + vtable. Emitted alongside the FieldCleanup stubs above, also gated on FSystemDefsEmitted. Skipped in separate-compilation mode - (FExportAll) — the main program provides these. } - if (not FExportAll) and (not FSystemDefsEmitted) then + (FSuppressSystemDefs) — the main program provides these. } + if (not FSuppressSystemDefs) and (not FSystemDefsEmitted) then for I := 0 to AUnit.IntfBlock.TypeDecls.Count - 1 do begin TD := TTypeDecl(AUnit.IntfBlock.TypeDecls.Items[I]); if TD.Def is TClassTypeDef then begin - EmitLine('data $typeinfo_TObject = { l 0, l 0, l ' + + EmitLine('export data $typeinfo_TObject = { l 0, l 0, l ' + EmitClassNameRef('TObject') + ', l 0' + ', l 8, l $_FieldCleanup_TObject, l $vtable_TObject, l 0 }'); - EmitLine('data $typeinfo_TCustomAttribute = { l $typeinfo_TObject, l 0, l ' + + EmitLine('export data $typeinfo_TCustomAttribute = { l $typeinfo_TObject, l 0, l ' + EmitClassNameRef('TCustomAttribute') + ', l 0' + ', l 8, l $_FieldCleanup_TCustomAttribute' + ', l $vtable_TCustomAttribute, l 0 }'); EmitLine(''); - EmitLine('data $vtable_TObject = { l $typeinfo_TObject' + + EmitLine('export data $vtable_TObject = { l $typeinfo_TObject' + ', l $TObject_Destroy, l $TObject_ToString }'); - EmitLine('data $vtable_TCustomAttribute = { l $typeinfo_TCustomAttribute' + + EmitLine('export data $vtable_TCustomAttribute = { l $typeinfo_TCustomAttribute' + ', l $TObject_Destroy, l $TObject_ToString }'); EmitLine(''); FSystemDefsEmitted := True; diff --git a/runtime/Makefile b/runtime/Makefile index 8565ae4..bc21285 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -25,6 +25,7 @@ LIB = $(OBJ_DIR)/blaise_rtl.a # driver finds it automatically next to itself. COMPILER_BIN = ../compiler/target BLAISE = $(COMPILER_BIN)/blaise +BLAISE_FLAGS = # Assembly sources — platform-specific, no C compiler needed. ASM_OBJS = $(OBJ_DIR)/blaise_setjmp_x86_64.o \ @@ -59,40 +60,40 @@ $(OBJ_DIR)/%.o: $(ASM_DIR)/%.s # --- Pascal unit rules (unit-as-top-level) --- $(OBJ_DIR)/blaise_mem.o: $(PAS_SRC_DIR)/blaise_mem.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/blaise_str.o: $(PAS_SRC_DIR)/blaise_str.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/blaise_set.o: $(PAS_SRC_DIR)/blaise_set.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/blaise_arc.o: $(PAS_SRC_DIR)/blaise_arc.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/blaise_weak.o: $(PAS_SRC_DIR)/blaise_weak.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/blaise_float.o: $(PAS_SRC_DIR)/blaise_float.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/blaise_thread.o: $(PAS_SRC_DIR)/blaise_thread.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/blaise_exc.o: $(PAS_SRC_DIR)/blaise_exc.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ $(OBJ_DIR)/rtl_platform_posix.o: $(PAS_SRC_DIR)/rtl.platform.posix.pas \ $(PAS_SRC_DIR)/rtl.platform.pas @mkdir -p $(OBJ_DIR) - $(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@ + $(BLAISE) $(BLAISE_FLAGS) --source $< --unit-path $(PAS_SRC_DIR) --output $@ install: $(LIB) @mkdir -p $(COMPILER_BIN) diff --git a/scripts/fixpoint.sh b/scripts/fixpoint.sh index 10ec07a..45ae18c 100755 --- a/scripts/fixpoint.sh +++ b/scripts/fixpoint.sh @@ -45,7 +45,8 @@ echo "stage-1: $STAGE1_BIN" ABS_STAGE1=$(readlink -f "$STAGE1_BIN") echo "[1/5] rebuild + install runtime (BLAISE=$ABS_STAGE1)" -( cd runtime && make BLAISE="$ABS_STAGE1" > /tmp/fp_rtl.log 2>&1 \ +( cd runtime && make clean > /tmp/fp_rtl.log 2>&1 \ + && make BLAISE="$ABS_STAGE1" >> /tmp/fp_rtl.log 2>&1 \ && make BLAISE="$ABS_STAGE1" install >> /tmp/fp_rtl.log 2>&1 ) || { if [ -f compiler/target/blaise_rtl.a ]; then echo " stage-1 too old for runtime; using existing blaise_rtl.a"