diff --git a/compiler/src/main/pascal/Blaise.pas b/compiler/src/main/pascal/Blaise.pas index babeefe..9744fb6 100644 --- a/compiler/src/main/pascal/Blaise.pas +++ b/compiler/src/main/pascal/Blaise.pas @@ -120,10 +120,10 @@ begin 'Write each unit''s TUnitInterface as /.bif')); WriteLn(FormatFlagLine('--skip-dep-codegen', 'Omit dep unit bodies from emitted IR (separate-compilation path)')); - WriteLn(FormatFlagLine('--incremental', - 'Compile each dep to its own .o as a side effect')); + WriteLn(FormatFlagLine('--no-incremental', + 'Disable per-unit .o emission; build a single whole-program object')); WriteLn(FormatFlagLine('--unit-cache ', - 'Where --incremental writes per-unit .o (default: alongside output)')); + 'Where per-unit .o files are written (default: alongside output)')); WriteLn(FormatFlagLine('--dump-ast', 'Print the resolved AST to stdout after semantic analysis')); WriteLn(FormatFlagLine('--debug', @@ -159,7 +159,7 @@ begin AFront.BackendExplicit := False; AFront.SkipDepCodegen := False; AFront.EmitIfaceDir := ''; - AFront.Incremental := False; + AFront.Incremental := True; { default-on; --no-incremental opts out } AFront.UnitCacheDir := ''; AOpts.OPDFEnabled := False; AOpts.DebugMode := False; @@ -197,14 +197,15 @@ begin Inc(I); AFront.EmitIfaceDir := ParamStr(I); end - else if Arg = '--incremental' then - { Phase 6c-H: compile each source-loaded dep to a stand-alone - .o (with embedded iface) as a side effect of the program - build. Implies --skip-dep-codegen for the main IR (deps - are not inlined; they're linked from the per-unit .o - files instead). Next compile auto-discovers the .o's - and skips parsing the .pas entirely. } - AFront.Incremental := True + else if Arg = '--no-incremental' then + { Incremental compilation is the default: each source-loaded dep + is compiled to a stand-alone .o (with embedded iface) as a side + effect of the program build, implying --skip-dep-codegen for the + main IR (deps are not inlined; they're linked from the per-unit + .o files instead) and letting the next compile auto-discover the + .o's and skip parsing the .pas. --no-incremental disables that + and builds a single whole-program object instead. } + AFront.Incremental := False else if (Arg = '--unit-cache') and (I < ParamCount()) then begin Inc(I); @@ -428,7 +429,7 @@ var PendingArgs: TStringList; { lookahead token per pending flag ('' if none) } PendIdx: Integer; { drain cursor over the pending lists } PendFlag: string; - WorkerDriver: TBackendDriver; { driver for the --incremental worker pool } + WorkerDriver: TBackendDriver; { driver for the incremental worker pool } OE: TOPDFEmitter; Loader: TUnitLoader; Units: TObjectList; @@ -446,7 +447,7 @@ var IR: string; IRFile: string; LinkErr: string; { Driver.LinkProgram result ('' on success) } - UnitOPath: string; { per-dep .o output path in --incremental mode } + UnitOPath: string; { per-dep .o output path in incremental mode } Workers: TObjectList; { TCompileWorker threads for parallel incremental } Worker: TCompileWorker; @@ -761,7 +762,8 @@ begin Each unit is compiled in a separate worker thread for parallel codegen + qbe + cc. The symbol table is read-only at this point (semantic analysis is complete), so concurrent reads are safe. } - if Incremental and (Units <> nil) and (Units.Count > 0) then + if Incremental and (not EmitIR) and (not EmitAsm) and (not DumpAST) + and (Units <> nil) and (Units.Count > 0) then begin { Pick a driver for the workers. Prefer the top-program backend when it supports per-unit emission; otherwise fall back to QBE — @@ -835,7 +837,19 @@ begin CG.SetSymbolTable(Prog.SymbolTable); if not SkipDepCodegen then for I := 0 to Units.Count - 1 do - CG.AppendUnit(TUnit(Units.Items[I])); + CG.AppendUnit(TUnit(Units.Items[I])) + 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 _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 + _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)); CG.AppendProgram(Prog); end else diff --git a/compiler/src/main/pascal/blaise.codegen.native.backend.pas b/compiler/src/main/pascal/blaise.codegen.native.backend.pas index 0d7ccb7..1a1e1e8 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.backend.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.backend.pas @@ -88,6 +88,12 @@ type into one assembly text retrieved via GetOutput. } procedure AppendUnit(AUnit: TUnit); procedure AppendProgram(AProg: TProgram); + { Separate-compilation init-call registration: record a dep unit whose body + is compiled elsewhere so $main still calls its _init. Concrete + backends that maintain an init-call list override this; the default is a + no-op. } + procedure NoteDepInitUnit(const AUnitName: string; + AHasInit: Boolean); virtual; function GetOutput: string; procedure SetSymbolTable(ASymTable: TSymbolTable); @@ -345,6 +351,12 @@ begin Self.EmitProgram(AProg); end; +procedure TNativeBackend.NoteDepInitUnit(const AUnitName: string; + AHasInit: Boolean); +begin + { Default: no init-call list to maintain. The x86_64 backend overrides. } +end; + function TNativeBackend.GetOutput: string; begin if FSeparateCompile and (not FFinalized) then diff --git a/compiler/src/main/pascal/blaise.codegen.native.pas b/compiler/src/main/pascal/blaise.codegen.native.pas index 4c0fca4..f19371c 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.pas @@ -65,6 +65,7 @@ type function GetDebugFacts: TDbgFacts; procedure AppendUnit(AUnit: TUnit); procedure AppendProgram(AProg: TProgram); + procedure NoteDepInitUnit(const AUnitName: string; AHasInit: Boolean); function GetOutput: string; end; @@ -187,6 +188,12 @@ begin FBackend.AppendProgram(AProg); end; +procedure TCodeGenNative.NoteDepInitUnit(const AUnitName: string; AHasInit: Boolean); +begin + Self.EnsureBackend(); + FBackend.NoteDepInitUnit(AUnitName, AHasInit); +end; + function TCodeGenNative.GetOutput: string; begin Result := 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 49243c8..0a520e4 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -353,6 +353,8 @@ type procedure EmitProgram(AProg: TProgram); override; procedure EmitUnit(AUnit: TUnit); override; + procedure NoteDepInitUnit(const AUnitName: string; + AHasInit: Boolean); override; procedure FinalizeEmit; override; { Emit a standalone procedure/function definition. AExported controls whether the symbol gets .globl visibility (True by default). In @@ -15419,6 +15421,16 @@ begin AUnit.GenericIntfInstances, UnitSym); end; +procedure TX86_64Backend.NoteDepInitUnit(const AUnitName: string; + AHasInit: Boolean); +begin + { Separate-compilation: the dep's body (and its _init) is in its own + object; record the mangled name so EmitProgram's $main calls it. Mangling + matches EmitUnit's FUnitInitNames.Add(NativeMangle(AUnit.Name)). } + if AHasInit then + FUnitInitNames.Add(NativeMangle(AUnitName)); +end; + procedure TX86_64Backend.FinalizeEmit; begin if FFinalized then Exit; diff --git a/compiler/src/main/pascal/blaise.codegen.pas b/compiler/src/main/pascal/blaise.codegen.pas index 51f8bda..0a1c22f 100644 --- a/compiler/src/main/pascal/blaise.codegen.pas +++ b/compiler/src/main/pascal/blaise.codegen.pas @@ -75,6 +75,17 @@ type { Append program IR after one or more AppendUnit calls. } procedure AppendProgram(AProg: TProgram); + { Incremental / separate-compilation: when a dependency unit's BODY is + compiled elsewhere (its own .o) and therefore NOT emitted here via + AppendUnit, the program startup must still call that unit's + _init() if it has an initialization section. This registers the + unit name into the init-call list (in dependency order) WITHOUT emitting + any body, so AppendProgram's $main emits `call $_init()` and the + call resolves against the symbol exported by the per-unit object. + AHasInit selects whether the unit actually has an init section; units + without one are skipped (no spurious call). } + procedure NoteDepInitUnit(const AUnitName: string; AHasInit: Boolean); + { Retrieve the complete generated output (QBE IR text for the QBE backend; target assembly text for the native backend). } function GetOutput: string; diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 4ebfcff..1f92d1c 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -518,6 +518,7 @@ type { Append program IR to existing output (companion to AppendUnit). Emits any remaining string literals and the $main function. } procedure AppendProgram(AProg: TProgram); + procedure NoteDepInitUnit(const AUnitName: string; AHasInit: Boolean); function GetOutput: string; end; @@ -13875,6 +13876,15 @@ begin end; end; +procedure TCodeGenQBE.NoteDepInitUnit(const AUnitName: string; AHasInit: Boolean); +begin + { Separate-compilation: the dep's body (and its $_init) is emitted in + its own object; record the name so AppendProgram's $main calls it. The + QBE init symbol is the bare unit name + '_init' (see AppendUnit). } + if AHasInit then + FUnitInitNames.Add(AUnitName); +end; + procedure TCodeGenQBE.AppendProgram(AProg: TProgram); var Body: TIRBuffer; diff --git a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas index dc1ae1a..1e4e185 100644 --- a/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas +++ b/compiler/src/test/pascal/cp.test.e2e.sepcompile.pas @@ -48,6 +48,7 @@ type procedure TestUninstantiatedGenericFunc_InUnit_Compiles; procedure TestDuplicateExternalAcrossUnits_Compiles; procedure TestNativeIncremental_MultiUnitClass_Compiles; + procedure TestNativeNoIncremental_MultiUnitClass_Compiles; end; implementation @@ -438,10 +439,12 @@ begin 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. } +{ Incremental compilation (per-unit .o + embedded .bif) is the DEFAULT on the + native backend (as it is on 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) WITHOUT any + --incremental flag — the default path must produce a working binary and leave + a per-unit .o behind. } const UnitSrc = ''' @@ -497,7 +500,7 @@ begin DeleteFile(UnitObj); Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin, - '--backend', 'native', '--incremental', + '--backend', 'native', '--unit-path', FScratch], Captured); AssertEquals('blaise(use_shapes) exit code (out: ' + Captured + ')', 0, Rc); AssertTrue('use_shapes exists', FileExists(ProgBin)); @@ -508,6 +511,74 @@ begin AssertEquals('use_shapes stdout', 'shape:box' + #10, Captured) end; +procedure TSepCompileTests.TestNativeNoIncremental_MultiUnitClass_Compiles; +{ --no-incremental opts out of the default per-unit .o emission: the same + multi-unit-class program must still compile and run as a single whole-program + object, and NO per-unit .o is 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_ni.pas'; + ProgBin := FScratch + '/use_shapes_ni'; + UnitObj := FScratch + '/shapesu.o'; + + WriteFile(UnitPas, UnitSrc); + WriteFile(ProgPas, ProgSrc); + DeleteFile(UnitObj); + + Rc := RunBlaise(['--source', ProgPas, '--output', ProgBin, + '--backend', 'native', '--no-incremental', + '--unit-path', FScratch], Captured); + AssertEquals('blaise(use_shapes_ni) exit code (out: ' + Captured + ')', 0, Rc); + AssertTrue('use_shapes_ni exists', FileExists(ProgBin)); + AssertFalse('no per-unit ShapesU.o with --no-incremental', FileExists(UnitObj)); + + Rc := RunBinary(ProgBin, Captured); + AssertEquals('use_shapes_ni exit code', 0, Rc); + AssertEquals('use_shapes_ni stdout', 'shape:box' + #10, Captured) +end; + initialization RegisterTest(TSepCompileTests); diff --git a/compiler/src/test/pascal/cp.test.recordret.pas b/compiler/src/test/pascal/cp.test.recordret.pas index 6ac93a9..21b85a2 100644 --- a/compiler/src/test/pascal/cp.test.recordret.pas +++ b/compiler/src/test/pascal/cp.test.recordret.pas @@ -27,7 +27,6 @@ type TRecordReturnTests = class(TTestCase) private function GenIR(const ASrc: string): string; - function GenIRWin64(const ASrc: string): string; published { rcInt1: one-field POD records return typed } procedure TestCodegen_OneIntegerField_ReturnsW; @@ -76,21 +75,6 @@ type procedure TestCodegen_IntegerPlusDouble_UsesIntSSE; procedure TestCodegen_DoublePlusInt64_UsesSSEInt; procedure TestCodegen_Int64PlusDouble_UsesIntSSE; - - { Win64 ABI: all POD records use rcWin64Agg — declare aggregate - return, let qbe -t amd64_win lower to rax-pack (sizes 1/2/4/8) - or hidden-pointer sret (everything else). Single uniform IR - shape independent of size or int/float content; the SysV-only - multi-register classes are unreachable on osWindows. Managed - records still go through rcSret. } - procedure TestCodegen_Win64_OneDoubleField_UsesAggregate; - procedure TestCodegen_Win64_OneSingleField_UsesAggregate; - procedure TestCodegen_Win64_OneIntegerField_UsesAggregate; - procedure TestCodegen_Win64_TwoInt64Fields_UsesAggregate; - procedure TestCodegen_Win64_TwoDoubleFields_UsesAggregate; - procedure TestCodegen_Win64_IntegerPlusDouble_UsesAggregate; - procedure TestCodegen_Win64_StringField_StaysOnSret; - procedure TestCodegen_Win64_OneDoubleField_CallerMemcpy; end; implementation @@ -795,204 +779,6 @@ begin AssertContains('type :_ffi_TM = align 8 { l, d }', IR); end; -{ --- Win64 reg-return classification --- } - -{ Helper: run GenIR with GTarget temporarily flipped to windows-x86_64, - restoring the host target afterwards. Whole-program codegen is - sequential and GTarget is a unit-level global, so this is safe inside - a single test method. } -function TRecordReturnTests.GenIRWin64(const ASrc: string): string; -var - Saved: TTargetDesc; -begin - Saved := GTarget; - try - MakeTarget(osWindows, cpuX86_64, GTarget); - Result := GenIR(ASrc); - finally - GTarget := Saved; - end; -end; - -procedure TRecordReturnTests.TestCodegen_Win64_OneDoubleField_UsesAggregate; -var IR: string; -begin - { SysV path: rcSSE1 -> `function d` (xmm0). Win64 path: rcWin64Agg - -> `function :_ffi_TD`. qbe -t amd64_win lowers the aggregate to - a Kl load into RAX (8B composite return). } - IR := GenIRWin64( - ''' - program P; - type TD = record V: Double; end; - function MakeIt(): TD; - begin - Result.V := 1.5 - end; - begin - end. - '''); - AssertContains('function :_ffi_TD $MakeIt(', IR); - AssertContains('type :_ffi_TD = align 8 { d }', IR); - AssertEquals(-1, Pos('function d $MakeIt(', IR)); - AssertEquals(-1, Pos('l %_par__sret', IR)); -end; - -procedure TRecordReturnTests.TestCodegen_Win64_OneSingleField_UsesAggregate; -var IR: string; -begin - { SysV: rcSSE1 -> `function s` (xmm0). Win64: rcWin64Agg -> - `function :_ffi_TS`; qbe -t amd64_win packs the 4B aggregate into - EAX (RAX low 32 bits). } - IR := GenIRWin64( - ''' - program P; - type TS = record V: Single; end; - function MakeIt(): TS; - begin - Result.V := 1.0 - end; - begin - end. - '''); - AssertContains('function :_ffi_TS $MakeIt(', IR); - AssertContains('type :_ffi_TS = align 4 { s }', IR); - AssertEquals(-1, Pos('function s $MakeIt(', IR)); - AssertEquals(-1, Pos('l %_par__sret', IR)); -end; - -procedure TRecordReturnTests.TestCodegen_Win64_OneIntegerField_UsesAggregate; -var IR: string; -begin - { Integer-class 4B record: SysV picks rcInt1 (`function w` -> EAX), - Win64 picks rcWin64Agg (`function :_ffi_TI` -> EAX via the qbe - amd64_win aggregate path). Both end up in the same register, but - the IR shape differs. } - IR := GenIRWin64( - ''' - program P; - type TI = record X: Integer; end; - function MakeIt(): TI; - begin - Result.X := 42 - end; - begin - end. - '''); - AssertContains('function :_ffi_TI $MakeIt(', IR); - AssertContains('type :_ffi_TI = align 4 { w }', IR); - AssertEquals(-1, Pos('l %_par__sret', IR)); -end; - -procedure TRecordReturnTests.TestCodegen_Win64_TwoInt64Fields_UsesAggregate; -var IR: string; -begin - { 16B record: qbe -t amd64_win sees size > 8 in type_is_by_copy and - synthesises the hidden first-arg out-pointer itself; from our IR - perspective it's still the aggregate-return shape. } - IR := GenIRWin64( - ''' - program P; - type TLL = record A, B: Int64; end; - function MakeIt(): TLL; - begin - Result.A := 1; - Result.B := 2 - end; - begin - end. - '''); - AssertContains('function :_ffi_TLL $MakeIt(', IR); - AssertContains('type :_ffi_TLL = align 8 { l, l }', IR); - AssertEquals(-1, Pos('l %_par__sret', IR)); -end; - -procedure TRecordReturnTests.TestCodegen_Win64_TwoDoubleFields_UsesAggregate; -var IR: string; -begin - IR := GenIRWin64( - ''' - program P; - type TDD = record A, B: Double; end; - function MakeIt(): TDD; - begin - Result.A := 1.0; - Result.B := 2.0 - end; - begin - end. - '''); - AssertContains('function :_ffi_TDD $MakeIt(', IR); - AssertContains('type :_ffi_TDD = align 8 { d, d }', IR); - AssertEquals(-1, Pos('l %_par__sret', IR)); -end; - -procedure TRecordReturnTests.TestCodegen_Win64_IntegerPlusDouble_UsesAggregate; -var IR: string; -begin - { SysV: rcIntSSE (rax+xmm0). Win64: rcWin64Agg; the aggregate-return - path lets qbe -t amd64_win lower this to a hidden-pointer sret - (size 16, not in [1,2,4,8]). Same IR shape either way. } - IR := GenIRWin64( - ''' - program P; - type TID = record I: Integer; D: Double; end; - function MakeIt(): TID; - begin - Result.I := 1; - Result.D := 2.0 - end; - begin - end. - '''); - AssertContains('function :_ffi_TID $MakeIt(', IR); - AssertContains('type :_ffi_TID = align 8 { w, d }', IR); - AssertEquals(-1, Pos('l %_par__sret', IR)); -end; - -procedure TRecordReturnTests.TestCodegen_Win64_StringField_StaysOnSret; -var IR: string; -begin - { Managed records continue to use the explicit sret path on Win64 — - the ARC bookkeeping at field-store time needs the caller's actual - storage. rcWin64Agg is gated by IsRecordManagedClean. } - IR := GenIRWin64( - ''' - program P; - type TStr = record S: string; end; - function MakeIt(): TStr; - begin - Result.S := 'hello' - end; - begin - end. - '''); - AssertContains('function $MakeIt(l %_par__sret', IR); - AssertEquals(-1, Pos('function :_ffi_TStr', IR)); -end; - -procedure TRecordReturnTests.TestCodegen_Win64_OneDoubleField_CallerMemcpy; -var IR: string; -begin - { Caller-side: aggregate-typed call capture, then memcpy bytes to - the destination — the same decomposition pattern used by the SysV - rcInt2/rcSSE*/rcIntSSE classes. } - IR := GenIRWin64( - ''' - program P; - type TD = record V: Double; end; - var R: TD; - function MakeIt(): TD; - begin - Result.V := 2.5 - end; - begin - R := MakeIt() - end. - '''); - AssertContains('=:_ffi_TD call $MakeIt', IR); - AssertContains('call $memcpy(l $R', IR); -end; - initialization RegisterTest(TRecordReturnTests);