From 19f992b8ea59c2c106da2caf8c6208c16252ea97 Mon Sep 17 00:00:00 2001 From: Helmut Eller Date: Fri, 7 Jun 2024 14:09:48 +0200 Subject: [PATCH 1/5] WIP Generate code for scan methods * admin/igc-codegen.el: New file. * src/Makefile.in: New rule for igc-generated.c * srg/igc.c: Include the generated code. --- admin/igc-codegen.el | 625 +++++++++++++++++++++++++++++++++++++++++++ src/Makefile.in | 3 + src/igc.c | 353 ++++++++++++++++++------ 3 files changed, 904 insertions(+), 77 deletions(-) create mode 100644 admin/igc-codegen.el diff --git a/admin/igc-codegen.el b/admin/igc-codegen.el new file mode 100644 index 00000000000..cefe4111866 --- /dev/null +++ b/admin/igc-codegen.el @@ -0,0 +1,625 @@ +;; -*- lexical-binding: t -*- + +(require 'treesit) +(require 'project) + +(defmacro igccg--define-record (name &rest fields) + (let* ((constructor (intern (format "igccg--make-%s" name))) + (conc-name (intern (format "igccg--%s." name))) + (tag-name (intern (format "igccg--%s" name)))) + `(cl-defstruct (,tag-name + (:constructor ,constructor (,@fields)) + (:constructor nil) + (:conc-name ,conc-name) + (:predicate nil) + (:copier nil) + (:noinline)) + ,@(mapcar (lambda (field) + `(,field nil :read-only t)) + fields)))) + +(igccg--define-record layout name header pvectype tag ctype fields) + +(defun igccg--arg-decl (name type) + (pcase-exhaustive type + (`(* ,type) (igccg--arg-decl (format "*%s" name) type)) + (`(struct ,s) (format "struct %s %s" s name)) + (`(array ,type) (igccg--arg-decl (format "%s[]" name) type)) + (`vectorlike_header (igccg--arg-decl name `(struct Lisp_Vector))) + ((guard (symbolp type)) (format "%s %s" type name)))) + +(defun igccg--type-spec (type) + (pcase-exhaustive type + (`(* ,type) (format "%s*" (igccg--type-spec type))) + (`(struct ,s) (format "struct %s" s)) + (`(array ,type) (format "%s*" (igccg--type-spec type))) + (`vectorlike_header (igccg--type-spec `(struct Lisp_Vector))) + ((guard (symbolp type)) (symbol-name type)))) + +(defvar igccg--indent 0) + +(defun igccg--emit-line (string) + (princ (format "%s%s\n" + (make-string igccg--indent ?\s) + string))) + +(defun igccg--emit-function (rtype name args body) + (princ (format "static %s\n%s (%s)\n{\n" rtype name (string-join args ", "))) + (let ((igccg--indent 2)) + (funcall body)) + (princ "}\n\n")) + +(defun igccg--emit-block (body) + (igccg--emit-line "{") + (let ((igccg--indent (+ 2 igccg--indent))) + (funcall body)) + (igccg--emit-line "}")) + +(defun igccg--emit-switch (exp cases) + (igccg--emit-line (format "switch (%s)" exp)) + (igccg--emit-block (lambda () + (dolist (c cases) + (igccg--emit-line + (cond ((equal (car c) "default") "default:") + (t (format "case %s:" (car c))))) + (let ((igccg--indent (+ 2 igccg--indent))) + (funcall (cdr c)) + (igccg--emit-line "break;")))))) + +(defun igccg--emit-\#if (exp body) + (igccg--emit-line (format "#if %s" exp)) + (funcall body) + (igccg--emit-line "#endif")) + +(defun igccg--ifdef-exp (exp) + (pcase-exhaustive exp + ((guard (symbolp exp)) (format "defined %s" exp)) + (`(or . ,exps) (mapconcat #'igccg--ifdef-exp exps " || ")))) + +(defun igccg--emit-scan-body (body) + (igccg--emit-line "MPS_SCAN_BEGIN (ss)") + (igccg--emit-block body) + (igccg--emit-line "MPS_SCAN_END (ss);") + (igccg--emit-line "return MPS_RES_OK;")) + +(defun igccg--field-addr-exp (var path) + (pcase-exhaustive path + ((guard (symbolp path)) + (format "&%s->%s" var path)) + (`(path . ,symbols) + (format "&%s->%s" var (mapconcat #'symbol-name symbols "."))) + ((guard (stringp path)) + (format path var)))) + +(defun igccg--field-value-exp (var path) + (pcase-exhaustive path + ((guard (symbolp path)) + (format "%s->%s" var path)) + (`(path . ,symbols) + (format "%s->%s" var (mapconcat #'symbol-name symbols "."))) + ((guard (stringp path)) + (format path var)) + ('(pvec-header-size) + (format "%s->header.size & PSEUDOVECTOR_SIZE_MASK" var)) + ('(igc-header-len) + (format "((struct igc_header *)client_to_base (%s))->nwords \ +- to_words (sizeof (struct igc_header))" var)) + ('(sub-char-table-len) + (format "(%s->header.size & PSEUDOVECTOR_SIZE_MASK)\ + - SUB_CHAR_TABLE_OFFSET" var)))) + +(defun igccg--emit-fix-call (ss type var fname) + (igccg--emit-line + (format "IGC_FIX_CALL_FN (%s, %s, %s, %s);" + ss (igccg--type-spec type) var fname))) + +(defun igccg--emit-abort () + (igccg--emit-line "emacs_abort ();")) + +(defun igccg--emit-fix-field-exp (ss obj exp) + (pcase-exhaustive exp + (`(tagged ,path) + (igccg--emit-line (format "IGC_FIX12_OBJ (%s, %s);" + ss (igccg--field-addr-exp obj path)))) + (`(untagged ,path) + (igccg--emit-line (format "IGC_FIX12_RAW (%s, %s);" + ss (igccg--field-addr-exp obj path)))) + (`(switch ,path . ,cases) + (igccg--emit-switch + (igccg--field-value-exp obj path) + (mapcar (lambda (case) + (pcase-exhaustive case + (`(,tag . ,fields) + (cons (symbol-name tag) + (lambda () + (mapc (lambda (field) + (igccg--emit-fix-field-exp ss obj field)) + fields)))))) + cases))) + (`(array tagged ,start ,len) + (igccg--emit-line + (format (concat "IGC_FIX12_NOBJS (%s, %s, %s);") + ss + (igccg--field-value-exp obj start) + (igccg--field-value-exp obj len)))) + (`(array untagged ,start ,len) + (igccg--emit-line + (format "size_t len = %s;" (igccg--field-value-exp obj len))) + (igccg--emit-line + (format "for (void **p = %s, **q = p + len; p < q; p++)" + (igccg--field-value-exp obj start))) + (igccg--emit-block (lambda () + (igccg--emit-line + (format "IGC_FIX12_RAW (%s, p);" ss))))) + (`(vectorlike) + (igccg--emit-line + (format + "IGC_FIX12_NOBJS (%s,\ + (Lisp_Object *)(&%s->header + 1),\ + %s->header.size & PSEUDOVECTOR_SIZE_MASK);" ss obj obj))) + (`(cfg ,test . ,exps) + (igccg--emit-\#if (igccg--ifdef-exp test) + (lambda () + (mapc (lambda (exp) + (igccg--emit-fix-field-exp ss obj exp)) + exps)))) + ('(abort) + (igccg--emit-abort)) + ('(frame-quirks) + (igccg--emit-line + (format "IGC_FIX_CALL_FN (%s, struct frame, %s, fix_frame_quirks);" + ss obj))) + ('(window-quirks) + (igccg--emit-line + (format "IGC_FIX_CALL_FN (%s, struct window, %s, fix_window_quirks);" + ss obj))) + ('(buffer-quirks) + (igccg--emit-line + (format "IGC_FIX_CALL_FN (%s, struct buffer, %s, fix_buffer_quirks);" + ss obj))) + ('(terminal-quirks) + (igccg--emit-line + (format "IGC_FIX_CALL_FN (%s, struct terminal, %s, fix_terminal_quirks);" + ss obj))) + ('(font-object-quirks) + (igccg--emit-line + (format "IGC_FIX_CALL_FN (%s, struct font, %s, fix_font_object_quirks);" + ss obj))))) + +(defun igccg--fix-method-name (layout) + (format "fix_%s" (igccg--layout.name layout))) + +(defun igccg--scan-vectorlike-method-name (prefix) + (format "%s_scan_vectorlike" prefix)) + +(defun igccg--emit-fix-method (layout) + (igccg--emit-function + "mps_res_t" + (igccg--fix-method-name layout) + (list "mps_ss_t ss" (igccg--arg-decl "o" + `(* ,(igccg--layout.ctype layout)))) + (lambda () + (igccg--emit-scan-body + (lambda () + (dolist (exp (igccg--layout.fields layout)) + (igccg--emit-fix-field-exp "ss" "o" exp))))))) + +(defun igccg--emit-scan-vectorlike-method (name layouts) + (igccg--emit-function + "mps_res_t" + name + (list "mps_ss_t ss" "struct Lisp_Vector *v") + (lambda () + (igccg--emit-scan-body + (lambda () + (igccg--emit-switch + "pseudo_vector_type (v->header)" + (append + (mapcar (lambda (l) + (cons (symbol-name (igccg--layout.pvectype l)) + (lambda () + (igccg--emit-fix-call + "ss" (igccg--layout.ctype l) + "v" (igccg--fix-method-name l))))) + layouts) + (list (cons 'PVEC_FREE (lambda () (igccg--emit-abort))))))))))) + +(defun igccg--emit-scan-object-method (prefix layouts) + (mapc #'igccg--emit-fix-method layouts) + (let* ((alist (seq-group-by #'igccg--layout.header igccg--layouts )) + (vectorlike (cdr (assq 'IGC_OBJ_VECTOR alist))) + (scan-vectorlike (igccg--scan-vectorlike-method-name prefix))) + (igccg--emit-scan-vectorlike-method scan-vectorlike vectorlike) + (igccg--emit-function + "mps_res_t" + (format "%s_scan_object" prefix) + (list "mps_ss_t ss" "mps_addr_t base") + (lambda () + (igccg--emit-scan-body + (lambda () + (igccg--emit-line "mps_addr_t client = base_to_client (base);") + (igccg--emit-line "struct igc_header *header = base;") + (igccg--emit-switch + "header->obj_type" + (append + (mapcar + (lambda (p) + (pcase-exhaustive p + (`(,type . (,layout)) + (cons (symbol-name type) + (lambda () + (igccg--emit-fix-call + "ss" (igccg--layout.ctype layout) + "client" (igccg--fix-method-name layout))))) + (`(IGC_OBJ_VECTOR . ,_) + (cons "IGC_OBJ_VECTOR" + (lambda () + (igccg--emit-fix-call "ss" '(struct Lisp_Vector) + "client" scan-vectorlike)))))) + alist) + (list + (cons "IGC_OBJ_FWD" (lambda ())) + (cons "IGC_OBJ_PAD" (lambda ())) + (cons "IGC_OBJ_INVALID" (lambda () (igccg--emit-abort)))))))))))) + +(defvar igccg--layouts + (list + (igccg--make-layout + 'cons 'IGC_OBJ_CONS nil 'Lisp_Cons '(struct Lisp_Cons) + '((tagged (path u s car)) + (tagged (path u s u cdr)))) + + (igccg--make-layout + 'symbol 'IGC_OBJ_SYMBOL nil 'Lisp_Symbol '(struct Lisp_Symbol) + '((tagged (path u s name)) + (tagged (path u s function)) + (tagged (path u s plist)) + (untagged (path u s next)) + (switch + (path u s redirect) + (SYMBOL_PLAINVAL (tagged (path u s val value))) + (SYMBOL_VARALIAS (untagged (path u s val alias))) + (SYMBOL_LOCALIZED (untagged (path u s val blv))) + (SYMBOL_FORWARDED + (switch + "XFWDTYPE (%s->u.s.val.fwd)" + (Lisp_Fwd_Int) + (Lisp_Fwd_Bool) + (Lisp_Fwd_Kboard_Obj) + (Lisp_Fwd_Obj + (tagged "((struct Lisp_Objfwd *)(%s->u.s.val.fwd.fwdptr))->objvar")) + (Lisp_Fwd_Buffer_Obj + (tagged + "&\ +((struct Lisp_Buffer_Objfwd *)(%s->u.s.val.fwd.fwdptr))\ +->predicate"))))))) + + (igccg--make-layout + 'interval 'IGC_OBJ_INTERVAL nil nil '(struct interval) + '((untagged left) + (untagged right) + (switch up_obj + (default (tagged (path up obj))) + (false (untagged (path up interval)))) + (tagged plist))) + + (igccg--make-layout + 'string 'IGC_OBJ_STRING nil 'Lisp_String '(struct Lisp_String) + '((untagged (path u s data)) + (untagged (path u s intervals)))) + + (igccg--make-layout + 'string_data 'IGC_OBJ_STRING_DATA nil nil '(array uint8_t) nil) + + (igccg--make-layout + 'itree_tree 'IGC_OBJ_ITREE_TREE nil nil '(struct itree_tree) + '((untagged root))) + + (igccg--make-layout + 'itree_node 'IGC_OBJ_ITREE_NODE nil nil '(struct itree_node) + '((untagged parent) + (untagged left) + (untagged right) + (tagged data))) + + (igccg--make-layout + 'image 'IGC_OBJ_IMAGE nil nil '(struct image) + '((tagged spec) + (tagged dependencies) + (tagged lisp_data) + (untagged next) + (untagged prev))) + + (igccg--make-layout + 'image_cache 'IGC_OBJ_IMAGE_CACHE nil nil '(struct image_cache) + '((untagged images) + (untagged buckets))) + + (igccg--make-layout + 'face 'IGC_OBJ_FACE nil nil '(struct face) + '((array tagged lface "ARRAYELTS (%s->lface)") + (untagged font) + (untagged next) + (untagged prev) + (untagged ascii_face) + (cfg + (or HAVE_XFT HAVE_FREETYPE) + (untagged extra)))) + + (igccg--make-layout + 'face_cache 'IGC_OBJ_FACE_CACHE nil nil '(struct face_cache) + '((untagged f) + (untagged faces_by_id) + (untagged buckets))) + + (igccg--make-layout + 'float 'IGC_OBJ_FLOAT nil 'Lisp_Float '(struct Lisp_Float) + '()) + + (igccg--make-layout + 'blv 'IGC_OBJ_BLV nil nil '(struct Lisp_Buffer_Local_Value) + '((tagged where) + (tagged defcell) + (tagged valcell))) + + ;; (igccg--make-layout + ;; 'weak_ref 'IGC_OBJ_WEAK 'Lisp_Vectorlike '(struct Lisp_Weak_Ref) + ;; '((tagged ref))) + + (igccg--make-layout + 'ptr_vec 'IGC_OBJ_PTR_VEC nil nil '(* void) + '((array untagged "%s" (igc-header-len)))) + + (igccg--make-layout + 'obj_vec 'IGC_OBJ_OBJ_VEC nil nil 'Lisp_Object + '((array tagged "%s" (igc-header-len)))) + + (igccg--make-layout + 'handler 'IGC_OBJ_HANDLER nil nil '(struct handler) + '((tagged tag_or_ch) + (tagged val) + (untagged next) + (untagged nextfree))) + + (igccg--make-layout + 'bytes 'IGC_OBJ_BYTES nil nil '(array uint8_t) nil) + + (igccg--make-layout + 'normal_vector 'IGC_OBJ_VECTOR 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike + '(struct Lisp_Vector) '((array tagged contents (path header size)))) + + (igccg--make-layout + 'bignum 'IGC_OBJ_VECTOR 'PVEC_BIGNUM 'Lisp_Vectorlike + '(struct Lisp_Bignum) '()) + + (igccg--make-layout + 'marker 'IGC_OBJ_VECTOR 'PVEC_MARKER 'Lisp_Vectorlike + '(struct Lisp_Marker) + '((untagged buffer) + ;;(untagged next) + )) + + (igccg--make-layout + 'overlay 'IGC_OBJ_VECTOR 'PVEC_OVERLAY 'Lisp_Vectorlike + '(struct Lisp_Overlay) + '((untagged buffer) + (tagged plist) + (untagged interval))) + + (igccg--make-layout + 'finalizer 'IGC_OBJ_VECTOR 'PVEC_FINALIZER 'Lisp_Vectorlike + '(struct Lisp_Finalizer) + '((tagged function) + (untagged next) + (untagged prev))) + + (igccg--make-layout + 'symbol_with_pos 'IGC_OBJ_VECTOR 'PVEC_SYMBOL_WITH_POS 'Lisp_Vectorlike + '(struct Lisp_Symbol_With_Pos) + '((vectorlike))) + + (igccg--make-layout + 'misc_ptr 'IGC_OBJ_VECTOR 'PVEC_MISC_PTR 'Lisp_Vectorlike + '(struct Lisp_Misc_Ptr) + '()) + + (igccg--make-layout + 'user_ptr 'IGC_OBJ_VECTOR 'PVEC_USER_PTR 'Lisp_Vectorlike + '(struct Lisp_User_Ptr) + '()) + + (igccg--make-layout + 'process 'IGC_OBJ_VECTOR 'PVEC_PROCESS 'Lisp_Vectorlike + '(struct Lisp_Process) + '((vectorlike))) + + (igccg--make-layout + 'frame 'IGC_OBJ_VECTOR 'PVEC_FRAME 'Lisp_Vectorlike + '(struct frame) + '((vectorlike) + (untagged face_cache) + (untagged terminal) + (frame-quirks))) + + (igccg--make-layout + 'window 'IGC_OBJ_VECTOR 'PVEC_WINDOW 'Lisp_Vectorlike + '(struct window) + '((vectorlike) + (tagged prev_buffers) + (tagged next_buffers) + (window-quirks))) + + (igccg--make-layout + 'bool_vector 'IGC_OBJ_VECTOR 'PVEC_BOOL_VECTOR 'Lisp_Vectorlike + '(struct Lisp_Bool_Vector) + '()) + + (igccg--make-layout + 'buffer 'IGC_OBJ_VECTOR 'PVEC_BUFFER 'Lisp_Vectorlike + '(struct buffer) + '((vectorlike) + (untagged (path own_text intervals)) + (untagged (path own_text markers)) + (untagged overlays) + (untagged base_buffer) + (tagged undo_list_) + (buffer-quirks))) + + (igccg--make-layout + 'hash_table 'IGC_OBJ_VECTOR 'PVEC_HASH_TABLE 'Lisp_Vectorlike + '(struct Lisp_Hash_Table) + '((untagged key) + (untagged value) + (untagged hash) + (untagged next) + (untagged index))) + + (igccg--make-layout + 'obarray 'IGC_OBJ_VECTOR 'PVEC_OBARRAY 'Lisp_Vectorlike + '(struct Lisp_Obarray) + '((untagged buckets))) + + (igccg--make-layout + 'terminal 'IGC_OBJ_VECTOR 'PVEC_TERMINAL 'Lisp_Vectorlike + '(struct terminal) + '((vectorlike) + (untagged next_terminal) + (cfg HAVE_WINDOW_SYSTEM + (untagged image_cache)) + (terminal-quirks))) + + (igccg--make-layout + 'window_configuraion 'IGC_OBJ_VECTOR 'PVEC_WINDOW_CONFIGURATION + 'Lisp_Vectorlike + 'vectorlike_header + '((vectorlike))) + + (igccg--make-layout + 'subr 'IGC_OBJ_VECTOR 'PVEC_SUBR 'Lisp_Vectorlike + '(struct Lisp_Subr) + '((tagged command_modes) + (cfg + HAVE_NATIVE_COMP + (tagged (path intspec native)) + (tagged native_comp_u) + (tagged lambda_list) + (tagged type)))) + + (igccg--make-layout + 'other 'IGC_OBJ_VECTOR 'PVEC_OTHER 'Lisp_Vectorlike + '(struct scroll_bar) + '((vectorlike))) + + (igccg--make-layout + 'xwidget 'IGC_OBJ_VECTOR 'PVEC_XWIDGET 'Lisp_Vectorlike + 'vectorlike_header + '((vectorlike))) + + (igccg--make-layout + 'xwidget_view 'IGC_OBJ_VECTOR 'PVEC_XWIDGET_VIEW 'Lisp_Vectorlike + 'vectorlike_header + '((vectorlike))) + + (igccg--make-layout + 'thread 'IGC_OBJ_VECTOR 'PVEC_THREAD 'Lisp_Vectorlike + '(struct thread_state) + '((vectorlike) + (untagged m_current_buffer) + (untagged next_thread) + (untagged m_handlerlist))) + + (igccg--make-layout + 'mutex 'IGC_OBJ_VECTOR 'PVEC_MUTEX 'Lisp_Vectorlike + '(struct Lisp_Mutex) + '((vectorlike))) + + (igccg--make-layout + 'condvar 'IGC_OBJ_VECTOR 'PVEC_CONDVAR 'Lisp_Vectorlike + '(struct Lisp_CondVar) + '((vectorlike))) + + (igccg--make-layout + 'module_function 'IGC_OBJ_VECTOR 'PVEC_MODULE_FUNCTION 'Lisp_Vectorlike + '(struct module_global_reference) + '((vectorlike))) + + (igccg--make-layout + 'module_global_reference 'IGC_OBJ_VECTOR 'PVEC_MODULE_GLOBAL_REFERENCE + 'Lisp_Vectorlike + 'vectorlike_header + '((vectorlike))) + + (igccg--make-layout + 'comp_unit 'IGC_OBJ_VECTOR 'PVEC_NATIVE_COMP_UNIT + 'Lisp_Vectorlike + '(struct Lisp_Native_Comp_Unit) + '((vectorlike))) + + (igccg--make-layout + 'ts_parser 'IGC_OBJ_VECTOR 'PVEC_TS_PARSER + 'Lisp_Vectorlike + '(struct Lisp_TS_Parser) + '((vectorlike))) + + (igccg--make-layout + 'ts_node 'IGC_OBJ_VECTOR 'PVEC_TS_NODE + 'Lisp_Vectorlike + '(struct Lisp_TS_Node) + '((vectorlike))) + + (igccg--make-layout + 'ts_query 'IGC_OBJ_VECTOR 'PVEC_TS_COMPILED_QUERY + 'Lisp_Vectorlike + '(struct Lisp_TS_Query) + '((vectorlike))) + + (igccg--make-layout + 'sqlite 'IGC_OBJ_VECTOR 'PVEC_SQLITE + 'Lisp_Vectorlike + '(struct Lisp_Sqlite) + '((vectorlike))) + + ;; (PVEC_WEAK_REF (struct Lisp_Weak_Ref)) + + (igccg--make-layout + 'closure 'IGC_OBJ_VECTOR 'PVEC_CLOSURE + 'Lisp_Vectorlike + 'vectorlike_header + '((vectorlike))) + + (igccg--make-layout + 'char_table 'IGC_OBJ_VECTOR 'PVEC_CHAR_TABLE + 'Lisp_Vectorlike + '(struct Lisp_Char_Table) + '((vectorlike))) + + (igccg--make-layout + 'sub_char_table 'IGC_OBJ_VECTOR 'PVEC_SUB_CHAR_TABLE + 'Lisp_Vectorlike + '(struct Lisp_Sub_Char_Table) + '((array tagged contents (sub-char-table-len)))) + + (igccg--make-layout + 'record 'IGC_OBJ_VECTOR 'PVEC_RECORD 'Lisp_Vectorlike + 'vectorlike_header + '((vectorlike))) + + (igccg--make-layout + 'font 'IGC_OBJ_VECTOR 'PVEC_FONT 'Lisp_Vectorlike + '(struct Lisp_Vector) + '((vectorlike) + (switch (pvec-header-size) + (FONT_SPEC_MAX) + (FONT_ENTITY_MAX) + (FONT_OBJECT_MAX (font-object-quirks)) + (default (abort))))) + )) + +(defun igccg-main () + (igccg--emit-line "/* Generated by igc-codegen.el */") + (igccg--emit-line "#pragma GCC diagnostic push") + ;;(igccg--emit-line "#pragma GCC diagnostic ignored \"-Wunused-function\"") + (igccg--emit-scan-object-method "dflt" igccg--layouts) + (igccg--emit-line "#pragma GCC diagnostic pop")) + +;; (igccg-main) diff --git a/src/Makefile.in b/src/Makefile.in index d9874104327..c0494e4edd0 100644 --- a/src/Makefile.in +++ b/src/Makefile.in @@ -556,6 +556,9 @@ dmpstruct.h: $(AM_V_GEN)POSIXLY_CORRECT=1 awk -f $(srcdir)/dmpstruct.awk \ $(dmpstruct_headers) > $@ +igc-generated.c: ../admin/igc-codegen.el + $(AM_V_GEN) emacs --batch -l $< -f igccg-main > $@ + AUTO_DEPEND = @AUTO_DEPEND@ DEPDIR = deps ifeq ($(AUTO_DEPEND),yes) diff --git a/src/igc.c b/src/igc.c index 541bbd6614e..c94be5aecef 100644 --- a/src/igc.c +++ b/src/igc.c @@ -47,6 +47,7 @@ #include "termhooks.h" #include "thread.h" #include "treesit.h" +#include "process.h" #include "puresize.h" #ifdef HAVE_WINDOW_SYSTEM #include TERM_HEADER @@ -528,9 +529,12 @@ object_nelems (void *client, size_t elem_size) } static enum pvec_type -pseudo_vector_type (const struct Lisp_Vector *v) +pseudo_vector_type (union vectorlike_header header) { - return PSEUDOVECTOR_TYPE (v); + ptrdiff_t size = header.size; + return (size & PSEUDOVECTOR_FLAG + ? (size & PVEC_TYPE_MASK) >> PSEUDOVECTOR_AREA_BITS + : PVEC_NORMAL_VECTOR); } static size_t @@ -545,7 +549,7 @@ vector_size (const struct Lisp_Vector *v) static size_t vector_start (const struct Lisp_Vector *v) { - enum pvec_type type = pseudo_vector_type (v); + enum pvec_type type = pseudo_vector_type (v->header); return type == PVEC_SUB_CHAR_TABLE ? SUB_CHAR_TABLE_OFFSET : 0; } @@ -718,6 +722,7 @@ scan_staticvec (mps_ss_t ss, void *start, void *end, void *closure) return MPS_RES_OK; } +#if 0 static mps_res_t fix_fwd (mps_ss_t ss, lispfwd fwd) { @@ -750,7 +755,9 @@ fix_fwd (mps_ss_t ss, lispfwd fwd) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym) { @@ -786,6 +793,7 @@ fix_symbol (mps_ss_t ss, struct Lisp_Symbol *sym) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif /* This exists because we need access to a threads' current specpdl pointer, which means we need access to the thread_state, which can @@ -805,6 +813,139 @@ scan_igc (mps_ss_t ss, void *start, void *end, void *closure) return MPS_RES_OK; } +static mps_res_t +fix_frame_quirks (mps_ss_t ss, struct frame *f) +{ + MPS_SCAN_BEGIN (ss) + { +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f) && FRAME_OUTPUT_DATA (f)) + { + struct font **font_ptr = &FRAME_FONT (f); + if (*font_ptr) + IGC_FIX12_RAW (ss, font_ptr); + Lisp_Object *nle = &FRAME_DISPLAY_INFO (f)->name_list_element; + IGC_FIX12_OBJ (ss, nle); + +#ifdef HAVE_NS + struct ns_display_info *i = FRAME_DISPLAY_INFO (f); + IGC_FIX12_RAW (ss, &i->terminal); + IGC_FIX12_OBJ (ss, &i->rdb); + IGC_FIX12_RAW (ss, &i->highlight_frame); + IGC_FIX12_RAW (ss, &i->ns_focus_frame); + IGC_FIX12_RAW (ss, &i->last_mouse_motion_frame); + struct frame **pf = ns_emacs_view_emacs_frame (f); + IGC_FIX12_RAW (ss, pf); +#endif + } +#endif // HAVE_WINDOW_SYSTEM + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_glyph_matrix (mps_ss_t ss, struct glyph_matrix *matrix) +{ + MPS_SCAN_BEGIN (ss) + { + struct glyph_row *row = matrix->rows; + struct glyph_row *end = row + matrix->nrows; + + for (; row < end; ++row) + if (row->enabled_p) + for (int area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area) + { + struct glyph *glyph = row->glyphs[area]; + struct glyph *end_glyph = glyph + row->used[area]; + for (; glyph < end_glyph; ++glyph) + IGC_FIX12_OBJ (ss, &glyph->object); + } + IGC_FIX12_RAW (ss, &matrix->buffer); + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_window_quirks (mps_ss_t ss, struct window *w) +{ + MPS_SCAN_BEGIN (ss) + { + if (w->current_matrix) + IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->current_matrix)); + if (w->desired_matrix) + IGC_FIX_CALL (ss, fix_glyph_matrix (ss, w->desired_matrix)); + +#ifdef HAVE_NS + void *pr[4]; + int n = ns_emacs_scroller_refs (w, pr, ARRAYELTS (pr)); + for (int i = 0; i < n; ++i) + IGC_FIX12_RAW (ss, pr[i]); +#endif + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_buffer_quirks (mps_ss_t ss, struct buffer *b) +{ + MPS_SCAN_BEGIN (ss) + { + if (b->base_buffer) + b->text = &b->base_buffer->own_text; + else + b->text = &b->own_text; + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_coding (mps_ss_t ss, struct coding_system *c) +{ + MPS_SCAN_BEGIN (ss) + { + if (c) + { + IGC_FIX12_OBJ (ss, &c->src_object); + IGC_FIX12_OBJ (ss, &c->dst_object); + } + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_terminal_quirks (mps_ss_t ss, struct terminal *t) +{ + MPS_SCAN_BEGIN (ss) + { + // These are malloc'd, so they can be accessed. + IGC_FIX_CALL_FN (ss, struct coding_system, t->keyboard_coding, + fix_coding); + IGC_FIX_CALL_FN (ss, struct coding_system, t->terminal_coding, + fix_coding); + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +static mps_res_t +fix_font_object_quirks (mps_ss_t ss, struct font *f) +{ + MPS_SCAN_BEGIN (ss) + { + Lisp_Object const *type = &f->driver->type; + IGC_FIX12_OBJ (ss, (Lisp_Object *)type); + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} + +#include "igc-generated.c" + static mps_res_t scan_lispsym (mps_ss_t ss, void *start, void *end, void *closure) { @@ -1108,6 +1249,7 @@ dflt_skip (mps_addr_t base_addr) return next; } +#if 0 static mps_res_t fix_string (mps_ss_t ss, struct Lisp_String *s) { @@ -1119,7 +1261,9 @@ fix_string (mps_ss_t ss, struct Lisp_String *s) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_interval (mps_ss_t ss, struct interval *iv) { @@ -1136,7 +1280,9 @@ fix_interval (mps_ss_t ss, struct interval *iv) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_itree_tree (mps_ss_t ss, struct itree_tree *t) { @@ -1148,7 +1294,9 @@ fix_itree_tree (mps_ss_t ss, struct itree_tree *t) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_itree_node (mps_ss_t ss, struct itree_node *n) { @@ -1165,7 +1313,9 @@ fix_itree_node (mps_ss_t ss, struct itree_node *n) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_image (mps_ss_t ss, struct image *i) { @@ -1182,7 +1332,9 @@ fix_image (mps_ss_t ss, struct image *i) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_image_cache (mps_ss_t ss, struct image_cache *c) { @@ -1196,7 +1348,9 @@ fix_image_cache (mps_ss_t ss, struct image_cache *c) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_face (mps_ss_t ss, struct face *f) { @@ -1214,7 +1368,9 @@ fix_face (mps_ss_t ss, struct face *f) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_face_cache (mps_ss_t ss, struct face_cache *c) { @@ -1227,7 +1383,9 @@ fix_face_cache (mps_ss_t ss, struct face_cache *c) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_ptr_vec (mps_ss_t ss, void *client) { @@ -1241,7 +1399,9 @@ fix_ptr_vec (mps_ss_t ss, void *client) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_obj_vec (mps_ss_t ss, Lisp_Object *v) { @@ -1254,7 +1414,9 @@ fix_obj_vec (mps_ss_t ss, Lisp_Object *v) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_cons (mps_ss_t ss, struct Lisp_Cons *cons) { @@ -1266,7 +1428,9 @@ fix_cons (mps_ss_t ss, struct Lisp_Cons *cons) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_blv (mps_ss_t ss, struct Lisp_Buffer_Local_Value *blv) { @@ -1279,7 +1443,9 @@ fix_blv (mps_ss_t ss, struct Lisp_Buffer_Local_Value *blv) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_handler (mps_ss_t ss, struct handler *h) { @@ -1294,9 +1460,11 @@ fix_handler (mps_ss_t ss, struct handler *h) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v); +#if 0 static mps_res_t dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, void *closure) @@ -1341,7 +1509,7 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, break; case IGC_OBJ_PTR_VEC: - IGC_FIX_CALL_FN (ss, mps_word_t, client, fix_ptr_vec); + IGC_FIX_CALL_FN (ss, void *, client, fix_ptr_vec); break; case IGC_OBJ_OBJ_VEC: @@ -1404,14 +1572,47 @@ dflt_scan_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, break; case IGC_OBJ_BLV: - IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, client, - fix_blv); + IGC_FIX_CALL_FN (ss, struct Lisp_Buffer_Local_Value, client, fix_blv); break; } } MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif + +static mps_res_t +dflt_scanx_obj (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, + void *closure) +{ + MPS_SCAN_BEGIN (ss) + { + mps_addr_t base = base_start; + mps_addr_t client = base_to_client (base); + struct igc_header *header = base; + + if (closure) + { + struct igc_stats *st = closure; + mps_word_t obj_type = header->obj_type; + igc_assert (obj_type < IGC_OBJ_NUM_TYPES); + st->obj[obj_type].nwords += header->nwords; + st->obj[obj_type].nobjs += 1; + if (obj_type == IGC_OBJ_VECTOR) + { + struct Lisp_Vector *v = (struct Lisp_Vector *)client; + enum pvec_type pvec_type = pseudo_vector_type (v->header); + igc_assert (0 <= pvec_type && pvec_type <= PVEC_TAG_MAX); + st->pvec[pvec_type].nwords += header->nwords; + st->pvec[pvec_type].nobjs += 1; + } + } + + IGC_FIX_CALL (ss, dflt_scan_object (ss, base)); + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} static mps_res_t dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, @@ -1421,7 +1622,7 @@ dflt_scanx (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit, { for (mps_addr_t base = base_start; base < base_limit; base = dflt_skip (base)) - IGC_FIX_CALL (ss, dflt_scan_obj (ss, base, base_limit, closure)); + IGC_FIX_CALL (ss, dflt_scanx_obj (ss, base, base_limit, closure)); } MPS_SCAN_END (ss); return MPS_RES_OK; @@ -1432,7 +1633,9 @@ dflt_scan (mps_ss_t ss, mps_addr_t base_start, mps_addr_t base_limit) { MPS_SCAN_BEGIN (ss) { - IGC_FIX_CALL (ss, dflt_scanx (ss, base_start, base_limit, NULL)); + for (mps_addr_t base = base_start; base < base_limit; + base = dflt_skip (base)) + IGC_FIX_CALL (ss, dflt_scan_object (ss, base)); } MPS_SCAN_END (ss); return MPS_RES_OK; @@ -1450,6 +1653,7 @@ fix_vectorlike (mps_ss_t ss, struct Lisp_Vector *v) return MPS_RES_OK; } +#if 0 static mps_res_t fix_buffer (mps_ss_t ss, struct buffer *b) { @@ -1472,32 +1676,9 @@ fix_buffer (mps_ss_t ss, struct buffer *b) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif -static mps_res_t -fix_glyph_matrix (mps_ss_t ss, struct glyph_matrix *matrix) -{ - MPS_SCAN_BEGIN (ss) - { - struct glyph_row *row = matrix->rows; - struct glyph_row *end = row + matrix->nrows; - - for (; row < end; ++row) - if (row->enabled_p) - { - for (int area = LEFT_MARGIN_AREA; area < LAST_AREA; ++area) - { - struct glyph *glyph = row->glyphs[area]; - struct glyph *end_glyph = glyph + row->used[area]; - for (; glyph < end_glyph; ++glyph) - IGC_FIX12_OBJ (ss, &glyph->object); - } - } - IGC_FIX12_RAW (ss, &matrix->buffer); - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - +#if 0 static mps_res_t fix_frame (mps_ss_t ss, struct frame *f) { @@ -1514,32 +1695,14 @@ fix_frame (mps_ss_t ss, struct frame *f) IGC_FIX12_RAW (ss, &f->face_cache); if (f->terminal) IGC_FIX12_RAW (ss, &f->terminal); -#ifdef HAVE_WINDOW_SYSTEM - if (FRAME_WINDOW_P (f) && FRAME_OUTPUT_DATA (f)) - { - struct font **font_ptr = &FRAME_FONT (f); - if (*font_ptr) - IGC_FIX12_RAW (ss, font_ptr); - Lisp_Object *nle = &FRAME_DISPLAY_INFO (f)->name_list_element; - IGC_FIX12_OBJ (ss, nle); - -#ifdef HAVE_NS - struct ns_display_info *i = FRAME_DISPLAY_INFO (f); - IGC_FIX12_RAW (ss, &i->terminal); - IGC_FIX12_OBJ (ss, &i->rdb); - IGC_FIX12_RAW (ss, &i->highlight_frame); - IGC_FIX12_RAW (ss, &i->ns_focus_frame); - IGC_FIX12_RAW (ss, &i->last_mouse_motion_frame); - struct frame **pf = ns_emacs_view_emacs_frame (f); - IGC_FIX12_RAW (ss, pf); -#endif - } -#endif // HAVE_WINDOW_SYSTEM + IGC_FIX_CALL_FN (ss, struct frame, f, fix_frame_quirks); } MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_window (mps_ss_t ss, struct window *w) { @@ -1569,7 +1732,9 @@ fix_window (mps_ss_t ss, struct window *w) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h) { @@ -1585,9 +1750,11 @@ fix_hash_table (mps_ss_t ss, struct Lisp_Hash_Table *h) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t -fix_char_table (mps_ss_t ss, struct Lisp_Vector *v) +fix_char_table (mps_ss_t ss, struct Lisp_Char_Table *v) { MPS_SCAN_BEGIN (ss) { @@ -1597,7 +1764,23 @@ fix_char_table (mps_ss_t ss, struct Lisp_Vector *v) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 +static mps_res_t +fix_sub_char_table (mps_ss_t ss, struct Lisp_Sub_Char_Table *v) +{ + MPS_SCAN_BEGIN (ss) + { + int size = v->header.size & PSEUDOVECTOR_SIZE_MASK; + IGC_FIX12_NOBJS (ss, v->contents, size - SUB_CHAR_TABLE_OFFSET); + } + MPS_SCAN_END (ss); + return MPS_RES_OK; +} +#endif + +#if 0 static mps_res_t fix_overlay (mps_ss_t ss, struct Lisp_Overlay *o) { @@ -1610,7 +1793,9 @@ fix_overlay (mps_ss_t ss, struct Lisp_Overlay *o) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_subr (mps_ss_t ss, struct Lisp_Subr *s) { @@ -1628,7 +1813,9 @@ fix_subr (mps_ss_t ss, struct Lisp_Subr *s) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_misc_ptr (mps_ss_t ss, struct Lisp_Misc_Ptr *p) { @@ -1640,7 +1827,9 @@ fix_misc_ptr (mps_ss_t ss, struct Lisp_Misc_Ptr *p) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_user_ptr (mps_ss_t ss, struct Lisp_User_Ptr *p) { @@ -1652,7 +1841,9 @@ fix_user_ptr (mps_ss_t ss, struct Lisp_User_Ptr *p) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_thread (mps_ss_t ss, struct thread_state *s) { @@ -1666,6 +1857,7 @@ fix_thread (mps_ss_t ss, struct thread_state *s) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif /* This is here because main_thread is, for some reason, a variable in the data segment, and not like other threads. */ @@ -1683,6 +1875,7 @@ scan_main_thread (mps_ss_t ss, void *start, void *end, void *closure) return MPS_RES_OK; } +#if 0 static mps_res_t fix_mutex (mps_ss_t ss, struct Lisp_Mutex *m) { @@ -1694,22 +1887,9 @@ fix_mutex (mps_ss_t ss, struct Lisp_Mutex *m) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif -static mps_res_t -fix_coding (mps_ss_t ss, struct coding_system *c) -{ - MPS_SCAN_BEGIN (ss) - { - if (c) - { - IGC_FIX12_OBJ (ss, &c->src_object); - IGC_FIX12_OBJ (ss, &c->dst_object); - } - } - MPS_SCAN_END (ss); - return MPS_RES_OK; -} - +#if 0 static mps_res_t fix_terminal (mps_ss_t ss, struct terminal *t) { @@ -1727,7 +1907,9 @@ fix_terminal (mps_ss_t ss, struct terminal *t) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_marker (mps_ss_t ss, struct Lisp_Marker *m) { @@ -1739,7 +1921,9 @@ fix_marker (mps_ss_t ss, struct Lisp_Marker *m) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f) { @@ -1752,7 +1936,9 @@ fix_finalizer (mps_ss_t ss, struct Lisp_Finalizer *f) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif +#if 0 static mps_res_t fix_comp_unit (mps_ss_t ss, struct Lisp_Native_Comp_Unit *u) { @@ -1768,6 +1954,7 @@ fix_comp_unit (mps_ss_t ss, struct Lisp_Native_Comp_Unit *u) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif #ifdef HAVE_XWIDGETS @@ -1812,6 +1999,7 @@ fix_global_ref (mps_ss_t ss, struct module_global_reference *r) #endif #ifndef IN_MY_FORK +#if 0 static mps_res_t fix_obarray (mps_ss_t ss, struct Lisp_Obarray *o) { @@ -1823,7 +2011,9 @@ fix_obarray (mps_ss_t ss, struct Lisp_Obarray *o) return MPS_RES_OK; } #endif +#endif +#if 0 static mps_res_t fix_font (mps_ss_t ss, struct Lisp_Vector *v) { @@ -1850,17 +2040,19 @@ fix_font (mps_ss_t ss, struct Lisp_Vector *v) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif /* Note that there is a small window after committing a vectorlike allocation where the object is zeroed, and so the vector header is also zero. This doesn't have an adverse effect. */ +#if 0 static mps_res_t fix_vector (mps_ss_t ss, struct Lisp_Vector *v) { MPS_SCAN_BEGIN (ss) { - switch (pseudo_vector_type (v)) + switch (pseudo_vector_type (v->header)) { #ifndef IN_MY_FORK case PVEC_OBARRAY: @@ -1885,8 +2077,12 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v) break; case PVEC_CHAR_TABLE: + IGC_FIX_CALL_FN (ss, struct Lisp_Char_Table, v, fix_char_table); + break; + case PVEC_SUB_CHAR_TABLE: - IGC_FIX_CALL_FN (ss, struct Lisp_Vector, v, fix_char_table); + IGC_FIX_CALL_FN (ss, struct Lisp_Sub_Char_Table, v, + fix_sub_char_table); break; case PVEC_BOOL_VECTOR: @@ -1983,6 +2179,7 @@ fix_vector (mps_ss_t ss, struct Lisp_Vector *v) MPS_SCAN_END (ss); return MPS_RES_OK; } +#endif static igc_scan_result_t scan_cell_callback (struct igc_opaque *op, Lisp_Object *addr) @@ -2557,7 +2754,7 @@ finalize_finalizer (struct Lisp_Finalizer *f) static void finalize_vector (mps_addr_t v) { - switch (pseudo_vector_type (v)) + switch (pseudo_vector_type (((struct Lisp_Vector *)v)->header)) { case PVEC_FREE: emacs_abort (); @@ -3575,7 +3772,9 @@ igc_header_size (void) static bool is_builtin_subr (enum igc_obj_type type, void *client) { - if (type == IGC_OBJ_VECTOR && pseudo_vector_type (client) == PVEC_SUBR) + if (type == IGC_OBJ_VECTOR + && pseudo_vector_type (((struct Lisp_Vector *)client)->header) + == PVEC_SUBR) { Lisp_Object subr = make_lisp_ptr (client, Lisp_Vectorlike); return !SUBR_NATIVE_COMPILEDP (subr); @@ -3809,7 +4008,7 @@ record_copy (struct igc_mirror *m, void *dumped, void *copy) if (h->obj_type == IGC_OBJ_VECTOR) { struct Lisp_Vector *v = base_to_client (copy); - int i = pseudo_vector_type (v); + int i = pseudo_vector_type (v->header); m->pvec[i].n += 1; m->pvec[i].nbytes += header_nbytes (h); } @@ -4281,9 +4480,9 @@ mirror_global_ref (struct igc_mirror *m, struct module_global_reference *r) #endif static void -mirror_vector (struct igc_mirror *m, void *client) +mirror_vector (struct igc_mirror *m, struct Lisp_Vector *client) { - switch (pseudo_vector_type (client)) + switch (pseudo_vector_type (client->header)) { #ifndef IN_MY_FORK case PVEC_OBARRAY: -- 2.39.2