From c25a02f01b68af1af5d7c55ff90542835f291f71 Mon Sep 17 00:00:00 2001 From: Helmut Eller Date: Thu, 13 Jun 2024 08:39:31 +0200 Subject: [PATCH 3/5] Improve code generator Add a cfg field to the layout description so that we can generate the needed #ifdefs. * src/igc.c (mirror_buffer_quirks): New. * admin/igc-codegen.el (igccg--emit-quirks): Buffers need special mirroring code. (igccg--layout.type): Renamed from igccg--layout.header. (igccg--layout.cfg): New field. (igccg--layouts): Add cfg expressions for packages and images. (igccg--emit-switch, igccg--emit-case): Introduce #ifdef cases. (igccg--field-addr-exp, igccg--emit-scan-method, igccg--scan-vectorlike-case) (igccg--scan-method-case, igccg--scan-method-vectorlike-case): Emit conditional code. (igccg--ifdef-exp): Allow not operator. --- admin/igc-codegen.el | 252 +++++++++++++++++++++++-------------------- src/igc.c | 9 ++ 2 files changed, 146 insertions(+), 115 deletions(-) diff --git a/admin/igc-codegen.el b/admin/igc-codegen.el index 6224252e7d7..f9a6c02827a 100644 --- a/admin/igc-codegen.el +++ b/admin/igc-codegen.el @@ -47,7 +47,7 @@ igccg--define-record `(,field nil :read-only t)) fields)))) -(igccg--define-record layout name header pvectype tag ctype fields) +(igccg--define-record layout name type pvectype tag cfg ctype fields) (defun igccg--arg-decl (name type) (pcase-exhaustive type @@ -87,16 +87,25 @@ igccg--emit-block (funcall body)) (igccg--emit-line "}")) +(defun igccg--emit-case (case) + (let ((emit-body (lambda (body) + (let ((igccg--indent (+ 2 igccg--indent))) + (funcall body) + (igccg--emit-line "break;"))))) + (pcase-exhaustive case + (`(case ,tag ,body) + (igccg--emit-line (format "case %s:" (symbol-name tag))) + (funcall emit-body body)) + (`(default ,body) + (igccg--emit-line "default:") + (funcall emit-body body)) + (`(cfg ,cfg ,case) + (igccg--emit-\#if (igccg--ifdef-exp cfg) + (lambda () (igccg--emit-case case))))))) + (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;")))))) + (igccg--emit-block (lambda () (mapc #'igccg--emit-case cases)))) (defun igccg--emit-\#if (exp body) (igccg--emit-line (format "#if %s" exp)) @@ -106,7 +115,8 @@ igccg--emit-\#if (defun igccg--ifdef-exp (exp) (pcase-exhaustive exp ((guard (symbolp exp)) (format "defined %s" exp)) - (`(or . ,exps) (mapconcat #'igccg--ifdef-exp exps " || ")))) + (`(or . ,exps) (mapconcat #'igccg--ifdef-exp exps " || ")) + (`(not ,exp) (format "!(%s)" (igccg--ifdef-exp exp))))) (defun igccg--field-addr-exp (var path) (pcase-exhaustive path @@ -149,12 +159,12 @@ igccg--emit-fix-field-exp (mapcar (lambda (case) (pcase-exhaustive case (`(,tag . ,fields) - (cons (symbol-name tag) - (lambda () - (mapc (lambda (f) - (igccg--emit-fix-field-exp - visitor layout obj f)) - fields)))))) + `(,@(if (eq tag 'default) `(default) `(case ,tag)) + ,(lambda () + (mapc (lambda (f) + (igccg--emit-fix-field-exp + visitor layout obj f)) + fields)))))) cases))) (`(array tagged ,start ,len) (igccg--emit-fix-tagged-array visitor @@ -185,14 +195,30 @@ igccg--scan-vectorlike-method-name (format "%s_scan_vectorlike" prefix)) (defun igccg--emit-scan-method (visitor layout) - (igccg--emit-function - (igccg--scan-method-spec visitor "o" layout) - (lambda () - (igccg--emit-function-body - visitor - (lambda () - (dolist (exp (igccg--layout.fields layout)) - (igccg--emit-fix-field-exp visitor layout "o" exp))))))) + (let ((f (lambda () + (igccg--emit-function + (igccg--scan-method-spec visitor "o" layout) + (lambda () + (igccg--emit-function-body + visitor + (lambda () + (dolist (exp (igccg--layout.fields layout)) + (igccg--emit-fix-field-exp visitor layout "o" exp))))))))) + (cond ((igccg--layout.cfg layout) + (igccg--emit-\#if (igccg--ifdef-exp (igccg--layout.cfg layout)) + f)) + (t (funcall f))))) + +(defun igccg--scan-vectorlike-case (visitor layout) + (let ((case `(case ,(igccg--layout.pvectype layout) + ,(lambda () + (igccg--emit-call + visitor + (aref (igccg--scan-method-spec visitor "x" layout) 0) + "v" (igccg--layout.ctype layout)))))) + (cond ((igccg--layout.cfg layout) + `(cfg ,(igccg--layout.cfg layout) ,case)) + (t case)))) (defun igccg--emit-scan-vectorlike (visitor layouts) (igccg--emit-function @@ -204,16 +230,9 @@ igccg--emit-scan-vectorlike (igccg--emit-switch "pseudo_vector_type (v->header)" (append - (mapcar (lambda (l) - (cons - (symbol-name (igccg--layout.pvectype l)) - (lambda () - (igccg--emit-call - visitor - (aref (igccg--scan-method-spec visitor "x" l) 0) - "v" (igccg--layout.ctype l))))) + (mapcar (lambda (l) (igccg--scan-vectorlike-case visitor l)) layouts) - (list (cons 'PVEC_FREE (lambda () (igccg--emit-abort))))))))))) + (list `(case PVEC_FREE ,#'igccg--emit-abort))))))))) (cl-defgeneric igccg--scan-object-spec (visitor)) (cl-defgeneric igccg--scan-vectorlike-spec (visitor)) @@ -327,28 +346,33 @@ igccg--emit-quirks (cl-defmethod igccg--emit-quirks ((v (eql 'mirror)) l obj) ) + + (cl-defmethod igccg--emit-quirks ((v (eql 'mirror)) (l (eql 'buffer)) obj) + (igccg--emit-line (format "mirror_buffer_quirks (%s);" obj))) ) (defun igccg--scan-method-case (visitor obj layout) - (cons - (symbol-name (igccg--layout.header layout)) - (lambda () - (igccg--emit-call visitor - (aref (igccg--scan-method-spec visitor "o" layout) 0) - obj - (igccg--layout.ctype layout))))) - + (let ((case `(case ,(igccg--layout.type layout) + ,(lambda () + (igccg--emit-call + visitor + (aref (igccg--scan-method-spec visitor "o" layout) 0) + obj + (igccg--layout.ctype layout)))))) + (cond ((igccg--layout.cfg layout) + `(cfg ,(igccg--layout.cfg layout) ,case)) + (t case)))) (defun igccg--scan-method-vectorlike-case (visitor obj) - (cons "IGC_OBJ_VECTOR" - (lambda () - (igccg--emit-call visitor - (aref (igccg--scan-vectorlike-spec visitor) 0) - obj + `(case IGC_OBJ_VECTOR + ,(lambda () + (igccg--emit-call visitor + (aref (igccg--scan-vectorlike-spec visitor) 0) + obj '(struct Lisp_Vector))))) (defun igccg--emit-scan-object-body (visitor layouts) - (let* ((alist (seq-group-by #'igccg--layout.header layouts)) + (let* ((alist (seq-group-by #'igccg--layout.type layouts)) (pvecs (assq 'IGC_OBJ_VECTOR alist)) (nonpvecs (mapcar (lambda (p) (pcase-exhaustive p @@ -368,14 +392,12 @@ igccg--emit-scan-object-body (igccg--scan-method-case visitor "client" layout)) nonpvecs) (list (igccg--scan-method-vectorlike-case visitor "client")) - (mapcar (lambda (type) (cons (symbol-name type) (lambda ()))) - ignored) - (mapcar (lambda (type) (cons (symbol-name type) #'igccg--emit-abort)) - unhandled))))) + (mapcar (lambda (type) `(case ,type ,(lambda ()))) ignored) + (mapcar (lambda (type) `(case ,type ,#'igccg--emit-abort)) unhandled))))) (defun igccg--emit-scan-object (visitor layouts) (mapc (lambda (l) (igccg--emit-scan-method visitor l)) layouts) - (let* ((alist (seq-group-by #'igccg--layout.header layouts)) + (let* ((alist (seq-group-by #'igccg--layout.type layouts)) (pvecs (cdr (assq 'IGC_OBJ_VECTOR alist)))) (igccg--emit-scan-vectorlike visitor pvecs) (igccg--emit-function @@ -389,12 +411,12 @@ igccg--emit-scan-object (defvar igccg--layouts (list (igccg--make-layout - 'cons 'IGC_OBJ_CONS nil 'Lisp_Cons '(struct Lisp_Cons) + 'cons 'IGC_OBJ_CONS nil 'Lisp_Cons nil '(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) + 'symbol 'IGC_OBJ_SYMBOL nil 'Lisp_Symbol nil '(struct Lisp_Symbol) '((tagged (path u s name)) (tagged (path u s function)) (tagged (path u s plist)) @@ -419,7 +441,7 @@ igccg--layouts ->predicate"))))))) (igccg--make-layout - 'interval 'IGC_OBJ_INTERVAL nil nil '(struct interval) + 'interval 'IGC_OBJ_INTERVAL nil nil nil '(struct interval) '((untagged left) (untagged right) (switch up_obj @@ -428,26 +450,26 @@ igccg--layouts (tagged plist))) (igccg--make-layout - 'string 'IGC_OBJ_STRING nil 'Lisp_String '(struct Lisp_String) + 'string 'IGC_OBJ_STRING nil 'Lisp_String nil '(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) + 'string_data 'IGC_OBJ_STRING_DATA nil nil nil '(array uint8_t) nil) (igccg--make-layout - 'itree_tree 'IGC_OBJ_ITREE_TREE nil nil '(struct itree_tree) + 'itree_tree 'IGC_OBJ_ITREE_TREE nil nil nil '(struct itree_tree) '((untagged root))) (igccg--make-layout - 'itree_node 'IGC_OBJ_ITREE_NODE nil nil '(struct itree_node) + 'itree_node 'IGC_OBJ_ITREE_NODE nil nil nil '(struct itree_node) '((untagged parent) (untagged left) (untagged right) (tagged data))) (igccg--make-layout - 'image 'IGC_OBJ_IMAGE nil nil '(struct image) + 'image 'IGC_OBJ_IMAGE nil nil 'HAVE_WINDOW_SYSTEM '(struct image) '((tagged spec) (tagged dependencies) (tagged lisp_data) @@ -455,12 +477,13 @@ igccg--layouts (untagged prev))) (igccg--make-layout - 'image_cache 'IGC_OBJ_IMAGE_CACHE nil nil '(struct image_cache) + 'image_cache 'IGC_OBJ_IMAGE_CACHE nil nil 'HAVE_WINDOW_SYSTEM + '(struct image_cache) '((untagged images) (untagged buckets))) (igccg--make-layout - 'face 'IGC_OBJ_FACE nil nil '(struct face) + 'face 'IGC_OBJ_FACE nil nil nil '(struct face) '((array tagged lface "ARRAYELTS (%s->lface)") (untagged font) (untagged next) @@ -471,98 +494,94 @@ igccg--layouts (untagged extra)))) (igccg--make-layout - 'face_cache 'IGC_OBJ_FACE_CACHE nil nil '(struct face_cache) + 'face_cache 'IGC_OBJ_FACE_CACHE nil 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) + 'float 'IGC_OBJ_FLOAT nil 'Lisp_Float nil '(struct Lisp_Float) '()) (igccg--make-layout - 'blv 'IGC_OBJ_BLV nil nil '(struct Lisp_Buffer_Local_Value) + 'blv 'IGC_OBJ_BLV nil 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) + 'ptr_vec 'IGC_OBJ_PTR_VEC nil nil nil '(* void) '((array untagged "%s" (igc-header-len)))) (igccg--make-layout - 'obj_vec 'IGC_OBJ_OBJ_VEC nil nil 'Lisp_Object + 'obj_vec 'IGC_OBJ_OBJ_VEC nil nil nil 'Lisp_Object '((array tagged "%s" (igc-header-len)))) (igccg--make-layout - 'handler 'IGC_OBJ_HANDLER nil nil '(struct handler) + 'handler 'IGC_OBJ_HANDLER nil 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) + 'bytes 'IGC_OBJ_BYTES nil nil nil '(array uint8_t) nil) (igccg--make-layout - 'normal_vector 'IGC_OBJ_VECTOR 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike + 'normal_vector 'IGC_OBJ_VECTOR 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike nil '(struct Lisp_Vector) '((array tagged contents (path header size)))) (igccg--make-layout - 'weak_vector 'IGC_OBJ_VECTOR_WEAK 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike + 'weak_vector 'IGC_OBJ_VECTOR_WEAK 'PVEC_NORMAL_VECTOR 'Lisp_Vectorlike nil '(struct Lisp_Vector) '((array tagged contents (path header size)))) (igccg--make-layout - 'bignum 'IGC_OBJ_VECTOR 'PVEC_BIGNUM 'Lisp_Vectorlike + 'bignum 'IGC_OBJ_VECTOR 'PVEC_BIGNUM 'Lisp_Vectorlike nil '(struct Lisp_Bignum) '()) (igccg--make-layout - 'marker 'IGC_OBJ_VECTOR 'PVEC_MARKER 'Lisp_Vectorlike + 'marker 'IGC_OBJ_VECTOR 'PVEC_MARKER 'Lisp_Vectorlike nil '(struct Lisp_Marker) '((untagged buffer) ;;(untagged next) )) (igccg--make-layout - 'overlay 'IGC_OBJ_VECTOR 'PVEC_OVERLAY 'Lisp_Vectorlike + 'overlay 'IGC_OBJ_VECTOR 'PVEC_OVERLAY 'Lisp_Vectorlike nil '(struct Lisp_Overlay) '((untagged buffer) (tagged plist) (untagged interval))) (igccg--make-layout - 'finalizer 'IGC_OBJ_VECTOR 'PVEC_FINALIZER 'Lisp_Vectorlike + 'finalizer 'IGC_OBJ_VECTOR 'PVEC_FINALIZER 'Lisp_Vectorlike nil '(struct Lisp_Finalizer) '((tagged function) (untagged next) (untagged prev))) (igccg--make-layout - 'symbol_with_pos 'IGC_OBJ_VECTOR 'PVEC_SYMBOL_WITH_POS 'Lisp_Vectorlike + 'symbol_with_pos 'IGC_OBJ_VECTOR 'PVEC_SYMBOL_WITH_POS 'Lisp_Vectorlike nil '(struct Lisp_Symbol_With_Pos) '((vectorlike))) (igccg--make-layout - 'misc_ptr 'IGC_OBJ_VECTOR 'PVEC_MISC_PTR 'Lisp_Vectorlike + 'misc_ptr 'IGC_OBJ_VECTOR 'PVEC_MISC_PTR 'Lisp_Vectorlike nil '(struct Lisp_Misc_Ptr) '()) (igccg--make-layout - 'user_ptr 'IGC_OBJ_VECTOR 'PVEC_USER_PTR 'Lisp_Vectorlike + 'user_ptr 'IGC_OBJ_VECTOR 'PVEC_USER_PTR 'Lisp_Vectorlike nil '(struct Lisp_User_Ptr) '()) (igccg--make-layout - 'process 'IGC_OBJ_VECTOR 'PVEC_PROCESS 'Lisp_Vectorlike + 'process 'IGC_OBJ_VECTOR 'PVEC_PROCESS 'Lisp_Vectorlike nil '(struct Lisp_Process) '((vectorlike))) (igccg--make-layout - 'frame 'IGC_OBJ_VECTOR 'PVEC_FRAME 'Lisp_Vectorlike + 'frame 'IGC_OBJ_VECTOR 'PVEC_FRAME 'Lisp_Vectorlike nil '(struct frame) '((vectorlike) (untagged face_cache) @@ -570,7 +589,7 @@ igccg--layouts (quirks))) (igccg--make-layout - 'window 'IGC_OBJ_VECTOR 'PVEC_WINDOW 'Lisp_Vectorlike + 'window 'IGC_OBJ_VECTOR 'PVEC_WINDOW 'Lisp_Vectorlike nil '(struct window) '((vectorlike) (tagged prev_buffers) @@ -578,12 +597,12 @@ igccg--layouts (quirks))) (igccg--make-layout - 'bool_vector 'IGC_OBJ_VECTOR 'PVEC_BOOL_VECTOR 'Lisp_Vectorlike + 'bool_vector 'IGC_OBJ_VECTOR 'PVEC_BOOL_VECTOR 'Lisp_Vectorlike nil '(struct Lisp_Bool_Vector) '()) (igccg--make-layout - 'buffer 'IGC_OBJ_VECTOR 'PVEC_BUFFER 'Lisp_Vectorlike + 'buffer 'IGC_OBJ_VECTOR 'PVEC_BUFFER 'Lisp_Vectorlike nil '(struct buffer) '((vectorlike) (untagged (path own_text intervals)) @@ -595,7 +614,7 @@ igccg--layouts (quirks))) (igccg--make-layout - 'hash_table 'IGC_OBJ_VECTOR 'PVEC_HASH_TABLE 'Lisp_Vectorlike + 'hash_table 'IGC_OBJ_VECTOR 'PVEC_HASH_TABLE 'Lisp_Vectorlike nil '(struct Lisp_Hash_Table) '((untagged key) (untagged value) @@ -604,12 +623,12 @@ igccg--layouts (untagged index))) (igccg--make-layout - 'obarray 'IGC_OBJ_VECTOR 'PVEC_OBARRAY 'Lisp_Vectorlike + 'obarray 'IGC_OBJ_VECTOR 'PVEC_OBARRAY 'Lisp_Vectorlike '(not IN_MY_FORK) '(struct Lisp_Obarray) '((untagged buckets))) (igccg--make-layout - 'terminal 'IGC_OBJ_VECTOR 'PVEC_TERMINAL 'Lisp_Vectorlike + 'terminal 'IGC_OBJ_VECTOR 'PVEC_TERMINAL 'Lisp_Vectorlike nil '(struct terminal) '((vectorlike) (untagged next_terminal) @@ -619,12 +638,12 @@ igccg--layouts (igccg--make-layout 'window_configuraion 'IGC_OBJ_VECTOR 'PVEC_WINDOW_CONFIGURATION - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil 'vectorlike_header '((vectorlike))) (igccg--make-layout - 'subr 'IGC_OBJ_VECTOR 'PVEC_SUBR 'Lisp_Vectorlike + 'subr 'IGC_OBJ_VECTOR 'PVEC_SUBR 'Lisp_Vectorlike nil '(struct Lisp_Subr) '((tagged command_modes) (cfg @@ -635,22 +654,22 @@ igccg--layouts (tagged type)))) (igccg--make-layout - 'other 'IGC_OBJ_VECTOR 'PVEC_OTHER 'Lisp_Vectorlike + 'other 'IGC_OBJ_VECTOR 'PVEC_OTHER 'Lisp_Vectorlike nil '(struct scroll_bar) '((vectorlike))) (igccg--make-layout - 'xwidget 'IGC_OBJ_VECTOR 'PVEC_XWIDGET 'Lisp_Vectorlike + 'xwidget 'IGC_OBJ_VECTOR 'PVEC_XWIDGET 'Lisp_Vectorlike nil 'vectorlike_header '((vectorlike))) (igccg--make-layout - 'xwidget_view 'IGC_OBJ_VECTOR 'PVEC_XWIDGET_VIEW 'Lisp_Vectorlike + 'xwidget_view 'IGC_OBJ_VECTOR 'PVEC_XWIDGET_VIEW 'Lisp_Vectorlike nil 'vectorlike_header '((vectorlike))) (igccg--make-layout - 'thread 'IGC_OBJ_VECTOR 'PVEC_THREAD 'Lisp_Vectorlike + 'thread 'IGC_OBJ_VECTOR 'PVEC_THREAD 'Lisp_Vectorlike nil '(struct thread_state) '((vectorlike) (untagged m_current_buffer) @@ -658,90 +677,95 @@ igccg--layouts (untagged m_handlerlist))) (igccg--make-layout - 'mutex 'IGC_OBJ_VECTOR 'PVEC_MUTEX 'Lisp_Vectorlike + 'mutex 'IGC_OBJ_VECTOR 'PVEC_MUTEX 'Lisp_Vectorlike nil '(struct Lisp_Mutex) '((vectorlike))) (igccg--make-layout - 'condvar 'IGC_OBJ_VECTOR 'PVEC_CONDVAR 'Lisp_Vectorlike + 'condvar 'IGC_OBJ_VECTOR 'PVEC_CONDVAR 'Lisp_Vectorlike nil '(struct Lisp_CondVar) '((vectorlike))) (igccg--make-layout - 'module_function 'IGC_OBJ_VECTOR 'PVEC_MODULE_FUNCTION 'Lisp_Vectorlike + 'module_function 'IGC_OBJ_VECTOR 'PVEC_MODULE_FUNCTION 'Lisp_Vectorlike nil '(struct module_global_reference) '((vectorlike))) (igccg--make-layout 'module_global_reference 'IGC_OBJ_VECTOR 'PVEC_MODULE_GLOBAL_REFERENCE - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil 'vectorlike_header '((vectorlike))) (igccg--make-layout 'comp_unit 'IGC_OBJ_VECTOR 'PVEC_NATIVE_COMP_UNIT - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil '(struct Lisp_Native_Comp_Unit) '((vectorlike))) (igccg--make-layout 'ts_parser 'IGC_OBJ_VECTOR 'PVEC_TS_PARSER - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil '(struct Lisp_TS_Parser) '((vectorlike))) (igccg--make-layout 'ts_node 'IGC_OBJ_VECTOR 'PVEC_TS_NODE - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil '(struct Lisp_TS_Node) '((vectorlike))) (igccg--make-layout 'ts_query 'IGC_OBJ_VECTOR 'PVEC_TS_COMPILED_QUERY - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil '(struct Lisp_TS_Query) '((vectorlike))) (igccg--make-layout 'sqlite 'IGC_OBJ_VECTOR 'PVEC_SQLITE - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil '(struct Lisp_Sqlite) '((vectorlike))) - ;; (PVEC_WEAK_REF (struct Lisp_Weak_Ref)) - (igccg--make-layout 'closure 'IGC_OBJ_VECTOR 'PVEC_CLOSURE - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil 'vectorlike_header '((vectorlike))) (igccg--make-layout 'char_table 'IGC_OBJ_VECTOR 'PVEC_CHAR_TABLE - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil '(struct Lisp_Char_Table) '((vectorlike))) (igccg--make-layout 'sub_char_table 'IGC_OBJ_VECTOR 'PVEC_SUB_CHAR_TABLE - 'Lisp_Vectorlike + 'Lisp_Vectorlike nil '(struct Lisp_Sub_Char_Table) '((array tagged contents (sub-char-table-len)))) (igccg--make-layout - 'record 'IGC_OBJ_VECTOR 'PVEC_RECORD 'Lisp_Vectorlike + 'record 'IGC_OBJ_VECTOR 'PVEC_RECORD 'Lisp_Vectorlike nil 'vectorlike_header '((vectorlike))) (igccg--make-layout - 'font 'IGC_OBJ_VECTOR 'PVEC_FONT 'Lisp_Vectorlike + 'font 'IGC_OBJ_VECTOR 'PVEC_FONT 'Lisp_Vectorlike nil '(struct Lisp_Vector) '((vectorlike) (switch (pvec-header-size) (FONT_SPEC_MAX) (FONT_ENTITY_MAX) (FONT_OBJECT_MAX (quirks)) - (default (abort))))))) + (default (abort))))) + + (igccg--make-layout + 'package 'IGC_OBJ_VECTOR 'PVEC_PACKAGE 'Lisp_Vectorlike 'IN_MY_FORK + 'vectorlike_header + '((vectorlike))) + + )) (defun igccg-main () (igccg--emit-line "/* Generated by igc-codegen.el */") @@ -750,5 +774,3 @@ igccg-main (igccg--emit-scan-object 'dflt igccg--layouts) (igccg--emit-scan-object 'mirror igccg--layouts) (igccg--emit-line "#pragma GCC diagnostic pop")) - -;; (igccg-main) diff --git a/src/igc.c b/src/igc.c index 12d2472bc69..7f213909677 100644 --- a/src/igc.c +++ b/src/igc.c @@ -992,6 +992,15 @@ fix_font_quirks (mps_ss_t ss, struct font *f) static void mirror_nobj (struct igc_mirror *m, Lisp_Object *array, size_t n); static void mirror_nraw (struct igc_mirror *m, mps_addr_t array[], size_t n); +static void +mirror_buffer_quirks (struct buffer *b) +{ + if (b->base_buffer) + b->text = &b->base_buffer->own_text; + else + b->text = &b->own_text; +} + #include "igc-generated.c" static mps_res_t -- 2.39.2