From b6778e7ac6e2a9f7c75e1adb95eeb28038e6c297 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 23 Aug 2021 21:31:32 +0100 Subject: [PATCH 01/11] fix Fix 7456, 3704, 12019 (debug scopes, self arg, incorrect information display on shadowing) #12018 --- src/fsharp/IlxGen.fs | 135 ++++++++++++++++---------- src/fsharp/absil/ilwrite.fs | 6 +- src/fsharp/absil/ilwritepdb.fs | 167 ++++++++++++++++++++++++++------ src/fsharp/absil/ilwritepdb.fsi | 11 +++ 4 files changed, 237 insertions(+), 82 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 974e3457b70..76c0af7726a 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -2094,15 +2094,26 @@ let GenConstArray cenv (cgbuf: CodeGenBuffer) eenv ilElementType (data:'a[]) (wr // the bodies of methods in a couple of places //------------------------------------------------------------------------- -let CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, codeGenFunction, m) = +let CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, selfArgOpt: Val option, codeGenFunction, m) = let cgbuf = CodeGenBuffer(m, mgbuf, methodName, alreadyUsedArgs) let start = CG.GenerateMark cgbuf "mstart" + let finish = CG.GenerateDelayMark cgbuf "mfinish" let innerVals = entryPointInfo |> List.map (fun (v, kind) -> (v, (kind, start))) - (* Call the given code generator *) + // When debugging, put the "this" parameter in a local that has the right name + match selfArgOpt with + | Some selfArg when selfArg.LogicalName <> "this" && not cenv.opts.localOptimizationsAreOn -> + let ilTy = selfArg.Type |> GenType cenv.amap m eenv.tyenv + let idx = cgbuf.AllocLocal([(selfArg.LogicalName, (start, finish)) ], ilTy, false) + cgbuf.EmitStartOfHiddenCode() + CG.EmitInstrs cgbuf (pop 0) Push0 [ mkLdarg0; I_stloc (uint16 idx) ] + | _ -> () + + // Call the given code generator codeGenFunction cgbuf {eenv with withinSEH=false liveLocals=IntMap.empty() innerVals = innerVals} + cgbuf.SetMarkToHere finish let locals, maxStack, lab2pc, code, exnSpecs, hasDebugPoints = cgbuf.Close() @@ -2138,10 +2149,10 @@ let CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, c localDebugSpecs, hasDebugPoints) -let CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, codeGenFunction, m) = +let CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, selfArgOpt, codeGenFunction, m) = let locals, maxStack, lab2pc, instrs, exns, localDebugSpecs, hasDebugPoints = - CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, codeGenFunction, m) + CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, selfArgOpt, codeGenFunction, m) let code = buildILCode methodName lab2pc instrs exns localDebugSpecs @@ -2600,10 +2611,10 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = and GenExprs cenv cgbuf eenv es = List.iter (fun e -> GenExpr cenv cgbuf eenv SPSuppress e Continue) es -and CodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, alreadyUsedArgs, expr0, sequel0) = +and CodeGenMethodForExpr cenv mgbuf (spReq, entryPointInfo, methodName, eenv, alreadyUsedArgs, selfArgOpt, expr0, sequel0) = let eenv = { eenv with exitSequel = sequel0 } let _, code = - CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, + CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, selfArgOpt, (fun cgbuf eenv -> GenExpr cenv cgbuf eenv spReq expr0 sequel0), expr0.Range) code @@ -3343,30 +3354,35 @@ and GenWitnessArgs cenv cgbuf eenv m tps tyargs = | Choice2Of2 arg -> GenExpr cenv cgbuf eenv SPSuppress arg Continue +and IsBranchTailcall (cenv: cenv) eenv (v: ValRef, tyargs, curriedArgs: _ list) sequel = + let g = cenv.g + match ListAssoc.tryFind g.valRefEq v eenv.innerVals with + | Some (kind, _) -> + not v.IsConstructor && + // when branch-calling methods we must have the right type parameters + (match kind with + | BranchCallClosure _ -> true + | BranchCallMethod (_, _, tps, _, _, _) -> + (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv g ty (mkTyparTy tp)) tyargs tps)) && + // must be exact #args, ignoring tupling - we untuple if needed below + (let arityInfo = + match kind with + | BranchCallClosure arityInfo + | BranchCallMethod (arityInfo, _, _, _, _, _) -> arityInfo + arityInfo.Length = curriedArgs.Length + ) && + // no tailcall out of exception handler, etc. + (match sequelIgnoringEndScopesAndDiscard sequel with + | Return + | ReturnVoid -> true + | _ -> false) + | None -> false + and GenApp (cenv: cenv) cgbuf eenv (f, fty, tyargs, curriedArgs, m) sequel = let g = cenv.g match (f, tyargs, curriedArgs) with // Look for tailcall to turn into branch - | Expr.Val (v, _, _), _, _ when - match ListAssoc.tryFind g.valRefEq v eenv.innerVals with - | Some (kind, _) -> - (not v.IsConstructor && - // when branch-calling methods we must have the right type parameters - (match kind with - | BranchCallClosure _ -> true - | BranchCallMethod (_, _, tps, _, _, _) -> - (List.lengthsEqAndForall2 (fun ty tp -> typeEquiv g ty (mkTyparTy tp)) tyargs tps)) && - // must be exact #args, ignoring tupling - we untuple if needed below - (let arityInfo = - match kind with - | BranchCallClosure arityInfo - | BranchCallMethod (arityInfo, _, _, _, _, _) -> arityInfo - arityInfo.Length = curriedArgs.Length - ) && - (* no tailcall out of exception handler, etc. *) - (match sequelIgnoringEndScopesAndDiscard sequel with Return | ReturnVoid -> true | _ -> false)) - | None -> false - -> + | Expr.Val (v, _, _), _, _ when IsBranchTailcall cenv eenv (v, tyargs, curriedArgs) sequel -> let kind, mark = ListAssoc.find g.valRefEq v eenv.innerVals // already checked above in when guard // Generate the arguments for the direct tail call. @@ -4654,26 +4670,35 @@ and fixupMethodImplFlags (mdef: ILMethodDef) = and GenObjectMethod cenv eenvinner (cgbuf: CodeGenBuffer) useMethodImpl tmethod = let g = cenv.g - // Check if we're compiling the property as a .NET event - let (TObjExprMethod(slotsig, attribs, methTyparsOfOverridingMethod, methodParams, moveNextExpr, m)) = tmethod + let (TObjExprMethod(slotsig, attribs, methTyparsOfOverridingMethod, methParams, methBodyExpr, m)) = tmethod let (TSlotSig(nameOfOverridenMethod, _, _, _, _, _)) = slotsig + + // Check if we're compiling the property as a .NET event if CompileAsEvent g attribs then [] else let eenvUnderTypars = AddTyparsToEnv methTyparsOfOverridingMethod eenvinner - let methodParams = List.concat methodParams - let methodParamsNonSelf = match methodParams with [] -> [] | _ :: t -> t // drop the 'this' arg when computing better argument names for IL parameters + let methParams = List.concat methParams + + // drop the 'this' arg when computing better argument names for IL parameters + let selfArgOpt, methParamsNonSelf = + match methParams with + | [] -> None, [] + | h :: t -> Some h, t + let ilParamsOfOverridingMethod, ilReturnOfOverridingMethod = - GenActualSlotsig m cenv eenvUnderTypars slotsig methTyparsOfOverridingMethod methodParamsNonSelf + GenActualSlotsig m cenv eenvUnderTypars slotsig methTyparsOfOverridingMethod methParamsNonSelf let ilAttribs = GenAttrs cenv eenvinner attribs - // Args are stored starting at #1 - let eenvForMeth = AddStorageForLocalVals g (methodParams |> List.mapi (fun i v -> (v, Arg i))) eenvUnderTypars + // Args are stored starting at #0, the args include the self parameter + let eenvForMeth = AddStorageForLocalVals g (methParams |> List.mapi (fun i v -> (v, Arg i))) eenvUnderTypars + let sequel = (if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return) - let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], nameOfOverridenMethod, eenvForMeth, 0, moveNextExpr, sequel) - let nameOfOverridingMethod, methodImplGenerator = GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) moveNextExpr.Range + let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], nameOfOverridenMethod, eenvForMeth, 0, selfArgOpt, methBodyExpr, sequel) + + let nameOfOverridingMethod, methodImplGenerator = GenMethodImpl cenv eenvinner (useMethodImpl, slotsig) methBodyExpr.Range let mdef = mkILGenericVirtualMethod @@ -4782,7 +4807,7 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel let eenvinner = eenvinner |> AddStorageForLocalVals g (thisVals |> List.map (fun v -> (v.Deref, Arg 0))) let eenvinner = eenvinner |> AddStorageForLocalVals g (argVals |> List.mapi (fun i v -> v, Arg (i+1))) let sequel = if retTy.IsNone then discardAndReturnVoid else Return - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], imethName, eenvinner, 1+argVals.Length, bodyR, sequel) + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], imethName, eenvinner, 1+argVals.Length, None, bodyR, sequel) let ilParams = (ilArgTys,argVals) ||> List.map2 (fun ty v -> mkILParamNamed(v.LogicalName, ty)) mkILNonGenericVirtualMethod(imethName, ILMemberAccess.Public, ilParams, mkILReturn ilRetTy, MethodBody.IL (notlazy ilCode)) ] @@ -4906,7 +4931,7 @@ and GenObjectExpr cenv cgbuf eenvouter objExpr (baseType, baseValOpt, basecall, let ilTyForOverriding = mkILBoxedTy ilCloTypeRef ilCloGenericActuals let eenvinner = bindBaseOrThisVarOpt cenv eenvinner baseValOpt - let ilCtorBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], cloName, eenvinner, 1, basecall, discardAndReturnVoid) + let ilCtorBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], cloName, eenvinner, 1, None, basecall, discardAndReturnVoid) let genMethodAndOptionalMethodImpl tmethod useMethodImpl = [ for (useMethodImpl, methodImplGeneratorFunction, methTyparsOfOverridingMethod), mdef in GenObjectMethod cenv eenvinner cgbuf useMethodImpl tmethod do @@ -4977,7 +5002,7 @@ and GenSequenceExpr let getFreshMethod = let _, mbody = CodeGenMethod cenv cgbuf.mgbuf - ([], "GetFreshEnumerator", eenvinner, 1, + ([], "GetFreshEnumerator", eenvinner, 1, None, (fun cgbuf eenv -> GenWitnessArgsFromWitnessInfos cenv cgbuf eenv m cloWitnessInfos for fv in cloFreeVars do @@ -4995,13 +5020,13 @@ and GenSequenceExpr let closeMethod = // Note: We suppress the first debug point in the body of this method since it is the initial state machine jump let spReq = SPSuppress - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "Close", eenvinner, 1, closeExpr, discardAndReturnVoid) + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "Close", eenvinner, 1, None, closeExpr, discardAndReturnVoid) mkILNonGenericVirtualMethod("Close", ILMemberAccess.Public, [], mkILReturn ILType.Void, MethodBody.IL (lazy ilCode)) let checkCloseMethod = // Note: We suppress the first debug point in the body of this method since it is the initial state machine jump let spReq = SPSuppress - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "get_CheckClose", eenvinner, 1, checkCloseExpr, Return) + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "get_CheckClose", eenvinner, 1, None, checkCloseExpr, Return) mkILNonGenericVirtualMethod("get_CheckClose", ILMemberAccess.Public, [], mkILReturn g.ilg.typ_Bool, MethodBody.IL (lazy ilCode)) let generateNextMethod = @@ -5011,11 +5036,11 @@ and GenSequenceExpr let eenvinner = eenvinner |> AddStorageForLocalVals g [ (nextEnumeratorValRef.Deref, Arg 1) ] let ilParams = [mkILParamNamed("next", ILType.Byref ilCloEnumerableTy)] let ilReturn = mkILReturn g.ilg.typ_Int32 - let ilCode = MethodBody.IL (lazy (CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "GenerateNext", eenvinner, 2, generateNextExpr, Return))) + let ilCode = MethodBody.IL (lazy (CodeGenMethodForExpr cenv cgbuf.mgbuf (spReq, [], "GenerateNext", eenvinner, 2, None, generateNextExpr, Return))) mkILNonGenericVirtualMethod("GenerateNext", ILMemberAccess.Public, ilParams, ilReturn, ilCode) let lastGeneratedMethod = - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], "get_LastGenerated", eenvinner, 1, exprForValRef m currvref, Return) + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], "get_LastGenerated", eenvinner, 1, None, exprForValRef m currvref, Return) mkILNonGenericVirtualMethod("get_LastGenerated", ILMemberAccess.Public, [], mkILReturn ilCloSeqElemTy, MethodBody.IL (lazy ilCode)) |> AddNonUserCompilerGeneratedAttribs g @@ -5125,7 +5150,7 @@ and GenClosureAsLocalTypeFunction cenv (cgbuf: CodeGenBuffer) eenv thisVars expr | _ -> failwith "AdjustNamedLocalTypeFuncIlxClosureInfo: local functions can currently only be type functions" strip cloinfo.ilCloLambdas - let ilCloBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, entryPointInfo, cloinfo.cloName, eenvinner, 1, body, Return) + let ilCloBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, entryPointInfo, cloinfo.cloName, eenvinner, 1, None, body, Return) let ilCtorBody = mkILMethodBody (true, [], 8, nonBranchingInstrsToCode (mkCallBaseConstructor(g.ilg.typ_Object, [])), None ) let cloMethods = [ mkILGenericVirtualMethod("DirectInvoke", ILMemberAccess.Assembly, ilDirectGenericParams, ilDirectWitnessParams, mkILReturn ilCloFormalReturnTy, MethodBody.IL(lazy ilCloBody)) ] @@ -5138,7 +5163,7 @@ and GenClosureAsFirstClassFunction cenv (cgbuf: CodeGenBuffer) eenv thisVars m e let entryPointInfo = thisVars |> List.map (fun v -> (v, BranchCallClosure (cloinfo.cloArityInfo))) let ilCloTypeRef = cloinfo.cloSpec.TypeRef - let ilCloBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, entryPointInfo, cloinfo.cloName, eenvinner, 1, body, Return) + let ilCloBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, entryPointInfo, cloinfo.cloName, eenvinner, 1, None, body, Return) let cloTypeDefs = GenClosureTypeDefs cenv (ilCloTypeRef, cloinfo.cloILGenericParams, [], cloinfo.ilCloAllFreeVars, cloinfo.ilCloLambdas, ilCloBody, [], [], g.ilg.typ_Object, [], Some cloinfo.cloSpec) cloinfo, ilCloTypeRef, cloTypeDefs @@ -5436,7 +5461,7 @@ and GenDelegateExpr cenv cgbuf eenvouter expr (TObjExprMethod(TSlotSig(_, delega let ilDelegeeParams, ilDelegeeRet = GenActualSlotsig m cenv envForDelegeeUnderTypars slotsig methTyparsOfOverridingMethod tmvs let envForDelegeeMeth = AddStorageForLocalVals g (List.mapi (fun i v -> (v, Arg (i+numthis))) tmvs) envForDelegeeUnderTypars - let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], delegeeMethName, envForDelegeeMeth, 1, body, (if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return)) + let ilMethodBody = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPAlways, [], delegeeMethName, envForDelegeeMeth, 1, None, body, (if slotSigHasVoidReturnTy slotsig then discardAndReturnVoid else Return)) let delegeeInvokeMeth = (if useStaticClosure then mkILNonGenericStaticMethod else mkILNonGenericInstanceMethod) (delegeeMethName, @@ -6094,16 +6119,16 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt CommitStartScope cgbuf startScopeMarkOpt - let generator = GenMethodForBinding + let hasWitnessEntry = cenv.g.generateWitnesses && not witnessInfos.IsEmpty - generator cenv cgbuf.mgbuf eenv (vspec, mspec, hasWitnessEntry, false, access, ctps, mtps, [], curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, methLambdaBodyTy) + GenMethodForBinding cenv cgbuf.mgbuf eenv (vspec, mspec, hasWitnessEntry, false, access, ctps, mtps, [], curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, methLambdaBodyTy) // If generating witnesses, then generate the second entry point with additional arguments. // Take a copy of the expression to ensure generated names are unique. if hasWitnessEntry then let copyOfLambdaBody = copyExpr cenv.g CloneAll methLambdaBody - generator cenv cgbuf.mgbuf eenv (vspec, mspecW, hasWitnessEntry, true, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, copyOfLambdaBody, methLambdaBodyTy) + GenMethodForBinding cenv cgbuf.mgbuf eenv (vspec, mspecW, hasWitnessEntry, true, access, ctps, mtps, witnessInfos, curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, copyOfLambdaBody, methLambdaBodyTy) | StaticProperty (ilGetterMethSpec, optShadowLocal) when not isStateVar -> @@ -6122,7 +6147,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilPropDef, m) let ilMethodDef = - let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, rhsExpr, Return) + let ilCode = CodeGenMethodForExpr cenv cgbuf.mgbuf (SPSuppress, [], ilGetterMethSpec.Name, eenv, 0, None, rhsExpr, Return) let ilMethodBody = MethodBody.IL(lazy ilCode) (mkILStaticMethod ([], ilGetterMethSpec.Name, access, [], mkILReturn ilTy, ilMethodBody)).WithSpecialName |> AddNonUserCompilerGeneratedAttribs g @@ -6671,7 +6696,12 @@ and GenMethodForBinding else body - let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, bodyExpr, sequel) + let selfValOpt = + match selfMethodVars with + | [h] -> Some h + | _ -> None + + let ilCodeLazy = lazy CodeGenMethodForExpr cenv mgbuf (SPAlways, tailCallInfo, mspec.Name, eenvForMeth, 0, selfValOpt, bodyExpr, sequel) // This is the main code generation for most methods false, MethodBody.IL(ilCodeLazy), false @@ -7061,7 +7091,6 @@ and GenGetStorageAndSequel (cenv: cenv) cgbuf eenv m (ty, ilTy) storage storeSeq CommitGetStorageSequel cenv cgbuf eenv m ty None storeSequel | Env (_, ilField, localCloInfo) -> - // Note: ldarg 0 is emitted in 'cu_erase' erasure of the ldenv instruction CG.EmitInstrs cgbuf (pop 0) (Push [ilTy]) [ mkLdarg0; mkNormalLdfld ilField ] CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel @@ -7484,7 +7513,7 @@ and GenImplFile cenv (mgbuf: AssemblyBuilder) mainInfoOpt eenv (implFile: TypedI // topInstrs is ILInstr[] and contains the abstract IL for this file's top-level actions. topCode is the ILMethodBody for that same code. let topInstrs, topCode = CodeGenMethod cenv mgbuf - ([], methodName, eenv, 0, + ([], methodName, eenv, 0, None, (fun cgbuf eenv -> GenModuleExpr cenv cgbuf qname lazyInitInfo eenv mexpr CG.EmitInstr cgbuf (pop 0) Push0 I_ret), m) @@ -8464,7 +8493,7 @@ let CodegenAssembly cenv eenv mgbuf implFiles = if not (isNil extraBindings) then let mexpr = TMDefs [ for b in extraBindings -> TMDefLet(b, range0) ] let _emptyTopInstrs, _emptyTopCode = - CodeGenMethod cenv mgbuf ([], "unused", eenv, 0, (fun cgbuf eenv -> + CodeGenMethod cenv mgbuf ([], "unused", eenv, 0, None, (fun cgbuf eenv -> let lazyInitInfo = ResizeArray() let qname = QualifiedNameOfFile(mkSynId range0 "unused") LocalScope "module" cgbuf (fun scopeMarks -> diff --git a/src/fsharp/absil/ilwrite.fs b/src/fsharp/absil/ilwrite.fs index f979e24da6d..8b5e2ec2d41 100644 --- a/src/fsharp/absil/ilwrite.fs +++ b/src/fsharp/absil/ilwrite.fs @@ -2114,7 +2114,6 @@ module Codebuf = mkScopeNode cenv localSigs (s1, e1, cl.DebugMappings, children)) trees - // Emit the SEH tree let rec emitExceptionHandlerTree (codebuf: CodeBuffer) (Node (x, childSEH)) = List.iter (emitExceptionHandlerTree codebuf) childSEH // internal first @@ -2151,7 +2150,10 @@ module Codebuf = // Build the locals information, ready to emit let localsTree = makeLocalsTree cenv localSigs pc2pos code.Labels code.Locals - localsTree + + // Adjust the scopes for shadowing + let unshadowed = List.collect (unshadowScopes >> Array.toList) localsTree + unshadowed let EmitTopCode cenv localSigs env nm code = use codebuf = CodeBuffer.Create nm diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index 5dc673b46dc..094cd1c290a 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -258,6 +258,13 @@ let sortMethods showTimes info = reportTime showTimes (sprintf "PDB: Sorted %d methods" info.Methods.Length) () +let scopeSorter (scope1: PdbMethodScope) (scope2: PdbMethodScope) = + if scope1.StartOffset > scope2.StartOffset then 1 + elif scope1.StartOffset < scope2.StartOffset then -1 + elif (scope1.EndOffset - scope1.StartOffset) > (scope2.EndOffset - scope2.StartOffset) then -1 + elif (scope1.EndOffset - scope1.StartOffset) < (scope2.EndOffset - scope2.StartOffset) then 1 + else 0 + let getRowCounts tableRowCounts = let builder = ImmutableArray.CreateBuilder(tableRowCounts |> Array.length) tableRowCounts |> Seq.iter(fun x -> builder.Add x) @@ -484,42 +491,92 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s // Write the scopes let nextHandle handle = MetadataTokens.LocalVariableHandle(MetadataTokens.GetRowNumber(LocalVariableHandle.op_Implicit handle) + 1) - let writeMethodScope scope = - let scopeSorter (scope1: PdbMethodScope) (scope2: PdbMethodScope) = - if scope1.StartOffset > scope2.StartOffset then 1 - elif scope1.StartOffset < scope2.StartOffset then -1 - elif (scope1.EndOffset - scope1.StartOffset) > (scope2.EndOffset - scope2.StartOffset) then -1 - elif (scope1.EndOffset - scope1.StartOffset) < (scope2.EndOffset - scope2.StartOffset) then 1 - else 0 - - let collectScopes scope = + let writeMethodScopes rootScope = + + // Smash apart scopes that have shadowed values + let unshadowedRootScopes = + let rec allNamesOfScope acc (scope: PdbMethodScope) = + let acc = (acc, scope.Locals) ||> Array.fold (fun z l -> Set.add l.Name z) + let acc = (acc, scope.Children) ||> Array.fold allNamesOfScope + acc + + let rec loop (scope: PdbMethodScope) = + // Don't bother if scopes are not nested + if scope.Children |> Array.forall (fun child -> + child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then + let newChildrenAndNames = scope.Children |> Array.map loop + let newChildren, childNames = newChildrenAndNames |> Array.unzip + let newChildren = Array.concat newChildren |> Array.sortWith scopeSorter + let childNames = Set.unionMany childNames + let scopeNames = set [| for n in scope.Locals -> n.Name |] + let allNames = Set.union scopeNames childNames + let unshadowedScopes = + if Set.isEmpty (Set.intersect scopeNames childNames) then + [| { scope with Children = newChildren } |] + else + // Do not emit 'scope' itself. Instead, + // 1. Emit a copy of 'scope' in each true gap, with all locals + // 2. Push the locals that do not have name conflicts down into each child + let filled = + [| yield (scope.StartOffset, scope.StartOffset) + for newChild in newChildren do + yield (newChild.StartOffset, newChild.EndOffset) + yield (scope.EndOffset, scope.EndOffset) |] + let unshadowed = + [| for ((_,a),(b,_)) in Array.pairwise filled do + if a < b then + yield { scope with Children = [| |]; StartOffset = a; EndOffset = b} + + for newChilds, childNames in newChildrenAndNames do + let preservedScopeLocals = + [| for l in scope.Locals do + if childNames.Contains l.Name then + yield { l with Name = l.Name + " (shadowed)" } + else + yield l |] + for newChild in newChilds do + yield { newChild with Locals = Array.append preservedScopeLocals newChild.Locals } |] + + |> Array.sortWith scopeSorter + unshadowed + + unshadowedScopes, allNames + else + [| scope |], allNamesOfScope Set.empty scope + let unshadowedRootScopes, _ = loop rootScope + unshadowedRootScopes + + let flattenedScopes = let list = List() - let rec toList scope parent = - let nested = - match parent with - | Some p -> scope.StartOffset <> p.StartOffset || scope.EndOffset <> p.EndOffset - | None -> true + let rec flattenScopes scope parent = + + list.Add scope + for nestedScope in scope.Children do + let isNested = + match parent with + | Some p -> nestedScope.StartOffset >= p.StartOffset && nestedScope.EndOffset <= p.EndOffset + | None -> true - if nested then list.Add scope - scope.Children |> Seq.iter(fun s -> toList s (if nested then Some scope else parent)) + flattenScopes nestedScope (if isNested then Some scope else parent) + + for unshadowedRootScope in unshadowedRootScopes do + flattenScopes unshadowedRootScope None - toList scope None list.ToArray() |> Array.sortWith scopeSorter - collectScopes scope |> Seq.iter(fun s -> - metadata.AddLocalScope(MetadataTokens.MethodDefinitionHandle(minfo.MethToken), - Unchecked.defaultof, - nextHandle lastLocalVariableHandle, - Unchecked.defaultof, - s.StartOffset, s.EndOffset - s.StartOffset ) |>ignore + for scope in flattenedScopes do + metadata.AddLocalScope(MetadataTokens.MethodDefinitionHandle(minfo.MethToken), + Unchecked.defaultof, + nextHandle lastLocalVariableHandle, + Unchecked.defaultof, + scope.StartOffset, scope.EndOffset - scope.StartOffset ) |>ignore - for localVariable in s.Locals do - lastLocalVariableHandle <- metadata.AddLocalVariable(LocalVariableAttributes.None, localVariable.Index, metadata.GetOrAddString(localVariable.Name)) - ) + for localVariable in scope.Locals do + lastLocalVariableHandle <- metadata.AddLocalVariable(LocalVariableAttributes.None, localVariable.Index, metadata.GetOrAddString(localVariable.Name)) match minfo.RootScope with | None -> () - | Some scope -> writeMethodScope scope ) + | Some scope -> writeMethodScopes scope ) let entryPoint = match info.EntryPoint with @@ -821,3 +878,59 @@ let logDebugInfo (outfile: string) (info: PdbData) = | None -> () | Some rootscope -> writeScope "" rootscope fprintfn sw "" + +let rec allNamesOfScope acc (scope: PdbMethodScope) = + let acc = (acc, scope.Locals) ||> Array.fold (fun z l -> Set.add l.Name z) + let acc = (acc, scope.Children) ||> Array.fold allNamesOfScope + acc + +// Check to see if a scope has a local with the same name as any of its children +// +// If so, do not emit 'scope' itself. Instead, +// 1. Emit a copy of 'scope' in each true gap, with all locals +// 2. Adjust each child scope to also contain the locals from 'scope', +// adding the text " (shadowed)" to the names of those with name conflicts. +let rec unshadowScopeAux (scope: PdbMethodScope) = + // Don't bother if scopes are not nested + if scope.Children |> Array.forall (fun child -> + child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then + let newChildrenAndNames = scope.Children |> Array.map unshadowScopeAux + let newChildren, childNames = newChildrenAndNames |> Array.unzip + let newChildren = Array.concat newChildren |> Array.sortWith scopeSorter + let childNames = Set.unionMany childNames + let scopeNames = set [| for n in scope.Locals -> n.Name |] + let allNames = Set.union scopeNames childNames + let unshadowedScopes = + if Set.isEmpty (Set.intersect scopeNames childNames) then + [| { scope with Children = newChildren } |] + else + let filled = + [| yield (scope.StartOffset, scope.StartOffset) + for newChild in newChildren do + yield (newChild.StartOffset, newChild.EndOffset) + yield (scope.EndOffset, scope.EndOffset) |] + let unshadowed = + [| for ((_,a),(b,_)) in Array.pairwise filled do + if a < b then + yield { scope with Children = [| |]; StartOffset = a; EndOffset = b} + + for newChilds, childNames in newChildrenAndNames do + let preservedScopeLocals = + [| for l in scope.Locals do + if childNames.Contains l.Name then + yield { l with Name = l.Name + " (shadowed)" } + else + yield l |] + for newChild in newChilds do + yield { newChild with Locals = Array.append preservedScopeLocals newChild.Locals } |] + + |> Array.sortWith scopeSorter + unshadowed + + unshadowedScopes, allNames + else + [| scope |], allNamesOfScope Set.empty scope + +let unshadowScopes rootScope = + let unshadowedRootScopes, _ = unshadowScopeAux rootScope + unshadowedRootScopes diff --git a/src/fsharp/absil/ilwritepdb.fsi b/src/fsharp/absil/ilwritepdb.fsi index d78dff7b0fa..dd8126a7c50 100644 --- a/src/fsharp/absil/ilwritepdb.fsi +++ b/src/fsharp/absil/ilwritepdb.fsi @@ -84,10 +84,21 @@ type HashAlgorithm = | Sha256 val generatePortablePdb : embedAllSource: bool -> embedSourceList: string list -> sourceLink: string -> checksumAlgorithm: HashAlgorithm -> showTimes: bool -> info: PdbData -> pathMap:PathMap -> int64 * BlobContentId * MemoryStream * string * byte[] + val compressPortablePdbStream : uncompressedLength:int64 -> contentId:BlobContentId -> stream:MemoryStream -> int64 * BlobContentId * MemoryStream + val embedPortablePdbInfo: uncompressedLength: int64 -> contentId: BlobContentId -> stream: MemoryStream -> showTimes: bool -> fpdb: string -> cvChunk: BinaryChunk -> pdbChunk: BinaryChunk -> deterministicPdbChunk: BinaryChunk -> checksumPdbChunk: BinaryChunk -> algorithmName: string -> checksum: byte[] -> embeddedPdb: bool -> deterministic: bool -> idd[] + val writePortablePdbInfo: contentId: BlobContentId -> stream: MemoryStream -> showTimes: bool -> fpdb: string -> pathMap: PathMap -> cvChunk: BinaryChunk -> deterministicPdbChunk: BinaryChunk -> checksumPdbChunk: BinaryChunk -> algorithmName: string -> checksum: byte[] -> embeddedPdb: bool -> deterministic: bool -> idd[] #if !FX_NO_PDB_WRITER val writePdbInfo : showTimes:bool -> f:string -> fpdb:string -> info:PdbData -> cvChunk:BinaryChunk -> idd[] #endif + +/// Check to see if a scope has a local with the same name as any of its children +/// +/// If so, do not emit 'scope' itself. Instead, +/// 1. Emit a copy of 'scope' in each true gap, with all locals +/// 2. Adjust each child scope to also contain the locals from 'scope', +/// adding the text " (shadowed)" to the names of those with name conflicts. +val unshadowScopes: PdbMethodScope -> PdbMethodScope[] From 974079590504bd7f29650faa3af26f7a0cfd1593 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 23 Aug 2021 21:57:17 +0100 Subject: [PATCH 02/11] update baselines --- src/fsharp/absil/ilwritepdb.fs | 56 +------------------ .../CCtorDUWithMember01.il.bsl | 16 ++++-- .../CompiledNameAttribute02.il.bsl | 30 +++++----- .../ComputationExpr05.il.bsl | 20 ++++--- .../Misc/ArgumentNamesInClosures01.il.bsl | 32 +++++++---- .../Source/CodeGen/EmittedIL/Misc/cas.il.bsl | 16 ++++-- .../ToplevelModule.il.bsl | 36 +++++++----- .../ToplevelNamespace.il.bsl | 50 ++++++++++------- .../TestFunctions/TestFunction23.il.bsl | 24 ++++---- .../EmittedIL/Tuples/OptionalArg01.il.bsl | 8 +-- .../EmittedIL/Tuples/TupleElimination.il.bsl | 14 ++--- 11 files changed, 148 insertions(+), 154 deletions(-) diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index 094cd1c290a..803eed804a2 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -493,59 +493,6 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s let nextHandle handle = MetadataTokens.LocalVariableHandle(MetadataTokens.GetRowNumber(LocalVariableHandle.op_Implicit handle) + 1) let writeMethodScopes rootScope = - // Smash apart scopes that have shadowed values - let unshadowedRootScopes = - let rec allNamesOfScope acc (scope: PdbMethodScope) = - let acc = (acc, scope.Locals) ||> Array.fold (fun z l -> Set.add l.Name z) - let acc = (acc, scope.Children) ||> Array.fold allNamesOfScope - acc - - let rec loop (scope: PdbMethodScope) = - // Don't bother if scopes are not nested - if scope.Children |> Array.forall (fun child -> - child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then - let newChildrenAndNames = scope.Children |> Array.map loop - let newChildren, childNames = newChildrenAndNames |> Array.unzip - let newChildren = Array.concat newChildren |> Array.sortWith scopeSorter - let childNames = Set.unionMany childNames - let scopeNames = set [| for n in scope.Locals -> n.Name |] - let allNames = Set.union scopeNames childNames - let unshadowedScopes = - if Set.isEmpty (Set.intersect scopeNames childNames) then - [| { scope with Children = newChildren } |] - else - // Do not emit 'scope' itself. Instead, - // 1. Emit a copy of 'scope' in each true gap, with all locals - // 2. Push the locals that do not have name conflicts down into each child - let filled = - [| yield (scope.StartOffset, scope.StartOffset) - for newChild in newChildren do - yield (newChild.StartOffset, newChild.EndOffset) - yield (scope.EndOffset, scope.EndOffset) |] - let unshadowed = - [| for ((_,a),(b,_)) in Array.pairwise filled do - if a < b then - yield { scope with Children = [| |]; StartOffset = a; EndOffset = b} - - for newChilds, childNames in newChildrenAndNames do - let preservedScopeLocals = - [| for l in scope.Locals do - if childNames.Contains l.Name then - yield { l with Name = l.Name + " (shadowed)" } - else - yield l |] - for newChild in newChilds do - yield { newChild with Locals = Array.append preservedScopeLocals newChild.Locals } |] - - |> Array.sortWith scopeSorter - unshadowed - - unshadowedScopes, allNames - else - [| scope |], allNamesOfScope Set.empty scope - let unshadowedRootScopes, _ = loop rootScope - unshadowedRootScopes - let flattenedScopes = let list = List() let rec flattenScopes scope parent = @@ -559,8 +506,7 @@ let generatePortablePdb (embedAllSource: bool) (embedSourceList: string list) (s flattenScopes nestedScope (if isNested then Some scope else parent) - for unshadowedRootScope in unshadowedRootScopes do - flattenScopes unshadowedRootScope None + flattenScopes rootScope None list.ToArray() |> Array.sortWith scopeSorter diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/CCtorDUWithMember/CCtorDUWithMember01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/CCtorDUWithMember/CCtorDUWithMember01.il.bsl index dacfacbd39b..f8f286e007d 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/CCtorDUWithMember/CCtorDUWithMember01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/CCtorDUWithMember/CCtorDUWithMember01.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000780 Length: 0x00000227 } .module CCtorDUWithMember01.exe -// MVID: {611C4D7E-26F1-14EE-A745-03837E4D1C61} +// MVID: {6124062C-26F1-14EE-A745-03832C062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x067A0000 +// Image base: 0x068A0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -483,11 +483,15 @@ .method public hidebysig specialname instance int32 get_P() cil managed { - // Code size 2 (0x2) - .maxstack 8 + // Code size 4 (0x4) + .maxstack 3 + .locals init ([0] class CCtorDUWithMember01a/C x) + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.0 + IL_0001: stloc.0 .line 6,6 : 18,19 '' - IL_0000: ldc.i4.1 - IL_0001: ret + IL_0002: ldc.i4.1 + IL_0003: ret } // end of method C::get_P .method public hidebysig virtual final diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/CompiledNameAttribute/CompiledNameAttribute02.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/CompiledNameAttribute/CompiledNameAttribute02.il.bsl index 6adf54e44d5..cc0468b88a0 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/CompiledNameAttribute/CompiledNameAttribute02.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/CompiledNameAttribute/CompiledNameAttribute02.il.bsl @@ -1,5 +1,5 @@ -// Microsoft (R) .NET Framework IL Disassembler. Version 4.6.1055.0 +// Microsoft (R) .NET Framework IL Disassembler. Version 4.8.3928.0 // Copyright (c) Microsoft Corporation. All rights reserved. @@ -13,7 +13,7 @@ .assembly extern FSharp.Core { .publickeytoken = (B0 3F 5F 7F 11 D5 0A 3A ) // .?_....: - .ver 4:4:1:0 + .ver 5:0:0:0 } .assembly CompiledNameAttribute02 { @@ -29,20 +29,20 @@ } .mresource public FSharpSignatureData.CompiledNameAttribute02 { - // Offset: 0x00000000 Length: 0x000002E8 + // Offset: 0x00000000 Length: 0x000002E4 } .mresource public FSharpOptimizationData.CompiledNameAttribute02 { - // Offset: 0x000002F0 Length: 0x000000CD + // Offset: 0x000002E8 Length: 0x000000CD } .module CompiledNameAttribute02.exe -// MVID: {59B1923F-F755-F3C0-A745-03833F92B159} +// MVID: {6124062C-F755-F3C0-A745-03832C062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x018A0000 +// Image base: 0x06A90000 // =============== CLASS MEMBERS DECLARATION =================== @@ -60,14 +60,18 @@ int32 y) cil managed { .custom instance void [FSharp.Core]Microsoft.FSharp.Core.CompilationSourceNameAttribute::.ctor(string) = ( 01 00 06 4D 65 74 68 6F 64 00 00 ) // ...Method.. - // Code size 4 (0x4) - .maxstack 8 + // Code size 6 (0x6) + .maxstack 4 + .locals init ([0] class CompiledNameAttribute02/T a) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 5,5 : 34,39 'C:\\GitHub\\dsyme\\visualfsharp\\tests\\fsharpqa\\Source\\CodeGen\\EmittedIL\\CompiledNameAttribute\\CompiledNameAttribute02.fs' - IL_0000: ldarg.1 - IL_0001: ldarg.2 - IL_0002: add - IL_0003: ret + .line 100001,100001 : 0,0 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\CompiledNameAttribute\\CompiledNameAttribute02.fs' + IL_0000: ldarg.0 + IL_0001: stloc.0 + .line 5,5 : 34,39 '' + IL_0002: ldarg.1 + IL_0003: ldarg.2 + IL_0004: add + IL_0005: ret } // end of method T::SomeCompiledName } // end of class T diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExpr05.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExpr05.il.bsl index 1d8c67b452c..8556c5ef694 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExpr05.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExpr05.il.bsl @@ -40,13 +40,13 @@ // Offset: 0x00000218 Length: 0x0000007D } .module ComputationExpr05.exe -// MVID: {611C4D7F-3687-E566-A745-03837F4D1C61} +// MVID: {6124062C-3687-E566-A745-03832C062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x05380000 +// Image base: 0x07110000 // =============== CLASS MEMBERS DECLARATION =================== @@ -76,11 +76,15 @@ instance void System.IDisposable.Dispose() cil managed { .override [mscorlib]System.IDisposable::Dispose - // Code size 1 (0x1) - .maxstack 8 + // Code size 3 (0x3) + .maxstack 4 + .locals init ([0] class [mscorlib]System.IDisposable x) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 9,9 : 68,70 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\ComputationExpressions\\ComputationExpr05.fs' - IL_0000: ret + .line 100001,100001 : 0,0 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\ComputationExpressions\\ComputationExpr05.fs' + IL_0000: ldarg.0 + IL_0001: stloc.0 + .line 9,9 : 68,70 '' + IL_0002: ret } // end of method 'res5@9-1'::System.IDisposable.Dispose } // end of class 'res5@9-1' @@ -112,8 +116,8 @@ { // Code size 45 (0x2d) .maxstack 6 - .locals init ([0] class [mscorlib]System.IDisposable x, - [1] int32 V_1) + .locals init ([0] class [mscorlib]System.IDisposable 'x (shadowed)', + [1] int32 x) .line 10,10 : 9,50 '' IL_0000: ldarg.1 IL_0001: stloc.0 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/ArgumentNamesInClosures01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/ArgumentNamesInClosures01.il.bsl index e6142d728e9..3065bbcf302 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/ArgumentNamesInClosures01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/ArgumentNamesInClosures01.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x000003A0 Length: 0x0000010D } .module ArgumentNamesInClosures01.dll -// MVID: {60B68B7F-39CA-41B5-A745-03837F8BB660} +// MVID: {6124062D-39CA-41B5-A745-03832D062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x00EF0000 +// Image base: 0x06BD0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -58,14 +58,18 @@ .method public hidebysig instance int32 F(object o) cil managed { - // Code size 9 (0x9) - .maxstack 8 + // Code size 11 (0xb) + .maxstack 3 + .locals init ([0] class M/C x) .language '{AB4F38C9-B6E6-43BA-BE3B-58080B2CCCE3}', '{994B45C4-E6E9-11D2-903F-00C04FA302A1}', '{5A869D0B-6611-11D3-BD2A-0000F80849BD}' - .line 36,36 : 29,44 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\Misc\\ArgumentNamesInClosures01.fs' + .line 100001,100001 : 0,0 'C:\\GitHub\\dsyme\\fsharp\\tests\\fsharpqa\\source\\CodeGen\\EmittedIL\\Misc\\ArgumentNamesInClosures01.fs' IL_0000: ldarg.0 - IL_0001: tail. - IL_0003: callvirt instance int32 [mscorlib]System.Object::GetHashCode() - IL_0008: ret + IL_0001: stloc.0 + .line 36,36 : 29,44 '' + IL_0002: ldarg.0 + IL_0003: tail. + IL_0005: callvirt instance int32 [mscorlib]System.Object::GetHashCode() + IL_000a: ret } // end of method C::F } // end of class C @@ -92,11 +96,15 @@ instance class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 get_F() cil managed { - // Code size 6 (0x6) - .maxstack 8 + // Code size 8 (0x8) + .maxstack 3 + .locals init ([0] class M/T x) + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.0 + IL_0001: stloc.0 .line 41,41 : 22,23 '' - IL_0000: ldsfld class M/get_F@41 M/get_F@41::@_instance - IL_0005: ret + IL_0002: ldsfld class M/get_F@41 M/get_F@41::@_instance + IL_0007: ret } // end of method T::get_F .property instance class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/cas.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/cas.il.bsl index 301f28d9b64..e5496eb0016 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/cas.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Misc/cas.il.bsl @@ -43,13 +43,13 @@ // Offset: 0x00000620 Length: 0x000000F3 } .module cas.exe -// MVID: {60B68B7F-35EA-18E3-A745-03837F8BB660} +// MVID: {6124062D-35EA-18E3-A745-03832D062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x05250000 +// Image base: 0x05010000 // =============== CLASS MEMBERS DECLARATION =================== @@ -92,11 +92,15 @@ = {class 'System.Security.Permissions.PrincipalPermissionAttribute, mscorlib, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089' = {property string 'Role' = string('test')}} .permissionset assert = {[cas]CustomSecAttr.CustomPermission2Attribute = {property enum class 'CustomSecAttr.SecurityArgType, cas, Version=0.0.0.0, Culture=neutral, PublicKeyToken=null' 'SecurityArg' = int32(2)}} - // Code size 6 (0x6) - .maxstack 8 + // Code size 8 (0x8) + .maxstack 3 + .locals init ([0] class Cas/AttrTest/Foo x) + .line 100001,100001 : 0,0 '' + IL_0000: ldarg.0 + IL_0001: stloc.0 .line 14,14 : 33,37 '' - IL_0000: ldc.i4 0x18c0 - IL_0005: ret + IL_0002: ldc.i4 0x18c0 + IL_0007: ret } // end of method Foo::someMethod } // end of class Foo diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl index 0ddb079f90c..20e58abd2bb 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001148 Length: 0x000003FD } .module TopLevelModule.dll -// MVID: {611C4D86-37F5-C118-A745-0383864D1C61} +// MVID: {61240631-37F5-C118-A745-038331062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x067D0000 +// Image base: 0x06970000 // =============== CLASS MEMBERS DECLARATION =================== @@ -825,12 +825,16 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 7 (0x7) - .maxstack 8 - .line 8,8 : 42,43 '' + // Code size 9 (0x9) + .maxstack 3 + .locals init ([0] class ABC/A __) + .line 100001,100001 : 0,0 '' IL_0000: ldarg.0 - IL_0001: ldfld string ABC/A::x - IL_0006: ret + IL_0001: stloc.0 + .line 8,8 : 42,43 '' + IL_0002: ldarg.0 + IL_0003: ldfld string ABC/A::x + IL_0008: ret } // end of method A::get_X .property instance string X() @@ -1616,12 +1620,16 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 7 (0x7) - .maxstack 8 - .line 18,18 : 46,47 '' + // Code size 9 (0x9) + .maxstack 3 + .locals init ([0] class ABC/ABC/A __) + .line 100001,100001 : 0,0 '' IL_0000: ldarg.0 - IL_0001: ldfld string ABC/ABC/A::x - IL_0006: ret + IL_0001: stloc.0 + .line 18,18 : 46,47 '' + IL_0002: ldarg.0 + IL_0003: ldfld string ABC/ABC/A::x + IL_0008: ret } // end of method A::get_X .property instance string X() @@ -1702,8 +1710,8 @@ { // Code size 13 (0xd) .maxstack 3 - .locals init ([0] string greeting, - [1] string V_1) + .locals init ([0] string 'greeting (shadowed)', + [1] string greeting) .line 12,12 : 9,31 '' IL_0000: call string ABC::get_greeting() IL_0005: stloc.0 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl index f96e7946db8..bd0e31b467f 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001850 Length: 0x0000055C } .module ToplevelNamespace.dll -// MVID: {611C4D8C-218B-729A-A745-03838C4D1C61} +// MVID: {61240635-218B-729A-A745-038335062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x072C0000 +// Image base: 0x06D90000 // =============== CLASS MEMBERS DECLARATION =================== @@ -820,12 +820,16 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 7 (0x7) - .maxstack 8 - .line 9,9 : 38,39 '' + // Code size 9 (0x9) + .maxstack 3 + .locals init ([0] class XYZ.A __) + .line 100001,100001 : 0,0 '' IL_0000: ldarg.0 - IL_0001: ldfld string XYZ.A::x - IL_0006: ret + IL_0001: stloc.0 + .line 9,9 : 38,39 '' + IL_0002: ldarg.0 + IL_0003: ldfld string XYZ.A::x + IL_0008: ret } // end of method A::get_X .property instance string X() @@ -1611,12 +1615,16 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 7 (0x7) - .maxstack 8 - .line 15,15 : 42,43 '' + // Code size 9 (0x9) + .maxstack 3 + .locals init ([0] class XYZ.ABC/A __) + .line 100001,100001 : 0,0 '' IL_0000: ldarg.0 - IL_0001: ldfld string XYZ.ABC/A::x - IL_0006: ret + IL_0001: stloc.0 + .line 15,15 : 42,43 '' + IL_0002: ldarg.0 + IL_0003: ldfld string XYZ.ABC/A::x + IL_0008: ret } // end of method A::get_X .property instance string X() @@ -2402,12 +2410,16 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 7 (0x7) - .maxstack 8 - .line 25,25 : 46,47 '' + // Code size 9 (0x9) + .maxstack 3 + .locals init ([0] class XYZ.ABC/ABC/A __) + .line 100001,100001 : 0,0 '' IL_0000: ldarg.0 - IL_0001: ldfld string XYZ.ABC/ABC/A::x - IL_0006: ret + IL_0001: stloc.0 + .line 25,25 : 46,47 '' + IL_0002: ldarg.0 + IL_0003: ldfld string XYZ.ABC/ABC/A::x + IL_0008: ret } // end of method A::get_X .property instance string X() @@ -2488,8 +2500,8 @@ { // Code size 13 (0xd) .maxstack 3 - .locals init ([0] string greeting, - [1] string V_1) + .locals init ([0] string 'greeting (shadowed)', + [1] string greeting) .line 19,19 : 9,31 '' IL_0000: call string XYZ.ABC::get_greeting() IL_0005: stloc.0 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction23.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction23.il.bsl index 7f88a4908a9..53cfd72c55c 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction23.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/TestFunctions/TestFunction23.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000340 Length: 0x000000E3 } .module TestFunction23.exe -// MVID: {60B68B97-A643-451C-A745-0383978BB660} +// MVID: {6124063B-A643-451C-A745-03833B062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x07240000 +// Image base: 0x05750000 // =============== CLASS MEMBERS DECLARATION =================== @@ -83,16 +83,20 @@ .method public hidebysig instance string M() cil managed { - // Code size 18 (0x12) - .maxstack 8 - .line 9,9 : 23,30 '' + // Code size 20 (0x14) + .maxstack 4 + .locals init ([0] class TestFunction23/C self) + .line 100001,100001 : 0,0 '' IL_0000: ldarg.0 - IL_0001: ldfld string TestFunction23/C::x@8 - IL_0006: ldarg.0 - IL_0007: callvirt instance string TestFunction23/C::g() - IL_000c: call string [mscorlib]System.String::Concat(string, + IL_0001: stloc.0 + .line 9,9 : 23,30 '' + IL_0002: ldarg.0 + IL_0003: ldfld string TestFunction23/C::x@8 + IL_0008: ldarg.0 + IL_0009: callvirt instance string TestFunction23/C::g() + IL_000e: call string [mscorlib]System.String::Concat(string, string) - IL_0011: ret + IL_0013: ret } // end of method C::M .method assembly hidebysig instance string diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl index 96b5fb284f9..6db863794d5 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/OptionalArg01.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00000460 Length: 0x00000445 } .module OptionalArg01.exe -// MVID: {611C4D9E-4F48-B5AF-A745-03839E4D1C61} +// MVID: {6124063B-4F48-B5AF-A745-03833B062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x064B0000 +// Image base: 0x04EE0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -100,8 +100,8 @@ .custom instance void [FSharp.Core]Microsoft.FSharp.Core.OptionalArgumentAttribute::.ctor() = ( 01 00 00 00 ) // Code size 93 (0x5d) .maxstack 4 - .locals init ([0] int32 count, - [1] int32 V_1, + .locals init ([0] int32 'count (shadowed)', + [1] int32 count, [2] class [mscorlib]System.Collections.Generic.List`1 attribs, [3] class [FSharp.Core]Microsoft.FSharp.Core.FSharpOption`1 V_3, [4] class OptionalArg01/A v2) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl index 56515db1026..f04b9c743b8 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/Tuples/TupleElimination.il.bsl @@ -41,13 +41,13 @@ // Offset: 0x00000230 Length: 0x0000007B } .module TupleElimination.exe -// MVID: {611C52B3-DFDD-92DF-A745-0383B3521C61} +// MVID: {6124063B-DFDD-92DF-A745-03833B062461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x050E0000 +// Image base: 0x06D10000 // =============== CLASS MEMBERS DECLARATION =================== @@ -64,12 +64,12 @@ .maxstack 5 .locals init ([0] class [mscorlib]System.Collections.Generic.Dictionary`2 dic, [1] int32 i, - [2] bool b, + [2] bool 'b (shadowed)', [3] class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4,class [mscorlib]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_3, [4] int32 V_4, [5] class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4,class [mscorlib]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_5, [6] int64 l, - [7] bool V_7, + [7] bool b, [8] class [mscorlib]System.Tuple`2 t, [9] int64 V_9, [10] class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4,class [mscorlib]System.IO.TextWriter,class [FSharp.Core]Microsoft.FSharp.Core.Unit,class [FSharp.Core]Microsoft.FSharp.Core.Unit> V_10, @@ -114,9 +114,9 @@ IL_0055: ldloca.s l IL_0057: call bool [mscorlib]System.Int64::TryParse(string, int64&) - IL_005c: stloc.s V_7 + IL_005c: stloc.s b .line 14,14 : 5,65 '' - IL_005e: ldloc.s V_7 + IL_005e: ldloc.s b IL_0060: ldloc.s l IL_0062: newobj instance void class [mscorlib]System.Tuple`2::.ctor(!0, !1) @@ -129,7 +129,7 @@ IL_0079: ldloc.3 IL_007a: call !!0 [FSharp.Core]Microsoft.FSharp.Core.PrintfModule::PrintFormatLineToTextWriter>(class [mscorlib]System.IO.TextWriter, class [FSharp.Core]Microsoft.FSharp.Core.PrintfFormat`4) - IL_007f: ldloc.s V_7 + IL_007f: ldloc.s b IL_0081: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) IL_0086: pop .line 16,16 : 5,8 '' From b1f9c724bb9c5b7b8a5512cc127a3cfc99a50b7b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 23 Aug 2021 23:00:50 +0100 Subject: [PATCH 03/11] fix regression in debug codegen --- src/fsharp/CreateILModule.fs | 2 +- src/fsharp/IlxGen.fs | 11 ++-- src/fsharp/IlxGen.fsi | 2 +- src/fsharp/OptimizeInputs.fs | 2 +- src/fsharp/Optimizer.fs | 39 ++++++------ src/fsharp/Optimizer.fsi | 4 +- src/fsharp/fsi/fsi.fs | 2 +- .../CodeGen/EmittedIL/BooleanLogic.fs | 60 ++++++++++++++++++- 8 files changed, 91 insertions(+), 31 deletions(-) diff --git a/src/fsharp/CreateILModule.fs b/src/fsharp/CreateILModule.fs index 087dcc881e2..1cbb4584175 100644 --- a/src/fsharp/CreateILModule.fs +++ b/src/fsharp/CreateILModule.fs @@ -270,7 +270,7 @@ module MainModuleBuilder = let isDLL = (tcConfig.target = CompilerTarget.Dll || tcConfig.target = CompilerTarget.Module) mkILSimpleModule assemblyName ilModuleName isDLL tcConfig.subsystemVersion tcConfig.useHighEntropyVA ilTypeDefs hashAlg locale flags (mkILExportedTypes exportedTypesList) metadataVersion - let disableJitOptimizations = not (tcConfig.optSettings.jitOpt()) + let disableJitOptimizations = not tcConfig.optSettings.JitOptimizationsEnabled let tcVersion = tcConfig.version.GetVersionInfo(tcConfig.implicitIncludeDir) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 974e3457b70..c23b0c8b7c5 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -194,7 +194,7 @@ type IlxGenOptions = mainMethodInfo: Attribs option /// Indicates if local optimizations are on - localOptimizationsAreOn: bool + localOptimizationsEnabled: bool /// Indicates if we are generating debug symbols generateDebugSymbols: bool @@ -2099,7 +2099,6 @@ let CodeGenThen cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, c let start = CG.GenerateMark cgbuf "mstart" let innerVals = entryPointInfo |> List.map (fun (v, kind) -> (v, (kind, start))) - (* Call the given code generator *) codeGenFunction cgbuf {eenv with withinSEH=false liveLocals=IntMap.empty() innerVals = innerVals} @@ -5624,7 +5623,7 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx // We have encountered this target before. See if we should generate it now let targetCount = targetCounts.[targetIdx] - let generateTargetNow = isTargetPostponed && cenv.opts.localOptimizationsAreOn && targetCount = 1 && targetNext.Value = targetIdx + let generateTargetNow = isTargetPostponed && cenv.opts.localOptimizationsEnabled && targetCount = 1 && targetNext.Value = targetIdx targetCounts.[targetIdx] <- targetCount - 1 // If not binding anything we can go directly to the targetMarkBeforeBinds point @@ -5683,7 +5682,7 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx // In debug mode, postpone all decision tree targets to after the switching. // In release mode, if a target is the target of multiple incoming success nodes, postpone it to avoid // making any backward branches - let generateTargetNow = cenv.opts.localOptimizationsAreOn && targetCount = 1 && targetNext.Value = targetIdx + let generateTargetNow = cenv.opts.localOptimizationsEnabled && targetCount = 1 && targetNext.Value = targetIdx targetCounts.[targetIdx] <- targetCount - 1 let genTargetInfoOpt = @@ -7083,7 +7082,7 @@ and AllocLocal cenv cgbuf eenv compgen (v, ty, isFixed) (scopeMarks: Mark * Mark let ranges = if compgen then [] else [(v, scopeMarks)] // Get an index for the local let j, realloc = - if cenv.opts.localOptimizationsAreOn then + if cenv.opts.localOptimizationsEnabled then cgbuf.ReallocLocal((fun i (_, ty', isFixed') -> not isFixed' && not isFixed && not (IntMap.mem i eenv.liveLocals) && (ty = ty')), ranges, ty, isFixed) else cgbuf.AllocLocal(ranges, ty, isFixed), false @@ -7152,7 +7151,7 @@ and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv = // decide whether to use a shadow local or not let useShadowLocal = cenv.opts.generateDebugSymbols && - not cenv.opts.localOptimizationsAreOn && + not cenv.opts.localOptimizationsEnabled && not v.IsCompilerGenerated && not v.IsMutable && // Don't use shadow locals for things like functions which are not compiled as static values/properties diff --git a/src/fsharp/IlxGen.fsi b/src/fsharp/IlxGen.fsi index b178fd4bc3b..7fe28f1616b 100644 --- a/src/fsharp/IlxGen.fsi +++ b/src/fsharp/IlxGen.fsi @@ -31,7 +31,7 @@ type internal IlxGenOptions = mainMethodInfo: Attribs option /// Indicates if local optimizations are active - localOptimizationsAreOn: bool + localOptimizationsEnabled: bool /// Indicates if we are generating debug symbols or not generateDebugSymbols: bool diff --git a/src/fsharp/OptimizeInputs.fs b/src/fsharp/OptimizeInputs.fs index 95a174e4aeb..f1bb56b1b8c 100644 --- a/src/fsharp/OptimizeInputs.fs +++ b/src/fsharp/OptimizeInputs.fs @@ -173,7 +173,7 @@ let GenerateIlxCode workAroundReflectionEmitBugs=tcConfig.isInteractive // REVIEW: is this still required? generateDebugSymbols= tcConfig.debuginfo fragName = fragName - localOptimizationsAreOn= tcConfig.optSettings.localOpt () + localOptimizationsEnabled= tcConfig.optSettings.LocalOptimizationsEnabled testFlagEmitFeeFeeAs100001 = tcConfig.testFlagEmitFeeFeeAs100001 mainMethodInfo= mainMethodInfo ilxBackend = ilxBackend diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 878495e08d5..e4058646d99 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -349,59 +349,64 @@ type OptimizationSettings = } /// Determines if JIT optimizations are enabled - member x.jitOpt() = match x.jitOptUser with Some f -> f | None -> jitOptDefault + member x.JitOptimizationsEnabled = match x.jitOptUser with Some f -> f | None -> jitOptDefault /// Determines if intra-assembly optimization is enabled - member x.localOpt () = match x.localOptUser with Some f -> f | None -> localOptDefault + member x.LocalOptimizationsEnabled = match x.localOptUser with Some f -> f | None -> localOptDefault /// Determines if cross-assembly optimization is enabled member x.crossAssemblyOpt () = - x.localOpt () && + x.LocalOptimizationsEnabled && x.crossAssemblyOptimizationUser |> Option.defaultValue crossAssemblyOptimizationDefault /// Determines if we should keep optimization values member x.KeepOptimizationValues = x.crossAssemblyOpt () /// Determines if we should inline calls - member x.InlineLambdas = x.localOpt () + member x.InlineLambdas = x.LocalOptimizationsEnabled /// Determines if we should eliminate unused bindings with no effect - member x.EliminateUnusedBindings = x.localOpt () + member x.EliminateUnusedBindings = x.LocalOptimizationsEnabled /// Determines if we should arrange things so we debug points for pipelines x |> f1 |> f2 /// including locals "", "" and so on. /// On by default for debug code. member x.DebugPointsForPipeRight = - not (x.localOpt ()) && + not x.LocalOptimizationsEnabled && x.debugPointsForPipeRight |> Option.defaultValue debugPointsForPipeRightDefault + /// Determines if we should eliminate for-loops around an expr if it has no effect + /// + /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 + member x.EliminateForLoop = x.LocalOptimizationsEnabled + /// Determines if we should eliminate try/with or try/finally around an expr if it has no effect /// /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 member _.EliminateTryWithAndTryFinally = false /// Determines if we should eliminate first part of sequential expression if it has no effect - member x.EliminateSequential = x.localOpt () + member x.EliminateSequential = x.LocalOptimizationsEnabled /// Determines if we should determine branches in pattern matching based on known information, e.g. /// eliminate a "if true then .. else ... " - member x.EliminateSwitch = x.localOpt () + member x.EliminateSwitch = x.LocalOptimizationsEnabled /// Determines if we should eliminate gets on a record if the value is known to be a record with known info and the field is not mutable - member x.EliminateRecdFieldGet = x.localOpt () + member x.EliminateRecdFieldGet = x.LocalOptimizationsEnabled /// Determines if we should eliminate gets on a tuple if the value is known to be a tuple with known info - member x.EliminateTupleFieldGet = x.localOpt () + member x.EliminateTupleFieldGet = x.LocalOptimizationsEnabled /// Determines if we should eliminate gets on a union if the value is known to be that union case and the particular field has known info - member x.EliminateUnionCaseFieldGet () = x.localOpt () + member x.EliminateUnionCaseFieldGet () = x.LocalOptimizationsEnabled /// Determines if we should eliminate non-compiler generated immediate bindings - member x.EliminateImmediatelyConsumedLocals() = x.localOpt () + member x.EliminateImmediatelyConsumedLocals() = x.LocalOptimizationsEnabled /// Determines if we should expand "let x = (exp1, exp2, ...)" bindings as prior tmps /// Also if we should expand "let x = Some exp1" bindings as prior tmps - member x.ExpandStructuralValues() = x.localOpt () + member x.ExpandStructuralValues() = x.LocalOptimizationsEnabled type cenv = { g: TcGlobals @@ -2453,7 +2458,7 @@ and OptimizeFastIntegerForLoop cenv env (spStart, v, e1, dir, e2, e3, m) = let einfos = [e1info;e2info;e3info] let eff = OrEffects einfos (* neither bounds nor body has an effect, and loops always terminate, hence eliminate the loop *) - if not eff then + if cenv.settings.EliminateForLoop && not eff then mkUnit cenv.g m, { TotalSize=0; FunctionSize=0; HasEffect=false; MightMakeCriticalTailcall=false; Info=UnknownValue } else let exprR = mkFor cenv.g (spStart, v, e1R, dir, e2R, e3R, m) @@ -3333,7 +3338,7 @@ and OptimizeDebugPipeRights cenv env expr = xs0R inputVals pipesExprR - expr, pipesInfo + expr, { pipesInfo with HasEffect=true} and OptimizeFSharpDelegateInvoke cenv env (invokeRef, f0, f0ty, tyargs, args, m) = let g = cenv.g @@ -3529,7 +3534,7 @@ and OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) = and OptimizeMatchPart2 cenv (spMatch, exprm, dtreeR, targetsR, dinfo, tinfos, m, ty) = let newExpr, newInfo = RebuildOptimizedMatch (spMatch, exprm, m, ty, dtreeR, targetsR, dinfo, tinfos) - let newExpr2 = if not (cenv.settings.localOpt()) then newExpr else CombineBoolLogic newExpr + let newExpr2 = if not cenv.settings.LocalOptimizationsEnabled then newExpr else CombineBoolLogic newExpr newExpr2, newInfo and CombineMatchInfos dinfo tinfo = @@ -3754,7 +3759,7 @@ and OptimizeModuleExpr cenv env x = let _renaming, hidden as rpi = ComputeRemappingFromImplementationToSignature cenv.g def mty let def = - if not (cenv.settings.localOpt()) then def else + if not cenv.settings.LocalOptimizationsEnabled then def else let fvs = freeInModuleOrNamespace CollectLocals def let dead = diff --git a/src/fsharp/Optimizer.fsi b/src/fsharp/Optimizer.fsi index f1a798afc0a..2f58475338a 100644 --- a/src/fsharp/Optimizer.fsi +++ b/src/fsharp/Optimizer.fsi @@ -43,9 +43,9 @@ type OptimizationSettings = } - member jitOpt: unit -> bool + member JitOptimizationsEnabled: bool - member localOpt: unit -> bool + member LocalOptimizationsEnabled: bool static member Defaults: OptimizationSettings diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 13983a01d36..f798664cc3b 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -1114,7 +1114,7 @@ type internal FsiDynamicCompiler let valuePrinter = FsiValuePrinter(fsi, tcConfigB, tcGlobals, generateDebugInfo, resolveAssemblyRef, outWriter) - let assemblyBuilder,moduleBuilder = mkDynamicAssemblyAndModule (assemblyName, tcConfigB.optSettings.localOpt(), generateDebugInfo, fsiCollectible) + let assemblyBuilder,moduleBuilder = mkDynamicAssemblyAndModule (assemblyName, tcConfigB.optSettings.LocalOptimizationsEnabled, generateDebugInfo, fsiCollectible) let rangeStdin = rangeN stdinMockFilename 0 diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs index 3f842a0c049..1975fc7a5a8 100644 --- a/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs @@ -6,10 +6,10 @@ open FSharp.Test open NUnit.Framework [] -module ``BooleanLogic`` = +module BooleanLogic = [] - let ``BooleanOrs``() = + let BooleanOrs() = CompilerAssert.CompileLibraryAndVerifyILWithOptions [|"-g"; "--optimize+"|] """ module BooleanOrs @@ -54,3 +54,59 @@ let compute (x: int) = """ ]) +[] +// We had a regression in debug code regression where we were falsely marking pipelines +// as non-side-effecting, causing them to be eliminated in loops. +// +// After the fix +// 1. pipelines are correctly marked as having effect +// 2. we don't eliminate loops anyway +module DontEliminateForLoopsInDebugCode = + + CompilerAssert.CompileLibraryAndVerifyILWithOptions [|"-g"; "--optimize-"|] + """ +module DontEliminateForLoops + +let unsolved = [true] +let ApplyDefaults () = + + for priority = 0 to 10 do + unsolved |> List.iter (fun tp -> System.Console.WriteLine()) + + """ + (fun verifier -> verifier.VerifyIL [ + """ +.method public static int32 compute(int32 x) cil managed + { + + .maxstack 8 + IL_0000: nop + IL_0001: ldarg.0 + IL_0002: ldc.i4.1 + IL_0003: beq.s IL_0009 + + IL_0005: ldarg.0 + IL_0006: ldc.i4.2 + IL_0007: bne.un.s IL_000b + + IL_0009: ldc.i4.2 + IL_000a: ret + + IL_000b: nop + IL_000c: ldarg.0 + IL_000d: ldc.i4.3 + IL_000e: beq.s IL_0014 + + IL_0010: ldarg.0 + IL_0011: ldc.i4.4 + IL_0012: bne.un.s IL_0016 + + IL_0014: ldc.i4.3 + IL_0015: ret + + IL_0016: ldc.i4.4 + IL_0017: ret +} + """ + ]) + From 2c22bccb2e51b1e153f0fe530718c2171861efd4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 23 Aug 2021 23:09:47 +0100 Subject: [PATCH 04/11] update test --- .../CodeGen/EmittedIL/BooleanLogic.fs | 90 ++++++++++++------- 1 file changed, 60 insertions(+), 30 deletions(-) diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs index 1975fc7a5a8..2a981b237f5 100644 --- a/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/BooleanLogic.fs @@ -63,6 +63,9 @@ let compute (x: int) = // 2. we don't eliminate loops anyway module DontEliminateForLoopsInDebugCode = + [] + // See https://github.com/dotnet/fsharp/pull/12021 + let Regression12021() = CompilerAssert.CompileLibraryAndVerifyILWithOptions [|"-g"; "--optimize-"|] """ module DontEliminateForLoops @@ -76,37 +79,64 @@ let ApplyDefaults () = """ (fun verifier -> verifier.VerifyIL [ """ -.method public static int32 compute(int32 x) cil managed - { +.method public static void ApplyDefaults() cil managed +{ + + .maxstack 5 + .locals init (int32 V_0, + class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 V_1, + class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2 V_2, + class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 V_3, + class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 V_4, + class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 V_5, + bool V_6) + IL_0000: ldc.i4.0 + IL_0001: stloc.0 + IL_0002: br.s IL_004b - .maxstack 8 - IL_0000: nop - IL_0001: ldarg.0 - IL_0002: ldc.i4.1 - IL_0003: beq.s IL_0009 - - IL_0005: ldarg.0 - IL_0006: ldc.i4.2 - IL_0007: bne.un.s IL_000b - - IL_0009: ldc.i4.2 - IL_000a: ret - - IL_000b: nop - IL_000c: ldarg.0 - IL_000d: ldc.i4.3 - IL_000e: beq.s IL_0014 - - IL_0010: ldarg.0 - IL_0011: ldc.i4.4 - IL_0012: bne.un.s IL_0016 - - IL_0014: ldc.i4.3 - IL_0015: ret - - IL_0016: ldc.i4.4 - IL_0017: ret -} + IL_0004: call class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 DontEliminateForLoops::get_unsolved() + IL_0009: stloc.1 + IL_000a: ldsfld class DontEliminateForLoops/ApplyDefaults@8 DontEliminateForLoops/ApplyDefaults@8::@_instance + IL_000f: stloc.2 + IL_0010: ldloc.1 + IL_0011: stloc.3 + IL_0012: ldloc.3 + IL_0013: stloc.s V_4 + IL_0015: ldloc.s V_4 + IL_0017: call instance class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1::get_TailOrNull() + IL_001c: stloc.s V_5 + IL_001e: ldloc.s V_5 + IL_0020: ldnull + IL_0021: cgt.un + IL_0023: brfalse.s IL_0047 + + IL_0025: ldloc.s V_4 + IL_0027: call instance !0 class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1::get_HeadOrDefault() + IL_002c: stloc.s V_6 + IL_002e: ldloc.2 + IL_002f: ldloc.s V_6 + IL_0031: callvirt instance !1 class [FSharp.Core]Microsoft.FSharp.Core.FSharpFunc`2::Invoke(!0) + IL_0036: pop + IL_0037: ldloc.s V_5 + IL_0039: stloc.s V_4 + IL_003b: ldloc.s V_4 + IL_003d: call instance class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1 class [FSharp.Core]Microsoft.FSharp.Collections.FSharpList`1::get_TailOrNull() + IL_0042: stloc.s V_5 + IL_0044: nop + IL_0045: br.s IL_001e + + IL_0047: ldloc.0 + IL_0048: ldc.i4.1 + IL_0049: add + IL_004a: stloc.0 + IL_004b: ldloc.0 + IL_004c: ldc.i4.1 + IL_004d: ldc.i4.s 10 + IL_004f: add + IL_0050: blt.s IL_0004 + + IL_0052: ret +} """ ]) From 09d9bb4256303b91a3d5e3c56117ed00fc950450 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 24 Aug 2021 00:26:08 +0100 Subject: [PATCH 05/11] update baselines --- .../ToplevelModule.il.bsl | 32 +++++-------- .../ToplevelNamespace.il.bsl | 46 +++++++------------ .../TheBigFileOfDebugStepping.fsx | 5 ++ 3 files changed, 34 insertions(+), 49 deletions(-) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl index 20e58abd2bb..876912097bf 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001148 Length: 0x000003FD } .module TopLevelModule.dll -// MVID: {61240631-37F5-C118-A745-038331062461} +// MVID: {61242E2D-37F5-C118-A745-03832D2E2461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x06970000 +// Image base: 0x06E00000 // =============== CLASS MEMBERS DECLARATION =================== @@ -825,16 +825,12 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 9 (0x9) - .maxstack 3 - .locals init ([0] class ABC/A __) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: stloc.0 + // Code size 7 (0x7) + .maxstack 8 .line 8,8 : 42,43 '' - IL_0002: ldarg.0 - IL_0003: ldfld string ABC/A::x - IL_0008: ret + IL_0000: ldarg.0 + IL_0001: ldfld string ABC/A::x + IL_0006: ret } // end of method A::get_X .property instance string X() @@ -1620,16 +1616,12 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 9 (0x9) - .maxstack 3 - .locals init ([0] class ABC/ABC/A __) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: stloc.0 + // Code size 7 (0x7) + .maxstack 8 .line 18,18 : 46,47 '' - IL_0002: ldarg.0 - IL_0003: ldfld string ABC/ABC/A::x - IL_0008: ret + IL_0000: ldarg.0 + IL_0001: ldfld string ABC/ABC/A::x + IL_0006: ret } // end of method A::get_X .property instance string X() diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl index bd0e31b467f..4e3b32c47f3 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001850 Length: 0x0000055C } .module ToplevelNamespace.dll -// MVID: {61240635-218B-729A-A745-038335062461} +// MVID: {61242E31-218B-729A-A745-0383312E2461} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x06D90000 +// Image base: 0x070E0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -820,16 +820,12 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 9 (0x9) - .maxstack 3 - .locals init ([0] class XYZ.A __) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: stloc.0 + // Code size 7 (0x7) + .maxstack 8 .line 9,9 : 38,39 '' - IL_0002: ldarg.0 - IL_0003: ldfld string XYZ.A::x - IL_0008: ret + IL_0000: ldarg.0 + IL_0001: ldfld string XYZ.A::x + IL_0006: ret } // end of method A::get_X .property instance string X() @@ -1615,16 +1611,12 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 9 (0x9) - .maxstack 3 - .locals init ([0] class XYZ.ABC/A __) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: stloc.0 + // Code size 7 (0x7) + .maxstack 8 .line 15,15 : 42,43 '' - IL_0002: ldarg.0 - IL_0003: ldfld string XYZ.ABC/A::x - IL_0008: ret + IL_0000: ldarg.0 + IL_0001: ldfld string XYZ.ABC/A::x + IL_0006: ret } // end of method A::get_X .property instance string X() @@ -2410,16 +2402,12 @@ .method public hidebysig specialname instance string get_X() cil managed { - // Code size 9 (0x9) - .maxstack 3 - .locals init ([0] class XYZ.ABC/ABC/A __) - .line 100001,100001 : 0,0 '' - IL_0000: ldarg.0 - IL_0001: stloc.0 + // Code size 7 (0x7) + .maxstack 8 .line 25,25 : 46,47 '' - IL_0002: ldarg.0 - IL_0003: ldfld string XYZ.ABC/ABC/A::x - IL_0008: ret + IL_0000: ldarg.0 + IL_0001: ldfld string XYZ.ABC/ABC/A::x + IL_0006: ret } // end of method A::get_X .property instance string X() diff --git a/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx b/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx index 9e1f794aa9f..68d9ae4c927 100644 --- a/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx +++ b/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx @@ -15,6 +15,11 @@ open System.Threading.Tasks type U2 = U2 of int * int +let (!) (r: 'T ref) = r.Value +let (:=) (r: 'T ref) (v: 'T) = r.Value <- v +let incr (r: int ref) = r.Value <- r.Value + 1 +let decr (r: int ref) = r.Value <- r.Value - 1 + let InnerRecursiveFunction (str: string) = let rec even n = if n = 0 then str else odd (n-1) and odd n = even (n-1) From dc32796d0fec7019942dd388b1343bf53eafa892 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 24 Aug 2021 15:43:20 +0100 Subject: [PATCH 06/11] fix debug scopes for module initialization code --- src/fsharp/IlxGen.fs | 96 ++++++++++++++++++++++++++------------------ 1 file changed, 56 insertions(+), 40 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 305da93b98b..d83ca1d2215 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -860,7 +860,7 @@ type ValStorage = /// Indicates if there is a shadow local storage for a local, to make sure it gets a good name in debugging and OptionalShadowLocal = | NoShadowLocal - | ShadowLocal of ValStorage + | ShadowLocal of startMark: Mark * storage: ValStorage /// The representation of a NamedLocalClosure is based on a cloinfo. However we can't generate a cloinfo until we've /// decided the representations of other items in the recursive set. Hence we use two phases to decide representations in @@ -2596,7 +2596,7 @@ and GenExprAux (cenv: cenv) (cgbuf: CodeGenBuffer) eenv sp expr sequel = | TOp.RefAddrGet _readonly, [e], [ty] -> GenGetAddrOfRefCellField cenv cgbuf eenv (e, ty, m) sequel | TOp.Coerce, [e], [tgty;srcty] -> GenCoerce cenv cgbuf eenv (e, tgty, m, srcty) sequel | TOp.Reraise, [], [rtnty] -> GenReraise cenv cgbuf eenv (rtnty, m) sequel - | TOp.TraitCall ss, args, [] -> GenTraitCall cenv cgbuf eenv (ss, args, m) expr sequel + | TOp.TraitCall traitInfo, args, [] -> GenTraitCall cenv cgbuf eenv (traitInfo, args, m) expr sequel | TOp.LValueOp (LSet, v), [e], [] -> GenSetVal cenv cgbuf eenv (v, e, m) sequel | TOp.LValueOp (LByrefGet, v), [], [] -> GenGetByref cenv cgbuf eenv (v, m) sequel | TOp.LValueOp (LByrefSet, v), [e], [] -> GenSetByref cenv cgbuf eenv (v, e, m) sequel @@ -5684,7 +5684,7 @@ and GetTarget (targets:_[]) n = /// If inplabOpt is present, this label must get set to the first logical place to execute. /// For example, if no variables get bound this can just be set to jump straight to the target. and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targets (targetNext: int ref, targetCounts: Dictionary) targetInfos sequel = - let (TTarget(vs, successExpr, spTarget, flags)) = GetTarget targets targetIdx + let (TTarget(vs, successExpr, spTarget, stateVarFlagsOpt)) = GetTarget targets targetIdx match IntMap.tryFind targetIdx targetInfos with | Some (targetInfo, isTargetPostponed) -> @@ -5735,16 +5735,19 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx let targetMarkBeforeBinds = CG.GenerateDelayMark cgbuf "targetBeforeBinds" let targetMarkAfterBinds = CG.GenerateDelayMark cgbuf "targetAfterBinds" let startScope, endScope as scopeMarks = StartDelayedLocalScope "targetBinds" cgbuf + // Allocate storage for variables (except those lifted to be state machine variables) let binds = - match flags with + match stateVarFlagsOpt with | None -> mkInvisibleBinds vs es | Some stateVarFlags -> (vs, es, stateVarFlags) |||> List.zip3 - |> List.choose (fun (v, e, flag) -> if flag then None else Some (mkInvisibleBind v e)) + |> List.choose (fun (v, e, isStateVar) -> if isStateVar then None else Some (mkInvisibleBind v e)) + let eenvAtTarget = AllocStorageForBinds cenv cgbuf scopeMarks eenv binds - let targetInfo = (targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, flags, startScope, endScope) + + let targetInfo = (targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, stateVarFlagsOpt, startScope, endScope) let targetCount = targetCounts.[targetIdx] @@ -5770,7 +5773,7 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targetInfos, genTargetInfoOpt and GenDecisionTreeTarget cenv cgbuf stackAtTargets targetInfo sequel = - let targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, flags, startScope, endScope = targetInfo + let targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, stateVarFlagsOpt, startScope, endScope = targetInfo CG.SetMarkToHere cgbuf targetMarkBeforeBinds let spExpr = (match spTarget with DebugPointAtTarget.Yes -> SPAlways | DebugPointAtTarget.No _ -> SPSuppress) @@ -5778,7 +5781,7 @@ and GenDecisionTreeTarget cenv cgbuf stackAtTargets targetInfo sequel = CG.SetMarkToHere cgbuf startScope let binds = mkInvisibleBinds vs es - GenBindings cenv cgbuf eenvAtTarget binds flags + GenBindings cenv cgbuf eenvAtTarget binds stateVarFlagsOpt CG.SetMarkToHere cgbuf targetMarkAfterBinds CG.SetStack cgbuf stackAtTargets (eenvAtTarget, spExpr, successExpr, (EndLocalScope(sequel, endScope))) @@ -6074,10 +6077,13 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) = let _ = (recursiveVars, allBinds) ||> List.fold (fun forwardReferenceSet (bind: Binding) -> GenBinding cenv cgbuf eenv bind false + // Record the variable as defined let forwardReferenceSet = Zset.remove bind.Var forwardReferenceSet + // Execute and discard any fixups that can now be committed fixups := !fixups |> List.filter (fun (boundv, fv, action) -> if (Zset.contains boundv forwardReferenceSet || Zset.contains fv forwardReferenceSet) then true else (action(); false)) + forwardReferenceSet) () @@ -6162,7 +6168,6 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt CommitStartScope cgbuf startScopeMarkOpt - let hasWitnessEntry = cenv.g.generateWitnesses && not witnessInfos.IsEmpty GenMethodForBinding cenv cgbuf.mgbuf eenv (vspec, mspec, hasWitnessEntry, false, access, ctps, mtps, [], curriedArgInfos, paramInfos, argTys, retInfo, topValInfo, methLambdaCtorThisValOpt, methLambdaBaseValOpt, methLambdaTypars, methLambdaVars, methLambdaBody, methLambdaBodyTy) @@ -6187,6 +6192,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt init = None, args = [], customAttrs = mkILCustomAttrs ilAttribs) + cgbuf.mgbuf.AddOrMergePropertyDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilPropDef, m) let ilMethodDef = @@ -6199,11 +6205,14 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt cgbuf.mgbuf.AddMethodDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilMethodDef) CommitStartScope cgbuf startScopeMarkOpt + match optShadowLocal with | NoShadowLocal -> () - | ShadowLocal storage -> + + | ShadowLocal (startMark, storage) -> CG.EmitInstr cgbuf (pop 0) (Push [ilTy]) (I_call (Normalcall, ilGetterMethSpec, None)) GenSetStorage m cgbuf storage + cgbuf.SetMarkToHere startMark | StaticField (fspec, vref, hasLiteralAttr, ilTyForProperty, ilPropName, fty, ilGetterMethRef, ilSetterMethRef, optShadowLocal) -> let mut = vspec.IsMutable @@ -6265,7 +6274,9 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt let getterMethod = let body = mkMethodBody(true, [], 2, nonBranchingInstrsToCode [ mkNormalLdsfld fspec ], None, eenv.imports) mkILStaticMethod([], ilGetterMethRef.Name, access, [], mkILReturn fty, body).WithSpecialName + cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty, getterMethod) + if mut || cenv.opts.isInteractiveItExpr then let body = mkMethodBody(true, [], 2, nonBranchingInstrsToCode [ mkLdarg0;mkNormalStsfld fspec], None, eenv.imports) let setterMethod = @@ -6273,15 +6284,17 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty, setterMethod) GenBindingRhs cenv cgbuf eenv sp vspec rhsExpr + CommitStartScope cgbuf startScopeMarkOpt + match optShadowLocal with | NoShadowLocal -> - CommitStartScope cgbuf startScopeMarkOpt EmitSetStaticField cgbuf fspec - | ShadowLocal storage-> - CommitStartScope cgbuf startScopeMarkOpt + + | ShadowLocal (startScope, storage) -> CG.EmitInstr cgbuf (pop 0) (Push [fty]) AI_dup EmitSetStaticField cgbuf fspec GenSetStorage m cgbuf storage + cgbuf.SetMarkToHere startScope | _ -> let storage = StorageForVal cenv.g m vspec eenv @@ -6986,12 +6999,12 @@ and GenPInvokeMethod (nm, dll, namedArgs) = CharBestFit=if (decoder.FindBool "BestFitMapping" false) then PInvokeCharBestFit.Enabled else PInvokeCharBestFit.UseAssembly } : PInvokeMethod MethodBody.PInvoke(lazy pinvoke) -and GenBindings cenv cgbuf eenv binds flags = - match flags with +and GenBindings cenv cgbuf eenv binds stateVarFlagsOpt = + match stateVarFlagsOpt with | None -> binds |> List.iter (fun bind -> GenBinding cenv cgbuf eenv bind false) - | Some flags -> - (binds, flags) ||> List.iter2 (fun bind flag -> GenBinding cenv cgbuf eenv bind flag) + | Some stateVarFlags -> + (binds, stateVarFlags) ||> List.iter2 (fun bind isStateVar -> GenBinding cenv cgbuf eenv bind isStateVar) //------------------------------------------------------------------------- // Generate locals and other storage of values @@ -7030,7 +7043,7 @@ and GenBindingRhs cenv cgbuf eenv sp (vspec: Val) expr = and CommitStartScope cgbuf startScopeMarkOpt = match startScopeMarkOpt with | None -> () - | Some ss -> cgbuf.SetMarkToHere ss + | Some startScope -> cgbuf.SetMarkToHere startScope and EmitInitLocal cgbuf ty idx = CG.EmitInstrs cgbuf (pop 0) Push0 [I_ldloca (uint16 idx); (I_initobj ty) ] @@ -7186,7 +7199,7 @@ and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = let idx, realloc, eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName g.CompilerGlobalState, GenTypeOfVal cenv eenv v, v.IsFixed) scopeMarks Local (idx, realloc, None), eenv let eenv = AddStorageForVal g (v, notlazy repr) eenv - Some repr, eenv + repr, eenv and AllocStorageForBind cenv cgbuf scopeMarks eenv bind = AllocStorageForBinds cenv cgbuf scopeMarks eenv [bind] @@ -7214,13 +7227,14 @@ and AllocStorageForBinds cenv cgbuf scopeMarks eenv binds = and AllocValForBind cenv cgbuf (scopeMarks: Mark * Mark) eenv (TBind(v, repr, _)) = match v.ValReprInfo with | None -> - AllocLocalVal cenv cgbuf v eenv (Some repr) scopeMarks + let repr, eenv = AllocLocalVal cenv cgbuf v eenv (Some repr) scopeMarks + Some repr, eenv | Some _ -> - None, AllocTopValWithinExpr cenv cgbuf eenv.cloc scopeMarks v eenv - + None, AllocTopValWithinExpr cenv cgbuf (snd scopeMarks) eenv.cloc v eenv -and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv = +and AllocTopValWithinExpr cenv cgbuf endScope cloc v eenv = let g = cenv.g + // decide whether to use a shadow local or not let useShadowLocal = cenv.opts.generateDebugSymbols && @@ -7232,10 +7246,9 @@ and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv = let optShadowLocal, eenv = if useShadowLocal then - let storageOpt, eenv = AllocLocalVal cenv cgbuf v eenv None scopeMarks - match storageOpt with - | None -> NoShadowLocal, eenv - | Some storage -> ShadowLocal storage, eenv + let startScope = CG.GenerateDelayMark cgbuf ("start_" + v.LogicalName) + let storage, eenv = AllocLocalVal cenv cgbuf v eenv None (startScope, endScope) + ShadowLocal (startScope, storage), eenv else NoShadowLocal, eenv @@ -7430,13 +7443,12 @@ and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = // We use one scope for all the bindings in the module, which makes them all appear with their "default" values // rather than incrementally as we step through the initializations in the module. This is a little unfortunate // but stems from the way we add module values all at once before we generate the module itself. - LocalScope "module" cgbuf (fun scopeMarks -> + LocalScope "module" cgbuf (fun (_, endScope) -> let sigToImplRemapInfo = ComputeRemappingFromImplementationToSignature cenv.g def mty let eenv = AddSignatureRemapInfo "defs" sigToImplRemapInfo eenv - let eenv = - // Allocate all the values, including any shadow locals for static fields - let allocVal cloc v = AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v - AddBindingsForModuleDef allocVal eenv.cloc eenv def + + // Allocate all the values, including any shadow locals for static fields + let eenv = AddBindingsForModuleDef (AllocTopValWithinExpr cenv cgbuf endScope) eenv.cloc eenv def let _eenvEnd = GenModuleDef cenv cgbuf qname lazyInitInfo eenv def ()) @@ -8203,23 +8215,27 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = if not (tycon.HasMember g "ToString" []) then yield! GenToStringMethod cenv eenv ilThisTy m + | TFSharpObjectRepr r when tycon.IsFSharpDelegateTycon -> // Build all the methods that go with a delegate type match r.fsobjmodel_kind with - | TTyconDelegate ss -> - let p, r = + | TTyconDelegate slotSig -> + + let parameters, ret = // When "type delegateTy = delegate of unit -> returnTy", // suppress the unit arg from delegate .Invoke vslot. - let (TSlotSig(nm, ty, ctps, mtps, paraml, returnTy)) = ss + let (TSlotSig(nm, ty, ctps, mtps, paraml, returnTy)) = slotSig let paraml = match paraml with | [[tsp]] when isUnitTy g tsp.Type -> [] (* suppress unit arg *) | paraml -> paraml GenActualSlotsig m cenv eenvinner (TSlotSig(nm, ty, ctps, mtps, paraml, returnTy)) [] [] - yield! mkILDelegateMethods reprAccess g.ilg (g.iltyp_AsyncCallback, g.iltyp_IAsyncResult) (p, r) + + yield! mkILDelegateMethods reprAccess g.ilg (g.iltyp_AsyncCallback, g.iltyp_IAsyncResult) (parameters, ret) | _ -> () + | TUnionRepr _ when not (tycon.HasMember g "ToString" []) -> yield! GenToStringMethod cenv eenv ilThisTy m | _ -> () ] @@ -8537,10 +8553,10 @@ let CodegenAssembly cenv eenv mgbuf implFiles = CodeGenMethod cenv mgbuf ([], "unused", eenv, 0, None, (fun cgbuf eenv -> let lazyInitInfo = ResizeArray() let qname = QualifiedNameOfFile(mkSynId range0 "unused") - LocalScope "module" cgbuf (fun scopeMarks -> - let eenv = AddBindingsForModuleDef (fun cloc v -> AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v) eenv.cloc eenv mexpr - let _eenvEnv = GenModuleDef cenv cgbuf qname lazyInitInfo eenv mexpr - ())), range0) + LocalScope "module" cgbuf (fun (_, endScope) -> + let eenv = AddBindingsForModuleDef (AllocTopValWithinExpr cenv cgbuf endScope) eenv.cloc eenv mexpr + let _eenvEnv = GenModuleDef cenv cgbuf qname lazyInitInfo eenv mexpr + ())), range0) //printfn "#_emptyTopInstrs = %d" _emptyTopInstrs.Length () From e7437627fb7affbc9c46863b07bf33ed12a428a6 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 24 Aug 2021 21:54:03 +0100 Subject: [PATCH 07/11] fix cases of nested shadowing --- src/fsharp/absil/ilwritepdb.fs | 91 ++++++++++--------- .../TheBigFileOfDebugStepping.fsx | 31 +++++++ 2 files changed, 78 insertions(+), 44 deletions(-) diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index ab7b31edb73..f34ea8c8a6b 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -996,8 +996,52 @@ let logDebugInfo (outfile: string) (info: PdbData) = let rec allNamesOfScope acc (scope: PdbMethodScope) = let acc = (acc, scope.Locals) ||> Array.fold (fun z l -> Set.add l.Name z) - let acc = (acc, scope.Children) ||> Array.fold allNamesOfScope + let acc = (acc, scope.Children) ||> allNamesOfScopes acc +and allNamesOfScopes acc (scopes: PdbMethodScope[]) = + (acc, scopes) ||> Array.fold allNamesOfScope + +let rec pushShadowedLocals (localsToPush: PdbLocalVar[]) (scope: PdbMethodScope) = + // Check if child scopes are properly nested + if scope.Children |> Array.forall (fun child -> + child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then + + let children = scope.Children |> Array.sortWith scopeSorter + + // Find all the names defined in this scope + let scopeNames = set [| for n in scope.Locals -> n.Name |] + + // Rename if necessary as we push + let rename, unprocessed = localsToPush |> Array.partition (fun l -> scopeNames.Contains l.Name) + let renamed = [| for l in rename -> { l with Name = l.Name + " (shadowed)" } |] + + let localsToPush2 = [| yield! renamed; yield! unprocessed; yield! scope.Locals |] + let newChildren, splits = children |> Array.map (pushShadowedLocals localsToPush2) |> Array.unzip + + // Check if a rename in any of the children forces a split + if splits |> Array.exists id then + let results = + [| + // First fill in the gaps between the children with an adjusted version of this scope. + let gaps = + [| yield (scope.StartOffset, scope.StartOffset) + for newChild in children do + yield (newChild.StartOffset, newChild.EndOffset) + yield (scope.EndOffset, scope.EndOffset) |] + + for ((_,a),(b,_)) in Array.pairwise gaps do + if a < b then + yield { scope with Locals=localsToPush2; Children = [| |]; StartOffset = a; EndOffset = b} + + yield! Array.concat newChildren + |] + let results2 = results |> Array.sortWith scopeSorter + results2, true + else + let splitsParent = renamed.Length > 0 + [| { scope with Locals=localsToPush2 } |], splitsParent + else + [| scope |], false // Check to see if a scope has a local with the same name as any of its children // @@ -1005,47 +1049,6 @@ let rec allNamesOfScope acc (scope: PdbMethodScope) = // 1. Emit a copy of 'scope' in each true gap, with all locals // 2. Adjust each child scope to also contain the locals from 'scope', // adding the text " (shadowed)" to the names of those with name conflicts. -let rec unshadowScopeAux (scope: PdbMethodScope) = - // Don't bother if scopes are not nested - if scope.Children |> Array.forall (fun child -> - child.StartOffset >= scope.StartOffset && child.EndOffset <= scope.EndOffset) then - let newChildrenAndNames = scope.Children |> Array.map unshadowScopeAux - let newChildren, childNames = newChildrenAndNames |> Array.unzip - let newChildren = Array.concat newChildren |> Array.sortWith scopeSorter - let childNames = Set.unionMany childNames - let scopeNames = set [| for n in scope.Locals -> n.Name |] - let allNames = Set.union scopeNames childNames - let unshadowedScopes = - if Set.isEmpty (Set.intersect scopeNames childNames) then - [| { scope with Children = newChildren } |] - else - let filled = - [| yield (scope.StartOffset, scope.StartOffset) - for newChild in newChildren do - yield (newChild.StartOffset, newChild.EndOffset) - yield (scope.EndOffset, scope.EndOffset) |] - let unshadowed = - [| for ((_,a),(b,_)) in Array.pairwise filled do - if a < b then - yield { scope with Children = [| |]; StartOffset = a; EndOffset = b} - - for newChilds, childNames in newChildrenAndNames do - let preservedScopeLocals = - [| for l in scope.Locals do - if childNames.Contains l.Name then - yield { l with Name = l.Name + " (shadowed)" } - else - yield l |] - for newChild in newChilds do - yield { newChild with Locals = Array.append preservedScopeLocals newChild.Locals } |] - - |> Array.sortWith scopeSorter - unshadowed - - unshadowedScopes, allNames - else - [| scope |], allNamesOfScope Set.empty scope - let unshadowScopes rootScope = - let unshadowedRootScopes, _ = unshadowScopeAux rootScope - unshadowedRootScopes + let result, _ = pushShadowedLocals [| |] rootScope + result diff --git a/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx b/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx index 68d9ae4c927..4f2a37f6f2f 100644 --- a/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx +++ b/tests/walkthroughs/DebugStepping/TheBigFileOfDebugStepping.fsx @@ -1009,3 +1009,34 @@ module DebuggingSteppingForMatchWithWhenWithUnionClauses= TestMatchWithWhen [4;5] TestMatchWithWhen [5;4] TestMatchWithWhen [6] + +module NestedScopesWithShadowing = + + let f2 (a, b) = + let v1 = 1 + if a then + let v2 = 1.4 + if b then + let v1 = "3" + let v2 = 5 + v1 + else + let v1 = "3" + let v2 = 5 + v1 + else + let v2 = 1.4 + if b then + let v1 = "3" + let v2 = 5 + v1 + else + let v1 = "3" + let v2 = 5 + v1 + + + f2 (true, true) + f2 (true, false) + f2 (false, true) + f2 (false, false) From 4ab1ebb95530c36662267da566f78a87d8d7948e Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 24 Aug 2021 22:22:49 +0100 Subject: [PATCH 08/11] fix shadowing for some cases --- src/fsharp/absil/ilwritepdb.fs | 3 +- tests/FSharp.Test.Utilities/CompilerAssert.fs | 30 ++++++++- ...omplexShadowingFunction.debuginfo.expected | 66 +++++++++++++++++++ .../SimpleFunction.debuginfo.expected | 21 ++++++ ...SimpleShadowingFunction.debuginfo.expected | 27 ++++++++ tests/fsharp/FSharpSuite.Tests.fsproj | 1 + 6 files changed, 144 insertions(+), 4 deletions(-) create mode 100644 tests/fsharp/Compiler/CodeGen/EmittedIL/ComplexShadowingFunction.debuginfo.expected create mode 100644 tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleFunction.debuginfo.expected create mode 100644 tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleShadowingFunction.debuginfo.expected diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index f34ea8c8a6b..fa5a2514f79 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -963,7 +963,8 @@ let logDebugInfo (outfile: string) (info: PdbData) = fprintfn sw "ENTRYPOINT\r\n %b\r\n" info.EntryPoint.IsSome fprintfn sw "DOCUMENTS" for i, doc in Seq.zip [0 .. info.Documents.Length-1] info.Documents do - fprintfn sw " [%d] %s" i doc.File + // File names elided because they are ephemeral during testing + fprintfn sw " [%d] " i // doc.File fprintfn sw " Type: %A" doc.DocumentType fprintfn sw " Language: %A" doc.Language fprintfn sw " Vendor: %A" doc.Vendor diff --git a/tests/FSharp.Test.Utilities/CompilerAssert.fs b/tests/FSharp.Test.Utilities/CompilerAssert.fs index 53fc3060bca..5edb97137fe 100644 --- a/tests/FSharp.Test.Utilities/CompilerAssert.fs +++ b/tests/FSharp.Test.Utilities/CompilerAssert.fs @@ -21,11 +21,13 @@ open TestFramework [] type ILVerifier (dllFilePath: string) = - member this.VerifyIL (expectedIL: string list) = + member _.VerifyIL (expectedIL: string list) = ILChecker.checkIL dllFilePath expectedIL - //member this.VerifyILWithDebugPoints (expectedIL: string list) = - // ILChecker.checkILWithDebugPoints dllFilePath expectedIL +[] +type PdbDebugInfo(debugInfo: string) = + + member _.InfoText = debugInfo type Worker () = inherit MarshalByRefObject() @@ -622,6 +624,28 @@ type CompilerAssert private () = f (ILVerifier outputFilePath) ) + static member CompileLibraryAndVerifyDebugInfoWithOptions options (expectedFile: string) (source: string) = + let options = [| yield! options; yield"--test:DumpDebugInfo" |] + compile false options source (fun (errors, outputFilePath) -> + let errors = + errors |> Array.filter (fun x -> x.Severity = FSharpDiagnosticSeverity.Error) + if errors.Length > 0 then + Assert.Fail (sprintf "Compile had errors: %A" errors) + let debugInfoFile = outputFilePath + ".debuginfo" + if not (File.Exists expectedFile) then + File.Copy(debugInfoFile, expectedFile) + failwith $"debug info expected file {expectedFile} didn't exist, now copied over" + let debugInfo = File.ReadAllLines(debugInfoFile) + let expected = File.ReadAllLines(expectedFile) + if debugInfo <> expected then + File.Copy(debugInfoFile, expectedFile, overwrite=true) + failwith $"""debug info mismatch +Expected is in {expectedFile} +Actual is in {debugInfoFile} +Updated automatically, please check diffs in your pull request, changes must be scrutinized +""" + ) + static member CompileLibraryAndVerifyIL (source: string) (f: ILVerifier -> unit) = CompilerAssert.CompileLibraryAndVerifyILWithOptions [||] source f diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/ComplexShadowingFunction.debuginfo.expected b/tests/fsharp/Compiler/CodeGen/EmittedIL/ComplexShadowingFunction.debuginfo.expected new file mode 100644 index 00000000000..d4290843220 --- /dev/null +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/ComplexShadowingFunction.debuginfo.expected @@ -0,0 +1,66 @@ +ENTRYPOINT + false + +DOCUMENTS + [0] + Type: None + Language: None + Vendor: None + +METHODS + f2 + Params: [] + Range: Some "[0,5:9] - [0,5:11]" + Points: + - Doc: 0 Offset:0 [5:5]-[5-15] + - Doc: 0 Offset:2 [6:5]-[6-14] + - Doc: 0 Offset:3 [16707566:0]-[16707566-0] + - Doc: 0 Offset:6 [7:9]-[7-21] + - Doc: 0 Offset:16 [8:9]-[8-18] + - Doc: 0 Offset:17 [16707566:0]-[16707566-0] + - Doc: 0 Offset:20 [9:12]-[9-24] + - Doc: 0 Offset:26 [10:12]-[10-22] + - Doc: 0 Offset:28 [11:12]-[11-14] + - Doc: 0 Offset:30 [13:12]-[13-24] + - Doc: 0 Offset:37 [14:12]-[14-22] + - Doc: 0 Offset:40 [15:12]-[15-14] + - Doc: 0 Offset:43 [17:9]-[17-21] + - Doc: 0 Offset:54 [18:9]-[18-18] + - Doc: 0 Offset:55 [16707566:0]-[16707566-0] + - Doc: 0 Offset:58 [19:12]-[19-24] + - Doc: 0 Offset:65 [20:12]-[20-22] + - Doc: 0 Offset:68 [21:12]-[21-14] + - Doc: 0 Offset:71 [23:12]-[23-24] + - Doc: 0 Offset:78 [24:12]-[24-22] + - Doc: 0 Offset:81 [25:12]-[25-14] + Scopes: + - [0-84] + - [1-15] + Locals: ["0: v1"] + - [15-25] + Locals: ["0: v1"; "1: v2"] + - [25-27] + Locals: ["0: v1 (shadowed)"; "1: v2"; "2: v1"] + - [27-30] + Locals: ["1: v2 (shadowed)"; "0: v1 (shadowed)"; "2: v1"; "3: v2"] + - [30-35] + Locals: ["0: v1"; "1: v2"] + - [35-38] + Locals: ["0: v1 (shadowed)"; "1: v2"; "4: v1"] + - [38-43] + Locals: ["1: v2 (shadowed)"; "0: v1 (shadowed)"; "4: v1"; "5: v2"] + - [43-52] + Locals: ["0: v1"] + - [52-63] + Locals: ["0: v1"; "6: v2"] + - [63-66] + Locals: ["0: v1 (shadowed)"; "6: v2"; "7: v1"] + - [66-71] + Locals: ["6: v2 (shadowed)"; "0: v1 (shadowed)"; "7: v1"; "8: v2"] + - [71-76] + Locals: ["0: v1"; "6: v2"] + - [76-79] + Locals: ["0: v1 (shadowed)"; "6: v2"; "9: v1"] + - [79-84] + Locals: ["6: v2 (shadowed)"; "0: v1 (shadowed)"; "9: v1"; "10: v2"] + diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleFunction.debuginfo.expected b/tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleFunction.debuginfo.expected new file mode 100644 index 00000000000..e33acec2b5e --- /dev/null +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleFunction.debuginfo.expected @@ -0,0 +1,21 @@ +ENTRYPOINT + false + +DOCUMENTS + [0] + Type: None + Language: None + Vendor: None + +METHODS + f + Params: [] + Range: Some "[0,4:9] - [0,4:10]" + Points: + - Doc: 0 Offset:0 [4:5]-[4-14] + - Doc: 0 Offset:2 [5:5]-[5-6] + Scopes: + - [0-4] + - [1-4] + Locals: ["0: y"] + diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleShadowingFunction.debuginfo.expected b/tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleShadowingFunction.debuginfo.expected new file mode 100644 index 00000000000..6204777c113 --- /dev/null +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/SimpleShadowingFunction.debuginfo.expected @@ -0,0 +1,27 @@ +ENTRYPOINT + false + +DOCUMENTS + [0] + Type: None + Language: None + Vendor: None + +METHODS + f + Params: [] + Range: Some "[0,4:9] - [0,4:10]" + Points: + - Doc: 0 Offset:0 [4:5]-[4-14] + - Doc: 0 Offset:2 [5:5]-[5-16] + - Doc: 0 Offset:6 [6:5]-[6-16] + - Doc: 0 Offset:10 [7:5]-[7-6] + Scopes: + - [0-12] + - [1-5] + Locals: ["0: y"] + - [5-9] + Locals: ["0: y (shadowed)"; "1: y"] + - [9-12] + Locals: ["1: y (shadowed)"; "0: y (shadowed)"; "2: y"] + diff --git a/tests/fsharp/FSharpSuite.Tests.fsproj b/tests/fsharp/FSharpSuite.Tests.fsproj index 79fdc521ea7..e210ad15eee 100644 --- a/tests/fsharp/FSharpSuite.Tests.fsproj +++ b/tests/fsharp/FSharpSuite.Tests.fsproj @@ -33,6 +33,7 @@ + From 8290ba4e909bdd3280b7a937f16cc83ed156e457 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Tue, 24 Aug 2021 22:50:52 +0100 Subject: [PATCH 09/11] add missing file --- src/fsharp/IlxGen.fs | 111 +++++++++--------- .../Compiler/CodeGen/EmittedIL/DebugScopes.fs | 71 +++++++++++ 2 files changed, 127 insertions(+), 55 deletions(-) create mode 100644 tests/fsharp/Compiler/CodeGen/EmittedIL/DebugScopes.fs diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index d83ca1d2215..46129923f97 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -838,7 +838,7 @@ type ValStorage = | Null /// Indicates the value is stored in a static field. - | StaticField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal + | StaticPropertyWithField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal /// Indicates the value is represented as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers | StaticProperty of ILMethodSpec * OptionalShadowLocal @@ -1021,7 +1021,7 @@ let AddSignatureRemapInfo _msg (rpi, mhi) eenv = let OutputStorage (pps: TextWriter) s = match s with - | StaticField _ -> pps.Write "(top)" + | StaticPropertyWithField _ -> pps.Write "(top)" | StaticProperty _ -> pps.Write "(top)" | Method _ -> pps.Write "(top)" | Local _ -> pps.Write "(local)" @@ -1207,7 +1207,7 @@ let ComputeStorageForFSharpValue amap (g:TcGlobals) cloc optIntraAssemblyInfo op let ilGetterMethRef = mkILMethRef (ilTypeRefForProperty, ILCallingConv.Static, "get_"+nm, 0, [], ilTy) let ilSetterMethRef = mkILMethRef (ilTypeRefForProperty, ILCallingConv.Static, "set_"+nm, 0, [ilTy], ILType.Void) let ilFieldSpec = ComputeFieldSpecForVal(optIntraAssemblyInfo, isInteractive, g, ilTyForProperty, vspec, nm, m, cloc, ilTy, ilGetterMethRef) - StaticField (ilFieldSpec, vref, hasLiteralAttr, ilTyForProperty, nm, ilTy, ilGetterMethRef, ilSetterMethRef, optShadowLocal) + StaticPropertyWithField (ilFieldSpec, vref, hasLiteralAttr, ilTyForProperty, nm, ilTy, ilGetterMethRef, ilSetterMethRef, optShadowLocal) /// Compute the representation information for an F#-declared member let ComputeStorageForFSharpMember amap g topValInfo memberInfo (vref: ValRef) m = @@ -2210,19 +2210,19 @@ let CodeGenMethod cenv mgbuf (entryPointInfo, methodName, eenv, alreadyUsedArgs, instrs, body let StartDelayedLocalScope nm cgbuf = - let startScope = CG.GenerateDelayMark cgbuf ("start_" + nm) - let endScope = CG.GenerateDelayMark cgbuf ("end_" + nm) - startScope, endScope + let startMark = CG.GenerateDelayMark cgbuf ("start_" + nm) + let endMark = CG.GenerateDelayMark cgbuf ("end_" + nm) + startMark, endMark let StartLocalScope nm cgbuf = - let startScope = CG.GenerateMark cgbuf ("start_" + nm) - let endScope = CG.GenerateDelayMark cgbuf ("end_" + nm) - startScope, endScope + let startMark = CG.GenerateMark cgbuf ("start_" + nm) + let endMark = CG.GenerateDelayMark cgbuf ("end_" + nm) + startMark, endMark let LocalScope nm cgbuf (f: Mark * Mark -> 'a) : 'a = - let _, endScope as scopeMarks = StartLocalScope nm cgbuf + let _, endMark as scopeMarks = StartLocalScope nm cgbuf let res = f scopeMarks - CG.SetMarkToHere cgbuf endScope + CG.SetMarkToHere cgbuf endMark res let compileSequenceExpressions = true // try (System.Environment.GetEnvironmentVariable("FSHARP_COMPILED_SEQ") <> null) with _ -> false @@ -2917,10 +2917,10 @@ and GenLinearExpr cenv cgbuf eenv sp expr sequel preSteps (contf: FakeUnit -> Fa // This case implemented here to get a guaranteed tailcall // Make sure we generate the debug point outside the scope of the variable - let startScope, endScope as scopeMarks = StartDelayedLocalScope "let" cgbuf + let startMark, endMark as scopeMarks = StartDelayedLocalScope "let" cgbuf let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind let spBind = GenDebugPointForBind cenv cgbuf bind - GenBindingAfterDebugPoint cenv cgbuf eenv spBind bind false (Some startScope) + GenBindingAfterDebugPoint cenv cgbuf eenv spBind bind false (Some startMark) // Work out if we need a debug point for the body. For any "user" binding then the body gets SPAlways. // For invisible compiler-generated bindings we just use "sp", unless its body is another invisible binding @@ -2934,7 +2934,7 @@ and GenLinearExpr cenv cgbuf eenv sp expr sequel preSteps (contf: FakeUnit -> Fa | DebugPointAtBinding.NoneAtSticky -> SPSuppress // Generate the body - GenLinearExpr cenv cgbuf eenv spBody body (EndLocalScope(sequel, endScope)) true contf + GenLinearExpr cenv cgbuf eenv spBody body (EndLocalScope(sequel, endMark)) true contf | Expr.Match (spBind, _exprm, tree, targets, m, ty) -> // Process the debug point and see if there's a replacement technique to process this expression @@ -4487,7 +4487,7 @@ and GenGetValAddr cenv cgbuf eenv (v: ValRef, m) sequel = | Arg idx -> CG.EmitInstrs cgbuf (pop 0) (Push [ILType.Byref ilTy]) [ I_ldarga (uint16 idx) ] - | StaticField (fspec, _vref, hasLiteralAttr, _ilTyForProperty, _, ilTy, _, _, _) -> + | StaticPropertyWithField (fspec, _vref, hasLiteralAttr, _ilTyForProperty, _, ilTy, _, _, _) -> if hasLiteralAttr then errorR(Error(FSComp.SR.ilAddressOfLiteralFieldIsInvalid(), m)) let ilTy = if ilTy.IsNominal && ilTy.Boxity = ILBoxity.AsValue then ILType.Byref ilTy else ilTy EmitGetStaticFieldAddr cgbuf ilTy fspec @@ -5261,7 +5261,7 @@ and GenFreevar cenv m eenvouter tyenvinner (fv: Val) = | Local(_, _, Some _) | Env(_, _, Some _) -> g.ilg.typ_Object #if DEBUG // Check for things that should never make it into the free variable set. Only do this in debug for performance reasons - | StaticField _ | StaticProperty _ | Method _ | Null -> error(InternalError("GenFreevar: compiler error: unexpected unrealized value", fv.Range)) + | StaticPropertyWithField _ | StaticProperty _ | Method _ | Null -> error(InternalError("GenFreevar: compiler error: unexpected unrealized value", fv.Range)) #endif | _ -> GenType cenv.amap m tyenvinner fv.Type @@ -5306,7 +5306,7 @@ and GetIlxClosureFreeVars cenv m (thisVars: ValRef list) boxity eenvouter takenN |> List.filter (fun fv -> (thisVars |> List.forall (fun v -> not (valRefEq g (mkLocalValRef fv) v))) && (match StorageForVal cenv.g m fv eenvouter with - | StaticField _ | StaticProperty _ | Method _ | Null -> false + | StaticPropertyWithField _ | StaticProperty _ | Method _ | Null -> false | _ -> true)) // Any closure using values represented as local type functions also captures the type variables captured @@ -5649,14 +5649,15 @@ and GenDecisionTreeAndTargetsInner cenv cgbuf inplabOpt stackAtTargets eenv tree match tree with | TDBind(bind, rest) -> cgbuf.SetMarkToHereIfNecessary inplabOpt - let startScope, endScope as scopeMarks = StartDelayedLocalScope "dtreeBind" cgbuf + let startMark, endMark as scopeMarks = StartDelayedLocalScope "dtreeBind" cgbuf let eenv = AllocStorageForBind cenv cgbuf scopeMarks eenv bind let sp = GenDebugPointForBind cenv cgbuf bind - GenBindingAfterDebugPoint cenv cgbuf eenv sp bind false (Some startScope) + GenBindingAfterDebugPoint cenv cgbuf eenv sp bind false (Some startMark) + // We don't get the scope marks quite right for dtree-bound variables. This is because // we effectively lose an EndLocalScope for all dtrees that go to the same target // So we just pretend that the variable goes out of scope here. - CG.SetMarkToHere cgbuf endScope + CG.SetMarkToHere cgbuf endMark GenDecisionTreeAndTargetsInner cenv cgbuf None stackAtTargets eenv rest targets targetCounts targetInfos sequel contf | TDSuccess(es, targetIdx) -> @@ -5734,7 +5735,7 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx let targetMarkBeforeBinds = CG.GenerateDelayMark cgbuf "targetBeforeBinds" let targetMarkAfterBinds = CG.GenerateDelayMark cgbuf "targetAfterBinds" - let startScope, endScope as scopeMarks = StartDelayedLocalScope "targetBinds" cgbuf + let startMark, endMark as scopeMarks = StartDelayedLocalScope "targetBinds" cgbuf // Allocate storage for variables (except those lifted to be state machine variables) let binds = @@ -5747,7 +5748,7 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx let eenvAtTarget = AllocStorageForBinds cenv cgbuf scopeMarks eenv binds - let targetInfo = (targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, stateVarFlagsOpt, startScope, endScope) + let targetInfo = (targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, stateVarFlagsOpt, startMark, endMark) let targetCount = targetCounts.[targetIdx] @@ -5773,18 +5774,18 @@ and GenDecisionTreeSuccess cenv cgbuf inplabOpt stackAtTargets eenv es targetIdx targetInfos, genTargetInfoOpt and GenDecisionTreeTarget cenv cgbuf stackAtTargets targetInfo sequel = - let targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, stateVarFlagsOpt, startScope, endScope = targetInfo + let targetMarkBeforeBinds, targetMarkAfterBinds, eenvAtTarget, successExpr, spTarget, vs, es, stateVarFlagsOpt, startMark, endMark = targetInfo CG.SetMarkToHere cgbuf targetMarkBeforeBinds let spExpr = (match spTarget with DebugPointAtTarget.Yes -> SPAlways | DebugPointAtTarget.No _ -> SPSuppress) cgbuf.EmitStartOfHiddenCode() - CG.SetMarkToHere cgbuf startScope + CG.SetMarkToHere cgbuf startMark let binds = mkInvisibleBinds vs es GenBindings cenv cgbuf eenvAtTarget binds stateVarFlagsOpt CG.SetMarkToHere cgbuf targetMarkAfterBinds CG.SetStack cgbuf stackAtTargets - (eenvAtTarget, spExpr, successExpr, (EndLocalScope(sequel, endScope))) + (eenvAtTarget, spExpr, successExpr, (EndLocalScope(sequel, endMark))) and GenDecisionTreeSwitch cenv cgbuf inplabOpt stackAtTargets eenv e cases defaultTargetOpt switchm targets targetCounts targetInfos sequel contf = let g = cenv.g @@ -6036,7 +6037,7 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) = | StaticProperty _ | Method _ // Note: Recursive data stored in static fields may require fixups e.g. let x = C(x) - // | StaticField _ + // | StaticPropertyWithField _ | Null -> false | _ -> true) @@ -6088,10 +6089,10 @@ and GenLetRecBindings cenv (cgbuf: CodeGenBuffer) eenv (allBinds: Bindings, m) = () and GenLetRec cenv cgbuf eenv (binds, body, m) sequel = - let _, endScope as scopeMarks = StartLocalScope "letrec" cgbuf + let _, endMark as scopeMarks = StartLocalScope "letrec" cgbuf let eenv = AllocStorageForBinds cenv cgbuf scopeMarks eenv binds GenLetRecBindings cenv cgbuf eenv (binds, m) - GenExpr cenv cgbuf eenv SPAlways body (EndLocalScope(sequel, endScope)) + GenExpr cenv cgbuf eenv SPAlways body (EndLocalScope(sequel, endMark)) //------------------------------------------------------------------------- // Generate simple bindings @@ -6120,7 +6121,7 @@ and ComputeMethodAccessRestrictedBySig eenv vspec = vspec.IsIncrClassGeneratedMember // compiler generated members for class function 'let' bindings get assembly visibility ComputeMemberAccess isHidden -and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isStateVar startScopeMarkOpt = +and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isStateVar startMarkOpt = let g = cenv.g // Record the closed reflection definition if publishing @@ -6150,13 +6151,13 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt | Null -> GenExpr cenv cgbuf eenv SPSuppress rhsExpr discard - CommitStartScope cgbuf startScopeMarkOpt + CommitStartScope cgbuf startMarkOpt // The initialization code for static 'let' and 'do' bindings gets compiled into the initialization .cctor for the whole file | _ when vspec.IsClassConstructor && isNil vspec.TopValDeclaringEntity.TyparsNoRange && not isStateVar -> let tps, _, _, _, cctorBody, _ = IteratedAdjustArityOfLambda g cenv.amap vspec.ValReprInfo.Value rhsExpr let eenv = EnvForTypars tps eenv - CommitStartScope cgbuf startScopeMarkOpt + CommitStartScope cgbuf startMarkOpt GenExpr cenv cgbuf eenv SPSuppress cctorBody discard | Method (topValInfo, _, mspec, mspecW, _, ctps, mtps, curriedArgInfos, paramInfos, witnessInfos, argTys, retInfo) when not isStateVar -> @@ -6166,7 +6167,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt let methLambdaVars = List.concat methLambdaCurriedVars - CommitStartScope cgbuf startScopeMarkOpt + CommitStartScope cgbuf startMarkOpt let hasWitnessEntry = cenv.g.generateWitnesses && not witnessInfos.IsEmpty @@ -6204,7 +6205,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt CountMethodDef() cgbuf.mgbuf.AddMethodDef(ilGetterMethSpec.MethodRef.DeclaringTypeRef, ilMethodDef) - CommitStartScope cgbuf startScopeMarkOpt + CommitStartScope cgbuf startMarkOpt match optShadowLocal with | NoShadowLocal -> () @@ -6214,7 +6215,7 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt GenSetStorage m cgbuf storage cgbuf.SetMarkToHere startMark - | StaticField (fspec, vref, hasLiteralAttr, ilTyForProperty, ilPropName, fty, ilGetterMethRef, ilSetterMethRef, optShadowLocal) -> + | StaticPropertyWithField (fspec, vref, hasLiteralAttr, ilTyForProperty, ilPropName, fty, ilGetterMethRef, ilSetterMethRef, optShadowLocal) -> let mut = vspec.IsMutable let canTarget(targets, goal: System.AttributeTargets) = @@ -6284,28 +6285,28 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt cgbuf.mgbuf.AddMethodDef(ilTypeRefForProperty, setterMethod) GenBindingRhs cenv cgbuf eenv sp vspec rhsExpr - CommitStartScope cgbuf startScopeMarkOpt + CommitStartScope cgbuf startMarkOpt match optShadowLocal with | NoShadowLocal -> EmitSetStaticField cgbuf fspec - | ShadowLocal (startScope, storage) -> + | ShadowLocal (startMark, storage) -> CG.EmitInstr cgbuf (pop 0) (Push [fty]) AI_dup EmitSetStaticField cgbuf fspec GenSetStorage m cgbuf storage - cgbuf.SetMarkToHere startScope + cgbuf.SetMarkToHere startMark | _ -> let storage = StorageForVal cenv.g m vspec eenv match storage, rhsExpr with // locals are zero-init, no need to initialize them, except if you are in a loop and the local is mutable. | Local (_, realloc, _), Expr.Const (Const.Zero, _, _) when not realloc && not (eenv.isInLoop && vspec.IsMutable) -> - CommitStartScope cgbuf startScopeMarkOpt + CommitStartScope cgbuf startMarkOpt | _ -> GetStoreValCtxt cenv cgbuf eenv vspec GenBindingRhs cenv cgbuf eenv SPSuppress vspec rhsExpr - CommitStartScope cgbuf startScopeMarkOpt + CommitStartScope cgbuf startMarkOpt GenStoreVal cenv cgbuf eenv vspec.Range vspec and GetStoreValCtxt cenv cgbuf eenv (vspec: Val) = @@ -7040,10 +7041,10 @@ and GenBindingRhs cenv cgbuf eenv sp (vspec: Val) expr = | _ -> GenExpr cenv cgbuf eenv sp expr Continue -and CommitStartScope cgbuf startScopeMarkOpt = - match startScopeMarkOpt with +and CommitStartScope cgbuf startMarkOpt = + match startMarkOpt with | None -> () - | Some startScope -> cgbuf.SetMarkToHere startScope + | Some startMark -> cgbuf.SetMarkToHere startMark and EmitInitLocal cgbuf ty idx = CG.EmitInstrs cgbuf (pop 0) Push0 [I_ldloca (uint16 idx); (I_initobj ty) ] @@ -7062,7 +7063,7 @@ and GenSetStorage m cgbuf storage = | Local (idx, _, _) -> EmitSetLocal cgbuf idx - | StaticField (_, _, hasLiteralAttr, ilContainerTy, _, _, _, ilSetterMethRef, _) -> + | StaticPropertyWithField (_, _, hasLiteralAttr, ilContainerTy, _, _, _, ilSetterMethRef, _) -> if hasLiteralAttr then errorR(Error(FSComp.SR.ilLiteralFieldsCannotBeSet(), m)) CG.EmitInstr cgbuf (pop 1) Push0 (I_call(Normalcall, mkILMethSpecForMethRefInTy(ilSetterMethRef, ilContainerTy, []), None)) @@ -7106,7 +7107,7 @@ and GenGetStorageAndSequel (cenv: cenv) cgbuf eenv m (ty, ilTy) storage storeSeq EmitGetLocal cgbuf ilTy idx CommitGetStorageSequel cenv cgbuf eenv m ty localCloInfo storeSequel - | StaticField (fspec, _, hasLiteralAttr, ilContainerTy, _, _, ilGetterMethRef, _, _) -> + | StaticPropertyWithField (fspec, _, hasLiteralAttr, ilContainerTy, _, _, ilGetterMethRef, _, _) -> // References to literals go directly to the field - no property is used if hasLiteralAttr then EmitGetStaticField cgbuf ilTy fspec @@ -7232,7 +7233,7 @@ and AllocValForBind cenv cgbuf (scopeMarks: Mark * Mark) eenv (TBind(v, repr, _) | Some _ -> None, AllocTopValWithinExpr cenv cgbuf (snd scopeMarks) eenv.cloc v eenv -and AllocTopValWithinExpr cenv cgbuf endScope cloc v eenv = +and AllocTopValWithinExpr cenv cgbuf endMark cloc v eenv = let g = cenv.g // decide whether to use a shadow local or not @@ -7246,9 +7247,9 @@ and AllocTopValWithinExpr cenv cgbuf endScope cloc v eenv = let optShadowLocal, eenv = if useShadowLocal then - let startScope = CG.GenerateDelayMark cgbuf ("start_" + v.LogicalName) - let storage, eenv = AllocLocalVal cenv cgbuf v eenv None (startScope, endScope) - ShadowLocal (startScope, storage), eenv + let startMark = CG.GenerateDelayMark cgbuf ("start_" + v.LogicalName) + let storage, eenv = AllocLocalVal cenv cgbuf v eenv None (startMark, endMark) + ShadowLocal (startMark, storage), eenv else NoShadowLocal, eenv @@ -7443,12 +7444,12 @@ and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = // We use one scope for all the bindings in the module, which makes them all appear with their "default" values // rather than incrementally as we step through the initializations in the module. This is a little unfortunate // but stems from the way we add module values all at once before we generate the module itself. - LocalScope "module" cgbuf (fun (_, endScope) -> + LocalScope "module" cgbuf (fun (_, endMark) -> let sigToImplRemapInfo = ComputeRemappingFromImplementationToSignature cenv.g def mty let eenv = AddSignatureRemapInfo "defs" sigToImplRemapInfo eenv // Allocate all the values, including any shadow locals for static fields - let eenv = AddBindingsForModuleDef (AllocTopValWithinExpr cenv cgbuf endScope) eenv.cloc eenv def + let eenv = AddBindingsForModuleDef (AllocTopValWithinExpr cenv cgbuf endMark) eenv.cloc eenv def let _eenvEnd = GenModuleDef cenv cgbuf qname lazyInitInfo eenv def ()) @@ -8553,8 +8554,8 @@ let CodegenAssembly cenv eenv mgbuf implFiles = CodeGenMethod cenv mgbuf ([], "unused", eenv, 0, None, (fun cgbuf eenv -> let lazyInitInfo = ResizeArray() let qname = QualifiedNameOfFile(mkSynId range0 "unused") - LocalScope "module" cgbuf (fun (_, endScope) -> - let eenv = AddBindingsForModuleDef (AllocTopValWithinExpr cenv cgbuf endScope) eenv.cloc eenv mexpr + LocalScope "module" cgbuf (fun (_, endMark) -> + let eenv = AddBindingsForModuleDef (AllocTopValWithinExpr cenv cgbuf endMark) eenv.cloc eenv mexpr let _eenvEnv = GenModuleDef cenv cgbuf qname lazyInitInfo eenv mexpr ())), range0) //printfn "#_emptyTopInstrs = %d" _emptyTopInstrs.Length @@ -8696,7 +8697,7 @@ let LookupGeneratedValue (amap: ImportMap) (ctxt: ExecutionContext) eenv (v: Val ctxt.LookupType ilTy // Lookup the compiled v value (as an object). match StorageForVal amap.g v.Range v eenv with - | StaticField (fspec, _, hasLiteralAttr, ilContainerTy, _, _, ilGetterMethRef, _, _) -> + | StaticPropertyWithField (fspec, _, hasLiteralAttr, ilContainerTy, _, _, ilGetterMethRef, _, _) -> let obj = if hasLiteralAttr then let staticTy = ctxt.LookupTypeRef fspec.DeclaringTypeRef @@ -8738,7 +8739,7 @@ let LookupGeneratedValue (amap: ImportMap) (ctxt: ExecutionContext) eenv (v: Val let SetGeneratedValue (ctxt: ExecutionContext) (g: TcGlobals) eenv isForced (v: Val) (value: obj) = try match StorageForVal g v.Range v eenv with - | StaticField (fspec, _, hasLiteralAttr, _, _, _, _f, ilSetterMethRef, _) -> + | StaticPropertyWithField (fspec, _, hasLiteralAttr, _, _, _, _f, ilSetterMethRef, _) -> if not hasLiteralAttr && (v.IsMutable || isForced) then if isForced then let staticTy = ctxt.LookupTypeRef fspec.DeclaringTypeRef @@ -8762,7 +8763,7 @@ let SetGeneratedValue (ctxt: ExecutionContext) (g: TcGlobals) eenv isForced (v: let ClearGeneratedValue (ctxt: ExecutionContext) (g: TcGlobals) eenv (v: Val) = try match StorageForVal g v.Range v eenv with - | StaticField (fspec, _, hasLiteralAttr, _, _, _, _ilGetterMethRef, _ilSetterMethRef, _) -> + | StaticPropertyWithField (fspec, _, hasLiteralAttr, _, _, _, _ilGetterMethRef, _ilSetterMethRef, _) -> if not hasLiteralAttr && v.IsMutable then let ty = ctxt.LookupType fspec.ActualType SetGeneratedValue ctxt g eenv false v (defaultOf ty) diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/DebugScopes.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/DebugScopes.fs new file mode 100644 index 00000000000..19353b0466f --- /dev/null +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/DebugScopes.fs @@ -0,0 +1,71 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +namespace FSharp.Compiler.UnitTests.CodeGen.EmittedIL + +open FSharp.Test +open NUnit.Framework + +[] +module DebugScopes = + + [] + let SimpleFunction() = + CompilerAssert.CompileLibraryAndVerifyDebugInfoWithOptions + [|"--debug:portable"; "--optimize-"; "--optimize-"|] + (__SOURCE_DIRECTORY__ + "/SimpleFunction.debuginfo.expected") + """ +module Test +let f x = + let y = 1 + 2 + """ + + [] + let SimpleShadowingFunction() = + CompilerAssert.CompileLibraryAndVerifyDebugInfoWithOptions + [|"--debug:portable"; "--optimize-"; "--optimize-"|] + (__SOURCE_DIRECTORY__ + "/SimpleShadowingFunction.debuginfo.expected") + """ +module Test +let f x = + let y = 1 + let y = y+1 + let y = y+1 + 2 + """ + + [] + let ComplexShadowingFunction() = + CompilerAssert.CompileLibraryAndVerifyDebugInfoWithOptions + [|"--debug:portable"; "--optimize-"; "--optimize-"|] + (__SOURCE_DIRECTORY__ + "/ComplexShadowingFunction.debuginfo.expected") + """ +module Test + +let f2 (a, b) = + let v1 = 1 + if a then + let v2 = 1.4 + if b then + let v1 = "3" + let v2 = 5 + v1 + else + let v1 = "3" + let v2 = 5 + v1 + else + let v2 = 1.4 + if b then + let v1 = "3" + let v2 = 5 + v1 + else + let v1 = "3" + let v2 = 5 + v1 + + + + """ + From df6a2b02f4aa521e13c4916e7ce94ae80ece137b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 25 Aug 2021 00:57:04 +0100 Subject: [PATCH 10/11] fix build --- src/fsharp/IlxGen.fs | 48 +++++++++++++++++++++++++++++++++++++------- 1 file changed, 41 insertions(+), 7 deletions(-) diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 46129923f97..0fd2eb3d67d 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -838,24 +838,53 @@ type ValStorage = | Null /// Indicates the value is stored in a static field. - | StaticPropertyWithField of ILFieldSpec * ValRef * (*hasLiteralAttr:*)bool * ILType * string * ILType * ILMethodRef * ILMethodRef * OptionalShadowLocal + | StaticPropertyWithField of + ilFieldSpec: ILFieldSpec * + valRef: ValRef * + hasLiteralAttr: bool * + ilTyForProperty: ILType * + name: string * + ilTy: ILType * + ilGetterMethRef: ILMethodRef * + ilSetterMethRef: ILMethodRef * + optShadowLocal: OptionalShadowLocal /// Indicates the value is represented as a property that recomputes it each time it is referenced. Used for simple constants that do not cause initialization triggers - | StaticProperty of ILMethodSpec * OptionalShadowLocal + | StaticProperty of + ilGetterMethSpec: ILMethodSpec * + optShadowLocal: OptionalShadowLocal /// Indicates the value is represented as an IL method (in a "main" class for a F# /// compilation unit, or as a member) according to its inferred or specified arity. - | Method of ValReprInfo * ValRef * ILMethodSpec * ILMethodSpec * range * Typars * Typars * CurriedArgInfos * ArgReprInfo list * TraitWitnessInfos * TType list * ArgReprInfo + | Method of + topValInfo: ValReprInfo * + valRef: ValRef * + ilMethSpec: ILMethodSpec * + ilMethSpecWithWitnesses: ILMethodSpec * + m: range * + classTypars: Typars * + methTypars: Typars * + curriedArgInfos: CurriedArgInfos * + paramInfos: ArgReprInfo list * + witnessInfos: TraitWitnessInfos * + methodArgTys: TType list * + retInfo: ArgReprInfo /// Indicates the value is stored at the given position in the closure environment accessed via "ldarg 0" - | Env of ILType * ILFieldSpec * (FreeTyvars * NamedLocalIlxClosureInfo ref) option + | Env of + ilCloTyInner: ILType * + ilField: ILFieldSpec * + localCloInfo: (FreeTyvars * NamedLocalIlxClosureInfo ref) option /// Indicates that the value is an argument of a method being generated - | Arg of int + | Arg of index: int /// Indicates that the value is stored in local of the method being generated. NamedLocalIlxClosureInfo is normally empty. /// It is non-empty for 'local type functions', see comments on definition of NamedLocalIlxClosureInfo. - | Local of idx: int * realloc: bool * (FreeTyvars * NamedLocalIlxClosureInfo ref) option + | Local of + index: int * + realloc: bool * + localCloInfo: (FreeTyvars * NamedLocalIlxClosureInfo ref) option /// Indicates if there is a shadow local storage for a local, to make sure it gets a good name in debugging and OptionalShadowLocal = @@ -6255,7 +6284,12 @@ and GenBindingAfterDebugPoint cenv cgbuf eenv sp (TBind(vspec, rhsExpr, _)) isSt CountStaticFieldDef() // ... and the get/set properties to access it. - if not hasLiteralAttr then + if hasLiteralAttr then + match optShadowLocal with + | NoShadowLocal -> () + | ShadowLocal (startMark, _storage) -> + cgbuf.SetMarkToHere startMark + else let ilAttribs = vspec.Attribs |> List.filter (fun (Attrib(_, _, _, _, _, targets, _)) -> canTarget(targets, System.AttributeTargets.Property)) From 32b4067dd0c10ee3bb4d10c5af6eb89646cd792b Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 25 Aug 2021 01:47:32 +0100 Subject: [PATCH 11/11] update baselines --- .../EmittedIL/SerializableAttribute/ToplevelModule.il.bsl | 8 ++++---- .../SerializableAttribute/ToplevelNamespace.il.bsl | 8 ++++---- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl index 876912097bf..27497d9c2c1 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelModule.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001148 Length: 0x000003FD } .module TopLevelModule.dll -// MVID: {61242E2D-37F5-C118-A745-03832D2E2461} +// MVID: {6125903C-37F5-C118-A745-03833C902561} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x06E00000 +// Image base: 0x009E0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -1702,8 +1702,8 @@ { // Code size 13 (0xd) .maxstack 3 - .locals init ([0] string 'greeting (shadowed)', - [1] string greeting) + .locals init ([0] string greeting, + [1] string V_1) .line 12,12 : 9,31 '' IL_0000: call string ABC::get_greeting() IL_0005: stloc.0 diff --git a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl index 4e3b32c47f3..5979b8d1850 100644 --- a/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl +++ b/tests/fsharpqa/Source/CodeGen/EmittedIL/SerializableAttribute/ToplevelNamespace.il.bsl @@ -36,13 +36,13 @@ // Offset: 0x00001850 Length: 0x0000055C } .module ToplevelNamespace.dll -// MVID: {61242E31-218B-729A-A745-0383312E2461} +// MVID: {61259040-218B-729A-A745-038340902561} .imagebase 0x00400000 .file alignment 0x00000200 .stackreserve 0x00100000 .subsystem 0x0003 // WINDOWS_CUI .corflags 0x00000001 // ILONLY -// Image base: 0x070E0000 +// Image base: 0x073B0000 // =============== CLASS MEMBERS DECLARATION =================== @@ -2488,8 +2488,8 @@ { // Code size 13 (0xd) .maxstack 3 - .locals init ([0] string 'greeting (shadowed)', - [1] string greeting) + .locals init ([0] string greeting, + [1] string V_1) .line 19,19 : 9,31 '' IL_0000: call string XYZ.ABC::get_greeting() IL_0005: stloc.0