diff --git a/compiler/src/main/pascal/blaise.codegen.native.backend.pas b/compiler/src/main/pascal/blaise.codegen.native.backend.pas index 80b018d..3746b2a 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.backend.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.backend.pas @@ -43,6 +43,10 @@ type FTarget: TTargetDesc; FSymTable: TSymbolTable; { not owned } FDebugMode: Boolean; + { Separate-compilation (incremental unit) mode: suppress the once-per-program + TObject/TCustomAttribute system defs, which the program object provides — + emitting them in each unit object would collide at link time. } + FSeparateCompile: 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 @@ -81,6 +85,7 @@ type function GetOutput: string; procedure SetSymbolTable(ASymTable: TSymbolTable); + procedure SetSeparateCompile(AEnabled: Boolean); { OPDF debug-facts sink — concrete backends that support exact debug info override this; the default ignores the facts object. } procedure SetDebugFacts(AFacts: TDbgFacts); virtual; @@ -88,6 +93,8 @@ type { Lower a whole program to assembly text and return it. } function GenerateProgram(AProg: TProgram): string; + { Lower a single unit (in isolation) to assembly text and return it. } + function GenerateUnit(AUnit: TUnit): string; property Target: TTargetDesc read FTarget; end; @@ -120,6 +127,11 @@ begin FSymTable := ASymTable; end; +procedure TNativeBackend.SetSeparateCompile(AEnabled: Boolean); +begin + FSeparateCompile := AEnabled; +end; + procedure TNativeBackend.SetDebugMode(AEnabled: Boolean); begin FDebugMode := AEnabled; @@ -302,6 +314,18 @@ begin Result := FAsm.ToString(); 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); + Result := FAsm.ToString(); +end; + procedure TNativeBackend.AppendUnit(AUnit: TUnit); begin { No clear — units and the program accumulate into one buffer. } diff --git a/compiler/src/main/pascal/blaise.codegen.native.driver.pas b/compiler/src/main/pascal/blaise.codegen.native.driver.pas index 1b8d3c5..56c8ada 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.driver.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.driver.pas @@ -19,11 +19,13 @@ unit blaise.codegen.native.driver; the cc driver; internal assembles in-process via AssembleToObject and only shells out for the final link. - * SupportsIncremental / SupportsWarmCache are False: the native - pipeline does not yet write per-unit .o + .bif sidecars, so the - --incremental worker pool falls back to the QBE driver (the - QBE-emitted .o files link cleanly alongside this backend's - top-program object). + * SupportsIncremental / SupportsWarmCache are True: the native pipeline + writes a self-contained per-unit .o (its assembly, assembled to an object, + with the .bif iface embedded) so the --incremental worker pool runs on the + native backend directly. Unit objects are compiled in separate-compilation + mode (FSeparateCompile) — they omit the once-per-program TObject/ + TCustomAttribute system defs (the program object provides the single + global definition) and carry their own file-local string literals. Architecture follows Andrew Haines' unify_backend_interface proposal. @@ -45,8 +47,18 @@ type function Name: string; override; function IRFileExt: string; override; function CreateCodeGen(AOpts: TBackendOpts): ICodeGen; override; + function CreateUnitCodeGen(AOpts: TBackendOpts): ICodeGen; override; function LinkProgram(const AIRFile, AOutputFile: string; AOpts: TBackendOpts; AExtraObjects: TStringList): string; override; + function LowerToObject(const AIRFile, AObjFile: string; + AOpts: TBackendOpts): string; override; + + { Per-unit parallel compilation + warm cache: native emits a self-contained + object per unit (.s assembled to .o, plus an embedded .bif), the same as + QBE. Enabling these routes the --incremental worker pool through the + native backend instead of falling back to QBE. } + function SupportsIncremental: Boolean; override; + function SupportsWarmCache: Boolean; override; { --- Option contract: owns --assembler internal|external --- } function AcceptOption(const AFlag, ANextArg: string; @@ -58,7 +70,8 @@ type implementation uses - SysUtils, + SysUtils, Classes, + uToolchain, blaise.assembler.x86_64; function TNativeBackendDriver.Kind: TBackendKind; @@ -87,6 +100,81 @@ begin Result := CG; end; +function TNativeBackendDriver.CreateUnitCodeGen(AOpts: TBackendOpts): ICodeGen; +var + CG: TCodeGenNative; +begin + { Same as CreateCodeGen; the native backend already emits unit globals, + methods, vtables and typeinfo with global (.globl) visibility, so sibling + units in the link resolve this unit's symbols without an extra export knob. } + CG := TCodeGenNative.Create(); + CG.SetTarget(AOpts.Target); + CG.SetDebugMode(AOpts.DebugMode); + CG.SetOpdfMode(AOpts.OPDFEnabled); + CG.SetSeparateCompile(True); { suppress per-unit system defs (link collision) } + Result := CG; +end; + +function TNativeBackendDriver.SupportsIncremental: Boolean; +begin + Result := True; +end; + +function TNativeBackendDriver.SupportsWarmCache: Boolean; +begin + Result := True; +end; + +function TNativeBackendDriver.LowerToObject(const AIRFile, AObjFile: string; + AOpts: TBackendOpts): string; +var + Args: TStringList; + AsmText: TStringList; + Msg: string; + ExitCode: Integer; +begin + Result := ''; + { For the native backend the "IR file" already IS the x86-64 assembly the + unit codegen emitted — there is no qbe step. Assemble it to a relocatable + object: in-process when --assembler internal, else via the toolchain's + `cc -c`. } + if AOpts.UseInternalAsm then + begin + AsmText := TStringList.Create(); + try + try + AsmText.LoadFromFile(AIRFile); + AssembleToObject(AsmText.Text, AObjFile); + except + on E: EAssembler do + Exit('Internal assembler error: ' + Exception(E).Message); + on E: Exception do + Exit('Internal assembler error [' + Exception(E).ClassName + ']: ' + + Exception(E).Message); + end; + finally + AsmText.Free(); + end; + Exit; + end; + Args := TStringList.Create(); + try + Args.Add('-c'); + { Force assembler language: the worker writes the IR to a name like + '.o.s.tmp', whose extension cc would not recognise as assembly. } + Args.Add('-x'); + Args.Add('assembler'); + Args.Add('-o'); + Args.Add(AObjFile); + Args.Add(AIRFile); + ExitCode := RunProcess(ResolveLinker(AOpts.Target).Path, Args, Msg); + finally + Args.Free(); + end; + if ExitCode <> 0 then + Result := 'cc -c error (exit ' + IntToStr(ExitCode) + '): ' + Msg; +end; + function TNativeBackendDriver.LinkProgram(const AIRFile, AOutputFile: string; AOpts: TBackendOpts; AExtraObjects: TStringList): string; var diff --git a/compiler/src/main/pascal/blaise.codegen.native.pas b/compiler/src/main/pascal/blaise.codegen.native.pas index 3703a5a..ee4fd9f 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.pas @@ -41,6 +41,7 @@ type FTarget: TTargetDesc; FSymTable: TSymbolTable; FDebugMode: Boolean; + FSeparateCompile: Boolean; FBackend: TNativeBackend; FOutput: string; FDbgFacts: TDbgFacts; { owned; created by SetOpdfMode(True) } @@ -52,6 +53,9 @@ type { Backend-specific configuration — set before the object is used as an ICodeGen. Not part of the ICodeGen contract. } procedure SetTarget(const ATarget: TTargetDesc); + { Separate-compilation (incremental unit) mode: suppress per-unit system + defs. Set by the driver's CreateUnitCodeGen before AppendUnit. } + procedure SetSeparateCompile(AEnabled: Boolean); { ICodeGen } procedure Generate(AProg: TProgram); @@ -97,6 +101,7 @@ begin MakeTarget(osLinux, cpuX86_64, FTarget); FSymTable := nil; FDebugMode := False; + FSeparateCompile := False; FBackend := nil; FOutput := ''; end; @@ -112,6 +117,11 @@ begin FTarget := ATarget; end; +procedure TCodeGenNative.SetSeparateCompile(AEnabled: Boolean); +begin + FSeparateCompile := AEnabled; +end; + procedure TCodeGenNative.EnsureBackend; begin if FBackend = nil then @@ -154,9 +164,10 @@ end; procedure TCodeGenNative.GenerateUnit(AUnit: TUnit); begin Self.EnsureBackend(); - raise ENativeCodeGenError.Create( - 'native backend: single-unit compilation not yet implemented (target ' + - TargetName(FTarget) + ')'); + FBackend.SetSymbolTable(FSymTable); + FBackend.SetDebugMode(FDebugMode); + FBackend.SetDebugFacts(FDbgFacts); + FOutput := FBackend.GenerateUnit(AUnit); end; procedure TCodeGenNative.AppendUnit(AUnit: TUnit); @@ -164,6 +175,7 @@ begin Self.EnsureBackend(); FBackend.SetSymbolTable(FSymTable); FBackend.SetDebugMode(FDebugMode); + FBackend.SetSeparateCompile(FSeparateCompile); FBackend.SetDebugFacts(FDbgFacts); FBackend.AppendUnit(AUnit); FOutput := FBackend.GetOutput(); 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 74d03db..cbb9b2f 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -1794,8 +1794,11 @@ var begin { Fixed RTL class-name strings and stubs for TObject and TCustomAttribute. Emitted exactly once across the whole program (the first class section that - runs); guarded so multiple units + the program do not redefine the symbols. } - EmitSys := not FSystemDefsEmitted; + runs); guarded so multiple units + the program do not redefine the symbols. + In separate-compilation (incremental unit) mode they are NOT emitted at all — + the program object provides the single definition, so emitting them in each + unit object would collide at link time. } + EmitSys := (not FSystemDefsEmitted) and (not FSeparateCompile); Self.Emit('.data'); if EmitSys then begin @@ -1862,6 +1865,9 @@ begin if EmitSys then begin Self.Emit('.balign 8'); + { Global so separately-compiled unit objects (incremental mode) can + reference the single program-provided system typeinfo. } + Self.Emit('.globl typeinfo_TObject'); Self.Emit('typeinfo_TObject:'); Self.Emit(#9'.quad 0'); { parent = nil } Self.Emit(#9'.quad 0'); { impllist = nil } @@ -1873,6 +1879,7 @@ begin Self.Emit(#9'.quad 0'); { attrs = nil } Self.Emit('.balign 8'); + Self.Emit('.globl typeinfo_TCustomAttribute'); Self.Emit('typeinfo_TCustomAttribute:'); Self.Emit(#9'.quad typeinfo_TObject'); Self.Emit(#9'.quad 0'); @@ -1982,12 +1989,14 @@ begin if EmitSys then begin Self.Emit('.balign 8'); + Self.Emit('.globl vtable_TObject'); Self.Emit('vtable_TObject:'); Self.Emit(#9'.quad typeinfo_TObject'); Self.Emit(#9'.quad TObject_Destroy'); Self.Emit(#9'.quad TObject_ToString'); Self.Emit('.balign 8'); + Self.Emit('.globl vtable_TCustomAttribute'); Self.Emit('vtable_TCustomAttribute:'); Self.Emit(#9'.quad typeinfo_TCustomAttribute'); Self.Emit(#9'.quad TObject_Destroy'); @@ -15159,6 +15168,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; end. diff --git a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas index 52c9c5c..dc1ae1a 100644 --- a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas +++ b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas @@ -47,6 +47,7 @@ type procedure TestGenericClass_RoundTrip_WithoutSource; procedure TestUninstantiatedGenericFunc_InUnit_Compiles; procedure TestDuplicateExternalAcrossUnits_Compiles; + procedure TestNativeIncremental_MultiUnitClass_Compiles; end; implementation @@ -436,6 +437,77 @@ begin AssertEquals('use_dupext stdout', '8' + #10, Captured) end; +procedure TSepCompileTests.TestNativeIncremental_MultiUnitClass_Compiles; +{ The native backend supports --incremental (per-unit .o + embedded .bif) the + same as QBE. Compile a program using a unit that declares a class (exercises + the system-def suppression + global typeinfo_TObject and per-unit string + literals in the unit object), then run it. A unit .o must be left behind. } +const + UnitSrc = + ''' + unit ShapesU; + interface + type + TShape = class + Name: string; + function Describe: string; + end; + implementation + function TShape.Describe: string; + begin Result := 'shape:' + Name end; + end. + '''; + ProgSrc = + ''' + program UseShapes; + uses ShapesU; + var S: TShape; + begin + S := TShape.Create(); + S.Name := 'box'; + WriteLn(S.Describe()); + S.Free() + end. + '''; +var + UnitPas, ProgPas, ProgBin, UnitObj: 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; + + UnitPas := FScratch + '/ShapesU.pas'; + ProgPas := FScratch + '/use_shapes.pas'; + ProgBin := FScratch + '/use_shapes'; + { Incremental writes the per-unit .o next to the output with a lowercased + unit name (see UnitOPath in Blaise.pas). } + UnitObj := FScratch + '/shapesu.o'; + + WriteFile(UnitPas, UnitSrc); + WriteFile(ProgPas, ProgSrc); + DeleteFile(UnitObj); + + Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin, + '--backend', 'native', '--incremental', + '--unit-path', FScratch], Captured); + AssertEquals('blaise(use_shapes) exit code (out: ' + Captured + ')', 0, Rc); + AssertTrue('use_shapes exists', FileExists(ProgBin)); + AssertTrue('per-unit ShapesU.o cached', FileExists(UnitObj)); + + Rc := RunBinary(ProgBin, Captured); + AssertEquals('use_shapes exit code', 0, Rc); + AssertEquals('use_shapes stdout', 'shape:box' + #10, Captured) +end; + initialization RegisterTest(TSepCompileTests);