From 6289a5235e46d08541b7885e2b41edbc601a3682 Mon Sep 17 00:00:00 2001 From: Graeme Geldenhuys Date: Thu, 18 Jun 2026 10:50:34 +0100 Subject: [PATCH] fix: fold Boolean/enum/named-const array-const elements + emit correct width MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- .../pascal/blaise.codegen.native.x86_64.pas | 52 +++++++- .../src/main/pascal/blaise.codegen.qbe.pas | 44 ++++++- compiler/src/main/pascal/uSemantic.pas | 45 +++++++ compiler/src/test/pascal/cp.test.e2e.gaps.pas | 118 ++++++++++++++++++ 4 files changed, 254 insertions(+), 5 deletions(-) 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 cbb9b2f..0b96dbd 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -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; diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index f2be6be..da74035 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -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 diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index c698d83..d6a357e 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -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); diff --git a/compiler/src/test/pascal/cp.test.e2e.gaps.pas b/compiler/src/test/pascal/cp.test.e2e.gaps.pas index ff75b0d..98def7b 100644 --- a/compiler/src/test/pascal/cp.test.e2e.gaps.pas +++ b/compiler/src/test/pascal/cp.test.e2e.gaps.pas @@ -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);