branch: externals/xelb
commit eee13488088e9eae6c0f6cf7f4b035aaa9b83f6b
Author: Chris Feng <chris.w.f...@gmail.com>
Commit: Chris Feng <chris.w.f...@gmail.com>
Precompute the size of <union>
; Rationale: Some unions in XKB are not aligned, which makes
; marshaling/unmarshaling unions at runtime impossible.
* el_client.el (xelb-node-size): New function for calculating node size.
(xelb-type-size): New function for calculation the size of a type.
(xelb-parse-union): Precompute the size of <union>.
* xcb-types.el (xcb:-union): Add a '~size~ slot for storing the size.
(xcb:marshal for xcb:-union, xcb:unmarshal for xcb:-union): Marshal and
unmarshal using the precomputed size.
* xcb-randr.el:
* xcb-xkb.el:
* xcb-xproto.el: Regenerated.
---
el_client.el | 35 ++++++++++++++++++++++++++++++++++-
xcb-randr.el | 3 ++-
xcb-types.el | 23 +++++++++++++----------
xcb-xkb.el | 6 ++++--
xcb-xproto.el | 3 ++-
5 files changed, 55 insertions(+), 15 deletions(-)
diff --git a/el_client.el b/el_client.el
index ee015da..06ca496 100644
--- a/el_client.el
+++ b/el_client.el
@@ -144,6 +144,36 @@ an `xelb-auto-padding' attribute."
(eq (xelb-node-name i) 'doc)))
(throw 'break i))))))
+(defun xelb-node-size (node)
+ "Return the size of NODE in bytes."
+ (pcase (xelb-node-name node)
+ (`pad (xelb-node-attr node 'bytes))
+ (`field (xelb-type-size (xelb-node-type node)))
+ (`list (* (xelb-type-size (xelb-node-type node))
+ (xelb-parse-expression (xelb-node-subnode node))))
+ ((or `comment `doc) 0)
+ (x (error "Unexpected element: <%s>" x))))
+
+(defun xelb-type-size (type &optional slot)
+ "Return size of TYPE in bytes."
+ (pcase (indirect-variable type)
+ (`xcb:-ignore 0)
+ ((or `xcb:-u1 `xcb:-i1 `xcb:void) 1)
+ ((or `xcb:-u2 `xcb:-i2) 2)
+ ((or `xcb:-u4 `xcb:-i4) 4)
+ (`xcb:-u8 8)
+ (`xcb:-pad (cl--slot-descriptor-initform slot))
+ (`xcb:-list
+ (let ((initform (cadr (cl--slot-descriptor-initform slot))))
+ (* (plist-get initform 'size)
+ (xelb-type-size (plist-get initform 'type)))))
+ ((and x (guard (child-of-class-p x 'xcb:-struct)))
+ (apply #'+
+ (mapcar (lambda (slot)
+ (xelb-type-size (cl--slot-descriptor-type slot) slot))
+ (eieio-class-slots x))))
+ (x (error "Unknown size of type: %s" x))))
+
(defsubst xelb-generate-pad-name ()
"Generate a new slot name for <pad>."
(make-symbol (format "pad~%d" (cl-incf xelb-pad-count))))
@@ -287,7 +317,10 @@ an `xelb-auto-padding' attribute."
(let ((name (intern (concat xelb-prefix (xelb-node-attr node 'name))))
(contents (xelb-node-subnodes node)))
`((defclass ,name (xcb:-union)
- ,(apply #'nconc (mapcar #'xelb-parse-structure-content contents))))))
+ ,(apply #'nconc
+ `((~size :initform
+ ,(apply #'max (mapcar #'xelb-node-size contents))))
+ (mapcar #'xelb-parse-structure-content contents))))))
(defun xelb-parse-xidtype (node)
"Parse <xidtype>."
diff --git a/xcb-randr.el b/xcb-randr.el
index ccb96ee..8d2c7c0 100644
--- a/xcb-randr.el
+++ b/xcb-randr.el
@@ -963,7 +963,8 @@
(defclass xcb:randr:NotifyData
(xcb:-union)
- ((cc :initarg :cc :type xcb:randr:CrtcChange)
+ ((~size :initform 28)
+ (cc :initarg :cc :type xcb:randr:CrtcChange)
(oc :initarg :oc :type xcb:randr:OutputChange)
(op :initarg :op :type xcb:randr:OutputProperty)
(pc :initarg :pc :type xcb:randr:ProviderChange)
diff --git a/xcb-types.el b/xcb-types.el
index de4e394..421cee5 100644
--- a/xcb-types.el
+++ b/xcb-types.el
@@ -743,7 +743,7 @@ Note that this method auto pads the result to 32 bytes, as
is always the case."
(cl-call-next-method obj (substring byte-array 4))) ;skip the first 4 bytes
(defclass xcb:-union (xcb:-struct)
- nil
+ ((~size :initarg :~size :type xcb:-ignore)) ;Size of the largest member.
:documentation "Union type.")
;;
(cl-defmethod xcb:marshal ((obj xcb:-union))
@@ -751,8 +751,9 @@ Note that this method auto pads the result to 32 bytes, as
is always the case."
This result is converted from the first bounded slot."
(let ((slots (eieio-class-slots (eieio-object-class obj)))
- result slot type name)
- (while (and (not result) slots)
+ (size (slot-value obj '~size))
+ result slot type name tmp)
+ (while (and (not result) slots (> size (length result)))
(setq slot (pop slots))
(setq type (cl--slot-descriptor-type slot)
name (eieio-slot-descriptor-name slot))
@@ -762,9 +763,12 @@ This result is converted from the first bounded slot."
(and (eq type 'xcb:-list)
(not (slot-boundp obj (plist-get (slot-value obj name)
'name)))))
- (setq result (xcb:-marshal-field obj
- (cl--slot-descriptor-type slot)
- (slot-value obj name)))))
+ (setq tmp (xcb:-marshal-field obj (cl--slot-descriptor-type slot)
+ (slot-value obj name)))
+ (when (> (length tmp) (length result))
+ (setq result tmp))))
+ (when (> size (length result))
+ (setq result (vconcat result (make-vector (- size (length result)) 0))))
result))
;;
(cl-defmethod xcb:unmarshal ((obj xcb:-union) byte-array &optional ctx)
@@ -772,7 +776,7 @@ This result is converted from the first bounded slot."
The optional argument CTX is for <paramref>."
(let ((slots (eieio-class-slots (eieio-object-class obj)))
- slot-name consumed tmp type)
+ slot-name tmp type)
(dolist (slot slots)
(setq type (cl--slot-descriptor-type slot))
(unless (eq type 'xcb:-ignore)
@@ -781,9 +785,8 @@ The optional argument CTX is for <paramref>."
(when (slot-boundp obj slot-name)
(eieio-oref-default obj slot-name))
ctx))
- (setf (slot-value obj (eieio-slot-descriptor-name slot)) (car tmp))
- (setq consumed (cadr tmp))))
- consumed)) ;consume byte-array only once
+ (setf (slot-value obj (eieio-slot-descriptor-name slot)) (car tmp))))
+ (slot-value obj '~size)))
diff --git a/xcb-xkb.el b/xcb-xkb.el
index d3458f8..3f315db 100644
--- a/xcb-xkb.el
+++ b/xcb-xkb.el
@@ -415,7 +415,8 @@
(defclass xcb:xkb:Behavior
(xcb:-union)
- ((common :initarg :common :type xcb:xkb:CommonBehavior)
+ ((~size :initform 2)
+ (common :initarg :common :type xcb:xkb:CommonBehavior)
(default :initarg :default :type xcb:xkb:DefaultBehavior)
(lock :initarg :lock :type xcb:xkb:LockBehavior)
(radioGroup :initarg :radioGroup :type xcb:xkb:RadioGroupBehavior)
@@ -862,7 +863,8 @@
(defclass xcb:xkb:Action
(xcb:-union)
- ((noaction :initarg :noaction :type xcb:xkb:SANoAction)
+ ((~size :initform 8)
+ (noaction :initarg :noaction :type xcb:xkb:SANoAction)
(setmods :initarg :setmods :type xcb:xkb:SASetMods)
(latchmods :initarg :latchmods :type xcb:xkb:SALatchMods)
(lockmods :initarg :lockmods :type xcb:xkb:SALockMods)
diff --git a/xcb-xproto.el b/xcb-xproto.el
index 599bc9a..58d55b8 100644
--- a/xcb-xproto.el
+++ b/xcb-xproto.el
@@ -686,7 +686,8 @@
(defclass xcb:ClientMessageData
(xcb:-union)
- ((data8 :initarg :data8 :type xcb:-ignore)
+ ((~size :initform 20)
+ (data8 :initarg :data8 :type xcb:-ignore)
(data8~ :initform
'(name data8 type xcb:CARD8 size 20)
:type xcb:-list)
