Merge pull request #1270 from dsyme/fixed

F# RFC FS-1015 - Support for "fixed"

Author: KevinRansom

src/absil/ilwrite.fs

@@ -849,6 +849,9 @@ and GetTypeAsTypeDefOrRef cenv env (ty:ILType) =
 
 and GetTypeAsBytes cenv env ty = emitBytesViaBuffer (fun bb -> EmitType cenv env bb ty)
 
+and GetTypeOfLocalAsBytes cenv env (l: ILLocal) = 
+    emitBytesViaBuffer (fun bb ->  EmitLocalInfo cenv env bb l)
+
 and GetTypeAsBlobIdx cenv env (ty:ILType) = 
     GetBytesAsBlobIdx cenv (GetTypeAsBytes cenv env ty)
 
@@ -912,6 +915,11 @@ and EmitType cenv env bb ty =
         EmitType cenv env bb ty
      | _ -> failwith "EmitType"
 
+and EmitLocalInfo cenv env (bb:ByteBuffer) (l:ILLocal) =
+    if l.IsPinned then 
+        bb.EmitByte et_PINNED
+    EmitType cenv env bb l.Type
+
 and EmitCallsig cenv env bb (callconv,args:ILTypes,ret,varargs:ILVarArgs,genarity) = 
     bb.EmitByte (callconvToByte genarity callconv)
     if genarity > 0 then bb.EmitZ32 genarity
@@ -1494,7 +1502,7 @@ let GetCallsigAsStandAloneSigIdx cenv env info =
 let EmitLocalSig cenv env (bb: ByteBuffer) (locals: ILLocals) = 
     bb.EmitByte e_IMAGE_CEE_CS_CALLCONV_LOCAL_SIG
     bb.EmitZ32 locals.Length
-    locals |> ILList.iter (fun l -> EmitType cenv env bb l.Type) 
+    locals |> ILList.iter (EmitLocalInfo cenv env bb)
 
 let GetLocalSigAsBlobHeapIdx cenv env locals = 
     GetBytesAsBlobIdx cenv (emitBytesViaBuffer (fun bb -> EmitLocalSig cenv env bb locals))
@@ -2237,7 +2245,7 @@ let GenILMethodBody mname cenv env (il: ILMethodBody) =
             // Write a fake entry for the local signature headed by e_IMAGE_CEE_CS_CALLCONV_FIELD. This is referenced by the PDB file
             ignore (FindOrAddSharedRow cenv TableNames.StandAloneSig (SharedRow [| Blob (GetFieldDefTypeAsBlobIdx cenv env l.Type) |]))
             // Now write the type
-            GetTypeAsBytes cenv env l.Type) 
+            GetTypeOfLocalAsBytes cenv env l) 
       else 
         [| |]
 

src/fsharp/FSComp.txt

@@ -1313,3 +1313,5 @@ estApplyStaticArgumentsForMethodNotImplemented,"A type provider implemented GetS
 3204,tcStructUnionMultiCase,"A union type which is a struct must have only one case."
 3205,tcUseMayNotBeMutable,"This feature is deprecated. A 'use' binding may not be marked 'mutable'."
 3206,CallerMemberNameIsOverriden,"The CallerMemberNameAttribute applied to parameter '%s' will have no effect. It is overridden by the CallerFilePathAttribute."
+3207,tcFixedNotAllowed,"Invalid use of 'fixed'. 'fixed' may only be used in a declaration of the form 'use x = fixed expr' where the expression is an array, the address of a field, the address of an array element or a string'"
+3208,tcCouldNotFindOffsetToStringData,"Could not find method System.Runtime.CompilerServices.OffsetToStringData in references when building 'fixed' expression."

src/fsharp/IlxGen.fs

@@ -1278,7 +1278,7 @@ type CodeGenBuffer(m:range,
                    alreadyUsedLocals:int,
                    zapFirstSeqPointToStart:bool) = 
 
-    let locals = new ResizeArray<((string * (Mark * Mark)) list * ILType)>(10)
+    let locals = new ResizeArray<((string * (Mark * Mark)) list * ILType * bool)>(10)
     let codebuf = new ResizeArray<ILInstr>(200)
     let exnSpecs = new ResizeArray<ILExceptionSpec>(10)
 
@@ -1417,20 +1417,20 @@ type CodeGenBuffer(m:range,
     member cgbuf.MethodName = methodName
     member cgbuf.PreallocatedArgCount = alreadyUsedArgs
 
-    member cgbuf.AllocLocal(ranges,ty) = 
+    member cgbuf.AllocLocal(ranges,ty,isFixed) = 
         let j = locals.Count
-        locals.Add((ranges,ty));
+        locals.Add((ranges,ty,isFixed));
         j 
 
-    member cgbuf.ReallocLocal(cond,ranges,ty) = 
+    member cgbuf.ReallocLocal(cond,ranges,ty,isFixed) = 
         let j = 
             match ResizeArray.tryFindIndexi cond locals with 
             | Some j -> 
-                let (prevRanges,_) = locals.[j]
-                locals.[j] <- ((ranges@prevRanges),ty);
+                let (prevRanges,_,isFixed) = locals.[j]
+                locals.[j] <- ((ranges@prevRanges),ty,isFixed);
                 j             
             | None -> 
-                cgbuf.AllocLocal(ranges,ty)
+                cgbuf.AllocLocal(ranges,ty,isFixed)
         let j = j + alreadyUsedLocals
         j
 
@@ -1562,15 +1562,16 @@ let CodeGenThen cenv mgbuf (zapFirstSeqPointToStart,entryPointInfo,methodName,ee
 
     let localDebugSpecs : ILLocalDebugInfo list = 
         locals
-        |> List.mapi (fun i (nms,_) -> List.map (fun nm -> (i,nm)) nms)
+        |> List.mapi (fun i (nms,_,_isFixed) -> List.map (fun nm -> (i,nm)) nms)
         |> List.concat
         |> List.map (fun (i,(nm,(start,finish))) -> 
             { Range=(start.CodeLabel, finish.CodeLabel);
               DebugMappings= [{ LocalIndex=i; LocalName=nm }] })
 
     let ilLocals =
         locals
-        |> List.map (fun (infos, ty) ->
+        |> List.map (fun (infos, ty, isFixed) ->
+          let loc = 
             // in interactive environment, attach name and range info to locals to improve debug experience
             if cenv.opts.isInteractive && cenv.opts.generateDebugSymbols then
                 match infos with
@@ -1580,7 +1581,8 @@ let CodeGenThen cenv mgbuf (zapFirstSeqPointToStart,entryPointInfo,methodName,ee
                 | [] -> mkILLocal ty None 
             // if not interactive, don't bother adding this info
             else
-                mkILLocal ty None)
+                mkILLocal ty None
+          if isFixed then { loc with IsPinned=true } else loc)
 
     (ilLocals, 
      maxStack,
@@ -2178,7 +2180,7 @@ and UnionCodeGen (cgbuf: CodeGenBuffer) =
     { new EraseUnions.ICodeGen<Mark> with 
         member __.CodeLabel(m) = m.CodeLabel
         member __.GenerateDelayMark() = CG.GenerateDelayMark cgbuf "unionCodeGenMark"
-        member __.GenLocal(ilty) = cgbuf.AllocLocal([],ilty) |> uint16
+        member __.GenLocal(ilty) = cgbuf.AllocLocal([],ilty,false) |> uint16
         member __.SetMarkToHere(m) = CG.SetMarkToHere cgbuf m
         member __.EmitInstr x = CG.EmitInstr cgbuf (pop 0) (Push []) x
         member __.EmitInstrs xs = CG.EmitInstrs cgbuf (pop 0) (Push []) xs }
@@ -2519,7 +2521,7 @@ and GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel =
                         // Only save arguments that have effects
                         if Optimizer.ExprHasEffect cenv.g laterArg then 
                             let ilTy = laterArg |> tyOfExpr cenv.g |> GenType cenv.amap m cenv.g eenv.tyenv
-                            let loc,eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("arg",m), ilTy) scopeMarks
+                            let loc,eenv = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("arg",m), ilTy, false) scopeMarks
                             GenExpr cenv cgbuf eenv SPSuppress laterArg Continue
                             EmitSetLocal cgbuf loc
                             Choice1Of2 (ilTy,loc),eenv
@@ -2652,7 +2654,7 @@ and GenIndirectCall cenv cgbuf eenv (functy,tyargs,args,m) sequel =
     CountCallFuncInstructions();
 
     // Generate the code code an ILX callfunc operation
-    let instrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps
+    let instrs = EraseClosures.mkCallFunc cenv.g.ilxPubCloEnv (fun ty -> cgbuf.AllocLocal([], ty,false) |> uint16) eenv.tyenv.Count isTailCall ilxClosureApps
     CG.EmitInstrs cgbuf (pop (1+args.Length)) (Push [ilActualRetTy]) instrs;
 
     // Done compiling indirect call...
@@ -2675,7 +2677,7 @@ and GenTry cenv cgbuf eenv scopeMarks (e1,m,resty,spTry) =
     let afterHandler = CG.GenerateDelayMark cgbuf "afterHandler"
     let eenvinner = {eenvinner with withinSEH = true}
     let ilResultTy = GenType cenv.amap m cenv.g eenvinner.tyenv resty
-    let whereToSave,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("tryres",m),ilResultTy) (startTryMark,endTryMark)
+    let whereToSave,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("tryres",m),ilResultTy, false) (startTryMark,endTryMark)
 
     // Generate the body of the try. In the normal case (SequencePointAtTry) we generate a sequence point
     // both on the 'try' keyword and on the start of the expression in the 'try'. For inlined code and
@@ -2835,7 +2837,7 @@ and GenForLoop cenv cgbuf eenv (spFor,v,e1,dir,e2,loopBody,m) sequel =
 
     let finishIdx,eenvinner = 
         if isFSharpStyle then 
-            let v,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop",m), cenv.g.ilg.typ_int32) (start,finish)
+            let v,eenvinner = AllocLocal cenv cgbuf eenvinner true (ilxgenGlobalNng.FreshCompilerGeneratedName ("endLoop",m), cenv.g.ilg.typ_int32, false) (start,finish)
             v, eenvinner
         else
             -1,eenvinner
@@ -3268,7 +3270,7 @@ and GenDefaultValue cenv cgbuf eenv (ty,m) =
         | _ -> 
             let ilTy = GenType cenv.amap m cenv.g eenv.tyenv ty
             LocalScope "ilzero" cgbuf (fun scopeMarks ->
-                let locIdx, _ = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("default",m), ilTy) scopeMarks
+                let locIdx, _ = AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("default",m), ilTy, false) scopeMarks
                 // "initobj" (Generated by EmitInitLocal) doesn't work on byref types 
                 // But ilzero(&ty) only gets generated in the built-in get-address function so 
                 // we can just rely on zeroinit of all IL locals. 
@@ -5411,14 +5413,14 @@ and GenStoreVal cgbuf eenv m (vspec:Val) =
 // Allocate locals for values
 //-------------------------------------------------------------------------- 
 
-and AllocLocal cenv cgbuf eenv compgen (v,ty) (scopeMarks: Mark * Mark) = 
+and AllocLocal cenv cgbuf eenv compgen (v,ty,isFixed) (scopeMarks: Mark * Mark) = 
      // The debug range for the local
      let ranges = if compgen then [] else [(v,scopeMarks)]
      // Get an index for the local
      let j = 
         if cenv.opts.localOptimizationsAreOn 
-        then cgbuf.ReallocLocal((fun i (_,ty') -> not (IntMap.mem i eenv.liveLocals) && (ty = ty')),ranges,ty)
-        else cgbuf.AllocLocal(ranges,ty)
+        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)
      j, { eenv with liveLocals =  IntMap.add j () eenv.liveLocals  }
 
 and AllocLocalVal cenv cgbuf v eenv repr scopeMarks = 
@@ -5434,11 +5436,11 @@ and AllocLocalVal cenv cgbuf v eenv repr scopeMarks =
                 let cloinfo,_,_ = GetIlxClosureInfo cenv v.Range true None eenvinner (Option.get repr)
                 cloinfo
 
-            let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, cenv.g.ilg.typ_Object) scopeMarks
+            let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, cenv.g.ilg.typ_Object, false) scopeMarks
             Local (idx,Some(ref (NamedLocalIlxClosureInfoGenerator cloinfoGenerate))),eenv
         else
             (* normal local *)
-            let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, GenTypeOfVal cenv eenv v) scopeMarks
+            let idx,eenv = AllocLocal cenv cgbuf eenv v.IsCompilerGenerated (v.CompiledName, GenTypeOfVal cenv eenv v, v.IsFixed) scopeMarks
             Local (idx,None),eenv
     let eenv = AddStorageForVal cenv.g (v,notlazy repr) eenv
     Some repr, eenv
@@ -5508,7 +5510,7 @@ and AllocTopValWithinExpr cenv cgbuf cloc scopeMarks v eenv =
 /// - and     because IL requires empty stack following a forward br (jump).
 and EmitSaveStack cenv cgbuf eenv m scopeMarks =
     let savedStack = (cgbuf.GetCurrentStack())
-    let savedStackLocals,eenvinner = List.mapFold (fun eenv ty -> AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("spill",m), ty) scopeMarks) eenv savedStack
+    let savedStackLocals,eenvinner = List.mapFold (fun eenv ty -> AllocLocal cenv cgbuf eenv true (ilxgenGlobalNng.FreshCompilerGeneratedName ("spill",m), ty, false) scopeMarks) eenv savedStack
     List.iter (EmitSetLocal cgbuf) savedStackLocals;
     cgbuf.AssertEmptyStack();
     (savedStack,savedStackLocals),eenvinner (* need to return, it marks locals "live" *)

src/fsharp/Optimizer.fs

@@ -431,7 +431,7 @@ let BindExternalLocalVal cenv (v:Val) vval env =
     CheckInlineValueIsComplete v vval;
 #endif
 
-    if verboseOptimizationInfo then dprintn ("*** Binding "^v.LogicalName); 
+    if verboseOptimizationInfo then dprintn ("*** Binding "+v.LogicalName); 
     let vval = if v.IsMutable then {vval with ValExprInfo=UnknownValue } else vval
     let env = 
 #if CHECKED
@@ -534,7 +534,7 @@ let TryGetInfoForEntity sv n =
     | Some info -> Some (info.Force())
     | None -> 
         if verboseOptimizationInfo then 
-            dprintn ("\n\n*** Optimization info for submodule "^n^" not found in parent module which contains submodules: "^String.concat "," (NameMap.domainL sv.ModuleOrNamespaceInfos)); 
+            dprintn ("\n\n*** Optimization info for submodule "+n+" not found in parent module which contains submodules: "+String.concat "," (NameMap.domainL sv.ModuleOrNamespaceInfos)); 
         None
 
 let rec TryGetInfoForPath sv (p:_[]) i = 
@@ -558,7 +558,7 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) =
             match structInfo.ValInfos.TryFind(vref) with 
             | Some ninfo -> snd ninfo
             | None -> 
-                  //dprintn ("\n\n*** Optimization info for value "^n^" from module "^(full_name_of_nlpath smv)^" not found, module contains values: "^String.concat "," (NameMap.domainL structInfo.ValInfos));  
+                  //dprintn ("\n\n*** Optimization info for value "+n+" from module "+(full_name_of_nlpath smv)+" not found, module contains values: "+String.concat "," (NameMap.domainL structInfo.ValInfos));  
                   //System.Diagnostics.Debug.Assert(false,sprintf "Break for module %s, value %s" (full_name_of_nlpath smv) n)
                   if cenv.g.compilingFslib then 
                       match structInfo.ValInfos.TryFindForFslib(vref) with 
@@ -1254,6 +1254,7 @@ let ValueIsUsedOrHasEffect cenv fvs (b:Binding,binfo) =
     not (cenv.settings.EliminateUnusedBindings()) ||
     isSome v.MemberInfo ||
     binfo.HasEffect || 
+    v.IsFixed ||
     Zset.contains v (fvs())
 
 let rec SplitValuesByIsUsedOrHasEffect cenv fvs x = 
@@ -1345,6 +1346,7 @@ let TryEliminateBinding cenv _env (TBind(vspec1,e1,spBind)) e2 _m  =
     if not (cenv.optimizing && cenv.settings.EliminateImmediatelyConsumedLocals()) && 
        not vspec1.IsCompilerGenerated then 
        None 
+    elif vspec1.IsFixed then None 
     else
         // Peephole on immediate consumption of single bindings, e.g. "let x = e in x" --> "e" 
         // REVIEW: enhance this by general elimination of bindings to 
@@ -1454,7 +1456,7 @@ let ExpandStructuralBindingRaw cenv expr =
           else
               let argTys = destTupleTy cenv.g v.Type
               let argBind i (arg:Expr) argTy =
-                  let name = v.LogicalName ^ "_" ^ string i
+                  let name = v.LogicalName + "_" + string i
                   let v,ve = mkCompGenLocal arg.Range name argTy
                   ve,mkCompGenBind v arg
 
@@ -2834,7 +2836,8 @@ and ComputeSplitToMethodCondition flag threshold cenv env (e,einfo) =
              //  None of them should be local polymorphic constrained values 
              not (IsGenericValWithGenericContraints cenv.g v) &&
              // None of them should be mutable 
-             not v.IsMutable))))
+             not v.IsMutable)))) &&
+    not (isByrefLikeTy cenv.g (tyOfExpr cenv.g e)) 
 
 and ConsiderSplitToMethod flag threshold cenv env (e,einfo) = 
     if ComputeSplitToMethodCondition flag threshold cenv env (e,einfo) then
@@ -2843,7 +2846,7 @@ and ConsiderSplitToMethod flag threshold cenv env (e,einfo) =
         let ty = tyOfExpr cenv.g e
         let nm = 
             match env.latestBoundId with 
-            | Some id -> id.idText^suffixForVariablesThatMayNotBeEliminated 
+            | Some id -> id.idText+suffixForVariablesThatMayNotBeEliminated 
             | None -> suffixForVariablesThatMayNotBeEliminated 
         let fv,fe = mkCompGenLocal m nm (cenv.g.unit_ty --> ty)
         mkInvisibleLet m fv (mkLambda m uv (e,ty)) 
@@ -3063,7 +3066,7 @@ and OptimizeBinding cenv isRec env (TBind(v,e,spBind)) =
             then {einfo with Info=UnknownValue} 
             else einfo 
         if v.MustInline  && IsPartialExprVal einfo.Info then 
-            errorR(InternalError("the mustinline value '"^v.LogicalName^"' was not inferred to have a known value",v.Range));
+            errorR(InternalError("the mustinline value '"+v.LogicalName+"' was not inferred to have a known value",v.Range));
 #if DEBUG
         if verboseOptimizations then dprintf "val %s gets opt info %s\n" (showL(valL v)) (showL(exprValueInfoL cenv.g einfo.Info));
 #endif