diff --git a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas index 4e23e90..202687f 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -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.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.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; diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 383c839..ef36b1d 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -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 diff --git a/compiler/src/main/pascal/uAST.pas b/compiler/src/main/pascal/uAST.pas index 028848e..231807e 100644 --- a/compiler/src/main/pascal/uAST.pas +++ b/compiler/src/main/pascal/uAST.pas @@ -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; diff --git a/compiler/src/main/pascal/uSemantic.pas b/compiler/src/main/pascal/uSemantic.pas index e16e0e1..80b62cd 100644 --- a/compiler/src/main/pascal/uSemantic.pas +++ b/compiler/src/main/pascal/uSemantic.pas @@ -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 '. } @@ -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. diff --git a/compiler/src/main/pascal/uSymbolTable.pas b/compiler/src/main/pascal/uSymbolTable.pas index 3c7b428..d33809d 100644 --- a/compiler/src/main/pascal/uSymbolTable.pas +++ b/compiler/src/main/pascal/uSymbolTable.pas @@ -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 diff --git a/compiler/src/test/pascal/TestRunner.pas b/compiler/src/test/pascal/TestRunner.pas index 0bf5c79..c264649 100644 --- a/compiler/src/test/pascal/TestRunner.pas +++ b/compiler/src/test/pascal/TestRunner.pas @@ -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, diff --git a/compiler/src/test/pascal/cp.test.e2e.jumboset.pas b/compiler/src/test/pascal/cp.test.e2e.jumboset.pas new file mode 100644 index 0000000..4864054 --- /dev/null +++ b/compiler/src/test/pascal/cp.test.e2e.jumboset.pas @@ -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. diff --git a/compiler/src/test/pascal/cp.test.jumboset.pas b/compiler/src/test/pascal/cp.test.jumboset.pas new file mode 100644 index 0000000..0b6bd6d --- /dev/null +++ b/compiler/src/test/pascal/cp.test.jumboset.pas @@ -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 ` 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. diff --git a/compiler/src/test/pascal/cp.test.sets.pas b/compiler/src/test/pascal/cp.test.sets.pas index c3f0f58..1813d24 100644 --- a/compiler/src/test/pascal/cp.test.sets.pas +++ b/compiler/src/test/pascal/cp.test.sets.pas @@ -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; diff --git a/docs/grammar.ebnf b/docs/grammar.ebnf index f30fc82..9403631 100644 --- a/docs/grammar.ebnf +++ b/docs/grammar.ebnf @@ -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. * diff --git a/docs/language-rationale.adoc b/docs/language-rationale.adoc index 12378f3..19fc853 100644 --- a/docs/language-rationale.adoc +++ b/docs/language-rationale.adoc @@ -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. diff --git a/runtime/Makefile b/runtime/Makefile index 076cee7..8565ae4 100644 --- a/runtime/Makefile +++ b/runtime/Makefile @@ -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 $@ diff --git a/runtime/src/main/pascal/blaise_set.pas b/runtime/src/main/pascal/blaise_set.pas new file mode 100644 index 0000000..ba9eecb --- /dev/null +++ b/runtime/src/main/pascal/blaise_set.pas @@ -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 ` 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. diff --git a/tools/bif-coverage/bif-coverage.status b/tools/bif-coverage/bif-coverage.status index 3047e80..b445f9a 100644 --- a/tools/bif-coverage/bif-coverage.status +++ b/tools/bif-coverage/bif-coverage.status @@ -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