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

feat(sets): jumbo sets — set of enum up to 256 members

Browse source 
Extend set of <enum> from a 64-member cap to 256, Java-EnumSet style. Sets
of 64 members or fewer keep the existing single-register bitmask (QBE w/l);
sets of 65..256 members ('jumbo') become an inline byte-array bitmap of
ceil(N/8) bytes, treated as a value aggregate (passed by reference, returned
via sret, memset/memcpy), with operations performed by new RTL helpers.

Representation (uSymbolTable): TSetTypeDesc.IsJumbo (BitCount > 64) and
RawByteSize; RawSize/ByteSize/AllocAlign sized accordingly. TSymbol gains
ConstSetBytes/ConstSetQbe for jumbo constants (can't fit an Int64 mask).

RTL: new runtime/src/main/pascal/blaise_set.pas — _SetIn/_SetInclude/
_SetExclude/_SetUnion/_SetInter/_SetDiff/_SetEqual/_SetCopy over byte-array
bitmaps (overlap-safe). Wired into runtime/Makefile.

Semantic: the four >64 caps become >256. AnalyseSetConstDecl folds a jumbo
const to a byte array. The anonymous set for 'X in [a,b,c]' is sized to the
largest listed ordinal (when constant), not the full enum — keeping the
common low-ordinal membership test (incl. the compiler's own TokenKind
tests) on the fast register path. This also fixes a latent miscompile: the
old fixed-l representation silently dropped any listed ordinal >= 64.

Codegen (both backends): jumbo branches for literal, in, +/-/*, =/<>,
Include/Exclude, for-in, assignment, params (pmJumboSetValue ABI), and sret
returns. The register 'in' gained a range guard for literal-sized sets.
Native reserves two 32-byte scratch slots per frame (and .bss in main) for
set-op/literal result buffers. QBE adds IsAggregateAddrType so jumbo sets
ride the record/static-array address paths and are never promoted.

OPDF: no format change — recSet SizeInBytes (1 byte) already covers <=32.

Verified: FIXPOINT_OK and NATIVE_FIXPOINT_OK; full suite (3172 tests) green
built by the stage-2 binary, the QBE fixpoint binary, and the native
fixpoint binary; bif-coverage OK. Tests: cp.test.jumboset (12 IR) and
cp.test.e2e.jumboset (6 e2e, both backends via AssertRunsOnAll); the
>256-member rejection test in cp.test.sets updated. Docs: grammar.ebnf and
language-rationale set-type sections updated for the 256 cap and literal
sizing.

Closes the design discussion behind #81.
This commit is contained in:
Graeme Geldenhuys 2026-06-14 23:23:19 +01:00
parent 2708a6209e
commit fa853e0eb2
14 changed files with 1446 additions and 172 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

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

@ -157,6 +157,10 @@ type
{ Number of exc frame global slots to emit for the program main body.
Zero when no try stmts appear in the top-level program statements. }
FProgExcFrameCount: Integer;
{ True when the program-main body uses jumbo sets: two scratch bitmap
buffers (_jset_scratch_0/1) are emitted as .bss globals (main has no
frame, so set-op result/literal buffers live in static storage). }
FProgHasJumboSet: Boolean;
{ Whole-program multi-unit guard: the system-class (TObject /
TCustomAttribute) class-name strings, typeinfo, vtables and field-cleanup
stubs are emitted by the FIRST class section that runs (the first unit
@ -631,7 +635,9 @@ begin
tyDouble: Result := 8;
tySingle: Result := 4;
tySet:
if TSetTypeDesc(AType).BitCount > 32 then
if TSetTypeDesc(AType).IsJumbo() then
Result := TSetTypeDesc(AType).RawSize() { inline byte-array bitmap }
else if TSetTypeDesc(AType).BitCount > 32 then
Result := 8
else
Result := 4;
@ -646,6 +652,21 @@ begin
Result := (AType <> nil) and (AType.Kind in [tyDouble, tySingle]);
end;
{ True for a JUMBO (>64-member) set: an inline byte-array bitmap aggregate
(like a record / static array), operated on via the _Set* RTL helpers and
passed/returned by pointer. Sets of 64 members or fewer stay register-sized. }
function IsJumboSet(AType: TTypeDesc): Boolean;
begin
Result := (AType <> nil) and (AType.Kind = tySet) and
TSetTypeDesc(AType).IsJumbo();
end;
{ Bitmap byte count of a jumbo set (= ceil(BitCount/8), <= 32). }
function JumboSetNBytes(AType: TTypeDesc): Integer;
begin
Result := TSetTypeDesc(AType).RawByteSize();
end;
{ SysV AMD64 XMM argument registers, in order. }
const
SysVXmmArgRegs: array[0..7] of string =
@ -795,7 +816,8 @@ var
HasData, HasTbss: Boolean;
InitCD: TConstDecl;
begin
if (FDataGlobals.Count = 0) and (FProgExcFrameCount = 0) then
if (FDataGlobals.Count = 0) and (FProgExcFrameCount = 0) and
(not FProgHasJumboSet) then
begin
Self.EmitStrLitSection();
Exit;
@ -810,6 +832,7 @@ begin
HasData := True;
end;
if FProgExcFrameCount > 0 then HasData := True;
if FProgHasJumboSet then HasData := True;
{ Two passes: first .data globals, then .tbss threadvars. }
if HasData then
Self.Emit('.data');
@ -854,7 +877,8 @@ begin
Continue;
end;
if (Self.GlobalType(Name) <> nil) and
(Self.GlobalType(Name).Kind in [tyRecord, tyStaticArray]) then
(IsJumboSet(Self.GlobalType(Name)) or
(Self.GlobalType(Name).Kind in [tyRecord, tyStaticArray])) then
begin
Sz := Self.GlobalType(Name).RawSize();
Self.Emit('.balign 8');
@ -904,6 +928,17 @@ begin
Self.Emit('_exc_frame_' + IntToStr(I) + ':');
Self.Emit(#9'.skip 512');
end;
{ Jumbo-set scratch buffers for the program-main body (32 bytes each, the
256-member maximum). }
if FProgHasJumboSet then
begin
Self.Emit('.balign 8');
Self.Emit('_jset_scratch_0:');
Self.Emit(#9'.skip 32');
Self.Emit('.balign 8');
Self.Emit('_jset_scratch_1:');
Self.Emit(#9'.skip 32');
end;
{ Threadvar globals: emit in .tbss (zero-initialised thread-local storage). }
if HasTbss then
begin
@ -913,7 +948,8 @@ begin
Name := FDataGlobals.Keys[I];
if not Self.IsThreadVarGlobal(Name) then Continue;
if (Self.GlobalType(Name) <> nil) and
(Self.GlobalType(Name).Kind in [tyRecord, tyStaticArray]) then
(IsJumboSet(Self.GlobalType(Name)) or
(Self.GlobalType(Name).Kind in [tyRecord, tyStaticArray])) then
Sz := Self.GlobalType(Name).RawSize()
else if (Self.GlobalType(Name) <> nil) and
(Self.GlobalType(Name).Kind = tyDouble) then
@ -1157,6 +1193,25 @@ begin
for I := 0 to ABlock.ConstDecls.Count - 1 do
begin
CD := TConstDecl(ABlock.ConstDecls.Items[I]);
{ Jumbo set constant: emit the bitmap as a byte blob under the mangled
label (shares the const-data pass with array consts). }
if (CD.ConstSetBytes <> nil) and (CD.ConstSetBytes.Count > 0) then
begin
if APrefix <> '' then
Lbl := APrefix + '_' + CD.Name
else if CD.ResolvedSetQbeName <> '' then
Lbl := NativeMangle(CD.ResolvedSetQbeName)
else
Lbl := CD.Name;
Self.Emit('.data');
Self.Emit('.balign 8');
if Copy(Lbl, 1, 2) <> '.L' then
Self.Emit('.globl ' + Lbl);
Self.Emit(Lbl + ':');
for J := 0 to CD.ConstSetBytes.Count - 1 do
Self.Emit(Format(#9'.byte %s', [CD.ConstSetBytes[J]]));
Continue;
end;
if not CD.IsArrayConst then Continue;
if (CD.ArrayElements = nil) or (CD.ArrayElements.Count = 0) then Continue;
if APrefix <> '' then
@ -3254,8 +3309,9 @@ procedure TX86_64Backend.AddSlot(const AName: string; AType: TTypeDesc;
var
Sz: Integer;
begin
if (AType <> nil) and (AType.Kind in [tyRecord, tyStaticArray]) then
Sz := (AType.RawSize() + 7) and (-8)
if ((AType <> nil) and (AType.Kind in [tyRecord, tyStaticArray])) or
IsJumboSet(AType) then
Sz := (AType.RawSize() + 7) and (-8) { full inline aggregate slot }
else if (AType <> nil) and (AType.Kind = tyInterface) then
Sz := 16 { fat pointer: obj slot (+0) then itab slot (+8) }
else if (AType <> nil) and (AType.Kind = tyProcedural) and
@ -3274,6 +3330,7 @@ var
I, J, K, Offset, StackOff, TryCount, IntIdx2: Integer;
P: TMethodParam;
VD: TVarDecl;
HasJumbo: Boolean;
begin
Self.ClearFrame();
FFrame := TDictionary<string, Integer>.Create();
@ -3352,7 +3409,8 @@ begin
Inc(IntIdx2);
end
else if (P.ResolvedType <> nil) and
(P.ResolvedType.Kind in [tyRecord, tyStaticArray]) and
((P.ResolvedType.Kind in [tyRecord, tyStaticArray]) or
IsJumboSet(P.ResolvedType)) and
not P.IsVarParam then
begin
if IntIdx2 < 6 then
@ -3395,8 +3453,11 @@ begin
buffer and the epilogue loads it into rax/rdx/xmm0/xmm1. }
if ADecl.ResolvedReturnType <> nil then
begin
if ADecl.ResolvedReturnType.Kind = tyInterface then
if (ADecl.ResolvedReturnType.Kind = tyInterface) or
IsJumboSet(ADecl.ResolvedReturnType) then
begin
{ Interface and jumbo-set returns are sret: a hidden pointer arg; the
Result slot holds that pointer. }
FSretFunc := True;
Self.AddSlot('Result', nil, Offset);
end
@ -3455,6 +3516,26 @@ begin
for K := 0 to TryCount - 1 do
Self.AddSlot('_for_end_' + IntToStr(K), nil, Offset);
end;
{ Jumbo-set scratch slots: a jumbo set literal, union, intersection, or
difference produces a new bitmap that must live somewhere addressable.
Such a value can appear deep inside any expression (e.g. 'X in [members]'
over a >64-member enum, which is common in the compiler's own token tests),
so rather than walk the whole body we reserve the two 32-byte scratch slots
in every function frame. The cost is 64 bytes per frame; correctness and
self-host stability outweigh it. HasJumbo is retained for future
refinement to a body-walk-gated reservation. }
HasJumbo := True;
if HasJumbo then
begin
Inc(Offset, 32);
Offset := (Offset + 7) and (-8);
FFrame.Add('_jset_scratch_0', -Offset);
FFrameTypes.Add('_jset_scratch_0', nil);
Inc(Offset, 32);
Offset := (Offset + 7) and (-8);
FFrame.Add('_jset_scratch_1', -Offset);
FFrameTypes.Add('_jset_scratch_1', nil);
end;
{ Round the reserved size up to a 16-byte multiple (SysV alignment).
-16 is the bitmask not(15) in two's complement (Blaise `not` is Boolean). }
FFrameSize := (Offset + 15) and (-16);
@ -4631,7 +4712,8 @@ begin
Self.Emit(Format(#9'addq $%d, %%rcx',
[TFieldInfo(TIdentExpr(AExpr).ImplicitFieldInfo).Offset]));
if (TIdentExpr(AExpr).ResolvedType <> nil) and
(TIdentExpr(AExpr).ResolvedType.Kind in [tyRecord, tyStaticArray]) then
(IsJumboSet(TIdentExpr(AExpr).ResolvedType) or
(TIdentExpr(AExpr).ResolvedType.Kind in [tyRecord, tyStaticArray])) then
Self.Emit(#9'movq %rcx, %rax')
else if (TIdentExpr(AExpr).ResolvedType <> nil) and
(TIdentExpr(AExpr).ResolvedType.Kind = tyClass) then
@ -4641,7 +4723,8 @@ begin
Exit;
end;
if (TIdentExpr(AExpr).ResolvedType <> nil) and
(TIdentExpr(AExpr).ResolvedType.Kind in [tyRecord, tyStaticArray]) then
(IsJumboSet(TIdentExpr(AExpr).ResolvedType) or
(TIdentExpr(AExpr).ResolvedType.Kind in [tyRecord, tyStaticArray])) then
begin
if FSretFunc and (TIdentExpr(AExpr).Name = 'Result') then
Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand('Result')]))
@ -5733,8 +5816,20 @@ begin
(BE.Right.ResolvedType <> nil) and
(BE.Right.ResolvedType.Kind = tySet) then
begin
if IsJumboSet(BE.Right.ResolvedType) then
begin
{ Jumbo: evaluate ordinal, save it, get the set's bitmap address, then
_SetIn(rdi=set, esi=ord). }
Self.EmitExprToEax(BE.Left);
Self.Emit(#9'pushq %rax'); { ordinal }
Self.EmitExprToEax(BE.Right); { set bitmap addr -> %rax }
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'popq %rsi');
Self.Emit(#9'callq _SetIn');
Exit;
end;
Self.EmitExprToEax(BE.Left);
Self.Emit(#9'movl %eax, %ecx');
Self.Emit(#9'movl %eax, %ecx'); { ordinal in %ecx (and %cl) }
Self.EmitExprToEax(BE.Right);
if TSetTypeDesc(BE.Right.ResolvedType).BitCount > 32 then
begin
@ -5746,13 +5841,64 @@ begin
Self.Emit(#9'shrl %cl, %eax');
Self.Emit(#9'andl $1, %eax');
end;
{ Range guard: force 0 when the ordinal is >= the set width. The set may
be sized to a literal's max ordinal (X in [low members]) while the
tested element's ordinal is larger; x86 shift counts wrap mod 32/64, so
the raw shift result for an out-of-range ordinal is meaningless and
must be masked out. %edx = (ord < BitCount) ? 1 : 0. }
Self.Emit(Format(#9'cmpl $%d, %%ecx',
[TSetTypeDesc(BE.Right.ResolvedType).BitCount]));
Self.Emit(#9'setl %dl');
Self.Emit(#9'movzbl %dl, %edx');
Self.Emit(#9'andl %edx, %eax');
Exit;
end;
{ Set arithmetic: union (+), difference (-), intersection (*) }
{ Set arithmetic: union (+), difference (-), intersection (*), equality. }
if (BE.Left.ResolvedType <> nil) and
(BE.Left.ResolvedType.Kind = tySet) and
(BE.Op in [boAdd, boSub, boMul, boEQ, boNE]) then
begin
if IsJumboSet(BE.Left.ResolvedType) then
begin
{ Equality compares two bitmap addresses via _SetEqual. }
if BE.Op in [boEQ, boNE] then
begin
Self.EmitExprToEax(BE.Left);
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(BE.Right);
Self.Emit(#9'movq %rax, %rsi');
Self.Emit(#9'popq %rdi');
Self.Emit(Format(#9'movl $%d, %%edx',
[JumboSetNBytes(BE.Left.ResolvedType)]));
Self.Emit(#9'callq _SetEqual');
if BE.Op = boNE then
Self.Emit(#9'xorl $1, %eax');
Exit;
end;
{ Union/intersection/difference: write the result into a frame scratch
slot and return its address. The _Set helper takes rdi=dest,
rsi=A, rdx=B, ecx=nbytes. %r12/%r13 are callee-saved across the two
operand evaluations and the helper call. }
Self.EmitExprToEax(BE.Left);
Self.Emit(#9'pushq %r12');
Self.Emit(#9'pushq %r13');
Self.Emit(#9'movq %rax, %r12'); { A addr }
Self.EmitExprToEax(BE.Right);
Self.Emit(#9'movq %rax, %r13'); { B addr }
Self.Emit(Format(#9'leaq %s, %%rdi', [Self.VarOperand('_jset_scratch_0')]));
Self.Emit(#9'movq %r12, %rsi');
Self.Emit(#9'movq %r13, %rdx');
Self.Emit(Format(#9'movl $%d, %%ecx', [JumboSetNBytes(BE.Left.ResolvedType)]));
case BE.Op of
boAdd: Self.Emit(#9'callq _SetUnion');
boMul: Self.Emit(#9'callq _SetInter');
boSub: Self.Emit(#9'callq _SetDiff');
end;
Self.Emit(Format(#9'leaq %s, %%rax', [Self.VarOperand('_jset_scratch_0')]));
Self.Emit(#9'popq %r13');
Self.Emit(#9'popq %r12');
Exit;
end;
Self.EmitExprToEax(BE.Left);
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(BE.Right);
@ -6215,7 +6361,8 @@ begin
Self.Emit(#9'movq %rax, %rcx');
if FAE.FieldInfo.Offset > 0 then
Self.Emit(Format(#9'leaq %d(%%rcx), %%rcx', [FAE.FieldInfo.Offset]));
if FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if (IsJumboSet(FAE.FieldInfo.TypeDesc) or
(FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray])) then
Self.Emit(#9'movq %rcx, %rax')
else
Self.EmitLoadVar('(%rcx)', FAE.FieldInfo.TypeDesc);
@ -6238,7 +6385,8 @@ begin
Self.Emit(Format(#9'addq $%d, %%rcx', [FAE.ImplicitBaseInfo.Offset]));
if FAE.IsClassAccess then
Self.Emit(#9'movq (%rcx), %rcx');
if FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if (IsJumboSet(FAE.FieldInfo.TypeDesc) or
(FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray])) then
Self.Emit(Format(#9'leaq %d(%%rcx), %%rax', [FAE.FieldInfo.Offset]))
else
Self.EmitLoadVar(Format('%d(%%rcx)', [FAE.FieldInfo.Offset]),
@ -6253,7 +6401,8 @@ begin
if FAE.IsVarParam then
{ var-param class: slot -> caller var -> instance }
Self.Emit(#9'movq (%rcx), %rcx');
if FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if (IsJumboSet(FAE.FieldInfo.TypeDesc) or
(FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray])) then
Self.Emit(Format(#9'leaq %d(%%rcx), %%rax', [FAE.FieldInfo.Offset]))
else
Self.EmitLoadVar(Format('%d(%%rcx)', [FAE.FieldInfo.Offset]),
@ -6265,7 +6414,8 @@ begin
Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FAE.RecordName)]))
else
Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FAE.RecordName]));
if FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if (IsJumboSet(FAE.FieldInfo.TypeDesc) or
(FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray])) then
Self.Emit(Format(#9'leaq %d(%%rcx), %%rax', [FAE.FieldInfo.Offset]))
else
Self.EmitLoadVar(Format('%d(%%rcx)', [FAE.FieldInfo.Offset]),
@ -6273,7 +6423,8 @@ begin
end
else if Self.IsLocal(FAE.RecordName) then
begin
if FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if (IsJumboSet(FAE.FieldInfo.TypeDesc) or
(FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray])) then
begin
Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(FAE.RecordName)]));
if FAE.FieldInfo.Offset = 0 then
@ -6292,7 +6443,8 @@ begin
end
else
begin
if FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if (IsJumboSet(FAE.FieldInfo.TypeDesc) or
(FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray])) then
begin
Self.Emit(Format(#9'leaq %s(%%rip), %%rcx', [FAE.RecordName]));
if FAE.FieldInfo.Offset = 0 then
@ -6605,6 +6757,27 @@ begin
if (AExpr is TArrayLiteralExpr) and
(AExpr.ResolvedType <> nil) and (AExpr.ResolvedType.Kind = tySet) then
begin
{ Jumbo set literal: build the bitmap in the scratch_1 slot — memset 0,
then _SetInclude per element (elements may be non-constant). Return the
buffer address. scratch_1 (not scratch_0) so a surrounding set-op
assignment, which uses scratch_0, is not clobbered. }
if IsJumboSet(AExpr.ResolvedType) then
begin
Self.Emit(Format(#9'leaq %s, %%rdi', [Self.VarOperand('_jset_scratch_1')]));
Self.Emit(#9'xorl %esi, %esi');
Self.Emit(Format(#9'movl $%d, %%edx', [TSetTypeDesc(AExpr.ResolvedType).RawSize()]));
Self.Emit(#9'callq memset');
for SetI := 0 to TArrayLiteralExpr(AExpr).Elements.Count - 1 do
begin
SetElem := TASTExpr(TArrayLiteralExpr(AExpr).Elements.Items[SetI]);
Self.EmitExprToEax(SetElem);
Self.Emit(#9'movl %eax, %esi'); { ordinal }
Self.Emit(Format(#9'leaq %s, %%rdi', [Self.VarOperand('_jset_scratch_1')]));
Self.Emit(#9'callq _SetInclude');
end;
Self.Emit(Format(#9'leaq %s, %%rax', [Self.VarOperand('_jset_scratch_1')]));
Exit;
end;
SetMask := 0;
for SetI := 0 to TArrayLiteralExpr(AExpr).Elements.Count - 1 do
begin
@ -6623,7 +6796,8 @@ begin
begin
Self.EmitExprToEax(TDerefExpr(AExpr).Expr);
if (AExpr.ResolvedType <> nil) and
(AExpr.ResolvedType.Kind in [tyRecord, tyStaticArray]) then
(IsJumboSet(AExpr.ResolvedType) or
(AExpr.ResolvedType.Kind in [tyRecord, tyStaticArray])) then
begin
{ Pointer-to-record/array: the pointer value IS the record address.
Callers (field access, assignment) work with addresses for records. }
@ -8123,8 +8297,16 @@ begin
Self.Emit(#9'jmp ' + LEnd);
Self.Emit(LBody + ':');
{ Test bit: (mask >> idx) & 1 }
if AStmt.SetBitCount > 32 then
{ Test bit: jumbo via _SetIn(set_addr, idx); else (mask >> idx) & 1 }
if AStmt.SetIsJumbo then
begin
Self.Emit(Format(#9'movq %s, %%rdi',
[Self.VarOperand(AStmt.SetMaskVarName)])); { set bitmap addr }
Self.Emit(Format(#9'movl %s, %%esi', [IdxOp]));
Self.Emit(#9'callq _SetIn');
Self.Emit(#9'testl %eax, %eax');
end
else if AStmt.SetBitCount > 32 then
begin
Self.Emit(Format(#9'movq %s, %%rax',
[Self.VarOperand(AStmt.SetMaskVarName)]));
@ -8843,6 +9025,21 @@ begin
'(%rbx)', False);
Self.Emit(#9'popq %rbx');
end
else if IsJumboSet(Asgn.ResolvedLhsType) then
begin
{ Jumbo set into an implicit-Self field: plain bitmap memcpy (a set has
no managed fields, so no retain/release). }
Self.EmitExprToEax(Asgn.Expr);
Self.Emit(#9'pushq %rbx');
Self.Emit(#9'movq %rax, %rbx'); { source bitmap addr }
Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand('Self')]));
if ISFld.Offset > 0 then
Self.Emit(Format(#9'addq $%d, %%rdi', [ISFld.Offset]));
Self.Emit(#9'movq %rbx, %rsi');
Self.Emit(Format(#9'movq $%d, %%rdx', [Asgn.ResolvedLhsType.RawSize()]));
Self.Emit(#9'callq memcpy');
Self.Emit(#9'popq %rbx');
end
else if (Asgn.ResolvedLhsType.Kind in [tyRecord, tyStaticArray]) then
begin
Self.EmitExprToEax(Asgn.Expr);
@ -8955,15 +9152,19 @@ begin
Self.Emit(#9'callq memcpy');
Exit;
end;
{ sret assignment: LHS is a record variable; RHS is a record-returning call.
Pass the destination buffer address as the hidden first arg (%rdi). }
{ sret assignment: LHS is a record (or jumbo set) variable; RHS is a
record/jumbo-set-returning call. Pass the destination buffer address as
the hidden first arg (%rdi). }
if (Asgn.ResolvedLhsType <> nil) and
(Asgn.ResolvedLhsType.Kind = tyRecord) and
((Asgn.ResolvedLhsType.Kind = tyRecord) or IsJumboSet(Asgn.ResolvedLhsType)) and
(Asgn.Expr is TFuncCallExpr) and
(TFuncCallExpr(Asgn.Expr).ResolvedDecl <> nil) and
(TMethodDecl(TFuncCallExpr(Asgn.Expr).ResolvedDecl).ResolvedReturnType <> nil) and
(TMethodDecl(TFuncCallExpr(Asgn.Expr).ResolvedDecl).ResolvedReturnType.Kind = tyRecord) then
((TMethodDecl(TFuncCallExpr(Asgn.Expr).ResolvedDecl).ResolvedReturnType.Kind = tyRecord) or
IsJumboSet(TMethodDecl(TFuncCallExpr(Asgn.Expr).ResolvedDecl).ResolvedReturnType)) then
begin
{ For a local jumbo set the dest is leaq'd; EmitSretCall's caller passes
the operand and a 'by-ref' flag. Mirror the record dispatch below. }
if FSretFunc and SameText(Asgn.Name, 'Result') then
Self.EmitSretCall(
FuncSymbolOf(TFuncCallExpr(Asgn.Expr)),
@ -8983,21 +9184,25 @@ begin
TFuncCallExpr(Asgn.Expr).Args,
Self.VarOperand(Asgn.Name), False)
else
begin
Self.AddGlobal(Asgn.Name, Asgn.ResolvedLhsType);
Self.EmitSretCall(
FuncSymbolOf(TFuncCallExpr(Asgn.Expr)),
TMethodDecl(TFuncCallExpr(Asgn.Expr).ResolvedDecl),
TFuncCallExpr(Asgn.Expr).Args,
Asgn.Name + '(%rip)', False);
end;
Exit;
end;
{ sret assignment: method call returning a record.
{ sret assignment: method call returning a record (or jumbo set).
%rdi = sret ptr, %rsi = Self, %rdx.. = user args. }
if (Asgn.ResolvedLhsType <> nil) and
(Asgn.ResolvedLhsType.Kind = tyRecord) and
((Asgn.ResolvedLhsType.Kind = tyRecord) or IsJumboSet(Asgn.ResolvedLhsType)) and
(Asgn.Expr is TMethodCallExpr) and
(TMethodCallExpr(Asgn.Expr).ResolvedMethod <> nil) and
(TMethodDecl(TMethodCallExpr(Asgn.Expr).ResolvedMethod).ResolvedReturnType <> nil) and
(TMethodDecl(TMethodCallExpr(Asgn.Expr).ResolvedMethod).ResolvedReturnType.Kind = tyRecord) then
((TMethodDecl(TMethodCallExpr(Asgn.Expr).ResolvedMethod).ResolvedReturnType.Kind = tyRecord) or
IsJumboSet(TMethodDecl(TMethodCallExpr(Asgn.Expr).ResolvedMethod).ResolvedReturnType)) then
begin
if FSretFunc and SameText(Asgn.Name, 'Result') then
Self.EmitMethodSretCall(TMethodCallExpr(Asgn.Expr),
@ -9009,8 +9214,11 @@ begin
Self.EmitMethodSretCall(TMethodCallExpr(Asgn.Expr),
Self.VarOperand(Asgn.Name), False)
else
begin
Self.AddGlobal(Asgn.Name, Asgn.ResolvedLhsType);
Self.EmitMethodSretCall(TMethodCallExpr(Asgn.Expr),
Asgn.Name + '(%rip)', False);
end;
Exit;
end;
if IsFloatFamily(Asgn.ResolvedLhsType) then
@ -9206,7 +9414,8 @@ begin
end;
end
else if (Asgn.ResolvedLhsType <> nil) and
(Asgn.ResolvedLhsType.Kind in [tyRecord, tyStaticArray]) then
(IsJumboSet(Asgn.ResolvedLhsType) or
(Asgn.ResolvedLhsType.Kind in [tyRecord, tyStaticArray])) then
begin
Self.EmitExprToEax(Asgn.Expr);
Self.Emit(#9'movq %rax, %rsi');
@ -9444,6 +9653,18 @@ begin
{ Include(S, elem): S := S or (1 shl ord(elem)) }
if SameText(PC.Name, 'Include') and (PC.Args.Count = 2) then
begin
{ Jumbo set: address of the set, ordinal, then _SetInclude. Handles any
lvalue shape (var, field, element), not just a bare ident. }
if IsJumboSet(TASTExpr(PC.Args.Items[0]).ResolvedType) then
begin
Self.EmitExprToEax(TASTExpr(PC.Args.Items[1]));
Self.Emit(#9'pushq %rax'); { ordinal }
Self.EmitExprToEax(TASTExpr(PC.Args.Items[0])); { set addr -> %rax }
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'popq %rsi');
Self.Emit(#9'callq _SetInclude');
Exit;
end;
Self.EmitExprToEax(TASTExpr(PC.Args.Items[1]));
Self.Emit(#9'movl %eax, %ecx');
FDynArgName := TIdentExpr(TASTExpr(PC.Args.Items[0])).Name;
@ -9473,6 +9694,17 @@ begin
{ Exclude(S, elem): S := S and (not (1 shl ord(elem))) }
if SameText(PC.Name, 'Exclude') and (PC.Args.Count = 2) then
begin
{ Jumbo set: address of the set, ordinal, then _SetExclude. }
if IsJumboSet(TASTExpr(PC.Args.Items[0]).ResolvedType) then
begin
Self.EmitExprToEax(TASTExpr(PC.Args.Items[1]));
Self.Emit(#9'pushq %rax');
Self.EmitExprToEax(TASTExpr(PC.Args.Items[0]));
Self.Emit(#9'movq %rax, %rdi');
Self.Emit(#9'popq %rsi');
Self.Emit(#9'callq _SetExclude');
Exit;
end;
Self.EmitExprToEax(TASTExpr(PC.Args.Items[1]));
Self.Emit(#9'movl %eax, %ecx');
FDynArgName := TIdentExpr(TASTExpr(PC.Args.Items[0])).Name;
@ -12194,13 +12426,14 @@ begin
Self.Emit(Format(#9'leaq %s, %%rax', [ASretAddr]));
Self.Emit(#9'pushq %rax');
{ Zero the destination buffer via memset(dest, 0, size), mirroring the QBE
backend. ADecl.ResolvedReturnType.Kind = tyRecord here. }
backend. The return type is a record or a jumbo set here; RawSize covers
both (TotalSize for a record, the bitmap byte count for a jumbo set). }
if (ADecl <> nil) and (ADecl.ResolvedReturnType <> nil) then
begin
Self.Emit(#9'movq (%rsp), %rdi');
Self.Emit(#9'xorl %esi, %esi');
Self.Emit(Format(#9'movq $%d, %%rdx',
[TRecordTypeDesc(ADecl.ResolvedReturnType).TotalSize()]));
[ADecl.ResolvedReturnType.RawSize()]));
Self.Emit(#9'callq memset');
end;
HD := TList<Integer>.Create();
@ -12377,7 +12610,7 @@ begin
Self.Emit(#9'movq (%rsp), %rdi');
Self.Emit(#9'xorl %esi, %esi');
Self.Emit(Format(#9'movq $%d, %%rdx',
[TRecordTypeDesc(MD.ResolvedReturnType).TotalSize()]));
[MD.ResolvedReturnType.RawSize()]));
Self.Emit(#9'callq memset');
end;
@ -13220,7 +13453,8 @@ begin
end;
end
else if (P.ResolvedType <> nil) and
(P.ResolvedType.Kind in [tyRecord, tyStaticArray]) then
((P.ResolvedType.Kind in [tyRecord, tyStaticArray]) or
IsJumboSet(P.ResolvedType)) then
begin
{ Phase 1: spill only the incoming pointer. The local copy is made
AFTER every register is spilled — memcpy clobbers the caller-saved
@ -13250,7 +13484,8 @@ begin
P := TMethodParam(ADecl.Params.Items[I]);
if P.IsOpenArray or P.IsVarParam then Continue;
if (P.ResolvedType = nil) or
not (P.ResolvedType.Kind in [tyRecord, tyStaticArray]) then Continue;
not ((P.ResolvedType.Kind in [tyRecord, tyStaticArray]) or
IsJumboSet(P.ResolvedType)) then Continue;
Self.Emit(Format(#9'movq %s, %%rsi', [Self.VarOperand(P.ParamName)]));
Self.Emit(Format(#9'leaq %s, %%rdi',
[Self.VarOperand(P.ParamName + '_data')]));
@ -13332,7 +13567,17 @@ begin
tySet:
for J := 0 to TVarDecl(ADecl.Body.Decls.Items[I]).Names.Count - 1 do
if TSetTypeDesc(TVarDecl(ADecl.Body.Decls.Items[I]).ResolvedType).BitCount <= 32 then
if IsJumboSet(TVarDecl(ADecl.Body.Decls.Items[I]).ResolvedType) then
begin
{ Jumbo set: zero the whole inline bitmap via memset. }
Self.Emit(Format(#9'leaq %s, %%rdi',
[Self.VarOperand(TVarDecl(ADecl.Body.Decls.Items[I]).Names.Strings[J])]));
Self.Emit(#9'xorl %esi, %esi');
Self.Emit(Format(#9'movl $%d, %%edx',
[TSetTypeDesc(TVarDecl(ADecl.Body.Decls.Items[I]).ResolvedType).RawSize()]));
Self.Emit(#9'callq memset');
end
else if TSetTypeDesc(TVarDecl(ADecl.Body.Decls.Items[I]).ResolvedType).BitCount <= 32 then
Self.Emit(Format(#9'movl $0, %s',
[Self.VarOperand(TVarDecl(ADecl.Body.Decls.Items[I]).Names.Strings[J])]))
else
@ -13640,6 +13885,11 @@ begin
for I := 0 to AProg.Block.Stmts.Count - 1 do
FProgExcFrameCount := FProgExcFrameCount +
Self.CountTryStmts(TASTStmt(AProg.Block.Stmts.Items[I]));
{ Jumbo-set scratch in main: main has no stack frame, so set literal / set-op
result buffers live in static .bss. A jumbo set value can appear in any
expression in the program body (e.g. 'X in [members]' over a >64 enum), so
always reserve the two scratch buffers. }
FProgHasJumboSet := True;
{ Reset per-function state before emitting the program body. }
FExcDepth := 0;
FExcFrameNext := 0;

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

@ -197,6 +197,11 @@ type
procedure EmitFuncDef(ADecl: TMethodDecl; AExported: Boolean);
procedure EmitBlock(ABlock: TBlock);
procedure EmitVarAllocs(ABlock: TBlock);
{ True for inline-aggregate value types whose "value" in QBE is the
ADDRESS of their storage (not a loaded register): records, static arrays,
and JUMBO (>64-member) sets. Used at the read/arg/return sites that must
return a storage address rather than a loaded scalar. }
function IsAggregateAddrType(AType: TTypeDesc): Boolean;
{ mem2reg helpers }
{ Returns True if AKind is a scalar type promotable to a QBE SSA temp. }
function IsPromotableKind(AKind: TTypeKind): Boolean;
@ -1007,6 +1012,11 @@ function TCodeGenQBE.QbeParamTypeOf(AType: TTypeDesc): string;
begin
if (AType <> nil) and (AType.Kind = tyRecord) then
Result := FFIRecordTypeRef(TRecordTypeDesc(AType))
{ Jumbo set: passed by pointer to its bitmap (the callee copies it into a
local slot for value semantics). }
else if (AType <> nil) and (AType.Kind = tySet) and
TSetTypeDesc(AType).IsJumbo() then
Result := 'l'
else
Result := QbeTypeOf(AType);
end;
@ -1194,6 +1204,13 @@ end;
mem2reg helpers
----------------------------------------------------------------------- }
function TCodeGenQBE.IsAggregateAddrType(AType: TTypeDesc): Boolean;
begin
if AType = nil then Exit(False);
Result := (AType.Kind in [tyRecord, tyStaticArray]) or
((AType.Kind = tySet) and TSetTypeDesc(AType).IsJumbo());
end;
function TCodeGenQBE.IsPromotableKind(AKind: TTypeKind): Boolean;
begin
{ Only promote pure scalar types that are never used as receivers for
@ -1619,6 +1636,12 @@ begin
{ tyProcedural method-pointers are two-slot aggregates — not promotable }
IsMethodPtr := (Decl.ResolvedType.Kind = tyProcedural) and
TProceduralTypeDesc(Decl.ResolvedType).IsMethodPtr;
{ Jumbo (>64-member) sets are inline byte-array aggregates, not
register values — promoting one to a single SSA temp would
silently truncate it to 8 bytes. }
if (Decl.ResolvedType.Kind = tySet) and
TSetTypeDesc(Decl.ResolvedType).IsJumbo() then
IsMethodPtr := True;
if not IsMethodPtr then
begin
FPromotedLocals.Add(VarName);
@ -1741,10 +1764,19 @@ begin
EmitLine(Format(' %%_var_%s =l alloc4 1', [VarName]));
EmitLine(Format(' storew 0, %%_var_%s', [VarName]));
end
else
else if TSetTypeDesc(Decl.ResolvedType).BitCount <= 64 then
begin
EmitLine(Format(' %%_var_%s =l alloc8 1', [VarName]));
EmitLine(Format(' storel 0, %%_var_%s', [VarName]));
end
else
begin
{ Jumbo set: inline byte-array bitmap, zero-init via memset (like
a static array). }
ArrSize := TSetTypeDesc(Decl.ResolvedType).RawSize();
EmitLine(Format(' %%_var_%s =l alloc8 %d', [VarName, ArrSize]));
EmitLine(Format(' call $memset(l %%_var_%s, w 0, l %d)',
[VarName, ArrSize]));
end;
end;
@ -1844,8 +1876,12 @@ begin
tySet:
if TSetTypeDesc(Decl.ResolvedType).BitCount <= 32 then
EmitLine(Format('%s $%s = { w 0 }', [Pfx, VarName]))
else if TSetTypeDesc(Decl.ResolvedType).BitCount <= 64 then
EmitLine(Format('%s $%s = { l 0 }', [Pfx, VarName]))
else
EmitLine(Format('%s $%s = { l 0 }', [Pfx, VarName]));
{ Jumbo set: zero-filled inline byte-array bitmap. }
EmitLine(Format('%s $%s = { z %d }',
[Pfx, VarName, TSetTypeDesc(Decl.ResolvedType).RawSize()]));
tyInt64, tyUInt64:
EmitLine(Format('%s $%s = { l 0 }', [Pfx, VarName]));
tyString, tyClass, tyPointer, tyPChar, tyMetaClass:
@ -1983,6 +2019,28 @@ var
IsStrArray: Boolean;
Label_: string;
begin
{ Jumbo set constant: emit the bitmap as a byte blob under the mangled label.
Shares the const-data pass with array consts. }
if (CD.ConstSetBytes <> nil) and (CD.ConstSetBytes.Count > 0) then
begin
if APrefix <> '' then
Label_ := APrefix + '_' + CD.Name
else if CD.ResolvedSetQbeName <> '' then
Label_ := CD.ResolvedSetQbeName
else
Label_ := CD.Name;
Parts := '';
for J := 0 to CD.ConstSetBytes.Count - 1 do
begin
if J > 0 then Parts := Parts + ', ';
Parts := Parts + Format('b %s', [CD.ConstSetBytes[J]]);
end;
if APrefix <> '' then
EmitLine(Format('export data $%s = { %s }', [Label_, Parts]))
else
EmitLine(Format('data $%s = { %s }', [Label_, Parts]));
Exit;
end;
if not CD.IsArrayConst then Exit;
if (CD.ArrayElements = nil) or (CD.ArrayElements.Count = 0) then Exit;
if APrefix <> '' then
@ -3263,9 +3321,15 @@ begin
EmitLine(Format(' %s =w copy %s', [IdxW, IdxSlot]))
else
EmitLine(Format(' %s =w loadw %s', [IdxW, IdxSlot]));
EmitLine(Format(' %s =%s shr %s, %s', [BitT, SetMQT, MaskT, IdxW]));
CmpT := AllocTemp();
EmitLine(Format(' %s =w and %s, 1', [CmpT, BitT]));
if AStmt.SetIsJumbo then
{ Jumbo: MaskT is the set's bitmap address; test membership via _SetIn. }
EmitLine(Format(' %s =w call $_SetIn(l %s, w %s)', [CmpT, MaskT, IdxW]))
else
begin
EmitLine(Format(' %s =%s shr %s, %s', [BitT, SetMQT, MaskT, IdxW]));
EmitLine(Format(' %s =w and %s, 1', [CmpT, BitT]));
end;
{ If bit is 0 skip body, go directly to forin_next }
EmitLine(Format(' jnz %s, @%s_yes, @%s', [CmpT, LblBody, LblNext]));
EmitLine('@' + LblBody + '_yes');
@ -4118,6 +4182,18 @@ begin
EmitLine(Format(' %s %s, %s', [StoreInstr, ValTemp, PtrTemp]));
end;
end
else if (AAssign.ResolvedLhsType <> nil) and
(AAssign.ResolvedLhsType.Kind = tySet) and
TSetTypeDesc(AAssign.ResolvedLhsType).IsJumbo() then
begin
{ Jumbo set assignment: the RHS evaluates to the source bitmap address
(a set variable, a set-op result buffer, or a const blob); copy the
whole bitmap into the destination slot. }
ValTemp := EmitExpr(AAssign.Expr);
EmitLine(Format(' call $memcpy(l %s, l %s, l %d)',
[VarRef(AAssign.Name, AAssign.IsGlobal), ValTemp,
TSetTypeDesc(AAssign.ResolvedLhsType).RawSize()]));
end
else if (AAssign.ResolvedLhsType <> nil) and
(AAssign.ResolvedLhsType.Kind = tyRecord) then
begin
@ -5160,6 +5236,18 @@ var
ArgLine, RetT, AggRef: string;
Sz: Integer;
begin
{ Jumbo set returns always use the plain sret path (a hidden dest pointer +
void return); they share this call helper with records but must not go
through ClassifyRecordReturn (which reads record-specific size fields). }
if (ARetType <> nil) and (TTypeDesc(ARetType).Kind = tySet) then
begin
if AVisibleArgs <> '' then
ArgLine := Format('l %s, %s', [ADestAddr, AVisibleArgs])
else
ArgLine := Format('l %s', [ADestAddr]);
EmitLine(Format(' call %s(%s)', [AFuncName, ArgLine]));
Exit;
end;
case Self.ClassifyRecordReturn(ARetType) of
rcSret:
begin
@ -6673,8 +6761,18 @@ begin
[Par.ParamName, Par.ParamName]));
end;
tySet:
{ A set is a w (≤32 members) or l (≤64) bitmask — spill at its width. }
if TSetTypeDesc(Par.ResolvedType).BitCount <= 32 then
{ A small set is a w (<=32) / l (<=64) bitmask spilled at its width.
A jumbo set arrives as a pointer to the caller's bitmap; copy it into
a fresh local bitmap slot for value semantics. }
if TSetTypeDesc(Par.ResolvedType).IsJumbo() then
begin
EmitLine(Format(' %%_var_%s =l alloc8 %d',
[Par.ParamName, TSetTypeDesc(Par.ResolvedType).RawSize()]));
EmitLine(Format(' call $memcpy(l %%_var_%s, l %%_par_%s, l %d)',
[Par.ParamName, Par.ParamName,
TSetTypeDesc(Par.ResolvedType).RawSize()]));
end
else if TSetTypeDesc(Par.ResolvedType).BitCount <= 32 then
begin
EmitLine(Format(' %%_var_%s =l alloc4 1', [Par.ParamName]));
EmitLine(Format(' storew %%_par_%s, %%_var_%s',
@ -6748,7 +6846,9 @@ begin
RC := Self.ClassifyRecordReturn(TRecordTypeDesc(AMethod.ResolvedReturnType));
Sig := 'l %_par_Self';
if IsFunc and (AMethod.ResolvedReturnType.Kind = tyInterface) then
if IsFunc and ((AMethod.ResolvedReturnType.Kind = tyInterface) or
((AMethod.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(AMethod.ResolvedReturnType).IsJumbo())) then
Sig := 'l %_par__sret, l %_par_Self'
else if IsFunc and (AMethod.ResolvedReturnType.Kind = tyRecord) then
EmitRecordReturnSignature(Sig, RC);
@ -6776,7 +6876,10 @@ begin
if IsFunc then
begin
RetQType := QbeTypeOf(AMethod.ResolvedReturnType);
if AMethod.ResolvedReturnType.Kind = tyInterface then
if (AMethod.ResolvedReturnType.Kind = tyInterface) or
((AMethod.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(AMethod.ResolvedReturnType).IsJumbo()) then
{ sret aggregate return — void function. }
EmitLine(Format('%sfunction %s(%s) {', [ExportPrefix(), FuncName, Sig]))
else if AMethod.ResolvedReturnType.Kind = tyRecord then
begin
@ -6843,6 +6946,14 @@ begin
begin
if AMethod.ResolvedReturnType.Kind = tyRecord then
EmitRecordReturnPrologue(TRecordTypeDesc(AMethod.ResolvedReturnType), RC)
else if (AMethod.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(AMethod.ResolvedReturnType).IsJumbo() then
begin
{ sret: jumbo-set Result aliases the caller's buffer; zero-init it. }
EmitLine(' %_var_Result =l copy %_par__sret');
EmitLine(Format(' call $memset(l %%_var_Result, w 0, l %d)',
[TSetTypeDesc(AMethod.ResolvedReturnType).RawSize()]));
end
else if AMethod.ResolvedReturnType.Kind = tyInterface then
begin
{ sret: interface Result is a 16-byte fat pointer (obj+itab) in the
@ -6919,7 +7030,10 @@ begin
begin
if AMethod.ResolvedReturnType.Kind = tyRecord then
EmitRecordReturnEpilogue(TRecordTypeDesc(AMethod.ResolvedReturnType), RC)
else if AMethod.ResolvedReturnType.Kind = tyInterface then
else if (AMethod.ResolvedReturnType.Kind = tyInterface) or
((AMethod.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(AMethod.ResolvedReturnType).IsJumbo()) then
{ sret aggregate return — written through %_par__sret; return void. }
EmitLine(' ret')
else
begin
@ -7629,8 +7743,12 @@ begin
if IsFunc then
begin
RetQType := QbeTypeOf(ADecl.ResolvedReturnType);
if ADecl.ResolvedReturnType.Kind = tyInterface then
if (ADecl.ResolvedReturnType.Kind = tyInterface) or
((ADecl.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(ADecl.ResolvedReturnType).IsJumbo()) then
begin
{ Interface and jumbo-set returns use a hidden sret pointer (the callee
writes the aggregate through it) and return void. }
if Sig <> '' then Sig := 'l %_par__sret, ' + Sig
else Sig := 'l %_par__sret';
EmitLine(Format('%sfunction %s(%s) {', [Prefix, FuncName, Sig]));
@ -7686,8 +7804,17 @@ begin
[Par.ParamName, Par.ParamName]));
end;
tySet:
{ w (≤32 members) or l (≤64) bitmask — spill at its width. }
if TSetTypeDesc(Par.ResolvedType).BitCount <= 32 then
{ Small set: w (<=32) / l (<=64) bitmask spilled at its width.
Jumbo set: arrives as a pointer; copy into a local bitmap slot. }
if TSetTypeDesc(Par.ResolvedType).IsJumbo() then
begin
EmitLine(Format(' %%_var_%s =l alloc8 %d',
[Par.ParamName, TSetTypeDesc(Par.ResolvedType).RawSize()]));
EmitLine(Format(' call $memcpy(l %%_var_%s, l %%_par_%s, l %d)',
[Par.ParamName, Par.ParamName,
TSetTypeDesc(Par.ResolvedType).RawSize()]));
end
else if TSetTypeDesc(Par.ResolvedType).BitCount <= 32 then
begin
EmitLine(Format(' %%_var_%s =l alloc4 1', [Par.ParamName]));
EmitLine(Format(' storew %%_par_%s, %%_var_%s',
@ -7775,6 +7902,15 @@ begin
begin
if ADecl.ResolvedReturnType.Kind = tyRecord then
EmitRecordReturnPrologue(TRecordTypeDesc(ADecl.ResolvedReturnType), RC)
else if (ADecl.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(ADecl.ResolvedReturnType).IsJumbo() then
begin
{ sret: jumbo-set Result aliases the caller's buffer; zero-init it so a
partial build (Include before full assignment) starts empty. }
EmitLine(' %_var_Result =l copy %_par__sret');
EmitLine(Format(' call $memset(l %%_var_Result, w 0, l %d)',
[TSetTypeDesc(ADecl.ResolvedReturnType).RawSize()]));
end
else if ADecl.ResolvedReturnType.Kind = tyInterface then
begin
{ sret: interface Result is a 16-byte fat pointer (obj+itab) in the
@ -7858,7 +7994,10 @@ begin
begin
if ADecl.ResolvedReturnType.Kind = tyRecord then
EmitRecordReturnEpilogue(TRecordTypeDesc(ADecl.ResolvedReturnType), RC)
else if ADecl.ResolvedReturnType.Kind = tyInterface then
else if (ADecl.ResolvedReturnType.Kind = tyInterface) or
((ADecl.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(ADecl.ResolvedReturnType).IsJumbo()) then
{ sret: the aggregate was written through %_par__sret — return void. }
EmitLine(' ret')
else
begin
@ -8316,37 +8455,61 @@ begin
end
else if UCaseName = 'INCLUDE' then
begin
{ Include(S, elem): S := S or (1 shl ord(elem)) }
SetQT := QbeTypeOf(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetLoad := LoadInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetStore := StoreInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
ArgTemp := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
ArgTemp2 := AllocTemp();
EmitLine(Format(' %s =%s %s %s', [ArgTemp2, SetQT, SetLoad, ArgTemp]));
SizeTemp := EmitExpr(TASTExpr(ACall.Args.Items[1]));
ArgLine := AllocTemp();
EmitLine(Format(' %s =%s shl 1, %s', [ArgLine, SetQT, SizeTemp]));
SizeTemp := AllocTemp();
EmitLine(Format(' %s =%s or %s, %s', [SizeTemp, SetQT, ArgTemp2, ArgLine]));
EmitLine(Format(' %s %s, %s', [SetStore, SizeTemp, ArgTemp]));
{ Jumbo set: in-place bit set via the RTL helper. }
if (TASTExpr(ACall.Args.Items[0]).ResolvedType <> nil) and
(TASTExpr(ACall.Args.Items[0]).ResolvedType.Kind = tySet) and
TSetTypeDesc(TASTExpr(ACall.Args.Items[0]).ResolvedType).IsJumbo() then
begin
ArgTemp := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
SizeTemp := EmitExpr(TASTExpr(ACall.Args.Items[1]));
EmitLine(Format(' call $_SetInclude(l %s, w %s)', [ArgTemp, SizeTemp]));
end
else
begin
{ Include(S, elem): S := S or (1 shl ord(elem)) }
SetQT := QbeTypeOf(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetLoad := LoadInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetStore := StoreInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
ArgTemp := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
ArgTemp2 := AllocTemp();
EmitLine(Format(' %s =%s %s %s', [ArgTemp2, SetQT, SetLoad, ArgTemp]));
SizeTemp := EmitExpr(TASTExpr(ACall.Args.Items[1]));
ArgLine := AllocTemp();
EmitLine(Format(' %s =%s shl 1, %s', [ArgLine, SetQT, SizeTemp]));
SizeTemp := AllocTemp();
EmitLine(Format(' %s =%s or %s, %s', [SizeTemp, SetQT, ArgTemp2, ArgLine]));
EmitLine(Format(' %s %s, %s', [SetStore, SizeTemp, ArgTemp]));
end;
end
else if UCaseName = 'EXCLUDE' then
begin
{ Exclude(S, elem): S := S and (not (1 shl ord(elem))) }
SetQT := QbeTypeOf(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetLoad := LoadInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetStore := StoreInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
ArgTemp := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
ArgTemp2 := AllocTemp();
EmitLine(Format(' %s =%s %s %s', [ArgTemp2, SetQT, SetLoad, ArgTemp]));
SizeTemp := EmitExpr(TASTExpr(ACall.Args.Items[1]));
ArgLine := AllocTemp();
EmitLine(Format(' %s =%s shl 1, %s', [ArgLine, SetQT, SizeTemp]));
SizeTemp := AllocTemp();
EmitLine(Format(' %s =%s xor %s, -1', [SizeTemp, SetQT, ArgLine]));
ArgLine := AllocTemp();
EmitLine(Format(' %s =%s and %s, %s', [ArgLine, SetQT, ArgTemp2, SizeTemp]));
EmitLine(Format(' %s %s, %s', [SetStore, ArgLine, ArgTemp]));
{ Jumbo set: in-place bit clear via the RTL helper. }
if (TASTExpr(ACall.Args.Items[0]).ResolvedType <> nil) and
(TASTExpr(ACall.Args.Items[0]).ResolvedType.Kind = tySet) and
TSetTypeDesc(TASTExpr(ACall.Args.Items[0]).ResolvedType).IsJumbo() then
begin
ArgTemp := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
SizeTemp := EmitExpr(TASTExpr(ACall.Args.Items[1]));
EmitLine(Format(' call $_SetExclude(l %s, w %s)', [ArgTemp, SizeTemp]));
end
else
begin
{ Exclude(S, elem): S := S and (not (1 shl ord(elem))) }
SetQT := QbeTypeOf(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetLoad := LoadInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
SetStore := StoreInstrFor(TASTExpr(ACall.Args.Items[0]).ResolvedType);
ArgTemp := EmitLValueAddr(TASTExpr(ACall.Args.Items[0]));
ArgTemp2 := AllocTemp();
EmitLine(Format(' %s =%s %s %s', [ArgTemp2, SetQT, SetLoad, ArgTemp]));
SizeTemp := EmitExpr(TASTExpr(ACall.Args.Items[1]));
ArgLine := AllocTemp();
EmitLine(Format(' %s =%s shl 1, %s', [ArgLine, SetQT, SizeTemp]));
SizeTemp := AllocTemp();
EmitLine(Format(' %s =%s xor %s, -1', [SizeTemp, SetQT, ArgLine]));
ArgLine := AllocTemp();
EmitLine(Format(' %s =%s and %s, %s', [ArgLine, SetQT, ArgTemp2, SizeTemp]));
EmitLine(Format(' %s %s, %s', [SetStore, ArgLine, ArgTemp]));
end;
end
else if UCaseName = 'DELETEFILE' then
begin
@ -8697,6 +8860,8 @@ var
DataTemp: string;
SQT: string;
PMark: Integer;
SetNB: Integer; { jumbo set bitmap byte count }
SetRS: Integer; { jumbo set slot size (RawSize, 8-rounded) }
begin
PMark := PendingReleaseMark();
if AExpr is TFuncCallExpr then
@ -9856,6 +10021,18 @@ begin
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
{ sret: jumbo-set-returning function — caller allocates a zero-init
bitmap buffer and passes its address as the hidden first parameter. }
if (MDecl.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(MDecl.ResolvedReturnType).IsJumbo() then
begin
SetRS := TSetTypeDesc(MDecl.ResolvedReturnType).RawSize();
SretBuf := AllocTemp();
EmitLine(Format(' %s =l alloc8 %d', [SretBuf, SetRS]));
EmitLine(Format(' call $memset(l %s, w 0, l %d)', [SretBuf, SetRS]));
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
if FC.IsImplicitSelfMethod then
begin
ArgTemp := AllocTemp();
@ -10288,6 +10465,17 @@ begin
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
{ sret: jumbo-set-returning method }
if (MDecl.ResolvedReturnType.Kind = tySet) and
TSetTypeDesc(MDecl.ResolvedReturnType).IsJumbo() then
begin
SetRS := TSetTypeDesc(MDecl.ResolvedReturnType).RawSize();
SretBuf := AllocTemp();
EmitLine(Format(' %s =l alloc8 %d', [SretBuf, SetRS]));
EmitLine(Format(' call $memset(l %s, w 0, l %d)', [SretBuf, SetRS]));
EmitRecordCallSret(AExpr, SretBuf);
Exit(SretBuf);
end;
{ Load the object pointer (Self): either from a named variable or from
evaluating the receiver expression (e.g. a typecast). }
@ -10675,7 +10863,7 @@ begin
end
else
Ptr := L;
if FldAccess.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if IsAggregateAddrType(FldAccess.FieldInfo.TypeDesc) then
Exit(Ptr);
QType := QbeTypeOf(FldAccess.FieldInfo.TypeDesc);
LoadInstr := LoadInstrFor(FldAccess.FieldInfo.TypeDesc);
@ -10769,7 +10957,7 @@ begin
begin
Exit(Ptr);
end;
if FldAccess.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if IsAggregateAddrType(FldAccess.FieldInfo.TypeDesc) then
Exit(Ptr);
QType := QbeTypeOf(FldAccess.FieldInfo.TypeDesc);
LoadInstr := LoadInstrFor(FldAccess.FieldInfo.TypeDesc);
@ -11192,7 +11380,7 @@ begin
below; without this, passing a class-field record/array by value emitted
`loadl` of the field address and passed the first 8 bytes as the
aggregate, crashing the callee.) }
if FldAccess.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if IsAggregateAddrType(FldAccess.FieldInfo.TypeDesc) then
Exit(Ptr);
QType := QbeTypeOf(FldAccess.FieldInfo.TypeDesc);
LoadInstr := LoadInstrFor(FldAccess.FieldInfo.TypeDesc);
@ -11231,7 +11419,7 @@ begin
begin
Exit(Ptr);
end;
if FldAccess.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then
if IsAggregateAddrType(FldAccess.FieldInfo.TypeDesc) then
Exit(Ptr);
QType := QbeTypeOf(FldAccess.FieldInfo.TypeDesc);
LoadInstr := LoadInstrFor(FldAccess.FieldInfo.TypeDesc);
@ -11337,7 +11525,8 @@ begin
end
else if TIdentExpr(AExpr).IsConstant and
((AExpr.ResolvedType = nil) or
(AExpr.ResolvedType.Kind <> tyStaticArray)) then
((AExpr.ResolvedType.Kind <> tyStaticArray) and
not IsAggregateAddrType(AExpr.ResolvedType))) then
begin
if (AExpr.ResolvedType <> nil) and (AExpr.ResolvedType.Kind = tyString) then
begin
@ -11365,7 +11554,7 @@ begin
from that address (no extra pointer hop). }
QType := QbeTypeOf(AExpr.ResolvedType);
if (AExpr.ResolvedType <> nil) and
(AExpr.ResolvedType.Kind in [tyRecord, tyStaticArray]) then
IsAggregateAddrType(AExpr.ResolvedType) then
begin
{ Aggregate: %_cap_Name is the storage address — return directly. }
EmitLine(Format(' %s =l copy %%_cap_%s', [T, TIdentExpr(AExpr).Name]));
@ -11379,9 +11568,16 @@ begin
EmitLine(Format(' %s =w loadw %%_cap_%s', [T, TIdentExpr(AExpr).Name]));
end;
end
else if TIdentExpr(AExpr).ParamMode = pmJumboSetValue then
begin
{ Jumbo set value param: the QBE backend spills it into a local inline
bitmap slot (value semantics), so %_var_X IS the bitmap address —
return it directly without a load. }
Exit(VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal));
end
else if (TIdentExpr(AExpr).ParamMode <> pmNone) and
(AExpr.ResolvedType <> nil) and
(AExpr.ResolvedType.Kind in [tyRecord, tyStaticArray]) then
IsAggregateAddrType(AExpr.ResolvedType) then
begin
{ Var param of aggregate type: the param slot already holds the address
of the caller's storage — load and return that as the storage address. }
@ -11406,7 +11602,7 @@ begin
Exit('$' + TIdentExpr(AExpr).ConstArraySymbol);
end
else if (AExpr.ResolvedType <> nil) and
(AExpr.ResolvedType.Kind in [tyRecord, tyStaticArray]) then
IsAggregateAddrType(AExpr.ResolvedType) then
begin
{ Aggregate variable — return its storage address directly (no load). }
Exit(VarRef(TIdentExpr(AExpr).Name, TIdentExpr(AExpr).IsGlobal));
@ -11577,20 +11773,80 @@ begin
end;
Exit(T);
end;
{ Set membership: elem in SetVar — (set >> ord(elem)) & 1 }
{ Set membership: elem in SetVar }
if BinExpr.Op = boIn then
begin
{ Jumbo set: R is the bitmap address, L the ordinal — _SetIn(R, L). }
if (BinExpr.Right.ResolvedType <> nil) and
(BinExpr.Right.ResolvedType.Kind = tySet) and
TSetTypeDesc(BinExpr.Right.ResolvedType).IsJumbo() then
begin
EmitLine(Format(' %s =w call $_SetIn(l %s, w %s)', [T, R, L]));
Exit(T);
end;
{ Small set: ((set >> ord) & 1) AND (ord < BitCount). The range guard
matters when the set is sized to a literal's max ordinal (e.g.
'X in [low members]') but the tested element's ordinal may exceed the
set width — a shift past the register width is undefined, so the guard
forces a 0 result for out-of-range ordinals. }
SQT := QbeTypeOf(BinExpr.Right.ResolvedType);
ArgTemp := AllocTemp();
EmitLine(Format(' %s =%s shr %s, %s', [ArgTemp, SQT, R, L]));
EmitLine(Format(' %s =w and %s, 1', [T, ArgTemp]));
T2 := AllocTemp();
EmitLine(Format(' %s =w and %s, 1', [T2, ArgTemp]));
ArgTemp := AllocTemp();
EmitLine(Format(' %s =w csltw %s, %d',
[ArgTemp, L, TSetTypeDesc(BinExpr.Right.ResolvedType).BitCount]));
EmitLine(Format(' %s =w and %s, %s', [T, T2, ArgTemp]));
Exit(T);
end;
{ Set arithmetic: union, difference, intersection }
{ Set arithmetic: union, difference, intersection, equality }
if (BinExpr.Left.ResolvedType <> nil) and
(BinExpr.Left.ResolvedType.Kind = tySet) then
begin
{ Jumbo set: L and R are bitmap addresses. Binary set ops write into a
fresh result buffer and return its address; equality returns a w 0/1.
NBytes is the (compile-time) bitmap length. }
if TSetTypeDesc(BinExpr.Left.ResolvedType).IsJumbo() then
begin
SetNB := TSetTypeDesc(BinExpr.Left.ResolvedType).RawByteSize();
SetRS := TSetTypeDesc(BinExpr.Left.ResolvedType).RawSize();
case BinExpr.Op of
boAdd:
begin
EmitLine(Format(' %s =l alloc8 %d', [T, SetRS]));
EmitLine(Format(' call $_SetUnion(l %s, l %s, l %s, w %d)',
[T, L, R, SetNB]));
end;
boSub:
begin
EmitLine(Format(' %s =l alloc8 %d', [T, SetRS]));
EmitLine(Format(' call $_SetDiff(l %s, l %s, l %s, w %d)',
[T, L, R, SetNB]));
end;
boMul:
begin
EmitLine(Format(' %s =l alloc8 %d', [T, SetRS]));
EmitLine(Format(' call $_SetInter(l %s, l %s, l %s, w %d)',
[T, L, R, SetNB]));
end;
boEQ:
EmitLine(Format(' %s =w call $_SetEqual(l %s, l %s, w %d)',
[T, L, R, SetNB]));
boNE:
begin
ArgTemp := AllocTemp();
EmitLine(Format(' %s =w call $_SetEqual(l %s, l %s, w %d)',
[ArgTemp, L, R, SetNB]));
EmitLine(Format(' %s =w ceqw %s, 0', [T, ArgTemp]));
end;
else
raise ECodeGenError.Create(Format(
'Operator not supported for set types at line %d', [BinExpr.Line]));
end;
Exit(T);
end;
SQT := QbeTypeOf(BinExpr.Left.ResolvedType);
case BinExpr.Op of
boAdd: { union: or }
@ -11918,7 +12174,7 @@ begin
For scalar types, load through T to get the actual value. }
T := EmitExpr(TDerefExpr(AExpr).Expr);
if (AExpr.ResolvedType <> nil) and
(AExpr.ResolvedType.Kind in [tyRecord, tyStaticArray]) then
IsAggregateAddrType(AExpr.ResolvedType) then
begin
{ P : ^TRecord — T is already the record's address; no further load }
Result := T;
@ -13839,13 +14095,34 @@ end;
function TCodeGenQBE.EmitSetLiteralExpr(AExpr: TArrayLiteralExpr): string;
var
Mask: Int64;
I: Integer;
Elem: TASTExpr;
IdExpr: TIdentExpr;
Tmp: string;
QT: string;
Mask: Int64;
I: Integer;
Elem: TASTExpr;
IdExpr: TIdentExpr;
Tmp: string;
QT: string;
ElemVal: string;
begin
{ Jumbo set literal: build the bitmap in a fresh stack buffer — memset 0,
then set each member's bit via _SetInclude. Elements may be non-constant
(evaluated at runtime), unlike the small-set fast path. }
if (AExpr.ResolvedType <> nil) and (AExpr.ResolvedType.Kind = tySet) and
TSetTypeDesc(AExpr.ResolvedType).IsJumbo() then
begin
Tmp := AllocTemp();
EmitLine(Format(' %s =l alloc8 %d',
[Tmp, TSetTypeDesc(AExpr.ResolvedType).RawSize()]));
EmitLine(Format(' call $memset(l %s, w 0, l %d)',
[Tmp, TSetTypeDesc(AExpr.ResolvedType).RawSize()]));
for I := 0 to AExpr.Elements.Count - 1 do
begin
Elem := TASTExpr(AExpr.Elements.Items[I]);
ElemVal := EmitExpr(Elem);
EmitLine(Format(' call $_SetInclude(l %s, w %s)', [Tmp, ElemVal]));
end;
Exit(Tmp);
end;
Mask := 0;
for I := 0 to AExpr.Elements.Count - 1 do
begin

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

@ -77,7 +77,8 @@ type
pmNone,
pmVar,
pmRecordValue,
pmStaticArrayValue
pmStaticArrayValue,
pmJumboSetValue { by-value jumbo (>64) set param: by-ref aggregate ABI }
);
TIdentExpr = class(TASTExpr)
@ -271,7 +272,11 @@ type
{ Set iteration path (IsSetIter = True) }
IsSetIter: Boolean;
SetBitCount: Integer; { number of bits in the set (= enum member count) }
SetMaskVarName: string; { synthetic slot holding the evaluated set mask }
SetMaskVarName: string; { synthetic slot: holds the evaluated set mask
(small set), or the set's ADDRESS (jumbo) }
SetIsJumbo: Boolean; { True when the set is >64 members: the slot
holds a pointer and membership is tested via
the _SetIn RTL helper, not a register shift }
destructor Destroy; override;
end;
@ -585,11 +590,19 @@ type
declared set type or the set type inferred from the members' enum. }
IsSet: Boolean;
SetElements: TStringList; { non-nil when IsSet; member ident names }
{ JUMBO (>64-member) set constant: the bitmap as one decimal byte value per
bitmap byte (RawByteSize entries). Set by uSemantic when IsSet and the
set type is jumbo, because the bitmask no longer fits in IntVal (Int64).
Nil for small sets (which keep using IntVal). }
ConstSetBytes: TStringList;
{ 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;
{ Canonical, mangled QBE data-label for a JUMBO set const's byte blob
(mirrors ResolvedQbeName for array consts). Empty otherwise. }
ResolvedSetQbeName: string;
destructor Destroy; override;
end;
@ -2164,6 +2177,20 @@ begin
end;
if ASrc.IntValueExpr <> nil then
Result.IntValueExpr := CloneExpr(ASrc.IntValueExpr);
Result.IsSet := ASrc.IsSet;
if ASrc.SetElements <> nil then
begin
Result.SetElements := TStringList.Create();
for I := 0 to ASrc.SetElements.Count - 1 do
Result.SetElements.Add(ASrc.SetElements.Strings[I]);
end;
if ASrc.ConstSetBytes <> nil then
begin
Result.ConstSetBytes := TStringList.Create();
for I := 0 to ASrc.ConstSetBytes.Count - 1 do
Result.ConstSetBytes.Add(ASrc.ConstSetBytes.Strings[I]);
end;
Result.ResolvedSetQbeName := ASrc.ResolvedSetQbeName;
end;
function CloneMethodParam(ASrc: TMethodParam): TMethodParam;

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

@ -240,6 +240,12 @@ type
function AnalyseStringSubscriptExpr(AExpr: TStringSubscriptExpr): TTypeDesc;
function AnalyseArrayLiteralExpr(AExpr: TArrayLiteralExpr): TTypeDesc;
function AnalyseSetLiteralExpr(AExpr: TArrayLiteralExpr; ASetType: TSetTypeDesc): TTypeDesc;
{ Width (in bits) needed for the anonymous set type of an 'X in [a,b,c]'
literal: largest listed member ordinal + 1 when every element is a
compile-time enum constant; otherwise the full base-enum member count
(conservative). Keeps low-ordinal membership tests off the jumbo path. }
function SetLiteralBitCount(AExpr: TArrayLiteralExpr;
ABaseEnum: TEnumTypeDesc): Integer;
procedure CoerceToCharOrd(ALit: TStringLiteral);
procedure AnalysePointerWriteStmt(AStmt: TPointerWriteStmt);
procedure AnalyseStaticSubscriptAssign(AStmt: TStaticSubscriptAssign);
@ -1887,9 +1893,9 @@ begin
end;
if Members.Count = 0 then
SemanticError('Empty anonymous enumeration in set type', 0, 0);
if Members.Count > 64 then
if Members.Count > 256 then
SemanticError(Format(
'Anonymous enumeration has %d members; set types support at most 64',
'Anonymous enumeration has %d members; set types support at most 256',
[Members.Count]), 0, 0);
{ Reuse an already-synthesised identical enum: if the first member is a
defined enum constant whose enum has exactly these members, return it. }
@ -2042,9 +2048,9 @@ begin
BaseType := FindTypeOrInstantiate(BaseName);
if (BaseType <> nil) and (BaseType.Kind = tyEnum) then
begin
if TEnumTypeDesc(BaseType).Members.Count > 64 then
if TEnumTypeDesc(BaseType).Members.Count > 256 then
SemanticError(Format(
'Enumeration ''%s'' has %d members; set types support at most 64',
'Enumeration ''%s'' has %d members; set types support at most 256',
[BaseType.Name, TEnumTypeDesc(BaseType).Members.Count]), 0, 0);
CanonName := 'set of ' + BaseType.Name;
Result := FTable.FindType(CanonName);
@ -3141,12 +3147,17 @@ var
CanonName: string;
ExistTD: TTypeDesc;
Sym: TSymbol;
Ords: TStringList;
Ord, BIdx, NB, BVal: Integer;
begin
Mask := 0;
EnumDesc := nil;
Ords := TStringList.Create();
{ Resolve each member to an enum constant; OR its bit into the mask and
pin down the shared base enum. }
{ Resolve each member to an enum constant; record its ordinal and pin down
the shared base enum. The bitmask (small set) or byte bitmap (jumbo set)
is built AFTER the set type is known, so we never `shl` by an ordinal >= 64
(undefined) before we know whether the set is jumbo. }
for I := 0 to ACD.SetElements.Count - 1 do
begin
MemName := ACD.SetElements.Strings[I];
@ -3168,7 +3179,7 @@ begin
[ACD.Name, EnumDesc.Name, MemSym.TypeDesc.Name]), ACD.Line, ACD.Col);
Exit;
end;
Mask := Mask or (Int64(1) shl MemSym.ConstValue);
Ords.Add(IntToStr(MemSym.ConstValue));
end;
{ Determine the set type descriptor. }
@ -3196,9 +3207,9 @@ begin
end
else if EnumDesc <> nil then
begin
if EnumDesc.Members.Count > 64 then
if EnumDesc.Members.Count > 256 then
SemanticError(
Format('Enumeration ''%s'' has %d members; set types support at most 64',
Format('Enumeration ''%s'' has %d members; set types support at most 256',
[EnumDesc.Name, EnumDesc.Members.Count]),
ACD.Line, ACD.Col);
{ Inferred set type: find or create the canonical 'set of <Enum>'. }
@ -3221,9 +3232,40 @@ begin
Exit;
end;
ACD.IntVal := Mask;
Sym := TSymbol.Create(ACD.Name, skConstant, SetDesc);
Sym.ConstValue := Mask;
Sym := TSymbol.Create(ACD.Name, skConstant, SetDesc);
if SetDesc.IsJumbo() then
begin
{ Jumbo set const: build a byte-array bitmap; the mask can't fit in Int64. }
NB := SetDesc.RawByteSize();
ACD.ConstSetBytes := TStringList.Create();
for I := 0 to NB - 1 do
ACD.ConstSetBytes.Add('0');
for I := 0 to Ords.Count - 1 do
begin
Ord := StrToInt(Ords.Strings[I]);
BIdx := Ord shr 3;
BVal := StrToInt(ACD.ConstSetBytes.Strings[BIdx]) or (1 shl (Ord and 7));
ACD.ConstSetBytes.Put(BIdx, IntToStr(BVal));
end;
Sym.ConstSetBytes := TStringList.Create();
for I := 0 to ACD.ConstSetBytes.Count - 1 do
Sym.ConstSetBytes.Add(ACD.ConstSetBytes.Strings[I]);
{ Mangled, file-local data label for the bitmap blob (mirrors array
consts), shared by the decl and the symbol so reads resolve to it. }
if ACD.ResolvedSetQbeName = '' then
ACD.ResolvedSetQbeName := Self.NewArrayConstLabel(ACD.Name);
Sym.ConstSetQbe := ACD.ResolvedSetQbeName;
ACD.IntVal := 0;
Sym.ConstValue := 0;
end
else
begin
{ Small set: pack into the Int64 bitmask (existing fast path). }
for I := 0 to Ords.Count - 1 do
Mask := Mask or (Int64(1) shl StrToInt(Ords.Strings[I]));
ACD.IntVal := Mask;
Sym.ConstValue := Mask;
end;
if not FTable.Define(Sym) then
Sym.Free(); { duplicate — cross-unit shadowing tolerated, like scalar consts }
end;
@ -3590,9 +3632,9 @@ begin
SemanticError(
Format('Set base type ''%s'' must be an enumeration type', [SetDef.BaseTypeName]),
TD.Line, TD.Col);
if TEnumTypeDesc(BaseSym.TypeDesc).Members.Count > 64 then
if TEnumTypeDesc(BaseSym.TypeDesc).Members.Count > 256 then
SemanticError(
Format('Enumeration ''%s'' has %d members; set types support at most 64',
Format('Enumeration ''%s'' has %d members; set types support at most 256',
[SetDef.BaseTypeName, TEnumTypeDesc(BaseSym.TypeDesc).Members.Count]),
TD.Line, TD.Col);
SetDesc := FTable.NewSetType(TD.Name, TEnumTypeDesc(BaseSym.TypeDesc));
@ -5595,6 +5637,7 @@ begin
ForInS.IsSetIter := True;
ForInS.ResolvedVarType := ElemType;
ForInS.SetBitCount := TSetTypeDesc(CollType).BitCount;
ForInS.SetIsJumbo := TSetTypeDesc(CollType).IsJumbo();
{ Inject synthetic mask slot for the evaluated set value }
ForInS.SetMaskVarName := '__setmask_' + IntToStr(FForInCounter);
@ -5605,7 +5648,14 @@ begin
begin
SynthDecl := TVarDecl.Create();
SynthDecl.Names.Add(ForInS.SetMaskVarName);
if TSetTypeDesc(CollType).BitCount > 32 then
if ForInS.SetIsJumbo then
begin
{ Jumbo: the slot holds the set's ADDRESS (pointer-sized), not a mask;
membership is tested per-ordinal via the _SetIn RTL helper. }
SynthDecl.TypeName := 'Int64';
SynthDecl.ResolvedType := FTable.TypeInt64;
end
else if TSetTypeDesc(CollType).BitCount > 32 then
begin
SynthDecl.TypeName := 'Int64';
SynthDecl.ResolvedType := FTable.TypeInt64;
@ -8709,6 +8759,9 @@ begin
else if (Sym.Kind = skParameter) and (Sym.TypeDesc <> nil) and
(Sym.TypeDesc.Kind = tyStaticArray) then
TIdentExpr(AExpr).ParamMode := pmStaticArrayValue
else if (Sym.Kind = skParameter) and (Sym.TypeDesc <> nil) and
(Sym.TypeDesc.Kind = tySet) and TSetTypeDesc(Sym.TypeDesc).IsJumbo() then
TIdentExpr(AExpr).ParamMode := pmJumboSetValue
else
TIdentExpr(AExpr).ParamMode := pmNone;
TIdentExpr(AExpr).IsGlobal := Sym.IsGlobal;
@ -8723,6 +8776,10 @@ begin
not $Name, to avoid link collisions. }
if (Sym.ConstArray <> nil) and (Sym.ConstArrayQbe <> '') then
TIdentExpr(AExpr).ConstArraySymbol := Sym.ConstArrayQbe;
{ Jumbo set const referenced bare: same mangled-label mechanism — the read
resolves to the bitmap blob's address via the aggregate-read path. }
if (Sym.ConstSetBytes <> nil) and (Sym.ConstSetQbe <> '') then
TIdentExpr(AExpr).ConstArraySymbol := Sym.ConstSetQbe;
{ Bare class type identifier used as a value: metaclass reference.
The result type is 'class of TFoo'; codegen emits the typeinfo
address. Compatibility with untyped Pointer (so 'Pointer(EError)'
@ -9315,11 +9372,19 @@ begin
if ABin.Op = boIn then
begin
{ Coerce array literal [a, b, c] to an anonymous set type when the left
operand is an enum — handles the common 'x in [A, B, C]' idiom. }
operand is an enum — handles the common 'x in [A, B, C]' idiom.
Size the anonymous set by the largest ORDINAL actually listed (when all
elements are compile-time enum constants), not the full enum's member
count. This keeps 'Kind in [low members]' on the fast <=64-bit register
path even when the base enum has more than 64 members, and only widens to
a jumbo set when a listed member's ordinal is itself >= 64. Elements that
are not constant fall back to the full enum size (conservative). }
if (ABin.Right is TArrayLiteralExpr) and (LType.Kind = tyEnum) then
begin
TmpSet := FTable.NewSetType('', TEnumTypeDesc(LType));
RType := AnalyseSetLiteralExpr(TArrayLiteralExpr(ABin.Right), TmpSet);
TmpSet.BitCount := SetLiteralBitCount(TArrayLiteralExpr(ABin.Right),
TEnumTypeDesc(LType));
end;
if RType.Kind <> tySet then
SemanticError(
@ -10122,6 +10187,33 @@ begin
AExpr.ResolvedType := Result;
end;
function TSemanticAnalyser.SetLiteralBitCount(AExpr: TArrayLiteralExpr;
ABaseEnum: TEnumTypeDesc): Integer;
var
I, MaxOrd: Integer;
Elem: TASTExpr;
begin
MaxOrd := -1;
for I := 0 to AExpr.Elements.Count - 1 do
begin
Elem := TASTExpr(AExpr.Elements.Items[I]);
{ Only compile-time enum constants have a known ordinal. Any non-constant
element forces the conservative full-enum width. }
if (Elem is TIdentExpr) and TIdentExpr(Elem).IsConstant then
begin
if TIdentExpr(Elem).ConstValue > MaxOrd then
MaxOrd := TIdentExpr(Elem).ConstValue;
end
else
Exit(ABaseEnum.Members.Count);
end;
{ Empty literal -> width 1 (a single zero byte fits any small set). }
if MaxOrd < 0 then
Result := 1
else
Result := MaxOrd + 1;
end;
function TSemanticAnalyser.AnalyseSetLiteralExpr(AExpr: TArrayLiteralExpr;
ASetType: TSetTypeDesc): TTypeDesc;
{ Validates a set literal [elem, ...] against ASetType.

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

@ -124,12 +124,25 @@ type
end;
{ Set type descriptor. BaseType is the element enum; BitCount is the number
of bits required (= BaseType.Members.Count). Stored as QBE 'w' for ≤32
members, 'l' for 33–64. Each member ordinal N maps to bit (1 shl N). }
of bits required (= BaseType.Members.Count). Each member ordinal N maps to
bit N of the bitmap. Representation depends on BitCount:
BitCount <= 32 -> QBE 'w' (32-bit register), bit (1 shl N)
BitCount <= 64 -> QBE 'l' (64-bit register), bit (1 shl N)
BitCount > 64 -> JUMBO: an inline byte-array bitmap of RawByteSize
bytes, treated as an aggregate (like a record): bit N
lives at byte (N shr 3), mask (1 shl (N and 7)).
Operated on via the _Set* RTL helpers, never a single
register. Max 256 members -> 32 bytes. }
TSetTypeDesc = class(TTypeDesc)
public
[Unretained] BaseType: TEnumTypeDesc; { not owned }
BitCount: Integer; { = BaseType.Members.Count }
{ True when this set is too wide for a single 64-bit register and must use
the inline byte-array (aggregate) representation + _Set* RTL helpers. }
function IsJumbo: Boolean;
{ Number of bitmap bytes for the jumbo representation = ceil(BitCount/8).
Only meaningful when IsJumbo; <= 32 for the 256-member ceiling. }
function RawByteSize: Integer;
end;
{ One parameter of a procedural type signature. }
@ -336,6 +349,12 @@ type
ConstArray: TStringList; { owned; non-nil for array-typed const; raw element values }
ConstArrayQbe: string; { canonical QBE data-label for an array const; mangled
to avoid collisions across scopes and with the RTL }
ConstSetBytes: TStringList; { owned; non-nil for a JUMBO (>64-member) set
const; one decimal byte value per bitmap byte
(RawByteSize entries). Small sets keep using
ConstValue (the Int64 mask) instead. }
ConstSetQbe: string; { canonical, mangled QBE data-label for a jumbo set
const's byte blob (mirrors ConstArrayQbe) }
IsWeak: Boolean; { true for variables declared [Weak]; codegen
keys off this to emit _WeakAssign instead
of the strong addref/release pattern. }
@ -627,6 +646,16 @@ begin
Result := Kind = tyRecord;
end;
function TSetTypeDesc.IsJumbo: Boolean;
begin
Result := BitCount > 64;
end;
function TSetTypeDesc.RawByteSize: Integer;
begin
Result := (BitCount + 7) div 8;
end;
function TTypeDesc.RawSize: Integer;
begin
case Kind of
@ -636,7 +665,10 @@ begin
tyInt64, tyUInt64, tyString, tyClass, tyPointer, tyNil, tyDouble: Result := 8;
tySingle: Result := 4;
tyRecord: Result := TRecordTypeDesc(Self).TotalSize();
tySet: if TSetTypeDesc(Self).BitCount <= 32 then Result := 4 else Result := 8;
tySet:
if TSetTypeDesc(Self).BitCount <= 32 then Result := 4
else if TSetTypeDesc(Self).BitCount <= 64 then Result := 8
else Result := (TSetTypeDesc(Self).RawByteSize() + 7) and (not 7);
tyStaticArray:
Result := (TStaticArrayTypeDesc(Self).HighBound -
TStaticArrayTypeDesc(Self).LowBound + 1) *
@ -662,7 +694,10 @@ begin
tyNil: Result := 8;
tyDouble: Result := 8;
tySingle: Result := 4;
tySet: if TSetTypeDesc(Self).BitCount <= 32 then Result := 4 else Result := 8;
tySet:
if TSetTypeDesc(Self).BitCount <= 32 then Result := 4
else if TSetTypeDesc(Self).BitCount <= 64 then Result := 8
else Result := (TSetTypeDesc(Self).RawByteSize() + 7) and (not 7);
tyStaticArray:
Result := (TStaticArrayTypeDesc(Self).HighBound -
TStaticArrayTypeDesc(Self).LowBound + 1) *
@ -685,6 +720,8 @@ begin
tySingle: Result := 4;
tyInt64, tyUInt64, tyString: Result := 8;
tyRecord: Result := TRecordTypeDesc(Self).MaxAlign();
{ Sets: 4-byte alignment for the 32-bit register form, else 8 (the 64-bit
register form and the jumbo byte-array, which we keep 8-aligned). }
tySet: if TSetTypeDesc(Self).BitCount <= 32 then Result := 4 else Result := 8;
tyStaticArray: Result := TStaticArrayTypeDesc(Self).ElementType.AllocAlign();
else

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

@ -72,6 +72,8 @@ uses
cp.test.defaultargs,
cp.test.caseenum,
cp.test.sets,
cp.test.jumboset,
cp.test.e2e.jumboset,
cp.test.selfhosting,
cp.test.process,
cp.test.openarray,

170
compiler/src/test/pascal/cp.test.e2e.jumboset.pas Normal file
View file

@ -0,0 +1,170 @@
{
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.jumboset;
{ E2E tests for JUMBO sets (set of an enum with >64 members): compile -> run,
assert stdout, on BOTH backends (QBE + native) via AssertRunsOnAll. Covers
membership across the >64 boundary, Include/Exclude, union/intersection/
difference, equality, for-in, value params, sret returns, and a jumbo
constant consumed at runtime. }
interface
uses
classes, blaise.testing, cp.test.e2e.base;
type
[Threaded]
TE2EJumboSetTests = class(TE2ETestCase)
protected
procedure SetUp; override;
published
procedure TestRun_IncludeMembership_AcrossBoundary;
procedure TestRun_SetOps_UnionInterDiff;
procedure TestRun_Equality;
procedure TestRun_ForIn_CountsMembers;
procedure TestRun_Param_And_Return;
procedure TestRun_Constant;
end;
implementation
const
LE = #10;
{ 80-member enum shared by the test programs. }
ENUMHDR =
'''
type TBig = (b00,b01,b02,b03,b04,b05,b06,b07,b08,b09,b10,b11,b12,b13,b14,b15,
b16,b17,b18,b19,b20,b21,b22,b23,b24,b25,b26,b27,b28,b29,b30,b31,
b32,b33,b34,b35,b36,b37,b38,b39,b40,b41,b42,b43,b44,b45,b46,b47,
b48,b49,b50,b51,b52,b53,b54,b55,b56,b57,b58,b59,b60,b61,b62,b63,
b64,b65,b66,b67,b68,b69,b70,b71,b72,b73,b74,b75,b76,b77,b78,b79);
TBigSet = set of TBig;
''';
procedure TE2EJumboSetTests.SetUp;
begin
inherited SetUp();
SetUpScratch('compiler/target/test-e2e-jumboset');
end;
procedure TE2EJumboSetTests.TestRun_IncludeMembership_AcrossBoundary;
var Src: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
Src := 'program P;' + LE + ENUMHDR + LE +
'var s: TBigSet;' + LE +
'begin' + LE +
' s := [];' + LE +
' Include(s, b70);' + LE +
' Include(s, b05);' + LE +
' WriteLn(b70 in s);' + LE + { True }
' WriteLn(b71 in s);' + LE + { False }
' WriteLn(b05 in s);' + LE + { True }
' Exclude(s, b70);' + LE +
' WriteLn(b70 in s)' + LE + { False }
'end.';
AssertRunsOnAll(Src, 'True' + LE + 'False' + LE + 'True' + LE + 'False' + LE, 0);
end;
procedure TE2EJumboSetTests.TestRun_SetOps_UnionInterDiff;
var Src: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
Src := 'program P;' + LE + ENUMHDR + LE +
'var a, b, c: TBigSet;' + LE +
'begin' + LE +
' a := [b05, b70];' + LE +
' b := [b05, b40];' + LE +
' c := a + b;' + LE +
' WriteLn(b05 in c, b40 in c, b70 in c);' + LE + { True True True }
' c := a * b;' + LE +
' WriteLn(b05 in c, b40 in c, b70 in c);' + LE + { True False False }
' c := a - b;' + LE +
' WriteLn(b05 in c, b70 in c)' + LE + { False True }
'end.';
AssertRunsOnAll(Src,
'TrueTrueTrue' + LE + 'TrueFalseFalse' + LE + 'FalseTrue' + LE, 0);
end;
procedure TE2EJumboSetTests.TestRun_Equality;
var Src: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
Src := 'program P;' + LE + ENUMHDR + LE +
'var a, b: TBigSet;' + LE +
'begin' + LE +
' a := [b70, b05];' + LE +
' b := [b05, b70];' + LE +
' WriteLn(a = b);' + LE + { True }
' Include(b, b79);' + LE +
' WriteLn(a = b);' + LE + { False }
' WriteLn(a <> b)' + LE + { True }
'end.';
AssertRunsOnAll(Src, 'True' + LE + 'False' + LE + 'True' + LE, 0);
end;
procedure TE2EJumboSetTests.TestRun_ForIn_CountsMembers;
var Src: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
Src := 'program P;' + LE + ENUMHDR + LE +
'var s: TBigSet; e: TBig; n: Integer;' + LE +
'begin' + LE +
' s := [b05, b40, b70, b79];' + LE +
' n := 0;' + LE +
' for e in s do n := n + 1;' + LE +
' WriteLn(n);' + LE + { 4 }
' for e in s do Write(Ord(e), '' '');' + LE +
' WriteLn' + LE +
'end.';
AssertRunsOnAll(Src, '4' + LE + '5 40 70 79 ' + LE, 0);
end;
procedure TE2EJumboSetTests.TestRun_Param_And_Return;
var Src: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
Src := 'program P;' + LE + ENUMHDR + LE +
'function HasHigh(const x: TBigSet): Boolean;' + LE +
'begin Result := b70 in x; end;' + LE +
'function MakeSet: TBigSet;' + LE +
'begin Result := [b65, b70]; end;' + LE +
'var s: TBigSet;' + LE +
'begin' + LE +
' s := [b70, b05];' + LE +
' WriteLn(HasHigh(s));' + LE + { True }
' s := [b05];' + LE +
' WriteLn(HasHigh(s));' + LE + { False }
' s := MakeSet();' + LE +
' WriteLn(b65 in s, b70 in s, b05 in s)' + LE + { True True False }
'end.';
AssertRunsOnAll(Src,
'True' + LE + 'False' + LE + 'TrueTrueFalse' + LE, 0);
end;
procedure TE2EJumboSetTests.TestRun_Constant;
var Src: string;
begin
if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit end;
Src := 'program P;' + LE + ENUMHDR + LE +
'const HIGHS: TBigSet = [b65, b70, b79];' + LE +
'var s: TBigSet;' + LE +
'begin' + LE +
' s := HIGHS;' + LE +
' WriteLn(b65 in s, b70 in s, b79 in s, b00 in s)' + LE + { True True True False }
'end.';
AssertRunsOnAll(Src, 'TrueTrueTrueFalse' + LE, 0);
end;
initialization
RegisterTest(TE2EJumboSetTests);
end.

189
compiler/src/test/pascal/cp.test.jumboset.pas Normal file
View file

@ -0,0 +1,189 @@
{
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.jumboset;
{ IR unit tests for JUMBO sets — `set of <enum>` whose enum has more than 64
members (up to the 256 ceiling). Jumbo sets are inline byte-array bitmaps
operated on via the _Set* RTL helpers, unlike <=64-member sets which stay in
a w/l register. These tests assert the generated QBE IR routes jumbo set
operations to the helper calls and that a <=64 set in the same file still
uses the register path (regression). }
interface
uses
Classes, SysUtils, blaise.testing,
uLexer, uParser, uAST, uSymbolTable, uSemantic, blaise.codegen.qbe;
type
TJumboSetTests = class(TTestCase)
private
function GenIR(const ASrc: string): string;
published
procedure TestSlot_SizedToBitmap;
procedure TestZeroInit_UsesMemset;
procedure TestIn_CallsSetIn;
procedure TestUnion_CallsSetUnion;
procedure TestInter_CallsSetInter;
procedure TestDiff_CallsSetDiff;
procedure TestEqual_CallsSetEqual;
procedure TestInclude_CallsSetInclude;
procedure TestExclude_CallsSetExclude;
procedure TestAssignment_UsesMemcpy;
procedure TestConst_EmitsByteBlob;
procedure TestSmallSet_StillUsesRegister;
end;
implementation
const
{ An 80-member enum (b00..b79) — clears the 64 boundary cheaply. }
EnumDecl =
' TBig = (b00,b01,b02,b03,b04,b05,b06,b07,b08,b09,b10,b11,b12,b13,b14,b15,' + #10 +
' b16,b17,b18,b19,b20,b21,b22,b23,b24,b25,b26,b27,b28,b29,b30,b31,' + #10 +
' b32,b33,b34,b35,b36,b37,b38,b39,b40,b41,b42,b43,b44,b45,b46,b47,' + #10 +
' b48,b49,b50,b51,b52,b53,b54,b55,b56,b57,b58,b59,b60,b61,b62,b63,' + #10 +
' b64,b65,b66,b67,b68,b69,b70,b71,b72,b73,b74,b75,b76,b77,b78,b79);' + #10 +
' TBigSet = set of TBig;' + #10;
function TJumboSetTests.GenIR(const ASrc: string): string;
var
Lex: TLexer;
Par: TParser;
SA: TSemanticAnalyser;
CG: TCodeGenQBE;
Prog: TProgram;
begin
Lex := TLexer.Create(ASrc);
Par := TParser.Create(Lex);
Prog := Par.Parse();
Par.Free(); Lex.Free();
SA := TSemanticAnalyser.Create();
SA.Analyse(Prog);
SA.Free();
CG := TCodeGenQBE.Create();
CG.Generate(Prog);
Result := CG.GetOutput();
CG.Free();
Prog.Free();
end;
procedure TJumboSetTests.TestSlot_SizedToBitmap;
var IR: string;
begin
{ 80 bits -> 10 bytes -> rounded to 16: the global slot is a 16-byte blob. }
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var s: TBigSet;' + #10 + 'begin end.');
AssertTrue('jumbo global emits a 16-byte zero blob',
Pos('$s = { z 16 }', IR) >= 0);
end;
procedure TJumboSetTests.TestZeroInit_UsesMemset;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'procedure Q; var s: TBigSet; begin s := []; end;' + #10 +
'begin end.');
AssertTrue('jumbo local zero-init via memset', Pos('call $memset', IR) >= 0);
end;
procedure TJumboSetTests.TestIn_CallsSetIn;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var s: TBigSet; b: Boolean;' + #10 +
'begin b := b70 in s; end.');
AssertTrue('jumbo in -> _SetIn', Pos('call $_SetIn(', IR) >= 0);
end;
procedure TJumboSetTests.TestUnion_CallsSetUnion;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var a, b, c: TBigSet;' + #10 + 'begin c := a + b; end.');
AssertTrue('jumbo + -> _SetUnion', Pos('call $_SetUnion(', IR) >= 0);
end;
procedure TJumboSetTests.TestInter_CallsSetInter;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var a, b, c: TBigSet;' + #10 + 'begin c := a * b; end.');
AssertTrue('jumbo * -> _SetInter', Pos('call $_SetInter(', IR) >= 0);
end;
procedure TJumboSetTests.TestDiff_CallsSetDiff;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var a, b, c: TBigSet;' + #10 + 'begin c := a - b; end.');
AssertTrue('jumbo - -> _SetDiff', Pos('call $_SetDiff(', IR) >= 0);
end;
procedure TJumboSetTests.TestEqual_CallsSetEqual;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var a, b: TBigSet; x: Boolean;' + #10 +
'begin x := a = b; end.');
AssertTrue('jumbo = -> _SetEqual', Pos('call $_SetEqual(', IR) >= 0);
end;
procedure TJumboSetTests.TestInclude_CallsSetInclude;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var s: TBigSet;' + #10 + 'begin Include(s, b70); end.');
AssertTrue('jumbo Include -> _SetInclude', Pos('call $_SetInclude(', IR) >= 0);
end;
procedure TJumboSetTests.TestExclude_CallsSetExclude;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var s: TBigSet;' + #10 + 'begin Exclude(s, b70); end.');
AssertTrue('jumbo Exclude -> _SetExclude', Pos('call $_SetExclude(', IR) >= 0);
end;
procedure TJumboSetTests.TestAssignment_UsesMemcpy;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'var a, b: TBigSet;' + #10 + 'begin a := b; end.');
AssertTrue('jumbo assignment via memcpy', Pos('call $memcpy', IR) >= 0);
end;
procedure TJumboSetTests.TestConst_EmitsByteBlob;
var IR: string;
begin
IR := GenIR('program P;' + #10 + 'type' + #10 + EnumDecl +
'const H: TBigSet = [b65, b70, b79];' + #10 +
'var s: TBigSet;' + #10 + 'begin s := H; end.');
{ 80-bit bitmap blob: a data item of `b` bytes; byte 8 holds bits for 65,70. }
AssertTrue('jumbo const emits a byte blob', Pos('data $', IR) >= 0);
AssertTrue('blob contains byte directives', Pos('b 66', IR) >= 0);
end;
procedure TJumboSetTests.TestSmallSet_StillUsesRegister;
var IR: string;
begin
{ A <=64 set in the same shape must NOT use the _Set* helpers — it stays a
register bitmask. }
IR := GenIR('program P;' + #10 +
'type TSmall = (s0,s1,s2,s3); TSmallSet = set of TSmall;' + #10 +
'var s: TSmallSet; b: Boolean;' + #10 +
'begin s := [s1]; b := s1 in s; end.');
AssertTrue('small set does not call _SetIn', Pos('call $_SetIn', IR) < 0);
AssertTrue('small set does not call _SetUnion', Pos('call $_SetUnion', IR) < 0);
end;
initialization
RegisterTest(TJumboSetTests);
end.

48
compiler/src/test/pascal/cp.test.sets.pas
View file

@ -100,7 +100,7 @@ type
{ 64-bit sets (>32 members) }
{ ------------------------------------------------------------------ }
procedure TestSemantic_Set64_TypeRegistered;
procedure TestSemantic_Set64_TooManyMembers_Fails;
procedure TestSemantic_Set_Over256Members_Fails;
procedure TestCodegen_Set64_VarAllocsEmitsLongZero;
procedure TestCodegen_Set64_LiteralEmitsLongMask;
procedure TestCodegen_Set64_InOperatorUsesLong;
@ -549,15 +549,39 @@ const
program P;
type
THuge = (
A00, A01, A02, A03, A04, A05, A06, A07,
A08, A09, A10, A11, A12, A13, A14, A15,
A16, A17, A18, A19, A20, A21, A22, A23,
A24, A25, A26, A27, A28, A29, A30, A31,
A32, A33, A34, A35, A36, A37, A38, A39,
A40, A41, A42, A43, A44, A45, A46, A47,
A48, A49, A50, A51, A52, A53, A54, A55,
A56, A57, A58, A59, A60, A61, A62, A63,
A64);
A000, A001, A002, A003, A004, A005, A006, A007,
A008, A009, A010, A011, A012, A013, A014, A015,
A016, A017, A018, A019, A020, A021, A022, A023,
A024, A025, A026, A027, A028, A029, A030, A031,
A032, A033, A034, A035, A036, A037, A038, A039,
A040, A041, A042, A043, A044, A045, A046, A047,
A048, A049, A050, A051, A052, A053, A054, A055,
A056, A057, A058, A059, A060, A061, A062, A063,
A064, A065, A066, A067, A068, A069, A070, A071,
A072, A073, A074, A075, A076, A077, A078, A079,
A080, A081, A082, A083, A084, A085, A086, A087,
A088, A089, A090, A091, A092, A093, A094, A095,
A096, A097, A098, A099, A100, A101, A102, A103,
A104, A105, A106, A107, A108, A109, A110, A111,
A112, A113, A114, A115, A116, A117, A118, A119,
A120, A121, A122, A123, A124, A125, A126, A127,
A128, A129, A130, A131, A132, A133, A134, A135,
A136, A137, A138, A139, A140, A141, A142, A143,
A144, A145, A146, A147, A148, A149, A150, A151,
A152, A153, A154, A155, A156, A157, A158, A159,
A160, A161, A162, A163, A164, A165, A166, A167,
A168, A169, A170, A171, A172, A173, A174, A175,
A176, A177, A178, A179, A180, A181, A182, A183,
A184, A185, A186, A187, A188, A189, A190, A191,
A192, A193, A194, A195, A196, A197, A198, A199,
A200, A201, A202, A203, A204, A205, A206, A207,
A208, A209, A210, A211, A212, A213, A214, A215,
A216, A217, A218, A219, A220, A221, A222, A223,
A224, A225, A226, A227, A228, A229, A230, A231,
A232, A233, A234, A235, A236, A237, A238, A239,
A240, A241, A242, A243, A244, A245, A246, A247,
A248, A249, A250, A251, A252, A253, A254, A255,
A256);
THugeSet = set of THuge;
begin
end.
@ -1069,8 +1093,10 @@ begin
SemanticOK(SrcSet64TypeDecl);
end;
procedure TSetTests.TestSemantic_Set64_TooManyMembers_Fails;
procedure TSetTests.TestSemantic_Set_Over256Members_Fails;
begin
{ 257 members exceeds the 256 ceiling — the largest set Blaise supports
(a jumbo byte-array bitmap of up to 32 bytes). }
SemanticFail(SrcSetTooManyMembers);
end;

15
docs/grammar.ebnf
View file

@ -647,11 +647,16 @@ SetType
= SET OF ( IDENT | EnumDef )
;
(* The base enumeration must have at most 64 members. Sets with up to 32
* members occupy 4 bytes (QBE 'w'); sets with 33–64 members occupy 8 bytes
* (QBE 'l'). Each member ordinal N maps to bit (1 shl N) in the bitmask.
* Enumerations with more than 64 members are rejected by the semantic
* analyser — extending to 256 (byte-array sets) is a future goal. *)
(* The base enumeration must have at most 256 members. Storage scales with the
* member count:
* <= 32 members : 4 bytes, a QBE 'w' register bitmask
* <= 64 members : 8 bytes, a QBE 'l' register bitmask
* <= 256 members: an inline byte-array bitmap of ceil(N/8) bytes (a "jumbo"
* set), operated on via the _Set* RTL helpers like an
* aggregate (record/static array)
* Member ordinal N maps to bit (N mod 8) of byte (N div 8) in all forms.
* Enumerations with more than 256 members are rejected by the semantic
* analyser (256 is the classic Pascal maximum, matching a byte-indexed set). *)
(* Procedural type — bare or method pointer.
*

43
docs/language-rationale.adoc
View file

@ -1280,16 +1280,45 @@ bitmask in which bit N is set when the enum member with ordinal N is included.
==== Storage model
- ≤ 32 enum members: stored as a single QBE `w` (32-bit word).
- 33–64 members: stored as a single QBE `l` (64-bit long).
- More than 64 members: rejected by the semantic analyser. QBE has no 128-bit
integer type, so supporting 65–256 elements would require a byte-array
representation — deferred until a real use case arises. FPC/Delphi support
up to 256 with a 32-byte fixed-size set, but 64 covers the vast majority of
real-world enum sets.
Storage scales with the enum member count, so the common small-set case stays a
single fast machine register and larger sets remain correct:
- ≤ 32 enum members: a single QBE `w` (32-bit word) register bitmask.
- 33–64 members: a single QBE `l` (64-bit long) register bitmask.
- 65–256 members ("jumbo" sets): an inline byte-array bitmap of `ceil(N/8)`
bytes (≤ 32 for the 256-member ceiling). QBE has no integer type wider than
`l`, so a jumbo set cannot live in one register; it is treated as a value
aggregate (like a record or static array) — passed by reference, returned via
sret, zero-initialised with `memset`, copied with `memcpy` — and its
operations (`in`, `+`, `-`, `*`, `=`, `<>`, `Include`, `Exclude`, `for..in`)
are performed by the `_Set*` RTL helpers in `blaise_set.pas` rather than
inline register instructions.
- More than 256 members: rejected by the semantic analyser. 256 is the classic
Pascal maximum — a byte-indexed set covering ordinals 0..255 — matching FPC's
32-byte fixed-size set.
In every form, member ordinal N occupies bit `N mod 8` of byte `N div 8`, so
the bitmap layout is identical whether the set lives in a register or memory.
Sets are value types (copied on assignment), not heap-allocated.
The Java `EnumSet` design is the closest analogue: ≤ 64 members use a single
machine word (`RegularEnumSet`), and a wider universe transparently switches to
a multi-word bitmap (`JumboEnumSet`) with the same operations applied across the
words.
==== Set literal sizing (`X in [a, b, c]`)
The anonymous set type synthesised for an `in`-literal is sized to the **largest
ordinal actually listed** (when every element is a compile-time constant), not
the base enum's full member count. So `Token in [tkBegin, tkEnd]` over an
86-member token enum stays a fast register set, and only widens to a jumbo set
if a listed member's own ordinal is ≥ 64. The register membership test carries
a range guard so that testing an element whose ordinal exceeds the set's width
correctly yields `False` (rather than relying on an out-of-range shift). This
keeps the compiler's own pervasive `Kind in [...]` token tests off the jumbo
path and avoids a latent miscompile that the old fixed-`l` representation hid
(any listed ordinal ≥ 64 was silently dropped).
==== Set literals and disambiguation
Set literals use the same `[elem, ...]` bracket notation as array literals.

5
runtime/Makefile
View file

@ -34,6 +34,7 @@ ASM_OBJS = $(OBJ_DIR)/blaise_setjmp_x86_64.o \
# Pascal RTL units compiled via the Blaise compiler.
PAS_OBJS = $(OBJ_DIR)/blaise_mem.o \
$(OBJ_DIR)/blaise_str.o \
$(OBJ_DIR)/blaise_set.o \
$(OBJ_DIR)/blaise_arc.o \
$(OBJ_DIR)/blaise_weak.o \
$(OBJ_DIR)/blaise_float.o \
@ -64,6 +65,10 @@ $(OBJ_DIR)/blaise_str.o: $(PAS_SRC_DIR)/blaise_str.pas
@mkdir -p $(OBJ_DIR)
$(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@
$(OBJ_DIR)/blaise_set.o: $(PAS_SRC_DIR)/blaise_set.pas
@mkdir -p $(OBJ_DIR)
$(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@
$(OBJ_DIR)/blaise_arc.o: $(PAS_SRC_DIR)/blaise_arc.pas
@mkdir -p $(OBJ_DIR)
$(BLAISE) --source $< --unit-path $(PAS_SRC_DIR) --output $@

164
runtime/src/main/pascal/blaise_set.pas Normal file
View file

@ -0,0 +1,164 @@
{
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.
}
{
Blaise RTL — jumbo set operations.
A "jumbo" set is a `set of <enum>` whose element enum has more than 64
members (up to the 256 ceiling). It cannot fit in a single CPU register,
so it is represented as an inline byte-array bitmap of NBytes bytes
(NBytes = ceil(BitCount/8), so at most 32). Member ordinal k occupies
bit (k and 7) of byte (k shr 3):
byte index = k shr 3 (k div 8)
bit mask = 1 shl (k and 7)
Sets of 64 members or fewer keep the fast single-register representation
and never reach these helpers; the codegen backends emit calls here only
for the jumbo case.
All set pointers are the address of the first bitmap byte. The binary
operators tolerate Dest aliasing A and/or B (e.g. S := S + T): the byte
loop runs strictly forward and reads both inputs for index i before
writing Dest[i], so full overlap is safe.
}
unit blaise_set;
interface
{ ------------------------------------------------------------------ }
{ Jumbo set RTL public interface }
{ ------------------------------------------------------------------ }
function _SetIn(S: Pointer; Ord: Integer): Integer; { 0 or 1 }
procedure _SetInclude(S: Pointer; Ord: Integer);
procedure _SetExclude(S: Pointer; Ord: Integer);
procedure _SetUnion(Dest, A, B: Pointer; NBytes: Integer); { Dest := A or B }
procedure _SetInter(Dest, A, B: Pointer; NBytes: Integer); { Dest := A and B }
procedure _SetDiff(Dest, A, B: Pointer; NBytes: Integer); { Dest := A and not B }
function _SetEqual(A, B: Pointer; NBytes: Integer): Integer; { 1 if equal }
procedure _SetCopy(Dest, Src: Pointer; NBytes: Integer); { byte copy }
implementation
{ Read byte i of a bitmap. }
function GetByte(S: Pointer; I: Integer): Integer;
var
P: ^Byte;
begin
P := S + I;
Result := P^;
end;
{ Write byte i of a bitmap. }
procedure PutByte(S: Pointer; I, V: Integer);
var
P: ^Byte;
begin
P := S + I;
P^ := Byte(V);
end;
function _SetIn(S: Pointer; Ord: Integer): Integer;
var
ByteIdx, BitMask, B: Integer;
begin
if S = nil then
Exit(0);
ByteIdx := Ord shr 3;
BitMask := 1 shl (Ord and 7);
B := GetByte(S, ByteIdx);
if (B and BitMask) <> 0 then
Result := 1
else
Result := 0;
end;
procedure _SetInclude(S: Pointer; Ord: Integer);
var
ByteIdx, BitMask, B: Integer;
begin
ByteIdx := Ord shr 3;
BitMask := 1 shl (Ord and 7);
B := GetByte(S, ByteIdx);
PutByte(S, ByteIdx, B or BitMask);
end;
procedure _SetExclude(S: Pointer; Ord: Integer);
var
ByteIdx, BitMask, B: Integer;
begin
ByteIdx := Ord shr 3;
BitMask := 1 shl (Ord and 7);
B := GetByte(S, ByteIdx);
PutByte(S, ByteIdx, B and (not BitMask));
end;
procedure _SetUnion(Dest, A, B: Pointer; NBytes: Integer);
var
I: Integer;
begin
I := 0;
while I < NBytes do
begin
PutByte(Dest, I, GetByte(A, I) or GetByte(B, I));
Inc(I);
end;
end;
procedure _SetInter(Dest, A, B: Pointer; NBytes: Integer);
var
I: Integer;
begin
I := 0;
while I < NBytes do
begin
PutByte(Dest, I, GetByte(A, I) and GetByte(B, I));
Inc(I);
end;
end;
procedure _SetDiff(Dest, A, B: Pointer; NBytes: Integer);
var
I: Integer;
begin
I := 0;
while I < NBytes do
begin
PutByte(Dest, I, GetByte(A, I) and (not GetByte(B, I)));
Inc(I);
end;
end;
function _SetEqual(A, B: Pointer; NBytes: Integer): Integer;
var
I: Integer;
begin
I := 0;
while I < NBytes do
begin
if GetByte(A, I) <> GetByte(B, I) then
Exit(0);
Inc(I);
end;
Result := 1;
end;
procedure _SetCopy(Dest, Src: Pointer; NBytes: Integer);
var
I: Integer;
begin
I := 0;
while I < NBytes do
begin
PutByte(Dest, I, GetByte(Src, I));
Inc(I);
end;
end;
end.

67
tools/bif-coverage/bif-coverage.status
View file

@ -24,9 +24,9 @@ TStringSubscriptExpr.IndexExpr serialise
TArrayLiteralExpr.Elements serialise
TArrayLiteralExpr.IsConstArray safe
# TNilLiteral (uAST.pas:70)
# TNilLiteral (uAST.pas:74)
# TIdentExpr (uAST.pas:79)
# TIdentExpr (uAST.pas:83)
TIdentExpr.Name serialise
TIdentExpr.ParamMode safe
TIdentExpr.IsConstant safe
@ -39,7 +39,7 @@ TIdentExpr.IsImplicitSelfMethod safe
TIdentExpr.IsMetaclassRef safe
TIdentExpr.ConstArraySymbol safe
# TFieldAccessExpr (uAST.pas:100)
# TFieldAccessExpr (uAST.pas:104)
TFieldAccessExpr.RecordName serialise
TFieldAccessExpr.FieldName serialise
TFieldAccessExpr.Base serialise
@ -64,29 +64,29 @@ TFieldAccessExpr.PropIndexExpr serialise
TFieldAccessExpr.IsCharAccess safe
TFieldAccessExpr.IsArrayAccess safe
# TIsExpr (uAST.pas:132)
# TIsExpr (uAST.pas:136)
TIsExpr.Obj serialise
TIsExpr.TypeName serialise
# TAsExpr (uAST.pas:140)
# TAsExpr (uAST.pas:144)
TAsExpr.Obj serialise
TAsExpr.TypeName serialise
# TSupportsExpr (uAST.pas:149)
# TSupportsExpr (uAST.pas:153)
TSupportsExpr.Obj serialise
TSupportsExpr.IntfTypeName serialise
TSupportsExpr.OutVarName serialise
TSupportsExpr.OutVarIsGlobal safe
# TBinaryExpr (uAST.pas:165)
# TBinaryExpr (uAST.pas:169)
TBinaryExpr.Op serialise
TBinaryExpr.Left serialise
TBinaryExpr.Right serialise
# TNotExpr (uAST.pas:173)
# TNotExpr (uAST.pas:177)
TNotExpr.Expr serialise
# TAssignment (uAST.pas:185)
# TAssignment (uAST.pas:189)
TAssignment.Name serialise
TAssignment.Expr serialise
TAssignment.IsVarParam safe
@ -95,23 +95,23 @@ TAssignment.IsThreadVar safe
TAssignment.IsWeakLhs safe
TAssignment.ImplicitSelfField safe
# TIfStmt (uAST.pas:201)
# TIfStmt (uAST.pas:205)
TIfStmt.Condition serialise
TIfStmt.ThenStmt serialise
TIfStmt.ElseStmt serialise
# TCompoundStmt (uAST.pas:209)
# TCompoundStmt (uAST.pas:213)
TCompoundStmt.Stmts serialise
# TWhileStmt (uAST.pas:216)
# TWhileStmt (uAST.pas:220)
TWhileStmt.Condition serialise
TWhileStmt.Body serialise
# TRepeatStmt (uAST.pas:223)
# TRepeatStmt (uAST.pas:227)
TRepeatStmt.Body serialise
TRepeatStmt.Condition serialise
# TForStmt (uAST.pas:230)
# TForStmt (uAST.pas:234)
TForStmt.VarName serialise
TForStmt.IsGlobal safe
TForStmt.StartExpr serialise
@ -119,7 +119,7 @@ TForStmt.EndExpr serialise
TForStmt.IsDownTo serialise
TForStmt.Body serialise
# TForInStmt (uAST.pas:241)
# TForInStmt (uAST.pas:245)
TForInStmt.VarName serialise
TForInStmt.VarIsGlobal safe
TForInStmt.CollExpr serialise
@ -137,35 +137,36 @@ TForInStmt.AdvVarName safe
TForInStmt.IsSetIter safe
TForInStmt.SetBitCount safe
TForInStmt.SetMaskVarName safe
TForInStmt.SetIsJumbo safe
# TTryFinallyStmt (uAST.pas:274)
# TTryFinallyStmt (uAST.pas:282)
TTryFinallyStmt.TryBody serialise
TTryFinallyStmt.FinallyBody serialise
# TTryExceptStmt (uAST.pas:291)
# TTryExceptStmt (uAST.pas:299)
TTryExceptStmt.TryBody serialise
TTryExceptStmt.Handlers serialise
TTryExceptStmt.ElseBody serialise
TTryExceptStmt.ExceptBody serialise
# TRaiseStmt (uAST.pas:304)
# TRaiseStmt (uAST.pas:312)
TRaiseStmt.Expr serialise
# TExitStmt (uAST.pas:315)
# TExitStmt (uAST.pas:323)
TExitStmt.Value safe
TExitStmt.ResultAssign safe
# TBreakStmt (uAST.pas:323)
# TBreakStmt (uAST.pas:331)
# TContinueStmt (uAST.pas:326)
# TContinueStmt (uAST.pas:334)
# TCaseStmt (uAST.pas:337)
# TCaseStmt (uAST.pas:345)
TCaseStmt.Selector serialise
TCaseStmt.Branches serialise
TCaseStmt.ElseStmt serialise
TCaseStmt.IsStringCase safe
# TFieldAssignment (uAST.pas:348)
# TFieldAssignment (uAST.pas:356)
TFieldAssignment.RecordName serialise
TFieldAssignment.FieldName serialise
TFieldAssignment.Expr serialise
@ -179,7 +180,7 @@ TFieldAssignment.PropIndexExpr serialise
TFieldAssignment.PropOwnerType safe
TFieldAssignment.IsElemWrite safe
# TStaticSubscriptAssign (uAST.pas:375)
# TStaticSubscriptAssign (uAST.pas:383)
TStaticSubscriptAssign.ArrayName serialise
TStaticSubscriptAssign.IndexExpr serialise
TStaticSubscriptAssign.ValueExpr serialise
@ -188,18 +189,18 @@ TStaticSubscriptAssign.IsGlobal safe
TStaticSubscriptAssign.IsVarParam safe
TStaticSubscriptAssign.IsImplicitSelf safe
# TPointerWriteStmt (uAST.pas:398)
# TPointerWriteStmt (uAST.pas:406)
TPointerWriteStmt.PtrExpr serialise
TPointerWriteStmt.ValExpr serialise
# TProcCall (uAST.pas:406)
# TProcCall (uAST.pas:414)
TProcCall.Name serialise
TProcCall.Args serialise
TProcCall.IsImplicitSelfMethod safe
TProcCall.IsIndirectCall safe
TProcCall.IndirectCallIsGlobal safe
# TFuncCallExpr (uAST.pas:419)
# TFuncCallExpr (uAST.pas:427)
TFuncCallExpr.Name serialise
TFuncCallExpr.Args serialise
TFuncCallExpr.IsImplicitSelfMethod safe
@ -209,18 +210,18 @@ TFuncCallExpr.IsBuiltinHasClassAttr safe
TFuncCallExpr.HasClassAttrClass safe
TFuncCallExpr.HasClassAttrAttr safe
# TIndirectFuncCallExpr (uAST.pas:445)
# TIndirectFuncCallExpr (uAST.pas:453)
TIndirectFuncCallExpr.CalleeExpr serialise
TIndirectFuncCallExpr.Args serialise
# TDerefExpr (uAST.pas:455)
# TDerefExpr (uAST.pas:463)
TDerefExpr.Expr serialise
# TAddrOfExpr (uAST.pas:462)
# TAddrOfExpr (uAST.pas:470)
TAddrOfExpr.Expr serialise
TAddrOfExpr.ResolvedFreeRoutine safe
# TMethodCallStmt (uAST.pas:474)
# TMethodCallStmt (uAST.pas:482)
TMethodCallStmt.ObjectName serialise
TMethodCallStmt.Name serialise
TMethodCallStmt.Args serialise
@ -231,11 +232,11 @@ TMethodCallStmt.IsVarParam safe
TMethodCallStmt.IsBuiltinToString safe
TMethodCallStmt.IsProcFieldCall safe
# TInheritedCallStmt (uAST.pas:506)
# TInheritedCallStmt (uAST.pas:514)
TInheritedCallStmt.Name serialise
TInheritedCallStmt.Args serialise
# TMethodCallExpr (uAST.pas:696)
# TMethodCallExpr (uAST.pas:789)
TMethodCallExpr.ObjectName serialise
TMethodCallExpr.Name serialise
TMethodCallExpr.Args serialise