administrator/blaise
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

fix: fold Boolean/enum/named-const array-const elements + emit correct width

Browse source 
An array constant with Boolean (or enum, or named-constant) elements emitted the
identifiers verbatim — `(False, True, ...)` became symbol references, failing at
link time on native ("undefined reference to `False'") and in QBE ("unknown
keyword False"). And even once folded, every non-string element was emitted at a
fixed 4-byte stride that did not match the element's actual read width, so a
Boolean array read all-zero.

Two fixes:
* Semantic (AnalyseArrayConstDecls): a new ResolveConstArrayElem folds each
  bare-identifier element to its numeric value once the element type is known —
  Boolean True/False to 1/0, enum members and named integer/boolean constants to
  their ordinal/value. Numeric/float literals pass through. An unresolved
  identifier is now a clear semantic error instead of a link failure.
* Codegen (both backends): array-const element data is emitted at the element's
  real width — .byte/.word/.long/.quad on native, b/h/w/l in QBE — instead of a
  fixed .long/w. Built-in scalar names are mapped directly so the width is
  correct even when the codegen has no symbol table set (the e2e in-process path).

Adds dual-backend e2e coverage including edge cases: Byte/Word/Int64 widths,
negative integer pass-through, named-const elements, and a Boolean array indexed
by an enum. All three fixpoints green; 3490 tests pass.
This commit is contained in:
Graeme Geldenhuys 2026-06-18 10:50:34 +01:00
parent 734030932d
commit 6289a5235e
4 changed files with 254 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

52
compiler/src/main/pascal/blaise.codegen.native.x86_64.pas
View file

@ -211,6 +211,7 @@ type
procedure EmitClassSection(ATypeDecls: TObjectList;
AGenericInstances: TObjectList;
ASymTable: TSymbolTable);
function ConstElemAsmDir(const AElemType: string): string;
procedure EmitArrayConstData(ABlock: TBlock; const APrefix: string);
{ Escape a Pascal string for use inside an AS .ascii directive. }
function AsmEscapeString(const AStr: string): string;
@ -1222,6 +1223,45 @@ end;
{ Evaluate a string literal: register it in the pool if new, then emit
leaq __sN+12(%rip), %rax so %rax holds the Blaise data pointer. }
{ Assembler data directive for one non-string array-const element of the named
element type. Honours the element's real width (Boolean/Byte -> .byte,
Int64/pointer -> .quad, ...) so the emitted stride matches the subscript-read
stride. Defaults to .long (4-byte Integer) when the type is unknown. }
function TX86_64Backend.ConstElemAsmDir(const AElemType: string): string;
var
TD: TTypeDesc;
Sz: Integer;
begin
{ Map built-in scalar names directly so the result is correct even when
FSymTable is unset (some callers build a codegen without a table); user
types fall back to the table, defaulting to .long (4-byte). }
if SameText(AElemType, 'Boolean') or SameText(AElemType, 'Byte') or
SameText(AElemType, 'ShortInt') or SameText(AElemType, 'AnsiChar') then
Exit(#9'.byte');
if SameText(AElemType, 'SmallInt') or SameText(AElemType, 'Word') then
Exit(#9'.word');
if SameText(AElemType, 'Int64') or SameText(AElemType, 'UInt64') or
SameText(AElemType, 'Pointer') or SameText(AElemType, 'Double') then
Exit(#9'.quad');
if SameText(AElemType, 'Integer') or SameText(AElemType, 'UInt32') or
SameText(AElemType, 'LongInt') or SameText(AElemType, 'Cardinal') or
SameText(AElemType, 'Single') then
Exit(#9'.long');
Sz := 4;
if FSymTable <> nil then
begin
TD := FSymTable.FindType(AElemType);
if TD <> nil then Sz := TD.RawSize();
end;
case Sz of
1: Result := #9'.byte';
2: Result := #9'.word';
8: Result := #9'.quad';
else
Result := #9'.long';
end;
end;
procedure TX86_64Backend.EmitArrayConstData(ABlock: TBlock;
const APrefix: string);
var
@ -1285,7 +1325,8 @@ begin
Self.Emit('.balign 4');
Self.Emit(Lbl + ':');
for J := 0 to CD.ArrayElements.Count - 1 do
Self.Emit(Format(#9'.long %s', [CD.ArrayElements[J]]));
Self.Emit(Format('%s %s',
[Self.ConstElemAsmDir(CD.ArrayElemType), CD.ArrayElements[J]]));
end;
end;
for I := 0 to ABlock.ProcDecls.Count - 1 do
@ -1322,7 +1363,8 @@ begin
Self.Emit('.balign 4');
Self.Emit(Lbl + ':');
for K := 0 to CD.ArrayElements.Count - 1 do
Self.Emit(Format(#9'.long %s', [CD.ArrayElements[K]]));
Self.Emit(Format('%s %s',
[Self.ConstElemAsmDir(CD.ArrayElemType), CD.ArrayElements[K]]));
end;
end;
end;
@ -1359,7 +1401,8 @@ begin
Self.Emit('.globl ' + Lbl);
Self.Emit(Lbl + ':');
for K := 0 to CD.ArrayElements.Count - 1 do
Self.Emit(Format(#9'.long %s', [CD.ArrayElements[K]]));
Self.Emit(Format('%s %s',
[Self.ConstElemAsmDir(CD.ArrayElemType), CD.ArrayElements[K]]));
end;
end;
for J := 0 to TClassTypeDef(TD.Def).Methods.Count - 1 do
@ -1396,7 +1439,8 @@ begin
Self.Emit('.balign 4');
Self.Emit(Lbl + ':');
for M := 0 to CD.ArrayElements.Count - 1 do
Self.Emit(Format(#9'.long %s', [CD.ArrayElements[M]]));
Self.Emit(Format('%s %s',
[Self.ConstElemAsmDir(CD.ArrayElemType), CD.ArrayElements[M]]));
end;
end;
end;

44
compiler/src/main/pascal/blaise.codegen.qbe.pas
View file

@ -244,6 +244,7 @@ type
procedure EmitGlobalVarData(ABlock: TBlock);
procedure EmitGlobalVarInit(const AVarName: string; AType: TTypeDesc;
CD: TConstDecl; const APrefix: string);
function ConstElemQbeDataType(const AElemType: string): string;
procedure EmitArrayConstData(CD: TConstDecl; const APrefix: string);
procedure EmitClassConstData(AClassDef: TClassTypeDef; const AClassName: string);
procedure EmitGlobalConstData(ABlock: TBlock);
@ -2032,6 +2033,43 @@ begin
end;
end;
function TCodeGenQBE.ConstElemQbeDataType(const AElemType: string): string;
{ QBE data-definition type letter for one non-string array-const element,
honouring the element's real width: 1-byte -> b, 2 -> h, 8 -> l, else w.
The built-in scalar names are mapped directly so the result is correct even
when FSymTable is not set (some callers create a codegen without a table);
user types (enums etc.) fall back to the table, defaulting to w (4-byte). }
var
TD: TTypeDesc;
Sz: Integer;
begin
if SameText(AElemType, 'Boolean') or SameText(AElemType, 'Byte') or
SameText(AElemType, 'ShortInt') or SameText(AElemType, 'AnsiChar') then
Exit('b');
if SameText(AElemType, 'SmallInt') or SameText(AElemType, 'Word') then
Exit('h');
if SameText(AElemType, 'Int64') or SameText(AElemType, 'UInt64') or
SameText(AElemType, 'Pointer') or SameText(AElemType, 'Double') then
Exit('l');
if SameText(AElemType, 'Integer') or SameText(AElemType, 'UInt32') or
SameText(AElemType, 'LongInt') or SameText(AElemType, 'Cardinal') or
SameText(AElemType, 'Single') then
Exit('w');
Sz := 4;
if FSymTable <> nil then
begin
TD := FSymTable.FindType(AElemType);
if TD <> nil then Sz := TD.RawSize();
end;
case Sz of
1: Result := 'b';
2: Result := 'h';
8: Result := 'l';
else
Result := 'w';
end;
end;
procedure TCodeGenQBE.EmitArrayConstData(CD: TConstDecl; const APrefix: string);
var
J: Integer;
@ -2090,7 +2128,11 @@ begin
Parts := Parts + Format('l $__s%d + 12', [StrIdx]);
end
else
Parts := Parts + Format('w %s', [ElemVal]);
{ Honour the element width: Boolean/Byte are 1-byte (b), Int64/pointer
8-byte (l), etc. A fixed 'w' (4-byte) emitted a stride the 1-byte
subscript read could not follow (every Boolean element read 0). }
Parts := Parts + Format('%s %s', [ConstElemQbeDataType(CD.ArrayElemType),
ElemVal]);
end;
{ Class/record consts keep an exported, type-qualified label (referenced as
TFoo.Const across the compilation). Block-local and program/unit array

45
compiler/src/main/pascal/uSemantic.pas
View file

@ -177,6 +177,8 @@ type
function EvalConstFloatExpr(AExpr: TASTExpr; ALine, ACol: Integer): string;
function IsFloatConstExpr(AExpr: TASTExpr): Boolean;
function ResolveArrayBound(const ABoundText: string): Integer;
function ResolveConstArrayElem(const AElem: string; AElemType: TTypeDesc;
ALine, ACol: Integer): string;
procedure AnalyseTypeDecls(ABlock: TBlock);
procedure LinkClassMethodImpls(ABlock: TBlock);
procedure LinkGenericClassMethodImpls(ABlock: TBlock);
@ -3935,6 +3937,37 @@ begin
end;
end;
function TSemanticAnalyser.ResolveConstArrayElem(const AElem: string;
AElemType: TTypeDesc; ALine, ACol: Integer): string;
{ Resolve one array-const element to the numeric string codegen needs. The
parser stores identifiers verbatim because it does not yet know the element
type; with the type now known, fold bare identifiers — Boolean True/False,
enum members, and named integer/boolean constants — to their ordinal value.
Numeric and float literals (and already-folded integers) pass through. }
var
Sym: TSymbol;
begin
Result := AElem;
if AElem = '' then Exit;
{ Already a numeric literal (int, negative int, or float) — leave as is. }
if IsPlainInt(AElem) then Exit;
if (AElem[0] >= '0') and (AElem[0] <= '9') then Exit;
if (AElem[0] = '-') or (AElem[0] = '+') or (AElem[0] = '.') then Exit;
{ Boolean literals. }
if SameText(AElem, 'True') then Exit('1');
if SameText(AElem, 'False') then Exit('0');
{ Named constant or enum member — both are skConstant symbols carrying their
ordinal/value in ConstValue. }
Sym := FTable.Lookup(AElem);
if (Sym <> nil) and (Sym.Kind = skConstant) then
Exit(IntToStr(Sym.ConstValue));
{ Unresolved identifier in a numeric/boolean/enum array — a real error;
leaving it would emit an undefined symbol reference at link time. }
SemanticError(Format(
'Cannot resolve array-const element ''%s'' to a constant value', [AElem]),
ALine, ACol);
end;
procedure TSemanticAnalyser.AnalyseSetConstDecl(ACD: TConstDecl);
var
I: Integer;
@ -4301,6 +4334,18 @@ begin
(J < CD.ArrayElements.Count) then
CD.ArrayElements.Put(J, IntToStr(FoldConstBitOpExpr(
TStringList(CD.ArrayElementParts.Items[J]), CD.Line, CD.Col)));
{ Resolve bare-identifier elements to their numeric values so codegen emits
integer constants, not symbol references. The parser stores identifiers
verbatim (it does not know the element type yet); here ElemTD is known.
Covers Boolean literals (False/True -> 0/1), enum members (-> ordinal),
and named integer/boolean constants. }
if (ElemTD <> nil) and
((ElemTD.Kind in [tyBoolean, tyEnum]) or
(ElemTD.IsNumeric() and not (ElemTD.Kind in [tyDouble, tySingle]))) then
for J := 0 to CD.ArrayElements.Count - 1 do
CD.ArrayElements.Put(J,
Self.ResolveConstArrayElem(CD.ArrayElements[J], ElemTD,
CD.Line, CD.Col));
if CD.ResolvedQbeName = '' then
CD.ResolvedQbeName := Self.NewArrayConstLabel(CD.Name);
Sym := TSymbol.Create(CD.Name, skConstant, ArrTD);

118
compiler/src/test/pascal/cp.test.e2e.gaps.pas
View file

@ -61,6 +61,14 @@ type
{ Named-type alias array const (GitHub #113) }
procedure TestRun_NamedArrayAlias_IntConst;
{ Boolean / enum / named-const array-const elements fold to ordinals }
procedure TestRun_BoolArrayConst_FoldsToOrdinals;
procedure TestRun_EnumArrayConst_FoldsToOrdinals;
{ Array-const element widths: Byte/Int64/Word stride matches the read }
procedure TestRun_ArrayConst_ElementWidths;
procedure TestRun_ArrayConst_NegativeInts;
procedure TestRun_ArrayConst_EnumIndexedBool;
{ Static array return by value (GitHub #112) }
procedure TestRun_StaticArrayReturn_12Bytes;
procedure TestRun_StaticArrayReturn_16Bytes;
@ -797,6 +805,116 @@ begin
AssertRunsOnAll(Src, '10' + Chr(10) + '20' + Chr(10) + '30' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_BoolArrayConst_FoldsToOrdinals;
{ Boolean literals as array-const elements were emitted as symbol references
(undefined `False'/`True' at link time on native; "unknown keyword False" on
QBE) and at the wrong element width. Now folded to 0/1 with 1-byte stride. }
const
Src =
'''
program P;
const Flags: array[0..3] of Boolean = (False, True, False, True);
var I: Integer;
begin
for I := 0 to 3 do
if Flags[I] then WriteLn('T') else WriteLn('F')
end.
''';
begin
AssertRunsOnAll(Src,
'F' + Chr(10) + 'T' + Chr(10) + 'F' + Chr(10) + 'T' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_EnumArrayConst_FoldsToOrdinals;
{ Enum members and named integer constants as array-const elements fold to their
ordinal/value rather than emitting a symbol reference. }
const
Src =
'''
program P;
type TColor = (Red, Green, Blue);
const N = 7;
const
Palette: array[0..2] of TColor = (Blue, Red, Green);
WithConst: array[0..1] of Integer = (N, 99);
var I: Integer;
begin
for I := 0 to 2 do WriteLn(Integer(Palette[I]));
WriteLn(WithConst[0]);
WriteLn(WithConst[1])
end.
''';
begin
AssertRunsOnAll(Src,
'2' + Chr(10) + '0' + Chr(10) + '1' + Chr(10) +
'7' + Chr(10) + '99' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_ArrayConst_ElementWidths;
{ Edge case: non-4-byte element widths must emit the matching stride. Byte (1),
Word (2) and Int64 (8) all read back correctly — a fixed .long/w stride would
scramble these. }
const
Src =
'''
program P;
const
B: array[0..2] of Byte = (0, 255, 128);
W: array[0..2] of Word = (1, 65535, 256);
L: array[0..1] of Int64 = (9000000000, 5);
var I: Integer;
begin
for I := 0 to 2 do WriteLn(B[I]);
for I := 0 to 2 do WriteLn(W[I]);
WriteLn(L[0]);
WriteLn(L[1])
end.
''';
begin
AssertRunsOnAll(Src,
'0' + Chr(10) + '255' + Chr(10) + '128' + Chr(10) +
'1' + Chr(10) + '65535' + Chr(10) + '256' + Chr(10) +
'9000000000' + Chr(10) + '5' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_ArrayConst_NegativeInts;
{ Edge case: negative integer literals in an array const pass through the
element-folding unchanged (they are not identifiers). }
const
Src =
'''
program P;
const Vals: array[0..2] of Integer = (-1, -100, 42);
var I: Integer;
begin
for I := 0 to 2 do WriteLn(Vals[I])
end.
''';
begin
AssertRunsOnAll(Src,
'-1' + Chr(10) + '-100' + Chr(10) + '42' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_ArrayConst_EnumIndexedBool;
{ Edge case: a Boolean array INDEXED BY an enum — combines enum-indexing with
Boolean element folding + 1-byte stride. }
const
Src =
'''
program P;
type TDay = (Mon, Tue, Wed);
const Open: array[TDay] of Boolean = (True, False, True);
var D: TDay;
begin
for D := Mon to Wed do
if Open[D] then WriteLn('open') else WriteLn('closed')
end.
''';
begin
AssertRunsOnAll(Src,
'open' + Chr(10) + 'closed' + Chr(10) + 'open' + Chr(10), 0);
end;
procedure TE2EGapTests.TestRun_IntfSret_SixArgs_DirectClassCall;
{ Class instance whose method returns an interface and takes 6 Integer args.
On native this is the class-sret interface call path (>4 user arg slots);