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 2122046..e57f52f 100644 --- a/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas +++ b/compiler/src/main/pascal/blaise.codegen.native.x86_64.pas @@ -68,6 +68,10 @@ type [Unretained] FDbgFacts: TDbgFacts; [Unretained] FDbgCur: TDbgFunc; { facts entry for the function being emitted } FDbgSeq: Integer; { .Ldbg_N label counter } + { Enclosing function while a nested proc is being emitted — lets + DbgMarkParams resolve captured-var types from the outer var/param + declarations. nil for top-level functions. } + [Unretained] FDbgOuterDecl: TMethodDecl; { Global slots to define in the .data section: program-level variables plus hidden for-loop end-value slots. Insertion-ordered so EmitDataSection emits them in declaration order; ContainsKey gives O(1) dedup. The value @@ -424,6 +428,7 @@ type procedure DbgBeginFunc(const ASymbol: string); procedure DbgRecordSlot(const AName: string; AType: TTypeDesc; AOffset: Integer); procedure DbgMarkParams(ADecl: TMethodDecl); + function OuterVarType(const AName: string): TTypeDesc; procedure DbgStmtLabel(AStmt: TASTStmt); procedure DbgEndFunc; procedure EmitIncDec(ACall: TProcCall); @@ -2657,6 +2662,9 @@ begin Self.Emit(Format(#9'movq %s, %s', [Self.VarOperand(AFA.RecordName), ADstReg])) else Self.Emit(Format(#9'movq %s(%%rip), %s', [AFA.RecordName, ADstReg])); + if AFA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(Format(#9'movq (%s), %s', [ADstReg, ADstReg])); end else if AFA.IsVarParam then begin @@ -3192,6 +3200,9 @@ begin Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand(FAE.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rdx', [FAE.RecordName])); + if FAE.IsClassAccess and FAE.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rdx), %rdx'); end else if Self.IsLocal(FAE.RecordName) then Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(FAE.RecordName)])) @@ -3220,12 +3231,12 @@ procedure TX86_64Backend.DbgRecordSlot(const AName: string; AType: TTypeDesc; AOffset: Integer); begin if FDbgCur = nil then Exit; - { Skip internal companion/bookkeeping slots: capture pointers, exception - frames, open-array highs. '_data' record-param shadows are kept — - DbgMarkParams presents them AS the parameter (the shadow holds the - callee's inline record copy, which is what a debugger should show). } + { Skip internal bookkeeping slots (exception frames, open-array highs). + '_data' record-param shadows and '_cap_' capture pointers are kept — + DbgMarkParams presents the shadow AS the parameter and a capture slot + AS the outer variable (indirect location). } if AName = '' then Exit; - if AName[0] = '_' then Exit; + if (AName[0] = '_') and (Copy(AName, 0, 5) <> '_cap_') then Exit; if (Length(AName) > 5) and (Copy(AName, Length(AName) - 5, 5) = '_high') then Exit; FDbgCur.AddVar(AName, AType, AOffset); end; @@ -3274,10 +3285,58 @@ begin DV.IsVarParam := P.IsVarParam; DV.IsConstParam := P.IsConstParam; end - else if (V.TypeDesc = nil) and (P.ResolvedType <> nil) and - not P.IsVarParam then + else if P.IsVarParam then + begin + { var/out parameter: the slot holds the ADDRESS of the caller's + variable — indirect location, typed as the VALUE. } + V.Indirect := True; + if (V.TypeDesc = nil) and (P.ResolvedType <> nil) then + V.TypeDesc := P.ResolvedType; + end + else if (V.TypeDesc = nil) and (P.ResolvedType <> nil) then V.TypeDesc := P.ResolvedType; end; + { Captured outer locals: each '_cap_' slot holds a pointer to the + outer variable. Present it as the variable itself via the indirect + location, typed from the enclosing function's var/param declarations + (FDbgOuterDecl — set while nested procs are emitted). } + if ADecl.CapturedVars <> nil then + for I := 0 to ADecl.CapturedVars.Count - 1 do + begin + V := FDbgCur.FindVar('_cap_' + ADecl.CapturedVars.Strings[I]); + if V = nil then Continue; + V.Name := ADecl.CapturedVars.Strings[I]; + V.Indirect := True; + if V.TypeDesc = nil then + V.TypeDesc := Self.OuterVarType(ADecl.CapturedVars.Strings[I]); + end; +end; + +{ Resolve the type of a captured outer variable by name from the enclosing + function's local var declarations and parameters. Returns nil when no + enclosing decl is recorded or the name is not found. } +function TX86_64Backend.OuterVarType(const AName: string): TTypeDesc; +var + I, J: Integer; + VD: TVarDecl; + P: TMethodParam; +begin + Result := nil; + if FDbgOuterDecl = nil then Exit; + if FDbgOuterDecl.Body <> nil then + for I := 0 to FDbgOuterDecl.Body.Decls.Count - 1 do + begin + VD := TVarDecl(FDbgOuterDecl.Body.Decls.Items[I]); + for J := 0 to VD.Names.Count - 1 do + if SameText(VD.Names.Strings[J], AName) then + Exit(VD.ResolvedType); + end; + for I := 0 to FDbgOuterDecl.Params.Count - 1 do + begin + P := TMethodParam(FDbgOuterDecl.Params.Items[I]); + if SameText(P.ParamName, AName) then + Exit(P.ResolvedType); + end; end; procedure TX86_64Backend.DbgStmtLabel(AStmt: TASTStmt); @@ -3633,7 +3692,22 @@ begin Ty := Self.LocalType(TIdentExpr(AExpr).Name); if (Ty = nil) then Ty := Self.GlobalType(TIdentExpr(AExpr).Name); - Self.EmitLoadFloat(Self.VarOperand(TIdentExpr(AExpr).Name), Ty); + if TIdentExpr(AExpr).ParamMode <> pmNone then + begin + { var/out float param: the slot holds the value's address. } + Self.Emit(Format(#9'movq %s, %%rcx', + [Self.VarOperand(TIdentExpr(AExpr).Name)])); + Self.EmitLoadFloat('(%rcx)', Ty); + end + else if Self.IsCaptured(TIdentExpr(AExpr).Name) then + begin + { Captured outer local: the _cap_ slot holds the var's address. } + Self.Emit(Format(#9'movq %s, %%rcx', + [Self.VarOperand('_cap_' + TIdentExpr(AExpr).Name)])); + Self.EmitLoadFloat('(%rcx)', Ty); + end + else + Self.EmitLoadFloat(Self.VarOperand(TIdentExpr(AExpr).Name), Ty); Exit; end; @@ -5437,6 +5511,9 @@ begin Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(FAE.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rdi', [FAE.RecordName])); + if FAE.IsClassAccess and FAE.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rdi), %rdi'); end; if FAE.FieldInfo <> nil then begin @@ -5492,6 +5569,9 @@ 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.IsClassAccess and FAE.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); end else if Self.IsLocal(FAE.RecordName) then Self.Emit(Format(#9'leaq %s, %%rcx', [Self.VarOperand(FAE.RecordName)])) @@ -5590,6 +5670,9 @@ 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.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); if FAE.FieldInfo.TypeDesc.Kind in [tyRecord, tyStaticArray] then Self.Emit(Format(#9'leaq %d(%%rcx), %%rax', [FAE.FieldInfo.Offset])) else @@ -5831,6 +5914,9 @@ 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.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); end else if FAE.IsVarParam then Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FAE.RecordName)])) @@ -5909,6 +5995,9 @@ 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.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); end else if FAE.IsVarParam then Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FAE.RecordName)])) @@ -8360,7 +8449,17 @@ begin (cvtss2sd). } Self.EmitXmm0WidthAdjust(Asgn.Expr.ResolvedType, Asgn.ResolvedLhsType.Kind = tySingle); - if Self.IsLocal(Asgn.Name) then + if Asgn.IsVarParam then + begin + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(Asgn.Name)])); + Self.EmitStoreFloat('(%rcx)', Asgn.ResolvedLhsType); + end + else if Self.IsCaptured(Asgn.Name) then + begin + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.EmitStoreFloat('(%rcx)', Asgn.ResolvedLhsType); + end + else if Self.IsLocal(Asgn.Name) then Self.EmitStoreFloat(Self.VarOperand(Asgn.Name), Self.LocalType(Asgn.Name)) else begin @@ -8388,6 +8487,16 @@ begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(Asgn.Name)])); Self.Emit(#9'movq %rax, (%rcx)'); end + else if Self.IsCaptured(Asgn.Name) then + begin + { Captured outer local: the _cap_ slot holds the var's address. } + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq (%rcx), %rdi'); + Self.Emit(#9'callq _StringRelease'); + Self.Emit(#9'popq %rax'); + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq %rax, (%rcx)'); + end else begin Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(Asgn.Name)])); @@ -8421,6 +8530,16 @@ begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(Asgn.Name)])); Self.Emit(#9'movq %rax, (%rcx)'); end + else if Self.IsCaptured(Asgn.Name) then + begin + { Captured outer local: the _cap_ slot holds the var's address. } + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq (%rcx), %rdi'); + Self.Emit(#9'callq _DynArrayRelease'); + Self.Emit(#9'popq %rax'); + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq %rax, (%rcx)'); + end else begin Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(Asgn.Name)])); @@ -8452,6 +8571,15 @@ begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(Asgn.Name)])); Self.Emit(#9'movq $0, (%rcx)'); end + else if Self.IsCaptured(Asgn.Name) then + begin + { Captured outer local: the _cap_ slot holds the var's address. } + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq (%rcx), %rdi'); + Self.Emit(#9'callq _ClassRelease'); + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq $0, (%rcx)'); + end else begin Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(Asgn.Name)])); @@ -8480,6 +8608,16 @@ begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(Asgn.Name)])); Self.Emit(#9'movq %rax, (%rcx)'); end + else if Self.IsCaptured(Asgn.Name) then + begin + { Captured outer local: the _cap_ slot holds the var's address. } + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq (%rcx), %rdi'); + Self.Emit(#9'callq _ClassRelease'); + Self.Emit(#9'popq %rax'); + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand('_cap_' + Asgn.Name)])); + Self.Emit(#9'movq %rax, (%rcx)'); + end else begin Self.Emit(Format(#9'movq %s, %%rax', [Self.VarOperand(Asgn.Name)])); @@ -8501,6 +8639,8 @@ begin Self.Emit(#9'movq %rax, %rsi'); if Asgn.IsVarParam then Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(Asgn.Name)])) + else if Self.IsCaptured(Asgn.Name) then + Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand('_cap_' + Asgn.Name)])) else if FSretFunc and SameText(Asgn.Name, 'Result') then Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand('Result')])) else if Self.IsLocal(Asgn.Name) then @@ -9105,6 +9245,9 @@ begin Self.Emit(Format(#9'movq %s, %%rdi', [Self.VarOperand(FA.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rdi', [FA.RecordName])); + if FA.IsClassAccess and FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rdi), %rdi'); end; if FA.PropIndexExpr <> nil then begin @@ -9164,6 +9307,9 @@ begin Self.Emit(Format(#9'movq %s, %%rdx', [Self.VarOperand(FA.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rdx', [FA.RecordName])); + if FA.IsClassAccess and FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rdx), %rdx'); end else if Self.IsLocal(FA.RecordName) then Self.Emit(Format(#9'leaq %s, %%rdx', [Self.VarOperand(FA.RecordName)])) @@ -9248,6 +9394,9 @@ begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FA.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FA.RecordName])); + if FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); end else if FA.IsVarParam then begin @@ -9295,6 +9444,9 @@ begin Self.Emit(Format(#9'movq %s, %%rbx', [Self.VarOperand(FA.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rbx', [FA.RecordName])); + if FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rbx), %rbx'); end else if FA.IsVarParam then begin @@ -9346,6 +9498,9 @@ begin Self.Emit(Format(#9'movq %s, %%rbx', [Self.VarOperand(FA.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rbx', [FA.RecordName])); + if FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rbx), %rbx'); end else begin @@ -9399,6 +9554,9 @@ begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FA.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FA.RecordName])); + if FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); Self.EmitLoadFloat('(%rsp)', FA.FieldInfo.TypeDesc); Self.Emit(#9'addq $8, %rsp'); end @@ -9527,10 +9685,16 @@ begin if FA.IsClassAccess then Self.Emit(#9'movq (%rcx), %rcx'); end - else if Self.IsLocal(FA.RecordName) then - Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FA.RecordName)])) else - Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FA.RecordName])); + begin + if Self.IsLocal(FA.RecordName) then + Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(FA.RecordName)])) + else + Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [FA.RecordName])); + if FA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); + end; if FA.FieldInfo.IsUnretained and (FA.FieldInfo.TypeDesc.Kind = tyClass) then begin Self.Emit(#9'popq %rax'); @@ -10714,7 +10878,7 @@ begin Inc(SlotOff, 8); end; end - else if IsFloatFamily(ParamType) then + else if IsFloatFamily(ParamType) and not IsVar then begin Self.EmitExprToXmm0(Arg); if (ParamType <> nil) and (ParamType.Kind = tySingle) then @@ -10836,8 +11000,10 @@ begin ParamType := Arg.ResolvedType; IsOA := (ADecl <> nil) and (I < ADecl.Params.Count) and TMethodParam(ADecl.Params.Items[I]).IsOpenArray; + IsVar := (ADecl <> nil) and (I < ADecl.Params.Count) and + TMethodParam(ADecl.Params.Items[I]).IsVarParam; - if IsFloatFamily(ParamType) and not IsOA then + if IsFloatFamily(ParamType) and not IsOA and not IsVar then begin if XmmIdx < 8 then begin @@ -11064,6 +11230,9 @@ begin Self.Emit(Format(#9'movq %s, %%rcx', [Self.VarOperand(AFA.RecordName)])) else Self.Emit(Format(#9'movq %s(%%rip), %%rcx', [AFA.RecordName])); + if AFA.IsVarParam then + { var-param class: slot -> caller var -> instance } + Self.Emit(#9'movq (%rcx), %rcx'); end else if AFA.IsVarParam then begin @@ -11822,19 +11991,27 @@ var IntIdx: Integer; XmmIdx: Integer; NestedDecl: TMethodDecl; + SavedOuterDecl: TMethodDecl; AddrTaken: TStringList; begin { Emit any nested procedures declared inside this function's body before emitting this function itself. Each nested proc gets a mangled name - OuterName_InnerName to avoid global symbol collisions. } + OuterName_InnerName to avoid global symbol collisions. FDbgOuterDecl + carries the enclosing decl so DbgMarkParams can type captured vars; + saved/restored to keep doubly-nested emission consistent. } if ADecl.Body <> nil then + begin + SavedOuterDecl := FDbgOuterDecl; for I := 0 to ADecl.Body.ProcDecls.Count - 1 do begin NestedDecl := TMethodDecl(ADecl.Body.ProcDecls.Items[I]); if NestedDecl.Body = nil then Continue; NestedDecl.ResolvedQbeName := ADecl.Name + '_' + NestedDecl.Name; + FDbgOuterDecl := ADecl; Self.EmitFunctionDef(NestedDecl); end; + FDbgOuterDecl := SavedOuterDecl; + end; for I := 0 to ADecl.Params.Count - 1 do begin @@ -11942,7 +12119,7 @@ begin Inc(IntIdx); end; end - else if IsFloatFamily(P.ResolvedType) then + else if IsFloatFamily(P.ResolvedType) and not P.IsVarParam then begin if XmmIdx < 6 then begin diff --git a/compiler/src/main/pascal/blaise.codegen.qbe.pas b/compiler/src/main/pascal/blaise.codegen.qbe.pas index 40dab06..8fb7a25 100644 --- a/compiler/src/main/pascal/blaise.codegen.qbe.pas +++ b/compiler/src/main/pascal/blaise.codegen.qbe.pas @@ -4247,6 +4247,13 @@ begin begin Loaded := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [Loaded, VarRef(Id.Name, Id.IsGlobal)])); + if Id.ParamMode <> pmNone then + begin + { var-param class ident: slot -> caller var -> instance. } + Result := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [Result, Loaded])); + Exit; + end; Result := Loaded; end else if Id.ParamMode <> pmNone then @@ -4296,7 +4303,15 @@ begin begin Loaded := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [Loaded, VarRef(Fld.RecordName, Fld.IsGlobal)])); - Base := Loaded; + if Fld.IsVarParam then + begin + { var-param class: the slot holds the ADDRESS of the caller's + variable — load again to reach the instance pointer. } + Base := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [Base, Loaded])); + end + else + Base := Loaded; end else if Fld.IsVarParam then begin @@ -4429,11 +4444,18 @@ begin begin { Class field leaf: the variable's slot holds a pointer to the heap object — load it so the offset addition reaches the field, not a - location adjacent to the slot itself. } + location adjacent to the slot itself. A var-param class slot holds + the ADDRESS of the caller's variable: load twice. } T := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [T, VarRef(FldAcc.RecordName, FldAcc.IsGlobal)])); - BaseAddr := T; + if FldAcc.IsVarParam then + begin + BaseAddr := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [BaseAddr, T])); + end + else + BaseAddr := T; end else if FldAcc.IsImplicitSelf then begin @@ -5453,9 +5475,16 @@ begin end else if AAssign.IsClassAccess then begin - { Load the heap pointer stored in the class variable } + { Load the heap pointer stored in the class variable. var-param class: + the slot holds the caller variable's address — one more load first. } PtrTemp := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [PtrTemp, VarRef(AAssign.RecordName, AAssign.IsGlobal)])); + if AAssign.IsVarParam then + begin + Ptr := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [Ptr, PtrTemp])); + PtrTemp := Ptr; + end; if AAssign.FieldInfo.Offset > 0 then begin Ptr := AllocTemp(); @@ -7163,8 +7192,8 @@ begin for I := 0 to ADecl.CapturedVars.Count - 1 do begin CapName := ADecl.CapturedVars.Strings[I]; + if Sig <> '' then Sig := Sig + ', '; Sig := Sig + Format('l %%_cap_%s', [CapName]); - if ADecl.Params.Count > 0 then Sig := Sig + ', '; end; for I := 0 to ADecl.Params.Count - 1 do @@ -10524,7 +10553,16 @@ begin end; end else if FldAccess.IsClassAccess or FldAccess.IsVarParam then - EmitLine(Format(' %s =l loadl %s', [L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)])) + begin + EmitLine(Format(' %s =l loadl %s', [L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)])); + if FldAccess.IsClassAccess and FldAccess.IsVarParam then + begin + { var-param class: slot -> caller var -> instance. } + T := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [T, L])); + L := T; + end; + end else EmitLine(Format(' %s =l copy %s', [L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)])); if FldAccess.FieldInfo.Offset > 0 then @@ -10639,9 +10677,16 @@ begin end else if FldAccess.IsClassAccess then begin - { Load heap pointer, then load field } + { Load heap pointer, then load field. var-param class: the slot holds + the caller variable's address — one more load first. } L := AllocTemp(); EmitLine(Format(' %s =l loadl %s', [L, VarRef(FldAccess.RecordName, FldAccess.IsGlobal)])); + if FldAccess.IsVarParam then + begin + Ptr := AllocTemp(); + EmitLine(Format(' %s =l loadl %s', [Ptr, L])); + L := Ptr; + end; if FldAccess.FieldInfo.Offset > 0 then begin Ptr := AllocTemp(); diff --git a/compiler/src/main/pascal/uDebugFacts.pas b/compiler/src/main/pascal/uDebugFacts.pas index e6d05c8..e630adb 100644 --- a/compiler/src/main/pascal/uDebugFacts.pas +++ b/compiler/src/main/pascal/uDebugFacts.pas @@ -43,6 +43,10 @@ type IsParam: Boolean; IsVarParam: Boolean; IsConstParam: Boolean; + { The slot holds the value's ADDRESS rather than the value itself + (var/out params, by-reference aggregates, captured outer locals) — + emitted as LocationExpr=3 'RBP-relative indirect'. } + Indirect: Boolean; end; { One statement-level line marker: the backend emitted LabelName ('.Ldbg_N') diff --git a/compiler/src/main/pascal/uDebugOPDF.pas b/compiler/src/main/pascal/uDebugOPDF.pas index e8883f6..8219f43 100644 --- a/compiler/src/main/pascal/uDebugOPDF.pas +++ b/compiler/src/main/pascal/uDebugOPDF.pas @@ -121,6 +121,7 @@ const SK_BOOLEAN = 1; LOC_RBP = 1; + LOC_RBP_INDIRECT = 3; { frame slot holds the value's address } PAT_FIELD = 0; { property accessor: direct field offset } PAT_METHOD = 1; { property accessor: method call } @@ -479,7 +480,18 @@ begin end; end; end; - Result := Pfx + AClassName; + { Generic instance names carry '<', '>' and ',' — apply the same + character mangling the native backend uses for its symbols + (NativeMangle: '<' and ',' become '_', '>' is dropped). } + Result := ''; + for I := 0 to Length(AClassName) - 1 do + begin + Ch := Copy(AClassName, I, 1); + if (Ch = '<') or (Ch = ',') then Result := Result + '_' + else if Ch = '>' then + else Result := Result + Ch; + end; + Result := Pfx + Result; end; procedure TOPDFEmitter.EmitClass(AType: TRecordTypeDesc); @@ -677,7 +689,7 @@ begin L(' .byte 8 # PointerSize: 8'); FTotRecIdx := FOutput.Count; L(' .int 0 # TotalRecords (patched at end)'); - L(' .int 1 # Flags: OPDF_FLAG_HAS_DIRECTORY'); + L(' .int 3 # Flags: HAS_DIRECTORY or DYNARRAY_LEN32'); end; procedure TOPDFEmitter.EmitFunctionScope_Main(AScopeID, ADeclIdx: Integer); @@ -1097,7 +1109,11 @@ begin EmitRecHdr(REC_LOCALVAR, RecSize); L(' .int ' + IntToStr(GetOrAllocTypeID(CName)) + ' # TypeID'); L(' .int ' + IntToStr(AScopeID) + ' # ScopeID'); - L(' .byte ' + IntToStr(LOC_RBP) + ' # LocationExpr (RBP-relative)'); + if AVar.Indirect then + L(' .byte ' + IntToStr(LOC_RBP_INDIRECT) + + ' # LocationExpr (RBP-relative indirect)') + else + L(' .byte ' + IntToStr(LOC_RBP) + ' # LocationExpr (RBP-relative)'); L(' .word ' + IntToStr(ADeclIdx) + ' # DeclIndex'); EmitNameLen(AVar.Name); L(' .word ' + IntToStr(AVar.RbpOffset) + ' # LocationData (RBP offset)'); diff --git a/compiler/src/test/pascal/cp.test.e2e.classes2.pas b/compiler/src/test/pascal/cp.test.e2e.classes2.pas index 04de376..2df6eed 100644 --- a/compiler/src/test/pascal/cp.test.e2e.classes2.pas +++ b/compiler/src/test/pascal/cp.test.e2e.classes2.pas @@ -88,6 +88,15 @@ type { Statement-position method call through a non-Self interface field: H.S.Note(); — expression position already worked. } procedure TestRun_InterfaceFieldCall_StatementPosition; + + { var-param class: field reads/writes must double-deref (slot -> caller + var -> instance); single-deref corrupted the caller frame. } + procedure TestRun_VarParamClass_FieldReadWrite; + { Nested proc with captured vars AND regular params: signature emission. } + procedure TestRun_NestedProc_CaptureAndParams; + { var Double param (pointer arrives in an int register, not xmm) and + captured float read/write through the _cap_ slot. } + procedure TestRun_VarParamFloat_CapturedFloat; end; implementation @@ -1401,6 +1410,110 @@ begin AssertRunsOnAll(SrcIntfFieldCallStmt, '9' + LE + 'note' + LE, 0); end; +const + SrcVarParamClass = ''' + program P; + type + TBox = class + V: Integer; + W: Integer; + end; + procedure MutB(var B: TBox); + begin + B.V := B.V + 98; + B.W := B.V * 2; + writeln(B.V); + end; + procedure Swap(var B: TBox); + var T: TBox; + begin + T := TBox.Create(); + T.V := 500; + B := T; + end; + var + Box: TBox; + begin + Box := TBox.Create(); + Box.V := 1; + MutB(Box); + writeln(Box.V); + writeln(Box.W); + Swap(Box); + writeln(Box.V); + end. + '''; + + SrcNestedCaptureParams = ''' + program P; + procedure Outer(); + var + Total: Integer; + Name: string; + procedure Inner(K: Integer; Tag: string); + begin + Total := Total + K; + Name := Name + Tag; + end; + begin + Total := 5; + Name := 'x'; + Inner(7, 'y'); + Inner(8, 'z'); + writeln(Total); + writeln(Name); + end; + begin + Outer(); + end. + '''; + +procedure TE2EClasses2Tests.TestRun_VarParamClass_FieldReadWrite; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcVarParamClass, + '99' + LE + '99' + LE + '198' + LE + '500' + LE, 0); +end; + +procedure TE2EClasses2Tests.TestRun_NestedProc_CaptureAndParams; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcNestedCaptureParams, '20' + LE + 'xyz' + LE, 0); +end; + +const + SrcVarParamFloat = ''' + program P; + procedure SetD(var D: Double); + begin + D := 2.5; + end; + procedure Outer(); + var + X: Double; + procedure Bump(F: Double); + begin + X := X + F; + end; + begin + X := 1.0; + SetD(X); + writeln(X); + Bump(0.5); + Bump(1.0); + writeln(X); + end; + begin + Outer(); + end. + '''; + +procedure TE2EClasses2Tests.TestRun_VarParamFloat_CapturedFloat; +begin + if not ToolchainAvailable() then begin Ignore('toolchain unavailable'); Exit; end; + AssertRunsOnAll(SrcVarParamFloat, '2.5' + LE + '4' + LE, 0); +end; + initialization RegisterTest(TE2EClasses2Tests);