From: Andrea Corallo Date: Sat, 21 Dec 2019 17:57:56 +0000 (+0100) Subject: initial gc support X-Git-Tag: emacs-28.0.90~2727^2~903 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=c5bb62f99db4b1c70e68e7c7a30ede8227f199a3;p=emacs.git initial gc support --- diff --git a/src/alloc.c b/src/alloc.c index dba2c2df881..547990c7a9e 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6567,10 +6567,18 @@ mark_object (Lisp_Object arg) case PVEC_SUBR: #ifdef HAVE_NATIVE_COMP if (SUBRP_NATIVE_COMPILEDP (obj)) - set_vector_marked (ptr); + { + set_vector_marked (ptr); + struct Lisp_Subr *subr = XSUBR (obj); + mark_object (subr->native_comp_u); + } + break; + case PVEC_NATIVE_COMP_UNIT: + set_vector_marked (ptr); + /* FIXME see comp.h. */ + mark_object (XCOMPILATION_UNIT (obj)->data_vec); #endif break; - case PVEC_FREE: emacs_abort (); diff --git a/src/comp.c b/src/comp.c index ea5d3238d2c..71d4d79f9e7 100644 --- a/src/comp.c +++ b/src/comp.c @@ -3225,8 +3225,10 @@ load_static_obj (dynlib_handle_ptr handle, const char *name) } static void -load_comp_unit (dynlib_handle_ptr handle, Lisp_Object file) +load_comp_unit (Lisp_Object comp_u_obj, Lisp_Object file) { + struct Lisp_Native_Compilation_Unit *comp_u = XCOMPILATION_UNIT (comp_u_obj); + dynlib_handle_ptr handle = comp_u->handle; struct thread_state ***current_thread_reloc = dynlib_sym (handle, CURRENT_THREAD_RELOC_SYM); EMACS_INT ***pure_reloc = dynlib_sym (handle, PURE_RELOC_SYM); @@ -3249,11 +3251,9 @@ load_comp_unit (dynlib_handle_ptr handle, Lisp_Object file) EMACS_INT d_vec_len = XFIXNUM (Flength (d_vec)); for (EMACS_INT i = 0; i < d_vec_len; i++) - { data_relocs[i] = AREF (d_vec, i); - prevent_gc (data_relocs[i]); - } + comp_u->data_vec = d_vec; /* Imported functions. */ *freloc_link_table = freloc.link_table; @@ -3270,24 +3270,26 @@ DEFUN ("comp--register-subr", Fcomp__register_subr, Scomp__register_subr, (Lisp_Object name, Lisp_Object minarg, Lisp_Object maxarg, Lisp_Object c_name, Lisp_Object doc, Lisp_Object intspec) { - dynlib_handle_ptr handle = xmint_pointer (XCAR (load_handle_stack)); + Lisp_Object comp_u = XCAR (load_handle_stack); + dynlib_handle_ptr handle = XCOMPILATION_UNIT (comp_u)->handle; if (!handle) xsignal0 (Qwrong_register_subr_call); void *func = dynlib_sym (handle, SSDATA (c_name)); eassert (func); - /* FIXME add gc support, now just leaking. */ - union Aligned_Lisp_Subr *x = xmalloc (sizeof (*x)); - - x->s.header.size = PVEC_SUBR << PSEUDOVECTOR_AREA_BITS; + union Aligned_Lisp_Subr *x = + (union Aligned_Lisp_Subr *) allocate_pseudovector ( + VECSIZE (union Aligned_Lisp_Subr), + 0, VECSIZE (union Aligned_Lisp_Subr), + PVEC_SUBR); x->s.function.a0 = func; x->s.min_args = XFIXNUM (minarg); x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (Fsymbol_name (name))); x->s.native_intspec = intspec; x->s.native_doc = doc; - XSETPVECTYPE (&x->s, PVEC_SUBR); + x->s.native_comp_u = comp_u; Lisp_Object tem; XSETSUBR (tem, &x->s); set_symbol_function (name, tem); @@ -3324,11 +3326,12 @@ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 1, 0, copy_file_fd (fd_out, fd_in, &st, Qnil, file); dynlib_handle_ptr handle = dynlib_open (format_string ("/proc/%d/fd/%d", getpid (), fd_out)); - load_handle_stack = Fcons (make_mint_ptr (handle), load_handle_stack); + Lisp_Object comp_u = make_native_comp_u (fd_in, handle); + load_handle_stack = Fcons (comp_u, load_handle_stack); if (!handle) xsignal2 (Qnative_lisp_load_failed, file, build_string (dynlib_error ())); - load_comp_unit (handle, file); + load_comp_unit (comp_u, file); load_handle_stack = XCDR (load_handle_stack); diff --git a/src/comp.h b/src/comp.h index 457b678699c..876615e8dd4 100644 --- a/src/comp.h +++ b/src/comp.h @@ -29,6 +29,7 @@ struct Lisp_Native_Compilation_Unit /* Compilation unit file descriptor and handle. */ int fd; dynlib_handle_ptr handle; + Lisp_Object data_vec; /* FIXME this should be in the normal lisp slot. */ }; INLINE bool diff --git a/src/lisp.h b/src/lisp.h index 7a4b3517574..3d467a84d18 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1342,6 +1342,7 @@ dead_object (void) #define XSETTHREAD(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_THREAD)) #define XSETMUTEX(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_MUTEX)) #define XSETCONDVAR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CONDVAR)) +#define XSETNATIVE_COMP_UNIT(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_NATIVE_COMP_UNIT)) /* Efficiently convert a pointer to a Lisp object and back. The pointer is represented as a fixnum, so the garbage collector @@ -2100,7 +2101,7 @@ struct Lisp_Subr Lisp_Object native_doc; }; #ifdef HAVE_NATIVE_COMP - Lisp_Object native_comp_u;; + Lisp_Object native_comp_u; #endif } GCALIGNED_STRUCT; union Aligned_Lisp_Subr @@ -2138,14 +2139,6 @@ enum char_table_specials = PSEUDOVECSIZE (struct Lisp_Sub_Char_Table, contents) - 1 }; -#ifdef HAVE_NATIVE_COMP -INLINE bool -SUBRP_NATIVE_COMPILEDP (Lisp_Object a) -{ - return SUBRP (a) && XSUBR (a)->native_comp_u; -} -#endif - /* Sanity-check pseudovector layout. */ verify (offsetof (struct Lisp_Char_Table, defalt) == header_size); verify (offsetof (struct Lisp_Char_Table, extras) @@ -4769,6 +4762,29 @@ extern void syms_of_profiler (void); extern char *emacs_root_dir (void); #endif /* DOS_NT */ +#ifdef HAVE_NATIVE_COMP +INLINE bool +SUBRP_NATIVE_COMPILEDP (Lisp_Object a) +{ + return SUBRP (a) && XSUBR (a)->native_comp_u; +} + +INLINE Lisp_Object +make_native_comp_u (int fd, dynlib_handle_ptr handle) +{ + struct Lisp_Native_Compilation_Unit *x = + (struct Lisp_Native_Compilation_Unit *) allocate_pseudovector ( + VECSIZE (struct Lisp_Native_Compilation_Unit), + 0, VECSIZE (struct Lisp_Native_Compilation_Unit), + PVEC_NATIVE_COMP_UNIT); + x->fd = fd; + x->handle = handle; + Lisp_Object cu; + XSETNATIVE_COMP_UNIT (cu, x); + return cu; +} +#endif + /* Defined in lastfile.c. */ extern char my_edata[]; extern char my_endbss[]; diff --git a/src/print.c b/src/print.c index 2e2c863ece8..e7ddafbbbbd 100644 --- a/src/print.c +++ b/src/print.c @@ -1828,7 +1828,7 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, #ifdef HAVE_NATIVE_COMP case PVEC_NATIVE_COMP_UNIT: { - print_c_string ("#", printcharfun); + print_c_string ("#fd); strout (buf, len, len, printcharfun); printchar ('>', printcharfun);