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 =