From e11e775a96f2c7e86c12dd81653f7ae6512df936 Mon Sep 17 00:00:00 2001 From: krangelov Date: Wed, 22 Sep 2021 13:21:07 +0200 Subject: [PATCH] merge pgf_free and pgf_free_revision since otherwise we cannot control the finalizers in Haskell --- src/runtime/c/pgf/db.cxx | 1 + src/runtime/c/pgf/db.h | 4 ++ src/runtime/c/pgf/pgf.cxx | 17 +++--- src/runtime/c/pgf/pgf.h | 6 +-- src/runtime/haskell/PGF2.hsc | 66 +++++++++-------------- src/runtime/haskell/PGF2/FFI.hsc | 7 +-- src/runtime/haskell/PGF2/Transactions.hsc | 24 ++++----- src/runtime/python/pypgf.c | 2 +- 8 files changed, 56 insertions(+), 71 deletions(-) diff --git a/src/runtime/c/pgf/db.cxx b/src/runtime/c/pgf/db.cxx index b0bad20f7..ff20835a5 100644 --- a/src/runtime/c/pgf/db.cxx +++ b/src/runtime/c/pgf/db.cxx @@ -289,6 +289,7 @@ PgfDB::PgfDB(const char* filepath, int flags, int mode) { fd = -1; ms = NULL; + ref_count = 0; if (filepath == NULL) { this->filepath = NULL; diff --git a/src/runtime/c/pgf/db.h b/src/runtime/c/pgf/db.h index bfde56ebb..b7bc01482 100644 --- a/src/runtime/c/pgf/db.h +++ b/src/runtime/c/pgf/db.h @@ -65,6 +65,10 @@ private: friend class PgfReader; public: + // Here we count to how many revisions the client has access. + // When the count is zero we release the database. + int ref_count; + PGF_INTERNAL_DECL PgfDB(const char* filepath, int flags, int mode); PGF_INTERNAL_DECL ~PgfDB(); diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 14a65b566..a6b228810 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -56,6 +56,7 @@ PgfDB *pgf_read_pgf(const char* fpath, *revision = pgf.as_object(); } + db->ref_count++; return db; } PGF_API_END @@ -97,6 +98,7 @@ PgfDB *pgf_boot_ngf(const char* pgf_path, const char* ngf_path, PgfDB::sync(); } + db->ref_count++; return db; } PGF_API_END @@ -130,6 +132,7 @@ PgfDB *pgf_read_ngf(const char *fpath, *revision = pgf.as_object(); } + db->ref_count++; return db; } PGF_API_END @@ -175,6 +178,7 @@ PgfDB *pgf_new_ngf(PgfText *abstract_name, PgfDB::sync(); } + db->ref_count++; return db; } PGF_API_END @@ -214,12 +218,6 @@ end: fclose(out); } -PGF_API -void pgf_free(PgfDB *db) -{ - delete db; -} - PGF_API_DECL void pgf_free_revision(PgfDB *db, PgfRevision revision) { @@ -240,9 +238,14 @@ void pgf_free_revision(PgfDB *db, PgfRevision revision) PgfPGF::release(pgf); PgfDB::free(pgf); } + + db->ref_count--; } catch (std::runtime_error& e) { // silently ignore and hope for the best } + + if (!db->ref_count) + delete db; } PGF_API @@ -601,6 +604,7 @@ PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision, memcpy(&new_pgf->name, ((name == NULL) ? &pgf->name : name), sizeof(PgfText)+name_size+1); + db->ref_count++; return new_pgf.as_object(); } PGF_API_END @@ -635,6 +639,7 @@ PgfRevision pgf_checkout_revision(PgfDB *db, PgfText *name, DB_scope scope(db, WRITER_SCOPE); ref pgf = PgfDB::get_revision(name); Node::add_value_ref(pgf); + db->ref_count++; return pgf.as_object(); } PGF_API_END diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index f9a8dd8b2..b8f866cd6 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -259,10 +259,8 @@ void pgf_write_pgf(const char* fpath, PgfDB *db, PgfRevision revision, PgfExn* err); -/* Release the database when it is no longer needed. */ -PGF_API_DECL -void pgf_free(PgfDB *pgf); - +/* Release a revision. If this is the last revision for the given + * database, then the database is released as well. */ PGF_API_DECL void pgf_free_revision(PgfDB *pgf, PgfRevision revision); diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 57083d4b8..2af222f92 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -112,11 +112,10 @@ readPGF fpath = withCString fpath $ \c_fpath -> alloca $ \p_revision -> mask_ $ do - c_pgf <- withPgfExn "readPGF" (pgf_read_pgf c_fpath p_revision) + c_db <- withPgfExn "readPGF" (pgf_read_pgf c_fpath p_revision) c_revision <- peek p_revision - fptr1 <- newForeignPtr pgf_free_fptr c_pgf - fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) - return (PGF fptr1 fptr2 Map.empty) + fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision) + return (PGF c_db fptr Map.empty) -- | Reads a PGF file and stores the unpacked data in an NGF file -- ready to be shared with other process, or used for quick startup. @@ -128,11 +127,10 @@ bootNGF pgf_path ngf_path = withCString ngf_path $ \c_ngf_path -> alloca $ \p_revision -> mask_ $ do - c_pgf <- withPgfExn "bootNGF" (pgf_boot_ngf c_pgf_path c_ngf_path p_revision) + c_db <- withPgfExn "bootNGF" (pgf_boot_ngf c_pgf_path c_ngf_path p_revision) c_revision <- peek p_revision - fptr1 <- newForeignPtr pgf_free_fptr c_pgf - fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) - return (PGF fptr1 fptr2 Map.empty) + fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision) + return (PGF c_db fptr Map.empty) -- | Reads the grammar from an already booted NGF file. -- The function fails if the file does not exist. @@ -143,9 +141,8 @@ readNGF fpath = mask_ $ do c_db <- withPgfExn "readNGF" (pgf_read_ngf c_fpath p_revision) c_revision <- peek p_revision - fptr1 <- newForeignPtr pgf_free_fptr c_db - fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) - return (PGF fptr1 fptr2 Map.empty) + fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision) + return (PGF c_db fptr Map.empty) -- | Creates a new NGF file with a grammar with the given abstract_name. -- Aside from the name, the grammar is otherwise empty but can be later @@ -159,16 +156,14 @@ newNGF abs_name mb_fpath = mask_ $ do c_db <- withPgfExn "newNGF" (pgf_new_ngf c_abs_name c_fpath p_revision) c_revision <- peek p_revision - fptr1 <- newForeignPtr pgf_free_fptr c_db - fptr2 <- C.newForeignPtr c_revision (withForeignPtr fptr1 (\c_db -> pgf_free_revision c_db c_revision)) - return (PGF fptr1 fptr2 Map.empty) + fptr <- C.newForeignPtr c_revision (pgf_free_revision c_db c_revision) + return (PGF c_db fptr Map.empty) writePGF :: FilePath -> PGF -> IO () writePGF fpath p = withCString fpath $ \c_fpath -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> - withPgfExn "writePGF" (pgf_write_pgf c_fpath c_db c_revision) + withPgfExn "writePGF" (pgf_write_pgf c_fpath (a_db p) c_revision) showPGF :: PGF -> String showPGF = error "TODO: showPGF" @@ -178,9 +173,8 @@ showPGF = error "TODO: showPGF" abstractName :: PGF -> AbsName abstractName p = unsafePerformIO $ - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> - bracket (withPgfExn "abstractName" (pgf_abstract_name c_db c_revision)) free $ \c_text -> + bracket (withPgfExn "abstractName" (pgf_abstract_name (a_db p) c_revision)) free $ \c_text -> peekText c_text -- | The start category is defined in the grammar with @@ -192,9 +186,8 @@ startCat :: PGF -> Type startCat p = unsafePerformIO $ withForeignPtr unmarshaller $ \u -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> do - c_typ <- withPgfExn "startCat" (pgf_start_cat c_db c_revision u) + c_typ <- withPgfExn "startCat" (pgf_start_cat (a_db p) c_revision u) typ <- deRefStablePtr c_typ freeStablePtr c_typ return typ @@ -204,10 +197,9 @@ functionType :: PGF -> Fun -> Maybe Type functionType p fn = unsafePerformIO $ withForeignPtr unmarshaller $ \u -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> withText fn $ \c_fn -> do - c_typ <- withPgfExn "functionType" (pgf_function_type c_db c_revision c_fn u) + c_typ <- withPgfExn "functionType" (pgf_function_type (a_db p) c_revision c_fn u) if c_typ == castPtrToStablePtr nullPtr then return Nothing else do typ <- deRefStablePtr c_typ @@ -218,27 +210,24 @@ functionIsConstructor :: PGF -> Fun -> Bool functionIsConstructor p fun = unsafePerformIO $ withText fun $ \c_fun -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> - do res <- withPgfExn "functionIsConstructor" (pgf_function_is_constructor c_db c_revision c_fun) + do res <- withPgfExn "functionIsConstructor" (pgf_function_is_constructor (a_db p) c_revision c_fun) return (res /= 0) functionProbability :: PGF -> Fun -> Float functionProbability p fun = unsafePerformIO $ withText fun $ \c_fun -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> - withPgfExn "functionProbability" (pgf_function_prob c_db c_revision c_fun) + withPgfExn "functionProbability" (pgf_function_prob (a_db p) c_revision c_fun) exprProbability :: PGF -> Expr -> Float exprProbability p e = unsafePerformIO $ - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> bracket (newStablePtr e) freeStablePtr $ \c_e -> withForeignPtr marshaller $ \m -> - withPgfExn "exprProbability" (pgf_expr_prob c_db c_revision c_e m) + withPgfExn "exprProbability" (pgf_expr_prob (a_db p) c_revision c_e m) checkExpr :: PGF -> Expr -> Type -> Either String Expr checkExpr = error "TODO: checkExpr" @@ -503,10 +492,9 @@ categories p = ref <- newIORef [] (allocaBytes (#size PgfItor) $ \itor -> bracket (wrapItorCallback (getCategories ref)) freeHaskellFunPtr $ \fptr -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> do (#poke PgfItor, fn) itor fptr - withPgfExn "categories" (pgf_iter_categories c_db c_revision itor) + withPgfExn "categories" (pgf_iter_categories (a_db p) c_revision itor) cs <- readIORef ref return (reverse cs)) where @@ -522,10 +510,9 @@ categoryContext p cat = withText cat $ \c_cat -> alloca $ \p_n_hypos -> withForeignPtr unmarshaller $ \u -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> mask_ $ do - c_hypos <- withPgfExn "categoryContext" (pgf_category_context c_db c_revision c_cat p_n_hypos u) + c_hypos <- withPgfExn "categoryContext" (pgf_category_context (a_db p) c_revision c_cat p_n_hypos u) if c_hypos == nullPtr then return Nothing else do n_hypos <- peek p_n_hypos @@ -550,9 +537,8 @@ categoryProbability :: PGF -> Cat -> Float categoryProbability p cat = unsafePerformIO $ withText cat $ \c_cat -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> - withPgfExn "categoryProbability" (pgf_category_prob c_db c_revision c_cat) + withPgfExn "categoryProbability" (pgf_category_prob (a_db p) c_revision c_cat) -- | List of all functions defined in the abstract syntax functions :: PGF -> [Fun] @@ -561,10 +547,9 @@ functions p = ref <- newIORef [] (allocaBytes (#size PgfItor) $ \itor -> bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> do (#poke PgfItor, fn) itor fptr - withPgfExn "functions" (pgf_iter_functions c_db c_revision itor) + withPgfExn "functions" (pgf_iter_functions (a_db p) c_revision itor) fs <- readIORef ref return (reverse fs)) where @@ -582,10 +567,9 @@ functionsByCat p cat = (withText cat $ \c_cat -> allocaBytes (#size PgfItor) $ \itor -> bracket (wrapItorCallback (getFunctions ref)) freeHaskellFunPtr $ \fptr -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> do (#poke PgfItor, fn) itor fptr - withPgfExn "functionsByCat" (pgf_iter_functions_by_cat c_db c_revision c_cat itor) + withPgfExn "functionsByCat" (pgf_iter_functions_by_cat (a_db p) c_revision c_cat itor) fs <- readIORef ref return (reverse fs)) where @@ -599,10 +583,9 @@ globalFlag :: PGF -> String -> Maybe Literal globalFlag p name = unsafePerformIO $ withText name $ \c_name -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> withForeignPtr unmarshaller $ \u -> do - c_lit <- withPgfExn "globalFlag" (pgf_get_global_flag c_db c_revision c_name u) + c_lit <- withPgfExn "globalFlag" (pgf_get_global_flag (a_db p) c_revision c_name u) if c_lit == castPtrToStablePtr nullPtr then return Nothing else do lit <- deRefStablePtr c_lit @@ -613,10 +596,9 @@ abstractFlag :: PGF -> String -> Maybe Literal abstractFlag p name = unsafePerformIO $ withText name $ \c_name -> - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> withForeignPtr unmarshaller $ \u -> do - c_lit <- withPgfExn "abstractFlag" (pgf_get_abstract_flag c_db c_revision c_name u) + c_lit <- withPgfExn "abstractFlag" (pgf_get_abstract_flag (a_db p) c_revision c_name u) if c_lit == castPtrToStablePtr nullPtr then return Nothing else do lit <- deRefStablePtr c_lit diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 3e229597b..76caeec29 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -23,11 +23,11 @@ type ConcName = String -- ^ Name of concrete syntax -- | An abstract data type representing multilingual grammar -- in Portable Grammar Format. -data PGF = PGF { a_db :: ForeignPtr PgfDB +data PGF = PGF { a_db :: Ptr PgfDB , revision :: ForeignPtr PgfRevision , languages:: Map.Map ConcName Concr } -data Concr = Concr {c_pgf :: ForeignPtr PgfDB, concr :: Ptr PgfConcr} +data Concr = Concr {c_pgf :: Ptr PgfDB, concr :: Ptr PgfConcr} ------------------------------------------------------------------ -- libpgf API @@ -62,9 +62,6 @@ foreign import ccall pgf_new_ngf :: Ptr PgfText -> CString -> Ptr (Ptr PgfRevisi foreign import ccall pgf_write_pgf :: CString -> Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO () -foreign import ccall "&pgf_free" - pgf_free_fptr :: FinalizerPtr PgfDB - foreign import ccall "pgf_free_revision" pgf_free_revision :: Ptr PgfDB -> Ptr PgfRevision -> IO () diff --git a/src/runtime/haskell/PGF2/Transactions.hsc b/src/runtime/haskell/PGF2/Transactions.hsc index 2231e360f..a3f4df371 100644 --- a/src/runtime/haskell/PGF2/Transactions.hsc +++ b/src/runtime/haskell/PGF2/Transactions.hsc @@ -73,41 +73,39 @@ branchPGF p name t = branchPGF_ :: Ptr PgfText -> PGF -> Transaction a -> IO PGF branchPGF_ c_name p (Transaction f) = - withForeignPtr (a_db p) $ \c_db -> withForeignPtr (revision p) $ \c_revision -> withPgfExn "branchPGF" $ \c_exn -> mask $ \restore -> do - c_revision <- pgf_clone_revision c_db c_revision c_name c_exn + c_revision <- pgf_clone_revision (a_db p) c_revision c_name c_exn ex_type <- (#peek PgfExn, type) c_exn if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE) - then do ((restore (f c_db c_revision c_exn)) + then do ((restore (f (a_db p) c_revision c_exn)) `catch` (\e -> do - pgf_free_revision c_db c_revision + pgf_free_revision (a_db p) c_revision throwIO (e :: SomeException))) ex_type <- (#peek PgfExn, type) c_exn if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE) - then do pgf_commit_revision c_db c_revision c_exn + then do pgf_commit_revision (a_db p) c_revision c_exn ex_type <- (#peek PgfExn, type) c_exn if (ex_type :: (#type PgfExnType)) == (#const PGF_EXN_NONE) - then do fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision)) - return (PGF (a_db p) fptr2 (languages p)) - else do pgf_free_revision c_db c_revision + then do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision) + return (PGF (a_db p) fptr (languages p)) + else do pgf_free_revision (a_db p) c_revision return p - else do pgf_free_revision c_db c_revision + else do pgf_free_revision (a_db p) c_revision return p else return p {- | Retrieves the branch with the given name -} checkoutPGF :: PGF -> String -> IO (Maybe PGF) checkoutPGF p name = - withForeignPtr (a_db p) $ \c_db -> withText name $ \c_name -> do - c_revision <- withPgfExn "checkoutPGF" (pgf_checkout_revision c_db c_name) + c_revision <- withPgfExn "checkoutPGF" (pgf_checkout_revision (a_db p) c_name) if c_revision == nullPtr then return Nothing - else do fptr2 <- C.newForeignPtr c_revision (withForeignPtr (a_db p) (\c_db -> pgf_free_revision c_db c_revision)) - return (Just (PGF (a_db p) fptr2 (languages p))) + else do fptr <- C.newForeignPtr c_revision (pgf_free_revision (a_db p) c_revision) + return (Just (PGF (a_db p) fptr (languages p))) createFunction :: Fun -> Type -> Int -> Float -> Transaction () createFunction name ty arity prob = Transaction $ \c_db c_revision c_exn -> diff --git a/src/runtime/python/pypgf.c b/src/runtime/python/pypgf.c index 6f2d7d7cd..dbf15ee7e 100644 --- a/src/runtime/python/pypgf.c +++ b/src/runtime/python/pypgf.c @@ -13,7 +13,7 @@ static void PGF_dealloc(PGFObject *self) { - pgf_free(self->db); + pgf_free_revision(self->db, self->revision); Py_TYPE(self)->tp_free((PyObject *)self); }