chiark - git - mdw - clg/blob - glib/proxy.lisp

   1 ;; Common Lisp bindings for GTK+ v2.x
   2 ;; Copyright 2000-2005 Espen S. Johnsen <espen@users.sf.net>
   3 ;;
   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:
  11 ;;
  12 ;; The above copyright notice and this permission notice shall be
  13 ;; included in all copies or substantial portions of the Software.
  14 ;;
  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.
  22
  23 ;; $Id: proxy.lisp,v 1.25 2006-02-05 15:38:57 espen Exp $
  24
  25 (in-package "GLIB")
  26
  27 ;;;; Superclass for all metaclasses implementing some sort of virtual slots
  28
  29 (eval-when (:compile-toplevel :load-toplevel :execute)
  30   (defclass virtual-slots-class (standard-class)
  31     ())
  32
  33   (defclass direct-virtual-slot-definition (standard-direct-slot-definition)
  34     ((setter :reader slot-definition-setter :initarg :setter)
  35      (getter :reader slot-definition-getter :initarg :getter)
  36      (unbound :reader slot-definition-unbound :initarg :unbound)
  37      (boundp :reader slot-definition-boundp :initarg :boundp)))
  38
  39   (defclass effective-virtual-slot-definition (standard-effective-slot-definition)
  40     ((setter :reader slot-definition-setter :initarg :setter)
  41      (getter :reader slot-definition-getter :initarg :getter)
  42      (unbound :reader slot-definition-unbound :initarg :unbound)
  43      (boundp :reader slot-definition-boundp :initarg :boundp)))
  44
  45   (defclass direct-special-slot-definition (standard-direct-slot-definition)
  46     ())
  47
  48   (defclass effective-special-slot-definition (standard-effective-slot-definition)
  49     ()))
  50
  51 (defvar *unbound-marker* (gensym "UNBOUND-MARKER-"))
  52
  53 (defun most-specific-slot-value (instances slot &optional (default *unbound-marker*))
  54   (let ((object (find-if
  55                  #'(lambda (ob)
  56                      (and (slot-exists-p ob slot) (slot-boundp ob slot)))
  57                  instances)))
  58     (if object
  59         (slot-value object slot)
  60       default)))
  61
  62 (defmethod initialize-instance ((slotd effective-special-slot-definition) &rest initargs)
  63   (declare (ignore initargs))
  64   (call-next-method)
  65   (setf (slot-value slotd 'allocation) :instance))
  66
  67
  68 (defmethod direct-slot-definition-class ((class virtual-slots-class) &rest initargs)
  69   (case (getf initargs :allocation)
  70     (:virtual (find-class 'direct-virtual-slot-definition))
  71     (:special (find-class 'direct-special-slot-definition))
  72     (t (call-next-method))))
  73
  74 (defmethod effective-slot-definition-class ((class virtual-slots-class) &rest initargs)
  75   (case (getf initargs :allocation)
  76     (:virtual (find-class 'effective-virtual-slot-definition))
  77     (:special (find-class 'effective-special-slot-definition))
  78     (t (call-next-method))))
  79
  80
  81 (defmethod initialize-internal-slot-functions ((slotd effective-virtual-slot-definition))
  82   (if (not (slot-boundp slotd 'getter))
  83       (setf
  84        (slot-value slotd 'reader-function)
  85        #'(lambda (object)
  86            (declare (ignore object))
  87            (error "Can't read slot: ~A" (slot-definition-name slotd)))
  88        (slot-value slotd 'boundp-function)
  89        #'(lambda (object) (declare (ignore object)) nil))
  90
  91     (let ((getter-function
  92            (let ((getter (slot-value slotd 'getter)))
  93              (etypecase getter
  94                (function getter)
  95                (symbol
  96                 #'(lambda (object)
  97                     (funcall getter object)))
  98                (string
  99                 (let ((reader nil))
 100                   (setf (slot-value slotd 'reader-function)
 101                         #'(lambda (object)
 102                             (unless reader
 103                               (setq reader
 104                                (mkbinding getter
 105                                 (slot-definition-type slotd) 'pointer)))
 106                             (funcall reader (foreign-location object))))))))))
 107
 108       (setf
 109        (slot-value slotd 'boundp-function)
 110        (cond
 111         ((slot-boundp slotd 'unbound)
 112          (let ((unbound-value (slot-value slotd 'unbound)))
 113            #'(lambda (object)
 114                (not (eq (funcall getter-function object) unbound-value)))))
 115         ((slot-boundp slotd 'boundp)
 116          (let ((boundp (slot-value slotd 'boundp)))
 117            (etypecase boundp
 118              (function boundp)
 119              (symbol #'(lambda (object)
 120                          (funcall boundp object)))
 121              (string (let ((reader ()))
 122                        #'(lambda (object)
 123                            (unless reader
 124                              (setq reader
 125                               (mkbinding boundp
 126                                (slot-definition-type slotd) 'pointer)))
 127                            (funcall reader (foreign-location object))))))))
 128         ((multiple-value-bind (unbound-p unbound-value)
 129              (unbound-value (slot-definition-type slotd))
 130            (when unbound-p
 131              #'(lambda (object)
 132                  (not (eq (funcall getter-function object) unbound-value))))))
 133         (#'(lambda (object) (declare (ignore object)) t))))
 134
 135       (setf
 136        (slot-value slotd 'reader-function)
 137        (cond
 138         ((slot-boundp slotd 'unbound)
 139          (let ((unbound (slot-value slotd 'unbound))
 140                (slot-name (slot-definition-name slotd)))
 141            #'(lambda (object)
 142                (let ((value (funcall getter-function object)))
 143                  (if (eq value unbound)
 144                      (slot-unbound (class-of object) object slot-name)
 145                    value)))))
 146         ((slot-boundp slotd 'boundp)
 147          (let ((boundp-function (slot-value slotd 'boundp-function)))
 148            #'(lambda (object)
 149                (and
 150                 (funcall boundp-function object)
 151                 (funcall getter-function object)))))
 152         ((multiple-value-bind (unbound-p unbound-value)
 153              (unbound-value (slot-definition-type slotd))
 154            (let ((slot-name (slot-definition-name slotd)))
 155              (when unbound-p
 156                #'(lambda (object)
 157                    (let ((value (funcall getter-function object)))
 158                      (if (eq value unbound-value)
 159                          (slot-unbound (class-of object) object slot-name)
 160                          value)))))))
 161         (getter-function)))))
 162
 163   (setf
 164    (slot-value slotd 'writer-function)
 165    (if (not (slot-boundp slotd 'setter))
 166        #'(lambda (object)
 167            (declare (ignore object))
 168            (error "Can't set slot: ~A" (slot-definition-name slotd)))
 169      (with-slots (setter) slotd
 170        (etypecase setter
 171          (function setter)
 172          ((or symbol cons)
 173           #'(lambda (value object)
 174               (funcall (fdefinition setter) value object)))
 175          (string
 176           (let ((writer ()))
 177             (setf
 178              (slot-value slotd 'writer-function)
 179              #'(lambda (value object)
 180                  (unless writer
 181                    (setq writer
 182                     (mkbinding setter 'nil 'pointer
 183                      (slot-definition-type slotd))))
 184                  (funcall writer (foreign-location object) value)))))))))
 185
 186   (initialize-internal-slot-gfs (slot-definition-name slotd)))
 187
 188
 189
 190 (defmethod compute-slot-accessor-info ((slotd effective-virtual-slot-definition) type gf)
 191   nil)
 192
 193 (defmethod compute-effective-slot-definition-initargs ((class virtual-slots-class) direct-slotds)
 194   (if (typep (first direct-slotds) 'direct-virtual-slot-definition)
 195       (let ((initargs ()))
 196         (let ((getter (most-specific-slot-value direct-slotds 'getter)))
 197           (unless (eq getter *unbound-marker*)
 198             (setf (getf initargs :getter) getter)))
 199         (let ((setter (most-specific-slot-value direct-slotds 'setter)))
 200           (unless (eq setter *unbound-marker*)
 201             (setf (getf initargs :setter) setter)))
 202         (let ((unbound (most-specific-slot-value direct-slotds 'unbound)))
 203           (unless (eq unbound *unbound-marker*)
 204             (setf (getf initargs :unbound) unbound)))
 205         (let ((boundp (most-specific-slot-value direct-slotds 'boundp)))
 206           (unless (eq boundp *unbound-marker*)
 207             (setf (getf initargs :boundp) boundp)))
 208         (nconc initargs (call-next-method)))
 209     (call-next-method)))
 210
 211
 212 (defmethod slot-value-using-class
 213     ((class virtual-slots-class) (object standard-object)
 214      (slotd effective-virtual-slot-definition))
 215   (if (funcall (slot-value slotd 'boundp-function) object)
 216       (funcall (slot-value slotd 'reader-function) object)
 217     (slot-unbound class object (slot-definition-name slotd))))
 218
 219 (defmethod slot-boundp-using-class
 220     ((class virtual-slots-class) (object standard-object)
 221      (slotd effective-virtual-slot-definition))
 222   (funcall (slot-value slotd 'boundp-function) object))
 223
 224 (defmethod (setf slot-value-using-class)
 225     (value (class virtual-slots-class) (object standard-object)
 226      (slotd effective-virtual-slot-definition))
 227   (funcall (slot-value slotd 'writer-function) value object))
 228
 229
 230 (defmethod validate-superclass
 231     ((class virtual-slots-class) (super standard-class))
 232   t)
 233
 234
 235 ;;;; Proxy cache
 236
 237 (internal *instance-cache*)
 238 (defvar *instance-cache* (make-hash-table :test #'eql))
 239
 240 (defun cache-instance (instance &optional (weak-ref t))
 241   (setf
 242    (gethash (sap-int (foreign-location instance)) *instance-cache*)
 243    (if weak-ref
 244        (make-weak-pointer instance)
 245      instance)))
 246
 247 (defun find-cached-instance (location)
 248   (let ((ref (gethash (sap-int location) *instance-cache*)))
 249     (when ref
 250       (if (weak-pointer-p ref)
 251           (weak-pointer-value ref)
 252         ref))))
 253
 254 (defun instance-cached-p (location)
 255   (gethash (sap-int location) *instance-cache*))
 256
 257 (defun remove-cached-instance (location)
 258   (remhash (sap-int location) *instance-cache*))
 259
 260 ;; For debuging
 261 (defun list-cached-instances ()
 262   (let ((instances ()))
 263     (maphash #'(lambda (location ref)
 264                  (declare (ignore location))
 265                  (push ref instances))
 266              *instance-cache*)
 267     instances))
 268
 269
 270
 271 ;;;; Proxy for alien instances
 272
 273 (defclass proxy ()
 274   ((location :allocation :special :reader foreign-location :type pointer))
 275   (:metaclass virtual-slots-class))
 276
 277 (defgeneric instance-finalizer (object))
 278 (defgeneric reference-foreign (class location))
 279 (defgeneric unreference-foreign (class location))
 280
 281 (defmethod reference-foreign ((name symbol) location)
 282   (reference-foreign (find-class name) location))
 283
 284 (defmethod unreference-foreign ((name symbol) location)
 285   (unreference-foreign (find-class name) location))
 286
 287 (defmethod unreference-foreign :around ((class class) location)
 288   (unless (null-pointer-p location)
 289     (call-next-method)))
 290
 291 (defmethod print-object ((instance proxy) stream)
 292   (print-unreadable-object (instance stream :type t :identity nil)
 293     (if (slot-boundp instance 'location)
 294         (format stream "at 0x~X" (sap-int (foreign-location instance)))
 295       (write-string "at \"unbound\"" stream))))
 296
 297 (defmethod initialize-instance :around ((instance proxy) &rest initargs)
 298   (declare (ignore initargs))
 299   (prog1
 300       (call-next-method)
 301     (cache-instance instance)
 302     (finalize instance (instance-finalizer instance))))
 303
 304 (defmethod instance-finalizer ((instance proxy))
 305   (let ((location (foreign-location instance))
 306         (class (class-of instance)))
 307 ;;     (unless (find-method #'unreference-foreign nil (list (class-of class) t) nil)
 308 ;;       (error "No matching method for UNREFERENCE-INSTANCE when called with class ~A" class))
 309     #'(lambda ()
 310         (remove-cached-instance location)
 311         (unreference-foreign class location))))
 312
 313
 314 ;;;; Metaclass used for subclasses of proxy
 315
 316 (defgeneric most-specific-proxy-superclass (class))
 317 (defgeneric direct-proxy-superclass (class))
 318 (defgeneric compute-foreign-size (class))
 319
 320
 321 (eval-when (:compile-toplevel :load-toplevel :execute)
 322   (defclass proxy-class (virtual-slots-class)
 323     ((size :reader foreign-size)))
 324
 325   (defclass direct-alien-slot-definition (direct-virtual-slot-definition)
 326     ((allocation :initform :alien)
 327      (offset :reader slot-definition-offset :initarg :offset)))
 328
 329   (defclass effective-alien-slot-definition (effective-virtual-slot-definition)
 330     ((offset :reader slot-definition-offset :initarg :offset)))
 331
 332   (defmethod most-specific-proxy-superclass ((class proxy-class))
 333     (find-if
 334      #'(lambda (class)
 335          (subtypep (class-name class) 'proxy))
 336      (cdr (compute-class-precedence-list class))))
 337
 338   (defmethod direct-proxy-superclass ((class proxy-class))
 339     (find-if
 340      #'(lambda (class)
 341          (subtypep (class-name class) 'proxy))
 342      (class-direct-superclasses class)))
 343
 344   (defmethod shared-initialize ((class proxy-class) names &key size)
 345     (call-next-method)
 346     (cond
 347       (size (setf (slot-value class 'size) (first size)))
 348       ((slot-boundp class 'size) (slot-makunbound class 'size))))
 349
 350   (defmethod direct-slot-definition-class ((class proxy-class) &rest initargs)
 351     (case (getf initargs :allocation)
 352       (:alien (find-class 'direct-alien-slot-definition))
 353       (t (call-next-method))))
 354
 355   (defmethod effective-slot-definition-class ((class proxy-class) &rest initargs)
 356     (case (getf initargs :allocation)
 357       (:alien (find-class 'effective-alien-slot-definition))
 358       (t (call-next-method))))
 359
 360
 361   (defmethod compute-effective-slot-definition-initargs ((class proxy-class) direct-slotds)
 362     (if (eq (most-specific-slot-value direct-slotds 'allocation) :alien)
 363         (nconc
 364          (list :offset (most-specific-slot-value direct-slotds 'offset))
 365          (call-next-method))
 366       (call-next-method)))
 367
 368
 369   (defmethod initialize-internal-slot-functions ((slotd effective-alien-slot-definition))
 370     (with-slots (offset) slotd
 371       (let ((type (slot-definition-type slotd)))
 372         (unless (slot-boundp slotd 'getter)
 373           (let ((reader (reader-function type)))
 374             (setf
 375              (slot-value slotd 'getter)
 376              #'(lambda (object)
 377                  (funcall reader (foreign-location object) offset)))))
 378
 379         (unless (slot-boundp slotd 'setter)
 380           (let ((writer (writer-function type))
 381                 (destroy (destroy-function type)))
 382             (setf
 383              (slot-value slotd 'setter)
 384              #'(lambda (value object)
 385                  (let ((location (foreign-location object)))
 386                    (funcall destroy location offset) ; destroy old value
 387                    (funcall writer value location offset))))))))
 388
 389     (call-next-method))
 390
 391   (defmethod compute-foreign-size ((class proxy-class))
 392     nil)
 393
 394   ;; TODO: call some C code to detect this a compile time
 395   (defconstant +struct-alignmen+ 4)
 396
 397   (defun align-offset (size)
 398     (if (zerop (mod size +struct-alignmen+))
 399         size
 400       (+ size (- +struct-alignmen+ (mod size +struct-alignmen+)))))
 401
 402   (defmethod compute-slots ((class proxy-class))
 403     (let ((alien-slots
 404            (remove-if-not
 405             #'(lambda (slotd)
 406                 (eq (slot-definition-allocation slotd) :alien))
 407             (class-direct-slots class))))
 408       (when alien-slots
 409         (loop
 410          as offset = (align-offset (foreign-size
 411                                     (most-specific-proxy-superclass class)))
 412                      then (align-offset
 413                            (+
 414                             (slot-definition-offset slotd)
 415                             (size-of (slot-definition-type slotd))))
 416        for slotd in alien-slots
 417        unless (slot-boundp slotd 'offset)
 418        do (setf (slot-value slotd 'offset) offset))))
 419     (call-next-method))
 420
 421   (defmethod compute-slots :after ((class proxy-class))
 422     (when (and (class-finalized-p class) (not (slot-boundp class 'size)))
 423       (let ((size (compute-foreign-size class)))
 424         (when size
 425           (setf (slot-value class 'size) size)))))
 426
 427   (defmethod validate-superclass ((class proxy-class) (super standard-class))
 428     (subtypep (class-name super) 'proxy))
 429
 430   (defmethod foreign-size ((class-name symbol))
 431     (foreign-size (find-class class-name))))
 432
 433 (defmethod foreign-size ((object proxy))
 434   (foreign-size (class-of object)))
 435
 436
 437 (defmethod alien-type ((class proxy-class) &rest args)
 438   (declare (ignore class args))
 439   (alien-type 'pointer))
 440
 441 (defmethod size-of ((class proxy-class) &rest args)
 442   (declare (ignore class args))
 443   (size-of 'pointer))
 444
 445 (defmethod from-alien-form (location (class proxy-class) &rest args)
 446   (declare (ignore args))
 447   `(ensure-proxy-instance ',(class-name class) ,location))
 448
 449 (defmethod from-alien-function ((class proxy-class) &rest args)
 450   (declare (ignore args))
 451   #'(lambda (location)
 452       (ensure-proxy-instance class location)))
 453
 454 (defmethod to-alien-form (instance (class proxy-class) &rest args)
 455   (declare (ignore class args))
 456   `(foreign-location ,instance))
 457
 458 (defmethod to-alien-function ((class proxy-class) &rest args)
 459   (declare (ignore class args))
 460   #'foreign-location)
 461
 462 (defmethod copy-from-alien-form (location (class proxy-class) &rest args)
 463   (declare (ignore args))
 464   (let ((class-name (class-name class)))
 465     `(ensure-proxy-instance ',class-name
 466       (reference-foreign ',class-name ,location))))
 467
 468 (defmethod copy-from-alien-function ((class proxy-class) &rest args)
 469   (declare (ignore args))
 470   #'(lambda (location)
 471       (ensure-proxy-instance class (reference-foreign class location))))
 472
 473 (defmethod copy-to-alien-form (instance (class proxy-class) &rest args)
 474   (declare (ignore args))
 475   `(reference-foreign ',(class-name class) (foreign-location ,instance)))
 476
 477 (defmethod copy-to-alien-function ((class proxy-class) &rest args)
 478   (declare (ignore args))
 479   #'(lambda (instance)
 480       (reference-foreign class (foreign-location instance))))
 481
 482 (defmethod writer-function ((class proxy-class) &rest args)
 483   (declare (ignore args))
 484   #'(lambda (instance location &optional (offset 0))
 485       (assert (null-pointer-p (sap-ref-sap location offset)))
 486       (setf
 487        (sap-ref-sap location offset)
 488        (reference-foreign class (foreign-location instance)))))
 489
 490 (defmethod reader-function ((class proxy-class) &rest args)
 491   (declare (ignore args))
 492   #'(lambda (location &optional (offset 0))
 493       (let ((instance (sap-ref-sap location offset)))
 494         (unless (null-pointer-p instance)
 495           (ensure-proxy-instance class (reference-foreign class instance))))))
 496
 497 (defmethod destroy-function ((class proxy-class) &rest args)
 498   (declare (ignore args))
 499   #'(lambda (location &optional (offset 0))
 500       (unreference-foreign class (sap-ref-sap location offset))))
 501
 502 (defmethod unbound-value ((class proxy-class) &rest args)
 503   (declare (ignore args))
 504   (values t nil))
 505
 506 (defun ensure-proxy-instance (class location &rest initargs)
 507   "Returns a proxy object representing the foreign object at the give
 508 location. If an existing object is not found in the cache
 509 MAKE-PROXY-INSTANCE is called to create one."
 510   (unless (null-pointer-p location)
 511     (or
 512      (find-cached-instance location)
 513      (let ((instance (apply #'make-proxy-instance class location initargs)))
 514        (cache-instance instance)
 515        instance))))
 516
 517 (defgeneric make-proxy-instance (class location &key weak)
 518   (:documentation "Creates a new proxy object representing the foreign
 519 object at the give location. If WEAK is non NIL the foreign memory
 520 will not be released when the proxy is garbage collected."))
 521
 522 (defmethod make-proxy-instance ((class symbol) location &key weak)
 523   (ensure-proxy-instance (find-class class) location :weak weak))
 524
 525 (defmethod make-proxy-instance ((class proxy-class) location &key weak)
 526   (declare (ignore weak-p))
 527   (let ((instance (allocate-instance class)))
 528     (setf (slot-value instance 'location) location)
 529     (unless weak
 530       (finalize instance (instance-finalizer instance)))
 531     instance))
 532
 533
 534 ;;;; Superclasses for wrapping of C structures
 535
 536 (defclass struct (proxy)
 537   ()
 538   (:metaclass proxy-class)
 539   (:size 0))
 540
 541 (defmethod initialize-instance ((struct struct) &rest initargs)
 542   (declare (ignore initargs))
 543   (unless (slot-boundp struct 'location)
 544     (let ((size (foreign-size (class-of struct))))
 545       (if (zerop size)
 546           (error "~A has zero size" (class-of struct))
 547         (setf (slot-value struct 'location) (allocate-memory size)))))
 548   (call-next-method))
 549
 550
 551 ;;;; Metaclasses used for subclasses of struct
 552
 553 (defclass struct-class (proxy-class)
 554   ())
 555
 556 (defmethod direct-slot-definition-class ((class struct-class) &rest initargs)
 557   (if (not (getf initargs :allocation))
 558       (find-class 'direct-alien-slot-definition)
 559     (call-next-method)))
 560
 561 (defmethod reference-foreign ((class struct-class) location)
 562   (copy-memory location (foreign-size class)))
 563
 564 (defmethod unreference-foreign ((class struct-class) location)
 565   (deallocate-memory location))
 566
 567 (defmethod compute-foreign-size ((class struct-class))
 568   (let ((size (loop
 569                for slotd in (class-slots class)
 570                when (eq (slot-definition-allocation slotd) :alien)
 571                maximize (+
 572                          (slot-definition-offset slotd)
 573                          (size-of (slot-definition-type slotd))))))
 574     (+ size (mod size +struct-alignmen+))))
 575
 576
 577 (defclass static-struct-class (struct-class)
 578   ())
 579
 580 (defmethod reference-foreign ((class static-struct-class) location)
 581   (declare (ignore class))
 582   location)
 583
 584 (defmethod unreference-foreign ((class static-struct-class) location)
 585   (declare (ignore class location))
 586   nil)
 587
 588
 589 ;;; Pseudo type for structs which are inlined in other objects
 590
 591 (defmethod size-of ((type (eql 'inlined)) &rest args)
 592   (declare (ignore type))
 593   (foreign-size (first args)))
 594
 595 (defmethod reader-function ((type (eql 'inlined)) &rest args)
 596   (declare (ignore type))
 597   (destructuring-bind (class) args
 598     #'(lambda (location &optional (offset 0))
 599         (ensure-proxy-instance class
 600          (reference-foreign class (sap+ location offset))))))
 601
 602 (defmethod destroy-function ((type (eql 'inlined)) &rest args)
 603   (declare (ignore args))
 604   #'(lambda (location &optional (offset 0))
 605       (declare (ignore location offset))))
 606
 607 (export 'inlined)