1 ;; Common Lisp bindings for GTK+ 2.x
2 ;; Copyright 1999-2005 Espen S. Johnsen <espen@users.sf.net>
4 ;; Permission is hereby granted, free of charge, to any person obtaining
5 ;; a copy of this software and associated documentation files (the
6 ;; "Software"), to deal in the Software without restriction, including
7 ;; without limitation the rights to use, copy, modify, merge, publish,
8 ;; distribute, sublicense, and/or sell copies of the Software, and to
9 ;; permit persons to whom the Software is furnished to do so, subject to
10 ;; the following conditions:
12 ;; The above copyright notice and this permission notice shall be
13 ;; included in all copies or substantial portions of the Software.
15 ;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
16 ;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
17 ;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
18 ;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
19 ;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
20 ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
21 ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
23 ;; $Id: glib.lisp,v 1.33 2006-02-09 22:24:31 espen Exp $
31 ;;;; Memory management
33 (defbinding (allocate-memory "g_malloc0") () pointer
36 (defbinding (reallocate-memory "g_realloc") () pointer
40 (defbinding (deallocate-memory "g_free") () nil
42 ;; (defun deallocate-memory (address)
43 ;; (declare (ignore address)))
45 (defun copy-memory (from length &optional (to (allocate-memory length)))
46 #+cmu(system-area-copy from 0 to 0 (* 8 length))
47 #+sbcl(system-area-ub8-copy from 0 to 0 length)
50 (defmacro with-allocated-memory ((var size) &body body)
51 `(let ((,var (allocate-memory ,size)))
54 (deallocate-memory ,var))))
57 ;;;; User data mechanism
59 (internal *user-data* *user-data-count*)
61 (defvar *user-data* (make-hash-table))
62 (defvar *user-data-count* 0)
64 (defun register-user-data (object &optional destroy-function)
65 (check-type destroy-function (or null symbol function))
66 (incf *user-data-count*)
68 (gethash *user-data-count* *user-data*)
69 (cons object destroy-function))
72 (defun find-user-data (id)
73 (check-type id fixnum)
74 (multiple-value-bind (user-data p) (gethash id *user-data*)
75 (values (car user-data) p)))
77 (defun user-data-exists-p (id)
78 (nth-value 1 (find-user-data id)))
80 (defun update-user-data (id object)
81 (check-type id fixnum)
82 (multiple-value-bind (user-data exists-p) (gethash id *user-data*)
84 ((not exists-p) (error "User data id ~A does not exist" id))
87 (funcall (cdr user-data) (car user-data)))
88 (setf (car user-data) object)))))
90 (defun destroy-user-data (id)
91 (check-type id fixnum)
92 (let ((user-data (gethash id *user-data*)))
94 (funcall (cdr user-data) (car user-data))))
95 (remhash id *user-data*))
100 (deftype quark () 'unsigned)
102 (defbinding %quark-from-string () quark
105 (defun quark-intern (object)
108 (string (%quark-from-string object))
109 (symbol (%quark-from-string (format nil "clg-~A:~A"
110 (package-name (symbol-package object))
113 (defbinding quark-to-string () (copy-of string)
117 ;;;; Linked list (GList)
119 (deftype glist (type)
120 `(or (null (cons ,type list))))
122 (defbinding (%glist-append "g_list_append") () pointer
126 (defun make-glist (type list)
128 with writer = (writer-function type)
130 as glist = (%glist-append (or glist (make-pointer 0)))
131 do (funcall writer element glist)
132 finally (return glist)))
134 (defun glist-next (glist)
135 (unless (null-pointer-p glist)
136 (sap-ref-sap glist +size-of-pointer+)))
138 ;; Also used for gslists
139 (defun map-glist (seqtype function glist element-type)
140 (let ((reader (reader-function element-type)))
144 as tmp = glist then (glist-next tmp)
145 until (null-pointer-p tmp)
146 do (funcall function (funcall reader tmp))))
149 as tmp = glist then (glist-next tmp)
150 until (null-pointer-p tmp)
151 collect (funcall function (funcall reader tmp))))
155 as tmp = glist then (glist-next tmp)
156 until (null-pointer-p tmp)
157 collect (funcall function (funcall reader tmp)))
160 (defbinding (glist-free "g_list_free") () nil
163 (defun destroy-glist (glist element-type)
165 with destroy = (destroy-function element-type)
166 as tmp = glist then (glist-next tmp)
167 until (null-pointer-p tmp)
168 do (funcall destroy tmp 0))
171 (defmethod alien-type ((type (eql 'glist)) &rest args)
172 (declare (ignore type args))
173 (alien-type 'pointer))
175 (defmethod size-of ((type (eql 'glist)) &rest args)
176 (declare (ignore type args))
179 (defmethod to-alien-form (list (type (eql 'glist)) &rest args)
180 (declare (ignore type))
181 (destructuring-bind (element-type) args
182 `(make-glist ',element-type ,list)))
184 (defmethod to-alien-function ((type (eql 'glist)) &rest args)
185 (declare (ignore type))
186 (destructuring-bind (element-type) args
188 (make-glist element-type list))))
190 (defmethod from-alien-form (glist (type (eql 'glist)) &rest args)
191 (declare (ignore type))
192 (destructuring-bind (element-type) args
193 `(let ((glist ,glist))
195 (map-glist 'list #'identity glist ',element-type)
196 (destroy-glist glist ',element-type)))))
198 (defmethod from-alien-function ((type (eql 'glist)) &rest args)
199 (declare (ignore type))
200 (destructuring-bind (element-type) args
203 (map-glist 'list #'identity glist element-type)
204 (destroy-glist glist element-type)))))
206 (defmethod copy-from-alien-form (glist (type (eql 'glist)) &rest args)
207 (declare (ignore type))
208 (destructuring-bind (element-type) args
209 `(map-glist 'list #'identity ,glist ',element-type)))
211 (defmethod copy-from-alien-function ((type (eql 'glist)) &rest args)
212 (declare (ignore type))
213 (destructuring-bind (element-type) args
215 (map-glist 'list #'identity glist element-type))))
217 (defmethod cleanup-form (glist (type (eql 'glist)) &rest args)
218 (declare (ignore type))
219 (destructuring-bind (element-type) args
220 `(destroy-glist ,glist ',element-type)))
222 (defmethod cleanup-function ((type (eql 'glist)) &rest args)
223 (declare (ignore type))
224 (destructuring-bind (element-type) args
226 (destroy-glist glist element-type))))
228 (defmethod writer-function ((type (eql 'glist)) &rest args)
229 (declare (ignore type))
230 (destructuring-bind (element-type) args
231 #'(lambda (list location &optional (offset 0))
233 (sap-ref-sap location offset)
234 (make-glist element-type list)))))
236 (defmethod reader-function ((type (eql 'glist)) &rest args)
237 (declare (ignore type))
238 (destructuring-bind (element-type) args
239 #'(lambda (location &optional (offset 0) weak-p)
240 (declare (ignore weak-p))
241 (unless (null-pointer-p (sap-ref-sap location offset))
242 (map-glist 'list #'identity (sap-ref-sap location offset) element-type)))))
244 (defmethod destroy-function ((type (eql 'glist)) &rest args)
245 (declare (ignore type))
246 (destructuring-bind (element-type) args
247 #'(lambda (location &optional (offset 0))
248 (unless (null-pointer-p (sap-ref-sap location offset))
249 (destroy-glist (sap-ref-sap location offset) element-type)
250 (setf (sap-ref-sap location offset) (make-pointer 0))))))
254 ;;;; Single linked list (GSList)
256 (deftype gslist (type) `(or (null (cons ,type list))))
258 (defbinding (%gslist-prepend "g_slist_prepend") () pointer
262 (defun make-gslist (type list)
264 with writer = (writer-function type)
265 for element in (reverse list)
266 as gslist = (%gslist-prepend (or gslist (make-pointer 0)))
267 do (funcall writer element gslist)
268 finally (return gslist)))
270 (defbinding (gslist-free "g_slist_free") () nil
273 (defun destroy-gslist (gslist element-type)
275 with destroy = (destroy-function element-type)
276 as tmp = gslist then (glist-next tmp)
277 until (null-pointer-p tmp)
278 do (funcall destroy tmp 0))
279 (gslist-free gslist))
281 (defmethod alien-type ((type (eql 'gslist)) &rest args)
282 (declare (ignore type args))
283 (alien-type 'pointer))
285 (defmethod size-of ((type (eql 'gslist)) &rest args)
286 (declare (ignore type args))
289 (defmethod to-alien-form (list (type (eql 'gslist)) &rest args)
290 (declare (ignore type))
291 (destructuring-bind (element-type) args
292 `(make-sglist ',element-type ,list)))
294 (defmethod to-alien-function ((type (eql 'gslist)) &rest args)
295 (declare (ignore type))
296 (destructuring-bind (element-type) args
298 (make-gslist element-type list))))
300 (defmethod from-alien-form (gslist (type (eql 'gslist)) &rest args)
301 (declare (ignore type))
302 (destructuring-bind (element-type) args
303 `(let ((gslist ,gslist))
305 (map-glist 'list #'identity gslist ',element-type)
306 (destroy-gslist gslist ',element-type)))))
308 (defmethod from-alien-function ((type (eql 'gslist)) &rest args)
309 (declare (ignore type))
310 (destructuring-bind (element-type) args
313 (map-glist 'list #'identity gslist element-type)
314 (destroy-gslist gslist element-type)))))
316 (defmethod copy-from-alien-form (gslist (type (eql 'gslist)) &rest args)
317 (declare (ignore type))
318 (destructuring-bind (element-type) args
319 `(map-glist 'list #'identity ,gslist ',element-type)))
321 (defmethod copy-from-alien-function ((type (eql 'gslist)) &rest args)
322 (declare (ignore type))
323 (destructuring-bind (element-type) args
325 (map-glist 'list #'identity gslist element-type))))
327 (defmethod cleanup-form (gslist (type (eql 'gslist)) &rest args)
328 (declare (ignore type))
329 (destructuring-bind (element-type) args
330 `(destroy-gslist ,gslist ',element-type)))
332 (defmethod cleanup-function ((type (eql 'gslist)) &rest args)
333 (declare (ignore type))
334 (destructuring-bind (element-type) args
336 (destroy-gslist gslist element-type))))
338 (defmethod writer-function ((type (eql 'gslist)) &rest args)
339 (declare (ignore type))
340 (destructuring-bind (element-type) args
341 #'(lambda (list location &optional (offset 0))
343 (sap-ref-sap location offset)
344 (make-gslist element-type list)))))
346 (defmethod reader-function ((type (eql 'gslist)) &rest args)
347 (declare (ignore type))
348 (destructuring-bind (element-type) args
349 #'(lambda (location &optional (offset 0) weak-p)
350 (declare (ignore weak-p))
351 (unless (null-pointer-p (sap-ref-sap location offset))
352 (map-glist 'list #'identity (sap-ref-sap location offset) element-type)))))
354 (defmethod destroy-function ((type (eql 'gslist)) &rest args)
355 (declare (ignore type))
356 (destructuring-bind (element-type) args
357 #'(lambda (location &optional (offset 0))
358 (unless (null-pointer-p (sap-ref-sap location offset))
359 (destroy-gslist (sap-ref-sap location offset) element-type)
360 (setf (sap-ref-sap location offset) (make-pointer 0))))))
365 (defun make-c-vector (type length &optional content location)
366 (let* ((size-of-type (size-of type))
367 (location (or location (allocate-memory (* size-of-type length))))
368 (writer (writer-function type)))
372 for element across content
373 for i from 0 below length
374 as offset = 0 then (+ offset size-of-type)
375 do (funcall writer element location offset)))
378 for element in content
379 for i from 0 below length
380 as offset = 0 then (+ offset size-of-type)
381 do (funcall writer element location offset))))
385 (defun map-c-vector (seqtype function location element-type length)
386 (let ((reader (reader-function element-type))
387 (size-of-element (size-of element-type)))
391 for i from 0 below length
392 as offset = 0 then (+ offset size-of-element)
393 do (funcall function (funcall reader location offset))))
396 for i from 0 below length
397 as offset = 0 then (+ offset size-of-element)
398 collect (funcall function (funcall reader location offset))))
401 with sequence = (make-sequence seqtype length)
402 for i from 0 below length
403 as offset = 0 then (+ offset size-of-element)
406 (funcall function (funcall reader location offset)))
407 finally (return sequence))))))
410 (defun destroy-c-vector (location element-type length)
412 with destroy = (destroy-function element-type)
413 with element-size = (size-of element-type)
414 for i from 0 below length
415 as offset = 0 then (+ offset element-size)
416 do (funcall destroy location offset))
417 (deallocate-memory location))
420 (defmethod alien-type ((type (eql 'vector)) &rest args)
421 (declare (ignore type args))
422 (alien-type 'pointer))
424 (defmethod size-of ((type (eql 'vector)) &rest args)
425 (declare (ignore type args))
428 (defmethod to-alien-form (vector (type (eql 'vector)) &rest args)
429 (declare (ignore type))
430 (destructuring-bind (element-type &optional (length '*)) args
432 `(let* ((vector ,vector)
434 (allocate-memory (+ ,+size-of-int+
435 (* ,(size-of element-type)
438 (make-c-vector ',element-type (length vector) vector location)
439 (setf (sap-ref-32 location ,(- +size-of-int+)) (length vector))
441 `(make-c-vector ',element-type ,length ,vector))))
443 (defmethod from-alien-form (c-vector (type (eql 'vector)) &rest args)
444 (declare (ignore type))
445 (destructuring-bind (element-type &optional (length '*)) args
447 (error "Can't use vector of variable size as return type")
448 `(let ((c-vector ,c-vector))
450 (map-c-vector 'vector #'identity c-vector ',element-type ,length)
451 (destroy-c-vector c-vector ',element-type ,length))))))
453 (defmethod copy-from-alien-form (c-vector (type (eql 'vector)) &rest args)
454 (declare (ignore type))
455 (destructuring-bind (element-type &optional (length '*)) args
457 (error "Can't use vector of variable size as return type")
458 `(map-c-vector 'vector #'identity ,c-vector ',element-type ,length))))
460 (defmethod copy-from-alien-function ((type (eql 'vector)) &rest args)
461 (declare (ignore type))
462 (destructuring-bind (element-type &optional (length '*)) args
464 (error "Can't use vector of variable size as return type")
466 (map-c-vector 'vector #'identity c-vector element-type length)))))
468 (defmethod cleanup-form (location (type (eql 'vector)) &rest args)
469 (declare (ignore type))
470 (destructuring-bind (element-type &optional (length '*)) args
471 `(let* ((location ,location)
472 (length ,(if (eq length '*)
473 `(sap-ref-32 location ,(- +size-of-int+))
476 with destroy = (destroy-function ',element-type)
477 for i from 0 below length
478 as offset = 0 then (+ offset ,(size-of element-type))
479 do (funcall destroy location offset))
480 (deallocate-memory ,(if (eq length '*)
481 `(sap+ location ,(- +size-of-int+))
484 (defmethod writer-function ((type (eql 'vector)) &rest args)
485 (declare (ignore type))
486 (destructuring-bind (element-type &optional (length '*)) args
487 #'(lambda (vector location &optional (offset 0))
489 (sap-ref-sap location offset)
490 (make-c-vector element-type length vector)))))
492 (defmethod reader-function ((type (eql 'vector)) &rest args)
493 (declare (ignore type))
494 (destructuring-bind (element-type &optional (length '*)) args
496 (error "Can't create reader function for vector of variable size")
497 #'(lambda (location &optional (offset 0) weak-p)
498 (declare (ignore weak-p))
499 (unless (null-pointer-p (sap-ref-sap location offset))
500 (map-c-vector 'vector #'identity (sap-ref-sap location offset)
501 element-type length))))))
503 (defmethod destroy-function ((type (eql 'vector)) &rest args)
504 (declare (ignore type))
505 (destructuring-bind (element-type &optional (length '*)) args
507 (error "Can't create destroy function for vector of variable size")
508 #'(lambda (location &optional (offset 0))
509 (unless (null-pointer-p (sap-ref-sap location offset))
511 (sap-ref-sap location offset) element-type length)
512 (setf (sap-ref-sap location offset) (make-pointer 0)))))))
515 ;;;; Null terminated vector
517 (defun make-0-vector (type content &optional location)
518 (let* ((size-of-type (size-of type))
521 (allocate-memory (* size-of-type (1+ (length content))))))
522 (writer (writer-function type)))
526 for element across content
527 as offset = 0 then (+ offset size-of-type)
528 do (funcall writer element location offset)
529 finally (setf (sap-ref-sap location offset) (make-pointer 0))))
532 for element in content
533 as offset = 0 then (+ offset size-of-type)
534 do (funcall writer element location offset)
535 finally (setf (sap-ref-sap location (+ offset size-of-type)) (make-pointer 0)))))
539 (defun map-0-vector (seqtype function location element-type)
540 (let ((reader (reader-function element-type))
541 (size-of-element (size-of element-type)))
545 as offset = 0 then (+ offset size-of-element)
546 until (null-pointer-p (sap-ref-sap location offset))
547 do (funcall function (funcall reader location offset))))
550 as offset = 0 then (+ offset size-of-element)
551 until (null-pointer-p (sap-ref-sap location offset))
552 collect (funcall function (funcall reader location offset))))
556 as offset = 0 then (+ offset size-of-element)
557 until (null-pointer-p (sap-ref-sap location offset))
558 collect (funcall function (funcall reader location offset)))
562 (defun destroy-0-vector (location element-type)
564 with destroy = (destroy-function element-type)
565 with element-size = (size-of element-type)
566 as offset = 0 then (+ offset element-size)
567 until (null-pointer-p (sap-ref-sap location offset))
568 do (funcall destroy location offset))
569 (deallocate-memory location))
571 (deftype null-terminated-vector (element-type) `(vector ,element-type))
573 (defmethod alien-type ((type (eql 'null-terminated-vector)) &rest args)
574 (declare (ignore type args))
575 (alien-type 'pointer))
577 (defmethod size-of ((type (eql 'null-terminated-vector)) &rest args)
578 (declare (ignore type args))
581 (defmethod to-alien-form (vector (type (eql 'null-terminated-vector)) &rest args)
582 (declare (ignore type))
583 (destructuring-bind (element-type) args
584 `(make-0-vector ',element-type ,vector)))
586 (defmethod from-alien-form (c-vector (type (eql 'null-terminated-vector)) &rest args)
587 (declare (ignore type))
588 (destructuring-bind (element-type) args
589 `(let ((c-vector ,c-vector))
591 (map-0-vector 'vector #'identity c-vector ',element-type)
592 (destroy-0-vector c-vector ',element-type)))))
594 (defmethod copy-from-alien-form (c-vector (type (eql 'null-terminated-vector)) &rest args)
595 (declare (ignore type))
596 (destructuring-bind (element-type) args
597 `(map-0-vector 'vector #'identity ,c-vector ',element-type)))
599 (defmethod cleanup-form (location (type (eql 'null-terminated-vector)) &rest args)
600 (declare (ignore type))
601 (destructuring-bind (element-type) args
602 `(destroy-0-vector ,location ',element-type)))
604 (defmethod writer-function ((type (eql 'null-terminated-vector)) &rest args)
605 (declare (ignore type))
606 (destructuring-bind (element-type) args
607 (unless (eq (alien-type element-type) (alien-type 'pointer))
608 (error "Elements in null-terminated vectors need to be of pointer types"))
609 #'(lambda (vector location &optional (offset 0))
611 (sap-ref-sap location offset)
612 (make-0-vector element-type vector)))))
614 (defmethod reader-function ((type (eql 'null-terminated-vector)) &rest args)
615 (declare (ignore type))
616 (destructuring-bind (element-type) args
617 (unless (eq (alien-type element-type) (alien-type 'pointer))
618 (error "Elements in null-terminated vectors need to be of pointer types"))
619 #'(lambda (location &optional (offset 0) weak-p)
620 (declare (ignore weak-p))
621 (unless (null-pointer-p (sap-ref-sap location offset))
622 (map-0-vector 'vector #'identity (sap-ref-sap location offset)
625 (defmethod destroy-function ((type (eql 'null-terminated-vector)) &rest args)
626 (declare (ignore type))
627 (destructuring-bind (element-type) args
628 (unless (eq (alien-type element-type) (alien-type 'pointer))
629 (error "Elements in null-terminated vectors need to be of pointer types"))
630 #'(lambda (location &optional (offset 0))
631 (unless (null-pointer-p (sap-ref-sap location offset))
633 (sap-ref-sap location offset) element-type)
634 (setf (sap-ref-sap location offset) (make-pointer 0))))))
636 (defmethod unbound-value ((type (eql 'null-terminated-vector)) &rest args)
637 (declare (ignore type args))
643 (defun make-counted-vector (type content)
644 (let* ((size-of-type (size-of type))
645 (length (length content))
647 (allocate-memory (+ +size-of-int+ (* size-of-type length)))))
648 (setf (sap-ref-32 location 0) length)
649 (make-c-vector type length content (sap+ location +size-of-int+))))
651 (defun map-counted-vector (seqtype function location element-type)
652 (let ((length (sap-ref-32 location 0)))
654 seqtype function (sap+ location +size-of-int+)
655 element-type length)))
657 (defun destroy-counted-vector (location element-type)
659 with destroy = (destroy-function element-type)
660 with element-size = (size-of element-type)
661 for i from 0 below (sap-ref-32 location 0)
662 as offset = +size-of-int+ then (+ offset element-size)
663 do (funcall destroy location offset))
664 (deallocate-memory location))
667 (deftype counted-vector (element-type) `(vector ,element-type))
669 (defmethod alien-type ((type (eql 'counted-vector)) &rest args)
670 (declare (ignore type args))
671 (alien-type 'pointer))
673 (defmethod size-of ((type (eql 'counted-vector)) &rest args)
674 (declare (ignore type args))
677 (defmethod to-alien-form (vector (type (eql 'counted-vector)) &rest args)
678 (declare (ignore type))
679 (destructuring-bind (element-type) args
680 `(make-counted-vector ',element-type ,vector)))
682 (defmethod from-alien-form (c-vector (type (eql 'counted-vector)) &rest args)
683 (declare (ignore type))
684 (destructuring-bind (element-type) args
685 `(let ((c-vector ,c-vector))
687 (map-counted-vector 'vector #'identity c-vector ',element-type)
688 (destroy-counted-vector c-vector ',element-type)))))
690 (defmethod copy-from-alien-form (c-vector (type (eql 'counted-vector)) &rest args)
691 (declare (ignore type))
692 (destructuring-bind (element-type) args
693 `(map-counted-vector 'vector #'identity ,c-vector ',element-type)))
695 (defmethod copy-from-alien-function ((type (eql 'counted-vector)) &rest args)
696 (declare (ignore type))
697 (destructuring-bind (element-type) args
699 (map-counted-vector 'vector #'identity c-vector element-type))))
701 (defmethod cleanup-form (location (type (eql 'counted-vector)) &rest args)
702 (declare (ignore type))
703 (destructuring-bind (element-type) args
704 `(destroy-counted-vector ,location ',element-type)))
706 (defmethod writer-function ((type (eql 'counted-vector)) &rest args)
707 (declare (ignore type))
708 (destructuring-bind (element-type) args
709 #'(lambda (vector location &optional (offset 0))
711 (sap-ref-sap location offset)
712 (make-counted-vector element-type vector)))))
714 (defmethod reader-function ((type (eql 'counted-vector)) &rest args)
715 (declare (ignore type))
716 (destructuring-bind (element-type) args
717 #'(lambda (location &optional (offset 0) weak-p)
718 (declare (ignore weak-p))
719 (unless (null-pointer-p (sap-ref-sap location offset))
720 (map-counted-vector 'vector #'identity
721 (sap-ref-sap location offset) element-type)))))
723 (defmethod destroy-function ((type (eql 'counted-vector)) &rest args)
724 (declare (ignore type))
725 (destructuring-bind (element-type) args
726 #'(lambda (location &optional (offset 0))
727 (unless (null-pointer-p (sap-ref-sap location offset))
728 (destroy-counted-vector
729 (sap-ref-sap location offset) element-type)
730 (setf (sap-ref-sap location offset) (make-pointer 0))))))