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

feat(vars): initialised global variables (var G: T = value)

Browse source 
A global variable declaration may now carry an initialiser whose value is
folded at compile time and emitted into the data section, so the variable
holds its initial value before the program body runs (matches FPC/Delphi):

  var
    G: Integer = 42;
    S: string = 'hello';
    A: array[0..2] of Integer = (10, 20, 30);

Implementation reuses the typed-constant pipeline end to end:
- Parser: the const value scanner is factored into ParseConstValue, shared by
  const declarations and the new var-initialiser path.  TVarDecl carries an
  owned InitConst: TConstDecl (TConstDecl moved ahead of TVarDecl so no
  forward declaration is needed).
- Semantic: AnalyseVarInitializer folds the value and type-checks it against
  the declared type; array initialisers derive element type and bounds from
  the resolved static-array type and mint a data label.
- Codegen: EmitGlobalVarInit (QBE) and EmitGlobalInitData (native) emit the
  folded value as a typed data slot - a single field for scalars/strings (a
  string global points at an immortal static header __sN + 12) and an inline
  element list for arrays.  Covers program- and unit-level globals on both
  backends.

Restrictions, each rejected with a clear diagnostic: global scope only (no
local initialisers), a single name per initialised declaration, and arrays
only for aggregates (record and inline-set initialisers are deferred - no
record-constant machinery yet, and a set initialiser would clash with the
const symbol the set folder defines).

Tests: cp.test.varinit (IR + parser/semantic) and cp.test.e2e.varinit
(compile+run on both backends).  Grammar and language rationale documented.
This commit is contained in:
Graeme Geldenhuys 2026-06-13 13:29:43 +01:00
parent 42f48c9ece
commit ba51a53365
10 changed files with 911 additions and 61 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -82,6 +82,7 @@ type
is the slot's static type so loads, stores, and the .data directive all
pick the right width and signedness. }
FDataGlobals: TOrderedDictionary<string, TTypeDesc>;
FGlobalInits: TDictionary<string, TConstDecl>; { global name → initialiser (var G: T = value) }
FThreadVarGlobals: TDictionary<string, Boolean>;
FWeakGlobals: TDictionary<string, Boolean>;
{ Class-name string blobs already emitted to avoid duplicate label errors.
@ -206,6 +207,10 @@ type
{ Emit a leaq __sN+12(%rip), %rax for the string literal AValue,
registering a new .rodata blob if not yet seen. }
procedure EmitStrLitAddr(const AValue: string);
{ Emit an initialised global's data slot from its folded const value
(var G: T = value). Called from EmitDataSection inside the .data pass. }
procedure EmitGlobalInitData(const AName: string; AType: TTypeDesc;
CD: TConstDecl);
{ Emit string literal blobs in .rodata. Called from EmitDataSection. }
procedure EmitStrLitSection;
{ Emit an immortal class-name string blob in the data section and return
@ -687,6 +692,7 @@ begin
inherited Create(ATarget);
FLabelCount := 0;
FDataGlobals := TOrderedDictionary<string, TTypeDesc>.Create();
FGlobalInits := TDictionary<string, TConstDecl>.Create();
FThreadVarGlobals := TDictionary<string, Boolean>.Create();
FWeakGlobals := TDictionary<string, Boolean>.Create();
FClassNameEmitted := TDictionary<string, Boolean>.Create();
@ -730,6 +736,7 @@ begin
FStrLits.Free();
FWeakGlobals.Free();
FThreadVarGlobals.Free();
FGlobalInits.Free();
FDataGlobals.Free();
inherited Destroy();
end;
@ -785,6 +792,7 @@ var
Directive: string;
IsTls: Boolean;
HasData, HasTbss: Boolean;
InitCD: TConstDecl;
begin
if (FDataGlobals.Count = 0) and (FProgExcFrameCount = 0) then
begin
@ -809,6 +817,13 @@ begin
Name := FDataGlobals.Keys[I];
IsTls := Self.IsThreadVarGlobal(Name);
if IsTls then Continue;
{ Initialised global (var G: T = value): emit the folded value. threadvars
are excluded (they live in .tbss / always zero). }
if FGlobalInits.TryGetValue(Name, InitCD) then
begin
Self.EmitGlobalInitData(Name, Self.GlobalType(Name), InitCD);
Continue;
end;
{ Method pointers (of-object): 16-byte Code+Data block, zero-initialised. }
if (Self.GlobalType(Name) <> nil) and
(Self.GlobalType(Name).Kind = tyProcedural) and
@ -919,6 +934,110 @@ begin
Self.EmitStrLitSection();
end;
procedure TX86_64Backend.EmitGlobalInitData(const AName: string;
AType: TTypeDesc; CD: TConstDecl);
var
J: Integer;
ElemKind: TTypeKind;
ElemDir: string;
Idx: Integer;
SAT: TStaticArrayTypeDesc;
begin
{ Static array initialiser: inline element list. }
if (AType.Kind = tyStaticArray) and CD.IsArrayConst then
begin
SAT := TStaticArrayTypeDesc(AType);
ElemKind := SAT.ElementType.Kind;
Self.Emit('.balign 8');
if Copy(AName, 0, 2) <> '.L' then
Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
if ElemKind = tyString then
begin
for J := 0 to CD.ArrayElements.Count - 1 do
if FStrLits.IndexOf(CD.ArrayElements[J]) < 0 then
FStrLits.Add(CD.ArrayElements[J]);
for J := 0 to CD.ArrayElements.Count - 1 do
begin
Idx := FStrLits.IndexOf(CD.ArrayElements[J]);
Self.Emit(Format(#9'.quad __s%d + 12', [Idx]));
end;
Exit;
end;
case ElemKind of
tyByte, tyBoolean: ElemDir := #9'.byte ';
tySmallInt, tyWord: ElemDir := #9'.word ';
tyInt64, tyUInt64, tyPointer, tyPChar: ElemDir := #9'.quad ';
tyDouble: ElemDir := #9'.double ';
tySingle: ElemDir := #9'.float ';
else
ElemDir := #9'.long ';
end;
for J := 0 to CD.ArrayElements.Count - 1 do
Self.Emit(ElemDir + CD.ArrayElements[J]);
Exit;
end;
{ String scalar: point at an immortal static string header (__sN + 12). }
if AType.IsString() then
begin
if FStrLits.IndexOf(CD.StrVal) < 0 then
FStrLits.Add(CD.StrVal);
Idx := FStrLits.IndexOf(CD.StrVal);
Self.Emit('.balign 8');
if Copy(AName, 0, 2) <> '.L' then
Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
Self.Emit(Format(#9'.quad __s%d + 12', [Idx]));
Exit;
end;
{ Scalar numeric / boolean / enum / real. }
case AType.Kind of
tyDouble:
begin
Self.Emit('.balign 8');
if Copy(AName, 0, 2) <> '.L' then Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
Self.Emit(Format(#9'.double %s', [CD.StrVal]));
end;
tySingle:
begin
Self.Emit('.balign 4');
if Copy(AName, 0, 2) <> '.L' then Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
Self.Emit(Format(#9'.float %s', [CD.StrVal]));
end;
tyByte, tyBoolean:
begin
Self.Emit('.balign 1');
if Copy(AName, 0, 2) <> '.L' then Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
Self.Emit(Format(#9'.byte %d', [CD.IntVal]));
end;
tySmallInt, tyWord:
begin
Self.Emit('.balign 2');
if Copy(AName, 0, 2) <> '.L' then Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
Self.Emit(Format(#9'.word %d', [CD.IntVal]));
end;
tyInt64, tyUInt64, tyPointer, tyPChar:
begin
Self.Emit('.balign 8');
if Copy(AName, 0, 2) <> '.L' then Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
Self.Emit(Format(#9'.quad %d', [CD.IntVal]));
end;
else
{ Integer / UInt32 / enum — 32-bit. }
Self.Emit('.balign 4');
if Copy(AName, 0, 2) <> '.L' then Self.Emit('.globl ' + AName);
Self.Emit(AName + ':');
Self.Emit(Format(#9'.long %d', [CD.IntVal]));
end;
end;
{ ------------------------------------------------------------------ }
{ String literal helpers (M7c) }
{ ------------------------------------------------------------------ }
@ -13279,6 +13398,8 @@ begin
Self.MarkThreadVar(VD.Names.Strings[J]);
if VD.IsWeak then
Self.MarkWeakGlobal(VD.Names.Strings[J]);
if VD.InitConst <> nil then
FGlobalInits.Add(VD.Names.Strings[J], VD.InitConst);
end;
end;
@ -13397,6 +13518,8 @@ begin
Self.AddGlobal(VD.Names.Strings[J], VD.ResolvedType);
if VD.IsThreadVar then
Self.MarkThreadVar(VD.Names.Strings[J]);
if VD.InitConst <> nil then
FGlobalInits.Add(VD.Names.Strings[J], VD.InitConst);
end;
end;
for I := 0 to AUnit.ImplBlock.Decls.Count - 1 do
@ -13412,6 +13535,8 @@ begin
Self.AddGlobal(VD.Names.Strings[J], VD.ResolvedType);
if VD.IsThreadVar then
Self.MarkThreadVar(VD.Names.Strings[J]);
if VD.InitConst <> nil then
FGlobalInits.Add(VD.Names.Strings[J], VD.InitConst);
end;
end;

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

@ -237,6 +237,8 @@ type
procedure EmitExcFrameAllocs(ABlock: TBlock);
procedure CollectThreadVarNames(ABlock: TBlock);
procedure EmitGlobalVarData(ABlock: TBlock);
procedure EmitGlobalVarInit(const AVarName: string; AType: TTypeDesc;
CD: TConstDecl; const APrefix: string);
procedure EmitArrayConstData(CD: TConstDecl; const APrefix: string);
procedure EmitClassConstData(AClassDef: TClassTypeDef; const AClassName: string);
procedure EmitGlobalConstData(ABlock: TBlock);
@ -1824,6 +1826,15 @@ begin
VarName := Decl.Names.Strings[J];
if Decl.IsThreadVar then
FThreadVarNames.Add(VarName);
{ Initialised global: emit the folded value into the data section instead
of a zero slot. threadvars cannot carry a non-zero static initialiser
(they live in .tbss), so the parser/semantic restrict initialisers to
non-threadvar globals — assert by falling through to the zero path. }
if (Decl.InitConst <> nil) and not Decl.IsThreadVar then
begin
Self.EmitGlobalVarInit(VarName, Decl.ResolvedType, Decl.InitConst, Pfx);
Continue;
end;
case Decl.ResolvedType.Kind of
tyInteger, tyUInt32, tyBoolean, tyByte, tyEnum:
EmitLine(Format('%s $%s = { w 0 }', [Pfx, VarName]));
@ -1876,6 +1887,92 @@ begin
end;
end;
{ Emit an initialised global variable's data slot from its folded const value.
Scalar/string/enum/boolean/real values become a single typed field; static
array values become an inline element list (same layout as array consts).
APrefix is the QBE storage prefix ('export data' / 'export thread data'). }
procedure TCodeGenQBE.EmitGlobalVarInit(const AVarName: string; AType: TTypeDesc;
CD: TConstDecl; const APrefix: string);
var
J: Integer;
Parts: string;
StrIdx: Integer;
IsStrArray: Boolean;
ElemKind: TTypeKind;
ElemSig: string;
SAT: TStaticArrayTypeDesc;
begin
{ Static array initialiser: inline element list. }
if (AType.Kind = tyStaticArray) and CD.IsArrayConst then
begin
SAT := TStaticArrayTypeDesc(AType);
ElemKind := SAT.ElementType.Kind;
IsStrArray := ElemKind = tyString;
if IsStrArray then
begin
for J := 0 to CD.ArrayElements.Count - 1 do
if FStrLits.IndexOf(CD.ArrayElements[J]) < 0 then
FStrLits.Add(CD.ArrayElements[J]);
EmitPendingStrLits();
end;
{ Per-element QBE field sigil by element width. }
case ElemKind of
tyByte, tyBoolean: ElemSig := 'b';
tySmallInt, tyWord: ElemSig := 'h';
tyInteger, tyUInt32, tyEnum: ElemSig := 'w';
tyInt64, tyUInt64, tyString, tyPointer, tyPChar: ElemSig := 'l';
tyDouble: ElemSig := 'd';
tySingle: ElemSig := 's';
else
ElemSig := 'w';
end;
Parts := '';
for J := 0 to CD.ArrayElements.Count - 1 do
begin
if J > 0 then Parts := Parts + ', ';
if IsStrArray then
begin
StrIdx := FStrLits.IndexOf(CD.ArrayElements[J]);
Parts := Parts + Format('l $__s%d + 12', [StrIdx]);
end
else
Parts := Parts + Format('%s %s', [ElemSig, CD.ArrayElements[J]]);
end;
EmitLine(Format('%s $%s = { %s }', [APrefix, AVarName, Parts]));
Exit;
end;
{ String scalar: point at an immortal static string header ($__sN + 12). }
if AType.IsString() then
begin
if FStrLits.IndexOf(CD.StrVal) < 0 then
FStrLits.Add(CD.StrVal);
EmitPendingStrLits();
StrIdx := FStrLits.IndexOf(CD.StrVal);
EmitLine(Format('%s $%s = { l $__s%d + 12 }', [APrefix, AVarName, StrIdx]));
Exit;
end;
{ Scalar numeric / boolean / enum / real. }
case AType.Kind of
tyInteger, tyUInt32, tyBoolean, tyByte, tyEnum:
EmitLine(Format('%s $%s = { w %d }', [APrefix, AVarName, CD.IntVal]));
tySmallInt, tyWord:
EmitLine(Format('%s $%s = { h %d }', [APrefix, AVarName, CD.IntVal]));
tyInt64, tyUInt64:
EmitLine(Format('%s $%s = { l %d }', [APrefix, AVarName, CD.IntVal]));
tyPointer, tyPChar:
EmitLine(Format('%s $%s = { l %d }', [APrefix, AVarName, CD.IntVal]));
tyDouble:
EmitLine(Format('%s $%s = { d d_%s }', [APrefix, AVarName, CD.StrVal]));
tySingle:
EmitLine(Format('%s $%s = { s s_%s }', [APrefix, AVarName, CD.StrVal]));
else
{ Unsupported kinds are rejected in semantic; emit a zero slot defensively. }
EmitLine(Format('%s $%s = { l 0 }', [APrefix, AVarName]));
end;
end;
procedure TCodeGenQBE.EmitArrayConstData(CD: TConstDecl; const APrefix: string);
var
J: Integer;

112
compiler/src/main/pascal/uAST.pas
View file

@ -518,6 +518,59 @@ type
{ Declarations }
{ ------------------------------------------------------------------ }
{ Constant declaration: const Name = Value; or const Name: Type = Value;
or const Name: array[IndexType] of ElemType = (v0, v1, ...).
Also carries a variable initialiser (var G: T = value) — see
TVarDecl.InitConst — which is why it is declared ahead of TVarDecl. }
TConstDecl = class(TASTNode)
public
Name: string;
TypeName: string; { non-empty when a type annotation was written }
IntVal: Int64; { used when kind = integer }
StrVal: string; { used when IsString = True or IsFloat = True (raw text) }
IsString: Boolean;
IsFloat: Boolean; { set when the rhs is a float literal }
ConstParts: TStringList; { non-nil when const expr has ident refs;
Objects[i] = nil → string literal,
Objects[i] <> nil → ident reference }
{ Array-typed constants — set when TypeName starts with 'array' }
IsArrayConst: Boolean;
ArrayIndexType: string; { enum type name used as index, e.g. 'TWeather' }
ArrayElemType: string; { element type name, e.g. 'string', 'Integer' }
ArrayElements: TStringList; { ordered list of raw element values (strings or int literals) }
ArrayIsRangeIndexed: Boolean; { True when index is Low..High integer range }
ArrayLowBound: Integer;
ArrayHighBound: Integer;
{ Integer bit-op expression in the value position — non-nil when the
RHS was a chain like 'FG_BLUE or 8' that couldn't be folded at
parse time (because it references named constants). Tokens are
stored alternating operand/operator: tokens[0,2,4,...] are operands
(Objects[i] = nil → integer literal, the string is the int;
Objects[i] <> nil → ident reference); tokens[1,3,5,...] are
operator names (one of 'or'/'and'/'xor'/'shl'/'shr'). Semantic
resolves idents and folds to CD.IntVal. }
IntExprTokens: TStringList;
{ Parallel to ArrayElements — each non-nil entry is an IntExprTokens-
shaped TStringList describing the bit-op expression for that
element. Semantic folds it and overwrites ArrayElements[i] with
the resolved integer. Nil indicates the matching ArrayElements[i]
is already a final scalar (literal, typecast, or ident). }
ArrayElementParts: TObjectList;
{ Set-valued constant — set when the RHS is a set literal '[a, b, ...]'.
SetElements holds the member identifier names (empty for '[]').
Semantic resolves each to its enum ordinal, ORs (1 shl ord) into IntVal
(the bitmask), and gives the symbol a tySet type — either CD.TypeName's
declared set type or the set type inferred from the members' enum. }
IsSet: Boolean;
SetElements: TStringList; { non-nil when IsSet; member ident names }
{ Canonical QBE data-label for an array const, set by uSemantic. Mangled
to a unique symbol so identically-named consts in different scopes (and
RTL-internal consts) do not collide at link time. Empty for non-array
consts. }
ResolvedQbeName: string;
destructor Destroy; override;
end;
TVarDecl = class(TASTNode)
public
Names: TStringList; { owned — one or more names: x, y: Integer }
@ -536,6 +589,12 @@ type
registry. See TFieldInfo.IsUnretained. }
IsGlobal: Boolean; { set by uSemantic when this is a program-level global variable }
IsThreadVar: Boolean; { set by parser when declared in a threadvar section }
InitConst: TConstDecl; { owned — optional initialiser for an initialised
variable (var G: T = value). nil when the
declaration has no initialiser. Reuses the
const value/fold/data-emit pipeline; semantic
type-checks it against ResolvedType and (for
aggregates) mints InitConst.ResolvedQbeName. }
constructor Create;
destructor Destroy; override;
end;
@ -833,57 +892,6 @@ type
destructor Destroy; override;
end;
{ Constant declaration: const Name = Value; or const Name: Type = Value;
or const Name: array[IndexType] of ElemType = (v0, v1, ...); }
TConstDecl = class(TASTNode)
public
Name: string;
TypeName: string; { non-empty when a type annotation was written }
IntVal: Int64; { used when kind = integer }
StrVal: string; { used when IsString = True or IsFloat = True (raw text) }
IsString: Boolean;
IsFloat: Boolean; { set when the rhs is a float literal }
ConstParts: TStringList; { non-nil when const expr has ident refs;
Objects[i] = nil → string literal,
Objects[i] <> nil → ident reference }
{ Array-typed constants — set when TypeName starts with 'array' }
IsArrayConst: Boolean;
ArrayIndexType: string; { enum type name used as index, e.g. 'TWeather' }
ArrayElemType: string; { element type name, e.g. 'string', 'Integer' }
ArrayElements: TStringList; { ordered list of raw element values (strings or int literals) }
ArrayIsRangeIndexed: Boolean; { True when index is Low..High integer range }
ArrayLowBound: Integer;
ArrayHighBound: Integer;
{ Integer bit-op expression in the value position — non-nil when the
RHS was a chain like 'FG_BLUE or 8' that couldn't be folded at
parse time (because it references named constants). Tokens are
stored alternating operand/operator: tokens[0,2,4,...] are operands
(Objects[i] = nil → integer literal, the string is the int;
Objects[i] <> nil → ident reference); tokens[1,3,5,...] are
operator names (one of 'or'/'and'/'xor'/'shl'/'shr'). Semantic
resolves idents and folds to CD.IntVal. }
IntExprTokens: TStringList;
{ Parallel to ArrayElements — each non-nil entry is an IntExprTokens-
shaped TStringList describing the bit-op expression for that
element. Semantic folds it and overwrites ArrayElements[i] with
the resolved integer. Nil indicates the matching ArrayElements[i]
is already a final scalar (literal, typecast, or ident). }
ArrayElementParts: TObjectList;
{ Set-valued constant — set when the RHS is a set literal '[a, b, ...]'.
SetElements holds the member identifier names (empty for '[]').
Semantic resolves each to its enum ordinal, ORs (1 shl ord) into IntVal
(the bitmask), and gives the symbol a tySet type — either CD.TypeName's
declared set type or the set type inferred from the members' enum. }
IsSet: Boolean;
SetElements: TStringList; { non-nil when IsSet; member ident names }
{ Canonical QBE data-label for an array const, set by uSemantic. Mangled
to a unique symbol so identically-named consts in different scopes (and
RTL-internal consts) do not collide at link time. Empty for non-array
consts. }
ResolvedQbeName: string;
destructor Destroy; override;
end;
{ ------------------------------------------------------------------ }
{ Block and Program }
{ ------------------------------------------------------------------ }
@ -2042,6 +2050,8 @@ begin
Result.Names.Add(ASrc.Names.Strings[I]);
for I := 0 to ASrc.Attributes.Count - 1 do
Result.Attributes.Add(ASrc.Attributes.Strings[I]);
if ASrc.InitConst <> nil then
Result.InitConst := CloneConstDecl(ASrc.InitConst);
end;
function CloneFieldDecl(ASrc: TFieldDecl): TFieldDecl;

47
compiler/src/main/pascal/uParser.pas
View file

@ -66,6 +66,7 @@ type
procedure ParseTypeSection(ABlock: TBlock);
procedure ParseTypeDecl(ABlock: TBlock);
procedure ParseConstBlock(AList: TObjectList);
procedure ParseConstValue(CD: TConstDecl);
function TryParseConstIntTypecast(out AValue: Int64): Boolean;
function CurrentIsConstBitOp: Boolean;
function ConsumeConstBitOpName: string;
@ -777,9 +778,6 @@ end;
procedure TParser.ParseConstBlock(AList: TObjectList);
var
CD: TConstDecl;
CastVal: Int64;
FirstOperand: string;
FirstIsIdent: Boolean;
begin
Expect(tkConst);
while Check(tkIdent) do
@ -842,6 +840,22 @@ begin
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
end;
Expect(tkEquals);
Self.ParseConstValue(CD);
Expect(tkSemicolon);
AList.Add(CD);
end;
end;
{ Parse a constant value (everything after '=', up to but excluding the
terminating ';') into CD. CD.IsArrayConst / CD.TypeName must already be set
by the caller when they were declared. Shared by const declarations and
initialised variable declarations (var G: T = value). }
procedure TParser.ParseConstValue(CD: TConstDecl);
var
CastVal: Int64;
FirstOperand: string;
FirstIsIdent: Boolean;
begin
{ Array const value list: (elem, elem, ...) }
if CD.IsArrayConst then
begin
@ -932,9 +946,7 @@ begin
Break;
end;
Expect(tkRParen);
Expect(tkSemicolon);
AList.Add(CD);
Continue;
Exit;
end;
if Check(tkMinus) then
begin
@ -1083,9 +1095,6 @@ begin
raise EParseError.Create(Format(
'Expected numeric or string constant at line %d col %d in %s',
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
Expect(tkSemicolon);
AList.Add(CD);
end;
end;
function TParser.ParseEnumDef: TEnumTypeDef;
@ -1892,6 +1901,26 @@ begin
end;
Expect(tkColon);
Decl.TypeName := ParseTypeName();
{ Optional initialiser: var G: T = value. Parsed via the shared const
value scanner; semantic folds it and codegen emits it into the data
section. An aggregate (array/record) type takes a parenthesised value
list, so mark the carrier IsArrayConst for the array branch. }
if Check(tkEquals) then
begin
if Decl.Names.Count <> 1 then
raise EParseError.Create(Format(
'An initialised variable declaration may declare only one name at line %d col %d in %s',
[FCurrent.Line, FCurrent.Col, FLexer.Filename]));
Advance(); { consume '=' }
Decl.InitConst := TConstDecl.Create();
Decl.InitConst.Line := Decl.Line;
Decl.InitConst.Col := Decl.Col;
Decl.InitConst.Name := Decl.Names.Strings[0];
Decl.InitConst.TypeName := Decl.TypeName;
if Copy(Decl.TypeName, 0, 6) = 'array[' then
Decl.InitConst.IsArrayConst := True;
Self.ParseConstValue(Decl.InitConst);
end;
Expect(tkSemicolon);
ABlock.Decls.Add(Decl);
except

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

@ -161,6 +161,7 @@ type
function AssignmentTargetsParameter(const AName: string;
const ADecl: TMethodDecl): Boolean;
procedure AnalyseVarDecls(ABlock: TBlock);
procedure AnalyseVarInitializer(ADecl: TVarDecl);
procedure AnalyseStmts(ABlock: TBlock);
procedure AnalyseStmt(AStmt: TASTStmt);
procedure AnalyseAssignment(AAssign: TAssignment);
@ -945,6 +946,8 @@ begin
TVarDecl(AUnit.IntfBlock.Decls.Items[I]).Col);
end;
end;
if TVarDecl(AUnit.IntfBlock.Decls.Items[I]).InitConst <> nil then
Self.AnalyseVarInitializer(TVarDecl(AUnit.IntfBlock.Decls.Items[I]));
end;
{ Register interface forward declaration signatures }
@ -1032,6 +1035,8 @@ begin
TVarDecl(AUnit.ImplBlock.Decls.Items[I]).Col);
end;
end;
if TVarDecl(AUnit.ImplBlock.Decls.Items[I]).InitConst <> nil then
Self.AnalyseVarInitializer(TVarDecl(AUnit.ImplBlock.Decls.Items[I]));
end;
{ Process implementation declarations — skip generic class method impls
@ -4945,6 +4950,116 @@ begin
Decl.Line, Decl.Col);
end;
end;
if Decl.InitConst <> nil then
Self.AnalyseVarInitializer(Decl);
end;
end;
{ Analyse and fold a variable initialiser (var G: T = value). The initialiser
is carried as a TConstDecl (Decl.InitConst) reusing the const value pipeline.
Scalar/string values are folded and type-checked against the declared type;
array values derive their element type and bounds from the declared static
array type, fold their elements, and mint a data label. Record initialisers
are not yet supported (no record-const machinery). }
procedure TSemanticAnalyser.AnalyseVarInitializer(ADecl: TVarDecl);
var
CD: TConstDecl;
Typ: TTypeDesc;
SAT: TStaticArrayTypeDesc;
J: Integer;
begin
CD := ADecl.InitConst;
Typ := ADecl.ResolvedType;
if Typ = nil then Exit;
{ Initialisers are only meaningful for global storage — locals are zeroed and
assigned in the body. Initialised locals could be supported later (emit the
assignment at scope entry); reject for now to keep the data-section path the
single source of truth. }
if not ADecl.IsGlobal then
SemanticError(
'Variable initialisers are only supported on global variables',
CD.Line, CD.Col);
{ Aggregate (array) initialiser: derive element type + bounds from the
declared static array type, then drive the array-const folding. }
if CD.IsArrayConst then
begin
if Typ.Kind <> tyStaticArray then
SemanticError(Format(
'Parenthesised initialiser requires a static array type, not ''%s''',
[ADecl.TypeName]), CD.Line, CD.Col);
SAT := TStaticArrayTypeDesc(Typ);
if SAT.ElementType.Kind = tyStaticArray then
SemanticError(
'Initialisers for multi-dimensional arrays are not yet supported',
CD.Line, CD.Col);
CD.ArrayElemType := SAT.ElementType.Name;
CD.ArrayLowBound := SAT.LowBound;
CD.ArrayHighBound := SAT.HighBound;
CD.ArrayIsRangeIndexed := True;
if CD.ArrayElements.Count <> (SAT.HighBound - SAT.LowBound + 1) then
SemanticError(Format(
'Initialiser for ''%s'' has %d element(s) but the array needs %d',
[ADecl.Names.Strings[0], CD.ArrayElements.Count,
SAT.HighBound - SAT.LowBound + 1]), CD.Line, CD.Col);
{ Fold any deferred bit-op element expressions to integer strings. }
if CD.ArrayElementParts <> nil then
for J := 0 to CD.ArrayElementParts.Count - 1 do
if (CD.ArrayElementParts.Items[J] <> nil) and
(J < CD.ArrayElements.Count) then
CD.ArrayElements.Put(J, IntToStr(FoldConstBitOpExpr(
TStringList(CD.ArrayElementParts.Items[J]), CD.Line, CD.Col)));
if CD.ResolvedQbeName = '' then
CD.ResolvedQbeName := Self.NewArrayConstLabel(CD.Name);
Exit;
end;
if Typ.Kind = tyRecord then
SemanticError(
'Record variable initialisers are not yet supported',
CD.Line, CD.Col);
{ Set initialiser: not yet supported on variables (AnalyseSetConstDecl also
defines a const symbol, which would clash with the variable symbol). Use a
named set constant for now. }
if CD.IsSet then
SemanticError(
'Set variable initialisers are not yet supported; use a named constant',
CD.Line, CD.Col);
{ Scalar / string initialiser. }
if CD.IsString and (CD.ConstParts <> nil) then
SemanticError(
'Named-constant string initialisers are not yet supported on variables',
CD.Line, CD.Col);
if CD.IntExprTokens <> nil then
CD.IntVal := FoldConstBitOpExpr(CD.IntExprTokens, CD.Line, CD.Col);
{ Type compatibility check between the folded value kind and the declared
type — catches 'var N: Integer = ''text''' and similar. }
if CD.IsString then
begin
if not Typ.IsString() then
SemanticError(Format(
'String initialiser is incompatible with type ''%s''', [ADecl.TypeName]),
CD.Line, CD.Col);
end
else if CD.IsFloat then
begin
if not (Typ.Kind in [tyDouble, tySingle]) then
SemanticError(Format(
'Real initialiser is incompatible with type ''%s''', [ADecl.TypeName]),
CD.Line, CD.Col);
end
else
begin
{ Integer/boolean/enum-ordinal initialiser. }
if not (Typ.IsNumeric() or (Typ.Kind in [tyBoolean, tyEnum,
tyPointer, tyPChar])) then
SemanticError(Format(
'Numeric initialiser is incompatible with type ''%s''', [ADecl.TypeName]),
CD.Line, CD.Col);
end;
end;

2
compiler/src/test/pascal/TestRunner.pas
View file

@ -76,6 +76,8 @@ uses
cp.test.process,
cp.test.openarray,
cp.test.staticarray,
cp.test.varinit,
cp.test.e2e.varinit,
cp.test.e2e.base,
cp.test.bif_coverage,
cp.test.e2e.exceptions,

187
compiler/src/test/pascal/cp.test.e2e.varinit.pas Normal file
View file

@ -0,0 +1,187 @@
{
Blaise - An Object Pascal Compiler
Copyright (c) 2026 Graeme Geldenhuys
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
Licensed under the Apache License v2.0 with Runtime Library Exception.
See LICENSE file in the project root for full license terms.
}
unit cp.test.e2e.varinit;
{ E2E tests for initialised global variables (var G: T = value): compile ->
run, asserting stdout on every backend (QBE + native). The IR-level tests
live in cp.test.varinit.pas. }
interface
uses
classes, blaise.testing, cp.test.e2e.base;
type
[Threaded]
TE2EVarInitTests = class(TE2ETestCase)
protected
procedure SetUp; override;
published
procedure TestRun_IntegerInit;
procedure TestRun_StringInit;
procedure TestRun_BooleanInit;
procedure TestRun_RealInit;
procedure TestRun_Int64Init;
procedure TestRun_ArrayInit_ZeroBased;
procedure TestRun_ArrayInit_NonZeroBased;
procedure TestRun_MultipleInits;
procedure TestRun_InitThenReassign;
end;
implementation
procedure TE2EVarInitTests.SetUp;
begin
inherited SetUp();
SetUpScratch('compiler/target/test-e2e-varinit')
end;
procedure TE2EVarInitTests.TestRun_IntegerInit;
const Src =
'''
program P;
var G: Integer = 42;
begin
WriteLn(G)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '42' + LineEnding, 0);
end;
procedure TE2EVarInitTests.TestRun_StringInit;
const Src =
'''
program P;
var S: string = 'hello world';
begin
WriteLn(S)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, 'hello world' + LineEnding, 0);
end;
procedure TE2EVarInitTests.TestRun_BooleanInit;
const Src =
'''
program P;
var B: Boolean = True;
begin
if B then WriteLn('yes') else WriteLn('no')
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, 'yes' + LineEnding, 0);
end;
procedure TE2EVarInitTests.TestRun_RealInit;
const Src =
'''
program P;
var D: Double = 3.5;
begin
WriteLn(D)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '3.5' + LineEnding, 0);
end;
procedure TE2EVarInitTests.TestRun_Int64Init;
const Src =
'''
program P;
var Big: Int64 = 9999999999;
begin
WriteLn(Big)
end.
''';
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
AssertRunsOnAll(Src, '9999999999' + LineEnding, 0);
end;
procedure TE2EVarInitTests.TestRun_ArrayInit_ZeroBased;
const Src =
'''
program P;
var A: array[0..2] of Integer = (10, 20, 30);
begin
WriteLn(A[0]); WriteLn(A[1]); WriteLn(A[2])
end.
''';
var LE: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
LE := LineEnding;
AssertRunsOnAll(Src, '10' + LE + '20' + LE + '30' + LE, 0);
end;
procedure TE2EVarInitTests.TestRun_ArrayInit_NonZeroBased;
const Src =
'''
program P;
var R: array[1..3] of Integer = (7, 8, 9);
begin
WriteLn(R[1]); WriteLn(R[3])
end.
''';
var LE: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
LE := LineEnding;
AssertRunsOnAll(Src, '7' + LE + '9' + LE, 0);
end;
procedure TE2EVarInitTests.TestRun_MultipleInits;
const Src =
'''
program P;
var
A: Integer = 1;
B: Integer = 2;
C: string = 'three';
begin
WriteLn(A); WriteLn(B); WriteLn(C)
end.
''';
var LE: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
LE := LineEnding;
AssertRunsOnAll(Src, '1' + LE + '2' + LE + 'three' + LE, 0);
end;
procedure TE2EVarInitTests.TestRun_InitThenReassign;
const Src =
'''
program P;
var G: Integer = 10;
begin
WriteLn(G);
G := G + 5;
WriteLn(G)
end.
''';
var LE: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
LE := LineEnding;
AssertRunsOnAll(Src, '10' + LE + '15' + LE, 0);
end;
initialization
RegisterTest(TE2EVarInitTests);
end.

223
compiler/src/test/pascal/cp.test.varinit.pas Normal file
View file

@ -0,0 +1,223 @@
{
Blaise - An Object Pascal Compiler
Copyright (c) 2026 Graeme Geldenhuys
SPDX-License-Identifier: Apache-2.0 WITH Swift-exception
Licensed under the Apache License v2.0 with Runtime Library Exception.
See LICENSE file in the project root for full license terms.
}
unit cp.test.varinit;
{ IR-level tests for initialised global variables: var G: T = value.
The initialiser is folded at compile time and emitted into the data
section. E2E coverage (compile -> run, both backends) lives in
cp.test.e2e.varinit.pas. }
interface
uses
blaise.testing,
uLexer, uParser, uAST, uSemantic, uSymbolTable, blaise.codegen.qbe;
type
TVarInitTests = class(TTestCase)
private
function GenIR(const ASrc: string): string;
function ParseProg(const ASrc: string): TProgram;
function IRHas(const AIR, AFragment: string): Boolean;
published
{ Parser }
procedure TestParse_ScalarInit_AttachesInitConst;
procedure TestParse_NoInit_InitConstNil;
procedure TestParse_MultiName_WithInit_Rejected;
{ Semantic }
procedure TestSemantic_TypeMismatch_StringIntoInteger_Rejected;
procedure TestSemantic_LocalInit_Rejected;
procedure TestSemantic_RecordInit_Rejected;
{ Codegen — data section }
procedure TestCodegen_IntegerInit_EmitsValue;
procedure TestCodegen_StringInit_EmitsHeaderPointer;
procedure TestCodegen_BooleanInit_EmitsOne;
procedure TestCodegen_ArrayInit_EmitsElements;
procedure TestCodegen_NoInit_StillZero;
end;
implementation
function TVarInitTests.ParseProg(const ASrc: string): TProgram;
var L: TLexer; P: TParser;
begin
L := TLexer.Create(ASrc);
P := TParser.Create(L);
try
Result := P.Parse();
finally
P.Free(); L.Free();
end;
end;
function TVarInitTests.GenIR(const ASrc: string): string;
var
L: TLexer;
P: TParser;
Pr: TProgram;
A: TSemanticAnalyser;
CG: TCodeGenQBE;
begin
L := TLexer.Create(ASrc);
P := TParser.Create(L);
Pr := P.Parse();
A := TSemanticAnalyser.Create();
try
A.Analyse(Pr);
CG := TCodeGenQBE.Create();
try
CG.Generate(Pr);
Result := CG.GetOutput();
finally
CG.Free();
end;
finally
A.Free();
Pr.Free();
P.Free();
L.Free();
end;
end;
function TVarInitTests.IRHas(const AIR, AFragment: string): Boolean;
begin
Result := Pos(AFragment, AIR) >= 0;
end;
{ ------------------------------------------------------------------ }
{ Parser }
{ ------------------------------------------------------------------ }
procedure TVarInitTests.TestParse_ScalarInit_AttachesInitConst;
var P: TProgram; Decl: TVarDecl;
begin
P := ParseProg('program X; var G: Integer = 42; begin end.');
try
Decl := TVarDecl(P.Block.Decls.Items[0]);
AssertNotNull('InitConst attached', Decl.InitConst);
AssertEquals('folded value 42', 42, Decl.InitConst.IntVal);
finally P.Free(); end;
end;
procedure TVarInitTests.TestParse_NoInit_InitConstNil;
var P: TProgram; Decl: TVarDecl;
begin
P := ParseProg('program X; var G: Integer; begin end.');
try
Decl := TVarDecl(P.Block.Decls.Items[0]);
AssertNull('no initialiser', Decl.InitConst);
finally P.Free(); end;
end;
procedure TVarInitTests.TestParse_MultiName_WithInit_Rejected;
var Raised: Boolean;
begin
Raised := False;
try
ParseProg('program X; var A, B: Integer = 1; begin end.').Free();
except
on E: EParseError do Raised := True;
end;
AssertTrue('multi-name initialiser is a parse error', Raised);
end;
{ ------------------------------------------------------------------ }
{ Semantic }
{ ------------------------------------------------------------------ }
procedure TVarInitTests.TestSemantic_TypeMismatch_StringIntoInteger_Rejected;
var Raised: Boolean;
begin
Raised := False;
try
GenIR('program X; var N: Integer = ''text''; begin end.');
except
on E: ESemanticError do Raised := True;
end;
AssertTrue('string-into-Integer rejected', Raised);
end;
procedure TVarInitTests.TestSemantic_LocalInit_Rejected;
var Raised: Boolean;
begin
Raised := False;
try
GenIR('program X; procedure Q; var L: Integer = 5; begin end; begin end.');
except
on E: ESemanticError do Raised := True;
end;
AssertTrue('local initialiser rejected', Raised);
end;
procedure TVarInitTests.TestSemantic_RecordInit_Rejected;
var Raised: Boolean;
begin
{ Records have no const-initialiser machinery yet; must fail cleanly,
not silently mis-emit. }
Raised := False;
try
GenIR('program X; type TR = record a: Integer; end; ' +
'var R: TR = 0; begin end.');
except
on E: ESemanticError do Raised := True;
end;
AssertTrue('record initialiser rejected', Raised);
end;
{ ------------------------------------------------------------------ }
{ Codegen }
{ ------------------------------------------------------------------ }
procedure TVarInitTests.TestCodegen_IntegerInit_EmitsValue;
var IR: string;
begin
IR := GenIR('program X; var G: Integer = 42; begin end.');
AssertTrue('data slot holds 42, not 0',
IRHas(IR, 'data $G = { w 42 }'));
end;
procedure TVarInitTests.TestCodegen_StringInit_EmitsHeaderPointer;
var IR: string;
begin
{ An initialised string global points at an immortal static header. }
IR := GenIR('program X; var S: string = ''hi''; begin end.');
AssertTrue('string global points at $__sN + 12',
IRHas(IR, 'data $S = { l $__s'));
end;
procedure TVarInitTests.TestCodegen_BooleanInit_EmitsOne;
var IR: string;
begin
IR := GenIR('program X; var B: Boolean = True; begin end.');
AssertTrue('boolean True folds to 1',
IRHas(IR, 'data $B = { w 1 }'));
end;
procedure TVarInitTests.TestCodegen_ArrayInit_EmitsElements;
var IR: string;
begin
IR := GenIR('program X; var A: array[0..2] of Integer = (10, 20, 30); begin end.');
AssertTrue('array elements inlined into the data slot',
IRHas(IR, 'data $A = { w 10, w 20, w 30 }'));
end;
procedure TVarInitTests.TestCodegen_NoInit_StillZero;
var IR: string;
begin
IR := GenIR('program X; var G: Integer; begin end.');
AssertTrue('uninitialised global is still zero',
IRHas(IR, 'data $G = { w 0 }'));
end;
initialization
RegisterTest(TVarInitTests);
end.

7
docs/grammar.ebnf
View file

@ -531,8 +531,13 @@ ThreadVarSection
* copy of the variable, zero-initialised on thread creation. Syntactically
* identical to VarSection except for the keyword. *)
(* A variable declaration may carry an initialiser ( = ConstValue ). The
* initialiser uses the same value grammar as a typed constant (scalar,
* string, set, or parenthesised aggregate list) and is folded at compile
* time, then emitted into the data section. An initialised declaration may
* declare only a single name (IdentList must be one IDENT). *)
VarDecl
= IdentList COLON TypeName SEMICOLON
= IdentList COLON TypeName [ EQUALS ConstValue ] SEMICOLON
;

57
docs/language-rationale.adoc
View file

@ -3825,3 +3825,60 @@ No new debug record is required. A nested array emits one `recArray`
pointing at the next inner `recArray`. The reference debugger (pdr)
follows the element chain and renders the value as a true multi-dimensional
structure, e.g. `array[0..1] of array[0..2] of Integer = [[0,0,0],[0,0,0]]`.
== Initialised Global Variables
=== Decision
A global variable declaration may carry an initialiser:
[source,pascal]
----
var
G: Integer = 42;
S: string = 'hello';
A: array[0..2] of Integer = (10, 20, 30);
----
The value is folded at compile time and emitted directly into the data
section, so the variable holds its initial value before the program body
runs. This matches FPC and Delphi.
The initialiser uses the same value grammar as a typed constant — a scalar,
string, boolean, real, or a parenthesised aggregate list — and is restricted
as follows:
* *Global scope only.* Initialisers are accepted on program-level and
unit-level variables. A local variable initialiser is rejected: locals are
zero-initialised and then assigned in the body, keeping the data-section
path the single source of truth for static initial values.
* *Single name.* `var A, B: Integer = 1` is a parse error — an initialiser
applies to exactly one variable, avoiding the ambiguity of whether the value
is shared or per-name.
* *Arrays only for aggregates.* Array initialisers reuse the existing
array-constant machinery. Record and inline-set initialisers are not yet
supported (Blaise has no record-constant infrastructure, and a set
initialiser would collide with the const-symbol the set folder defines); both
are rejected with a clear diagnostic rather than silently mis-emitted.
=== Rationale
Reusing the constant pipeline (parse → fold → data-section emit) keeps the
feature small and consistent: an initialised global is, in effect, a constant
value placed in mutable storage. The folded value is emitted as a typed data
slot in both backends — a single field for scalars/strings (a string global
points at an immortal static header, `__sN + 12`), and an inline element list
for arrays (identical layout to an array constant). No runtime initialiser
code is generated; the loader provides the value.
=== Alternatives considered
* *Emit an assignment at program start instead of static data.* Rejected:
it defeats the point (the variable would be zero until the assignment runs)
and bloats the entry path. Static data is what FPC/Delphi emit and what the
debugger expects.
* *Allow local initialisers (assignment at scope entry).* Deferred. It is a
reasonable future extension but mixes two emission models; the global
data-section path is the clean baseline.
* *Support record/set initialisers now.* Deferred until record-constant
infrastructure exists; rejecting them keeps the feature honest.