From ac0acc7bdd97b2fce954ef90e2ff3acea808515c Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 11 Jun 2026 17:32:25 +0100 Subject: [PATCH] feat(native): build blaise-compiler with the native backend by default MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit compiler/project.xml now passes --backend native --debug-opdf for the blaise-compiler module, so local builds of the compiler and TestRunner exercise the native x86-64 backend end-to-end and are debuggable with pdr. The shipped default backend remains QBE. Compiling the compiler itself natively (never done before) exposed two pre-existing native codegen bugs, both fixed: - Local dynamic-array variables were not zero-initialised. SetLength reads the old data pointer and the epilogue releases it, so stack garbage in the slot corrupted the heap — the unit→.o iface-embed path crashed in the allocator. Dyn-array locals now start nil like string/class/record locals. New e2e test TestRun_Native_LocalDynArray_DirtyStack pins this with a dirty-stack helper. - P[I] := Chr(N) stored the low byte of the _Chr-allocated STRING POINTER instead of N: the native backend lacked the QBE backend's EmitByteRhs short-circuit. Added EmitByteRhsToEax (Chr folds to its argument, single-char literals to their ordinal) and applied it at every byte-sized store site (PChar subscript, dyn/static array byte elements, P^ byte writes, byte array-field elements). This corrupted every ELF header patch in uElfObject, producing .o files with garbage e_shoff/e_shnum. With both fixes the full separate-compilation round trip works under the all-native toolchain and the complete suite passes (2959 tests) with a natively-built compiler and TestRunner. uDebugOPDF: interface-typed globals are two labels (Name_obj/_itab); recGlobalVar now references Name_obj so --debug-opdf links for programs with interface globals (e.g. the compiler's own CG). --- compiler/project.xml | 10 ++++ .../pascal/blaise.codegen.native.x86_64.pas | 57 +++++++++++++++++-- compiler/src/main/pascal/uDebugOPDF.pas | 7 ++- .../src/test/pascal/cp.test.e2e.native.pas | 38 +++++++++++++ 4 files changed, 106 insertions(+), 6 deletions(-) diff --git a/compiler/project.xml b/compiler/project.xml index 2b6fe0c..d512332 100644 --- a/compiler/project.xml +++ b/compiler/project.xml @@ -10,6 +10,16 @@ ../runtime/src/main/pascal ../stdlib/src/main/pascal + + + + + 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 e57f52f..3622e32 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -402,6 +402,7 @@ type AArgs: TObjectList); { Evaluate an integer expression; result left in %rax (64-bit-extended). } procedure EmitExprToEax(AExpr: TASTExpr); + procedure EmitByteRhsToEax(AExpr: TASTExpr); { Evaluate a float expression (tyDouble or tySingle); result left in %xmm0. Binary ops: left → push onto int stack via subq/movsd, right → %xmm0, pop left → %xmm1, then addsd/subsd/mulsd/divsd. } @@ -3150,6 +3151,32 @@ end; field-access targets: R.F (inline record), C.F (class variable — slot holds the object pointer), implicit-Self record/class bases, var-param record bases, and chained Base.F (Base evaluated to an address). } +{ Evaluate the RHS of a byte-sized store into %eax. + + Chr(N) must NOT lower via the normal _Chr call — that returns a heap + string POINTER, and the byte store would truncate to the pointer's low + byte (the "P[I] := Chr(N)" garbage bug). Emit the argument N directly. + Single-char string literals get the same fold to their ordinal. + Mirrors the QBE backend's EmitByteRhs. } +procedure TX86_64Backend.EmitByteRhsToEax(AExpr: TASTExpr); +begin + if (AExpr is TFuncCallExpr) and + SameText(TFuncCallExpr(AExpr).Name, 'Chr') and + (TFuncCallExpr(AExpr).Args.Count = 1) then + begin + Self.EmitExprToEax(TASTExpr(TFuncCallExpr(AExpr).Args.Items[0])); + Exit; + end; + if (AExpr is TStringLiteral) and + (Length(TStringLiteral(AExpr).Value) = 1) then + begin + Self.Emit(Format(#9'movl $%d, %%eax', + [Ord(TStringLiteral(AExpr).Value[0])])); + Exit; + end; + Self.EmitExprToEax(AExpr); +end; + procedure TX86_64Backend.EmitLValueSlotAddr(AExpr: TASTExpr); var IE: TIdentExpr; @@ -9276,7 +9303,10 @@ begin DAElemType := TDynArrayTypeDesc(FA.FieldInfo.TypeDesc).ElementType else DAElemType := TStaticArrayTypeDesc(FA.FieldInfo.TypeDesc).ElementType; - Self.EmitExprToEax(FA.Expr); + if DAElemType.Kind in [tyByte, tyBoolean] then + Self.EmitByteRhsToEax(FA.Expr) + else + Self.EmitExprToEax(FA.Expr); Self.Emit(#9'pushq %rax'); { value (or record src addr) } Self.EmitExprToEax(FA.PropIndexExpr); if (FA.FieldInfo.TypeDesc.Kind = tyStaticArray) and @@ -9901,7 +9931,7 @@ begin begin { PChar subscript write: P[I] := byte — storeb at base + I. The PChar value lives directly in the variable slot (an 8-byte pointer). } - Self.EmitExprToEax(SSA.ValueExpr); + Self.EmitByteRhsToEax(SSA.ValueExpr); Self.Emit(#9'pushq %rax'); Self.EmitExprToEax(SSA.IndexExpr); if Self.IsLocal(SSA.ArrayName) then @@ -9943,7 +9973,10 @@ begin Self.Emit(#9'popq %rbx'); Exit; end; - Self.EmitExprToEax(SSA.ValueExpr); + if DAElemType.Kind in [tyByte, tyBoolean] then + Self.EmitByteRhsToEax(SSA.ValueExpr) + else + Self.EmitExprToEax(SSA.ValueExpr); Self.Emit(#9'pushq %rax'); Self.EmitExprToEax(SSA.IndexExpr); Self.Emit(Format(#9'imulq $%d, %%rax', [DAElemType.RawSize()])); @@ -10042,7 +10075,10 @@ begin Self.Emit(#9'popq %rbx'); Exit; end; - Self.EmitExprToEax(SSA.ValueExpr); + if DAElemType.Kind in [tyByte, tyBoolean] then + Self.EmitByteRhsToEax(SSA.ValueExpr) + else + Self.EmitExprToEax(SSA.ValueExpr); Self.Emit(#9'pushq %rax'); Self.EmitExprToEax(SSA.IndexExpr); if TStaticArrayTypeDesc(SSA.ResolvedArrayType).LowBound <> 0 then @@ -10171,7 +10207,11 @@ begin end else begin - Self.EmitExprToEax(TPointerWriteStmt(AStmt).ValExpr); + if (TPointerWriteStmt(AStmt).BaseTy <> nil) and + (TPointerWriteStmt(AStmt).BaseTy.Kind in [tyByte, tyBoolean]) then + Self.EmitByteRhsToEax(TPointerWriteStmt(AStmt).ValExpr) + else + Self.EmitExprToEax(TPointerWriteStmt(AStmt).ValExpr); Self.Emit(#9'pushq %rax'); Self.EmitExprToEax(TPointerWriteStmt(AStmt).PtrExpr); Self.Emit(#9'movq %rax, %rcx'); @@ -12244,6 +12284,13 @@ begin Self.Emit(Format(#9'movq $0, %s', [Self.IntfItabOperand(TVarDecl(ADecl.Body.Decls.Items[I]).Names.Strings[J], False)])); end + else if TVarDecl(ADecl.Body.Decls.Items[I]).ResolvedType.Kind = tyDynArray then + { Dyn-array locals MUST start nil: SetLength reads the old pointer + (_DynArrayLength / _BlaiseFreeMem on it) and the epilogue releases + it — stack garbage in the slot corrupts the heap or crashes. } + for J := 0 to TVarDecl(ADecl.Body.Decls.Items[I]).Names.Count - 1 do + Self.Emit(Format(#9'movq $0, %s', + [Self.VarOperand(TVarDecl(ADecl.Body.Decls.Items[I]).Names.Strings[J])])) else if TVarDecl(ADecl.Body.Decls.Items[I]).ResolvedType.Kind = tyRecord then for J := 0 to TVarDecl(ADecl.Body.Decls.Items[I]).Names.Count - 1 do begin diff --git a/compiler/src/main/pascal/uDebugOPDF.pas b/compiler/src/main/pascal/uDebugOPDF.pas index 8219f43..b158018 100644 --- a/compiler/src/main/pascal/uDebugOPDF.pas +++ b/compiler/src/main/pascal/uDebugOPDF.pas @@ -561,7 +561,12 @@ begin L(' # recGlobalVar: ' + AVarName); EmitRecHdr(REC_GLOBALVAR, RecSize); L(' .int ' + IntToStr(GetOrAllocTypeID(CName)) + ' # TypeID'); - L(' .quad ' + AVarName + ' # Address (linker-resolved)'); + if (AType <> nil) and (AType.Kind = tyInterface) then + { Interface globals are two labels, Name_obj + Name_itab — there is no + bare Name symbol. Point the record at the object-pointer half. } + L(' .quad ' + AVarName + '_obj # Address (linker-resolved)') + else + L(' .quad ' + AVarName + ' # Address (linker-resolved)'); EmitStrField(AVarName); end; diff --git a/compiler/src/test/pascal/cp.test.e2e.native.pas b/compiler/src/test/pascal/cp.test.e2e.native.pas index 0e32dbb..66f4402 100644 --- a/compiler/src/test/pascal/cp.test.e2e.native.pas +++ b/compiler/src/test/pascal/cp.test.e2e.native.pas @@ -125,6 +125,11 @@ type procedure TestRun_Native_String_ConcatWithInt; procedure TestRun_Native_String_ChrConcat; + { Local dynamic-array variables must start nil: SetLength reads the old + pointer and the epilogue releases it. The dirty-stack helper makes the + uninitialised slot hold garbage rather than lucky zeros. } + procedure TestRun_Native_LocalDynArray_DirtyStack; + { M7d — exception handling } procedure TestRun_Native_TryFinally_Normal; procedure TestRun_Native_TryFinally_NestedNormal; @@ -1924,6 +1929,39 @@ begin AssertRunsOnAll(SrcChrConcat, 'ABC' + LE + 'ABCDE' + LE, 0); end; +const + SrcLocalDynDirty = + ''' + program P; + procedure Dirty(); + var + A: array[0..63] of Int64; + I: Integer; + begin + for I := 0 to 63 do + A[I] := -81985529216486896; + end; + procedure UseLocalDyn(); + var + Arr: array of Integer; + begin + SetLength(Arr, 5); + Arr[2] := 42; + writeln(Arr[2]); + end; + begin + Dirty(); + UseLocalDyn(); + writeln('done'); + end. + '''; + +procedure TE2ENativeTests.TestRun_Native_LocalDynArray_DirtyStack; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcLocalDynDirty, '42' + LE + 'done' + LE, 0); +end; + { M7d — exception handling source programs } const SrcExcBase =