futhark 0.21.14 → 0.21.15
raw patch · 13 files changed
+83/−67 lines, 13 files
Files
- docs/c-api.rst +16/−5
- futhark.cabal +1/−1
- rts/c/cuda.h +1/−9
- rts/c/free_list.h +43/−3
- rts/c/opencl.h +1/−21
- src/Futhark/CLI/Test.hs +3/−4
- src/Futhark/CodeGen/Backends/GenericC.hs +8/−5
- src/Futhark/Compiler/Program.hs +5/−9
- src/Futhark/Internalise/Bindings.hs +0/−1
- src/Futhark/Internalise/Exps.hs +2/−6
- src/Futhark/Pkg/Types.hs +1/−1
- src/Language/Futhark/Parser/Parser.y +1/−1
- src/Language/Futhark/TypeChecker/Terms.hs +1/−1
docs/c-api.rst view
@@ -607,17 +607,19 @@ * The C function name of the entry point. - * A list of all *inputs*, including their type and whether they are- *unique* (consuming).+ * A list of all *inputs*, including their type (as a name) and+ *whether they are unique* (consuming). - * A list of all *outputs*, including their type and whether they are- *unique*.+ * A list of all *outputs*, including their type (as a name) and+ *whether they are unique*. * A mapping from the name of each non-scalar type to: - * The C type of used to represent the type (which is in practice+ * The C type used to represent this type (which is in practice always a pointer of some kind). + * What *kind* of type this is - either an *array* or an *opaque*.+ * For arrays, the element type and rank. * A mapping from *operations* to the names of the C functions that@@ -628,6 +630,15 @@ * For arrays: ``free``, ``shape``, ``values``, ``new``. * For opaques: ``free``, ``store``, ``restore``.++ * For opaques that are actually records (including tuples):++ * The list of fields, including their type and a projection+ function. The field ordering here is the one used expected by+ the *new* function.++ * The name of the C *new* function for creating a record from+ field values. Manifests are defined by the following JSON Schema:
futhark.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: futhark-version: 0.21.14+version: 0.21.15 synopsis: An optimising compiler for a functional, array-oriented language. description: Futhark is a small programming language designed to be compiled to
rts/c/cuda.h view
@@ -699,7 +699,7 @@ } size_t size;- if (free_list_find(&ctx->free_list, min_size, &size, mem_out) == 0) {+ if (free_list_find(&ctx->free_list, min_size, tag, &size, mem_out) == 0) { if (size >= min_size) { if (ctx->cfg.debugging) { fprintf(log, "No need to allocate: Found a block in the free list.\n");@@ -742,14 +742,6 @@ const char *tag) { size_t size; CUdeviceptr existing_mem;-- // If there is already a block with this tag, then remove it.- if (free_list_find(&ctx->free_list, -1, &size, &existing_mem) == 0) {- CUresult res = cuMemFree(existing_mem);- if (res != CUDA_SUCCESS) {- return res;- }- } CUresult res = cuMemGetAddressRange(NULL, &size, mem); if (res == CUDA_SUCCESS) {
rts/c/free_list.h view
@@ -85,16 +85,56 @@ l->used++; } +// Determine whether this entry in the free list is acceptable for+// satisfying the request.+static bool free_list_acceptable(size_t size, const char* tag, struct free_list_entry *entry) {+ // We check not just the hard requirement (is the entry acceptable+ // and big enough?) but also put a cap on how much wasted space+ // (internal fragmentation) we allow. This is necessarily a+ // heuristic, and a crude one.++ if (!entry->valid) {+ return false;+ }++ if (size > entry->size) {+ return false;+ }++ // We know the block fits. Now the question is whether it is too+ // big. Our policy is as follows:+ //+ // 1) We don't care about wasted space below 4096 bytes (to avoid+ // churn in tiny allocations).+ //+ // 2) If the tag matches, we allow _any_ amount of wasted space.+ //+ // 3) Otherwise we allow up to 50% wasted space.++ if (entry->size < 4096) {+ return true;+ }++ if (entry->tag == tag) {+ return true;+ }++ if (entry->size < size * 2) {+ return true;+ }++ return false;+}+ // Find and remove a memory block of the indicated tag, or if that // does not exist, another memory block with exactly the desired size. // Returns 0 on success.-static int free_list_find(struct free_list *l, size_t size,+static int free_list_find(struct free_list *l, size_t size, const char *tag, size_t *size_out, fl_mem_t *mem_out) { int size_match = -1; int i; for (i = 0; i < l->capacity; i++) {- if (l->entries[i].valid &&- size <= l->entries[i].size &&+ if (free_list_acceptable(size, tag, &l->entries[i]) && (size_match < 0 || l->entries[i].size < l->entries[size_match].size)) { // If this entry is valid, has sufficient size, and is smaller than the // best entry found so far, use this entry.
rts/c/opencl.h view
@@ -966,20 +966,8 @@ size_t size; - if (free_list_find(&ctx->free_list, min_size, &size, mem_out) == 0) {+ if (free_list_find(&ctx->free_list, min_size, tag, &size, mem_out) == 0) { // Successfully found a free block. Is it big enough?- //- // FIXME: we might also want to check whether the block is *too- // big*, to avoid internal fragmentation. However, this can- // sharply impact performance on programs where arrays change size- // frequently. Fortunately, such allocations are usually fairly- // short-lived, as they are necessarily within a loop, so the risk- // of internal fragmentation resulting in an OOM situation is- // limited. However, it would be preferable if we could go back- // and *shrink* oversize allocations when we encounter an OOM- // condition. That is technically feasible, since we do not- // expose OpenCL pointer values directly to the application, but- // instead rely on a level of indirection. if (size >= min_size) { if (ctx->cfg.debugging) { fprintf(log, "No need to allocate: Found a block in the free list.\n");@@ -1034,14 +1022,6 @@ static int opencl_free(struct opencl_context *ctx, cl_mem mem, const char *tag) { size_t size; cl_mem existing_mem;-- // If there is already a block with this tag, then remove it.- if (free_list_find(&ctx->free_list, -1, &size, &existing_mem) == 0) {- int error = clReleaseMemObject(existing_mem);- if (error != CL_SUCCESS) {- return error;- }- } int error = clGetMemObjectInfo(mem, CL_MEM_SIZE, sizeof(size_t), &size, NULL);
src/Futhark/CLI/Test.hs view
@@ -594,10 +594,9 @@ -- Removes "Now testing" output. when fancy $ cursorUpLine 1 >> clearLine - let excluded_str- | null excluded = ""- | otherwise = " (" ++ show (length excluded) ++ " program(s) excluded).\n"- putStr excluded_str+ unless (null excluded) . putStrLn $+ show (length excluded) ++ " program(s) excluded."+ exitWith $ case testStatusFail ts of 0 -> ExitSuccess _ -> ExitFailure 1
src/Futhark/CodeGen/Backends/GenericC.hs view
@@ -283,13 +283,16 @@ // We preserve the original error so that a savvy user can perhaps find // glory despite our naiveté. + // We cannot use set_error() here because we want to replace the old error.+ lock_lock(&ctx->error_lock); char *old_error = ctx->error;- set_error(ctx, msgprintf("Failed to allocate memory in %s.\nAttempted allocation: %12lld bytes\nCurrently allocated: %12lld bytes\n%s",- $string:spacedesc,- (long long) size,- (long long) ctx->$id:usagename,- old_error));+ ctx->error = msgprintf("Failed to allocate memory in %s.\nAttempted allocation: %12lld bytes\nCurrently allocated: %12lld bytes\n%s",+ $string:spacedesc,+ (long long) size,+ (long long) ctx->$id:usagename,+ old_error); free(old_error);+ lock_unlock(&ctx->error_lock); return FUTHARK_OUT_OF_MEMORY; } }|]
src/Futhark/Compiler/Program.hs view
@@ -99,10 +99,6 @@ newState :: [ImportName] -> IO ReaderState newState known = newMVar $ M.fromList $ zip known $ repeat Nothing --- Since we need to work with base 4.14 that does not have NE.singleton.-singleError :: ProgError -> NE.NonEmpty ProgError-singleError = (NE.:| [])- orderedImports :: [(ImportName, MVar UncheckedImport)] -> IO [(ImportName, WithErrors (LoadedFile E.UncheckedProg))]@@ -116,7 +112,7 @@ <> intercalate " -> " (map includeToString $ reverse $ include : steps)- modify ((include, Left (singleError problem)) :)+ modify ((include, Left (NE.singleton problem)) :) | otherwise = do prev <- gets $ lookup include case prev of@@ -189,7 +185,7 @@ handleFile state_mvar vfs (LoadedFile file_name import_name file_contents mod_time) = do case parseFuthark file_name file_contents of Left (SyntaxError loc err) ->- pure . UncheckedImport . Left . singleError $ ProgError loc $ text err+ pure . UncheckedImport . Left . NE.singleton $ ProgError loc $ text err Right prog -> do let imports = map (uncurry (mkImportFrom import_name)) $ E.progImports prog mvars <-@@ -212,7 +208,7 @@ Nothing -> do prog_mvar <- newImportMVar $ do readImportFile include vfs >>= \case- Left e -> pure $ UncheckedImport $ Left $ singleError e+ Left e -> pure $ UncheckedImport $ Left $ NE.singleton e Right file -> handleFile state_mvar vfs file pure (M.insert include prog_mvar state, prog_mvar) @@ -247,12 +243,12 @@ lfPath = fp } Just (Left e) ->- pure . UncheckedImport . Left . singleError $+ pure . UncheckedImport . Left . NE.singleton $ ProgError NoLoc $ text $ show e Nothing ->- pure . UncheckedImport . Left . singleError $+ pure . UncheckedImport . Left . NE.singleton $ ProgError NoLoc $ text $ fp <> ": file not found."
src/Futhark/Internalise/Bindings.hs view
@@ -146,7 +146,6 @@ flattenPat' $ E.Id name t loc flattenPat' (E.Id v (Info t) loc) = pure [(E.Ident v (Info t) loc, mempty)]- -- XXX: treat empty tuples and records as unit. flattenPat' (E.TuplePat [] loc) = flattenPat' (E.Wildcard (Info $ E.Scalar $ E.Record mempty) loc) flattenPat' (E.RecordPat [] loc) =
src/Futhark/Internalise/Exps.hs view
@@ -581,9 +581,6 @@ ses <- internaliseAppExp desc appres e bindExtSizes appres ses pure ses---- XXX: we map empty records and tuples to units, because otherwise--- arrays of unit will lose their sizes. internaliseExp _ (E.TupLit [] _) = pure [constant UnitValue] internaliseExp _ (E.RecordLit [] _) =@@ -880,11 +877,10 @@ compares pat ses compares (E.PatAttr _ pat _) ses = compares pat ses- -- XXX: treat empty tuples and records as bool. compares (E.TuplePat [] loc) ses =- compares (E.Wildcard (Info $ E.Scalar $ E.Prim E.Bool) loc) ses+ compares (E.Wildcard (Info $ E.Scalar $ E.Record mempty) loc) ses compares (E.RecordPat [] loc) ses =- compares (E.Wildcard (Info $ E.Scalar $ E.Prim E.Bool) loc) ses+ compares (E.Wildcard (Info $ E.Scalar $ E.Record mempty) loc) ses compares (E.TuplePat pats _) ses = comparesMany pats ses compares (E.RecordPat fs _) ses =
src/Futhark/Pkg/Types.hs view
@@ -76,7 +76,7 @@ -- | @commitVersion timestamp commit@ constructs a commit version. commitVersion :: T.Text -> T.Text -> SemVer commitVersion time commit =- SemVer 0 0 0 [Str time NE.:| []] (Just commit)+ SemVer 0 0 0 [NE.singleton (Str time)] (Just commit) -- | Unfortunately, Data.Versions has a buggy semver parser that -- collapses consecutive zeroes in the metadata field. So, we define
src/Language/Futhark/Parser/Parser.y view
@@ -778,7 +778,7 @@ in AppExp (Match $2 $> loc) NoInfo } Cases :: { NE.NonEmpty (CaseBase NoInfo Name) }- : Case %prec caseprec { $1 NE.:| [] }+ : Case %prec caseprec { NE.singleton $1 } | Case Cases { NE.cons $1 $2 } Case :: { CaseBase NoInfo Name }
src/Language/Futhark/TypeChecker/Terms.hs view
@@ -738,7 +738,7 @@ case NE.uncons rest_cs of (c, Nothing) -> do (c', t, retext) <- checkCase mt c- pure (c' NE.:| [], t, retext)+ pure (NE.singleton c', t, retext) (c, Just cs) -> do (((c', c_t, _), (cs', cs_t, _)), dflow) <- tapOccurrences $ checkCase mt c `alternative` checkCases mt cs