/
types.lisp
86 lines (71 loc) · 2.83 KB
/
types.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
;;; -*- Mode: Lisp -*-
;;; Copyright (c) 2008 Julian Stecklina
;;;
;;; This file is part of CL-DBUS. Look into LICENSE for license terms.
(in-package :blitz.desktop.dbus)
(defclass* dbus-type ()
(name char alignment))
(defclass* dbus-compound-type (dbus-type)
(element-type))
(eval-when (:load-toplevel :compile-toplevel :execute)
(defmacro define-dbus-type (name type-char alignment &optional (superclass 'dbus-type) slots)
`(defclass* ,(intern (format nil "DBUS-~A" name) (find-package :blitz.desktop.dbus))
(,superclass)
,slots
(:default-initargs
:name ',name
:char ',type-char
:alignment ,alignment))))
(define-dbus-type boolean #\b 4)
(define-dbus-type uint8 #\y 1)
(define-dbus-type int16 #\n 2)
(define-dbus-type uint16 #\q 2)
(define-dbus-type int32 #\i 4)
(define-dbus-type uint32 #\u 4)
(define-dbus-type int64 #\x 8)
(define-dbus-type uint64 #\t 8)
(define-dbus-type double #\d 8)
(define-dbus-type string #\s 4)
(define-dbus-type signature #\g 1)
(define-dbus-type object-path #\o 4)
(define-dbus-type variant #\v 1)
(define-dbus-type struct #\r 8 dbus-compound-type)
(define-dbus-type array #\a 4 dbus-compound-type)
(define-dbus-type dict-entry #\e 8 dbus-compound-type)
(defgeneric marshall (type object vector start)
(:documentation "Marshalls OBJECT (interpreted as TYPE) into
VECTOR (starting at START). Returns VECTOR and an index pointing
after the written data. VECTOR is destructively modified!"))
(defun dbus-write-byte (vector byte start &optional (repeat 1))
"Writes BYTE REPEAT-times into VECTOR starting at START. Returns the
new position in VECTOR."
(iter (repeat repeat)
(for i upfrom 0)
(setf (aref vector (+ start i)) byte))
(+ start repeat))
(defun dbus-write-sequence (destination source start)
"Writes SOURCE into DESTINATION (both vectors) starting at
START. Returns the new position in DESTINATION."
(when (> (+ (length source) start)
(length destination))
(error "Vector too small."))
(setf (subseq destination start) source)
(+ start (length source)))
(defmethod marshall :around ((type dbus-type) object vector start)
;; Alignment is handled in this around method.
(let* ((alignment (alignment-of type))
(mod (nth-value 1 (truncate start alignment))))
(format t "~A ~A~%" alignment mod)
(values
(call-next-method type object vector
(dbus-write-byte vector 0 start
(mod (- alignment mod) alignment)))
vector)))
(defmethod marshall ((type dbus-boolean) object vector start)
(dbus-write-sequence vector
(if object
#+ little-endian #(1 0 0 0)
#+ big-endian #(0 0 0 1)
#(0 0 0 0))
start))
;;; EOF