src/compiler/ppc/c-call.lisp

   1 ;;;; VOPs and other machine-specific support routines for call-out to C
   2
   3 ;;;; This software is part of the SBCL system. See the README file for
   4 ;;;; more information.
   5 ;;;;
   6 ;;;; This software is derived from the CMU CL system, which was
   7 ;;;; written at Carnegie Mellon University and released into the
   8 ;;;; public domain. The software is in the public domain and is
   9 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
  10 ;;;; files for more information.
  11
  12 (in-package "SB!VM")
  13
  14 ;;; Return the number of bytes needed for the current non-descriptor
  15 ;;; stack frame.  Non-descriptor stack frames must be multiples of 16
  16 ;;; bytes under the PPC SVr4 ABI (though the EABI may be less
  17 ;;; restrictive).  On linux, two words are reserved for the stack
  18 ;;; backlink and saved LR (see SB!VM::NUMBER-STACK-DISPLACEMENT).
  19
  20 (defconstant +stack-alignment-bytes+
  21   ;; Duh.  PPC Linux (and VxWorks) adhere to the EABI.
  22   #!-darwin 7
  23   ;; But Darwin doesn't
  24   #!+darwin 15)
  25
  26 (defun my-make-wired-tn (prim-type-name sc-name offset)
  27   (make-wired-tn (primitive-type-or-lose prim-type-name)
  28                  (sc-number-or-lose sc-name)
  29                  offset))
  30
  31 (defstruct arg-state
  32   (gpr-args 0)
  33   (fpr-args 0)
  34   ;; SVR4 [a]abi wants two words on stack (callee saved lr,
  35   ;; backpointer).
  36   #!-darwin (stack-frame-size 2)
  37   ;; PowerOpen ABI wants 8 words on the stack corresponding to GPR3-10
  38   ;; in addition to the 6 words of link area (see number-stack-displacement)
  39   #!+darwin (stack-frame-size (+ 8 6)))
  40
  41 (defun int-arg (state prim-type reg-sc stack-sc)
  42   (let ((reg-args (arg-state-gpr-args state)))
  43     (cond ((< reg-args 8)
  44            (setf (arg-state-gpr-args state) (1+ reg-args))
  45            (my-make-wired-tn prim-type reg-sc (+ reg-args nl0-offset)))
  46           (t
  47            (let ((frame-size (arg-state-stack-frame-size state)))
  48              (setf (arg-state-stack-frame-size state) (1+ frame-size))
  49              (my-make-wired-tn prim-type stack-sc frame-size))))))
  50
  51 (define-alien-type-method (integer :arg-tn) (type state)
  52   (if (alien-integer-type-signed type)
  53       (int-arg state 'signed-byte-32 'signed-reg 'signed-stack)
  54       (int-arg state 'unsigned-byte-32 'unsigned-reg 'unsigned-stack)))
  55
  56 (define-alien-type-method (system-area-pointer :arg-tn) (type state)
  57   (declare (ignore type))
  58   (int-arg state 'system-area-pointer 'sap-reg 'sap-stack))
  59
  60 ;;; If a single-float arg has to go on the stack, it's promoted to
  61 ;;; double.  That way, C programs can get subtle rounding errors when
  62 ;;; unrelated arguments are introduced.
  63
  64 #!-darwin
  65 (define-alien-type-method (single-float :arg-tn) (type state)
  66   (declare (ignore type))
  67   (let* ((fprs (arg-state-fpr-args state)))
  68     (cond ((< fprs 8)
  69            (incf (arg-state-fpr-args state))
  70            ;; Assign outgoing FPRs starting at FP1
  71            (my-make-wired-tn 'single-float 'single-reg (1+ fprs)))
  72           (t
  73            (let* ((stack-offset (arg-state-stack-frame-size state)))
  74              (if (oddp stack-offset)
  75                (incf stack-offset))
  76              (setf (arg-state-stack-frame-size state) (+ stack-offset 2))
  77              (my-make-wired-tn 'double-float 'double-stack stack-offset))))))
  78
  79 #!+darwin
  80 (define-alien-type-method (single-float :arg-tn) (type state)
  81   (declare (ignore type))
  82   (let* ((fprs (arg-state-fpr-args state))
  83          (gprs (arg-state-gpr-args state)))
  84     (cond ((< gprs 8) ; and by implication also (< fprs 13)
  85            ;; Corresponding GPR is kept empty for functions with fixed args
  86            (incf (arg-state-gpr-args state))
  87            (incf (arg-state-fpr-args state))
  88            ;; Assign outgoing FPRs starting at FP1
  89            (my-make-wired-tn 'single-float 'single-reg (1+ fprs)))
  90           ((< fprs 13)
  91            ;; According to PowerOpen ABI, we need to pass those both in the
  92            ;; FPRs _and_ the stack.  However empiric testing on OS X/gcc
  93            ;; shows they are only passed in FPRs, AFAICT.
  94            ;;
  95            ;; "I" in "AFAICT" probably refers to PRM.  -- CSR, still
  96            ;; reverse-engineering comments in 2003 :-)
  97            (incf (arg-state-fpr-args state))
  98            (incf (arg-state-stack-frame-size state))
  99            (my-make-wired-tn 'single-float 'single-reg (1+ fprs)))
 100           (t
 101            ;; Pass on stack only
 102            (let ((stack-offset (arg-state-stack-frame-size state)))
 103              (incf (arg-state-stack-frame-size state))
 104              (my-make-wired-tn 'single-float 'single-stack stack-offset))))))
 105 #!-darwin
 106 (define-alien-type-method (double-float :arg-tn) (type state)
 107   (declare (ignore type))
 108   (let* ((fprs (arg-state-fpr-args state)))
 109     (cond ((< fprs 8)
 110            (incf (arg-state-fpr-args state))
 111            ;; Assign outgoing FPRs starting at FP1
 112            (my-make-wired-tn 'double-float 'double-reg (1+ fprs)))
 113           (t
 114            (let* ((stack-offset (arg-state-stack-frame-size state)))
 115              (if (oddp stack-offset)
 116                (incf stack-offset))
 117              (setf (arg-state-stack-frame-size state) (+ stack-offset 2))
 118              (my-make-wired-tn 'double-float 'double-stack stack-offset))))))
 119
 120 #!+darwin
 121 (define-alien-type-method (double-float :arg-tn) (type state)
 122   (declare (ignore type))
 123   (let ((fprs (arg-state-fpr-args state))
 124         (gprs (arg-state-gpr-args state)))
 125     (cond ((< gprs 8) ; and by implication also (< fprs 13)
 126            ;; Corresponding GPRs are also kept empty
 127            (incf (arg-state-gpr-args state) 2)
 128            (when (> (arg-state-gpr-args state) 8)
 129              ;; Spill one word to stack
 130              (decf (arg-state-gpr-args state))
 131              (incf (arg-state-stack-frame-size state)))
 132            (incf (arg-state-fpr-args state))
 133            ;; Assign outgoing FPRs starting at FP1
 134            (my-make-wired-tn 'double-float 'double-reg (1+ fprs)))
 135           ((< fprs 13)
 136            ;; According to PowerOpen ABI, we need to pass those both in the
 137            ;; FPRs _and_ the stack.  However empiric testing on OS X/gcc
 138            ;; shows they are only passed in FPRs, AFAICT.
 139            (incf (arg-state-stack-frame-size state) 2)
 140            (incf (arg-state-fpr-args state))
 141            (my-make-wired-tn 'double-float 'double-reg (1+ fprs)))
 142           (t
 143            ;; Pass on stack only
 144            (let ((stack-offset (arg-state-stack-frame-size state)))
 145              (incf (arg-state-stack-frame-size state) 2)
 146              (my-make-wired-tn 'double-float 'double-stack stack-offset))))))
 147
 148 ;;; Result state handling
 149
 150 (defstruct result-state
 151   (num-results 0))
 152
 153 (defun result-reg-offset (slot)
 154   (ecase slot
 155     (0 nl0-offset)
 156     (1 nl1-offset)))
 157
 158 ;;; FIXME: These #!-DARWIN methods should be adjusted to take a state
 159 ;;; argument, firstly because that's our "official" API (see
 160 ;;; src/code/host-alieneval) and secondly because that way we can
 161 ;;; probably have less duplication of code.  -- CSR, 2003-07-29
 162
 163 #!-darwin
 164 (define-alien-type-method (system-area-pointer :result-tn) (type)
 165   (declare (ignore type))
 166   (my-make-wired-tn 'system-area-pointer 'sap-reg nl0-offset))
 167
 168 #!+darwin
 169 (define-alien-type-method (system-area-pointer :result-tn) (type state)
 170   (declare (ignore type))
 171   (let ((num-results (result-state-num-results state)))
 172     (setf (result-state-num-results state) (1+ num-results))
 173     (my-make-wired-tn 'system-area-pointer 'sap-reg
 174                       (result-reg-offset num-results))))
 175
 176 #!-darwin
 177 (define-alien-type-method (single-float :result-tn) (type)
 178   (declare (ignore type state))
 179   (my-make-wired-tn 'single-float 'single-reg 1))
 180
 181 #!+darwin
 182 (define-alien-type-method (single-float :result-tn) (type state)
 183   (declare (ignore type state))
 184   (my-make-wired-tn 'single-float 'single-reg 1))
 185
 186 #!-darwin
 187 (define-alien-type-method (double-float :result-tn) (type)
 188   (declare (ignore type))
 189   (my-make-wired-tn 'double-float 'double-reg 1))
 190
 191 #!+darwin
 192 (define-alien-type-method (double-float :result-tn) (type state)
 193   (declare (ignore type state))
 194   (my-make-wired-tn 'double-float 'double-reg 1))
 195
 196 #!-darwin
 197 (define-alien-type-method (values :result-tn) (type)
 198   (mapcar #'(lambda (type)
 199               (invoke-alien-type-method :result-tn type))
 200           (alien-values-type-values type)))
 201
 202 #!+darwin
 203 (define-alien-type-method (values :result-tn) (type state)
 204   (let ((values (alien-values-type-values type)))
 205     (when (> (length values) 2)
 206       (error "Too many result values from c-call."))
 207     (mapcar #'(lambda (type)
 208                 (invoke-alien-type-method :result-tn type state))
 209             values)))
 210 #!-darwin
 211 (define-alien-type-method (integer :result-tn) (type)
 212   (if (alien-integer-type-signed type)
 213       (my-make-wired-tn 'signed-byte-32 'signed-reg nl0-offset)
 214       (my-make-wired-tn 'unsigned-byte-32 'unsigned-reg nl0-offset)))
 215
 216 #!+darwin
 217 (define-alien-type-method (integer :result-tn) (type state)
 218   (let ((num-results (result-state-num-results state)))
 219     (setf (result-state-num-results state) (1+ num-results))
 220     (multiple-value-bind (ptype reg-sc)
 221         (if (alien-integer-type-signed type)
 222             (values 'signed-byte-32 'signed-reg)
 223             (values 'unsigned-byte-32 'unsigned-reg))
 224       (my-make-wired-tn ptype reg-sc (result-reg-offset num-results)))))
 225
 226
 227 (!def-vm-support-routine make-call-out-tns (type)
 228   (declare (type alien-fun-type type))
 229   (let ((arg-state (make-arg-state)))
 230     (collect ((arg-tns))
 231       (dolist (arg-type (alien-fun-type-arg-types type))
 232         (arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state)))
 233       (values (my-make-wired-tn 'positive-fixnum 'any-reg nsp-offset)
 234               (* (arg-state-stack-frame-size arg-state) n-word-bytes)
 235               (arg-tns)
 236               (invoke-alien-type-method
 237                :result-tn
 238                (alien-fun-type-result-type type)
 239                #!+darwin (make-result-state))))))
 240
 241 #!+darwin
 242 (deftransform %alien-funcall ((function type &rest args))
 243   (aver (sb!c::constant-lvar-p type))
 244   (let* ((type (sb!c::lvar-value type))
 245          (arg-types (alien-fun-type-arg-types type))
 246          (result-type (alien-fun-type-result-type type)))
 247     (aver (= (length arg-types) (length args)))
 248     ;; We need to do something special for 64-bit integer arguments
 249     ;; and results.
 250     (if (or (some #'(lambda (type)
 251                       (and (alien-integer-type-p type)
 252                            (> (sb!alien::alien-integer-type-bits type) 32)))
 253                   arg-types)
 254             (and (alien-integer-type-p result-type)
 255                  (> (sb!alien::alien-integer-type-bits result-type) 32)))
 256         (collect ((new-args) (lambda-vars) (new-arg-types))
 257                  (dolist (type arg-types)
 258                    (let ((arg (gensym)))
 259                      (lambda-vars arg)
 260                      (cond ((and (alien-integer-type-p type)
 261                                  (> (sb!alien::alien-integer-type-bits type) 32))
 262                             ;; 64-bit long long types are stored in
 263                             ;; consecutive locations, most significant word
 264                             ;; first (big-endian).
 265                             (new-args `(ash ,arg -32))
 266                             (new-args `(logand ,arg #xffffffff))
 267                             (if (alien-integer-type-signed type)
 268                                 (new-arg-types (parse-alien-type '(signed 32) (sb!kernel:make-null-lexenv)))
 269                                 (new-arg-types (parse-alien-type '(unsigned 32) (sb!kernel:make-null-lexenv))))
 270                             (new-arg-types (parse-alien-type '(unsigned 32) (sb!kernel:make-null-lexenv))))
 271                            (t
 272                             (new-args arg)
 273                             (new-arg-types type)))))
 274                  (cond ((and (alien-integer-type-p result-type)
 275                              (> (sb!alien::alien-integer-type-bits result-type) 32))
 276                         (let ((new-result-type
 277                                (let ((sb!alien::*values-type-okay* t))
 278                                  (parse-alien-type
 279                                   (if (alien-integer-type-signed result-type)
 280                                       '(values (signed 32) (unsigned 32))
 281                                       '(values (unsigned 32) (unsigned 32)))
 282                                   (sb!kernel:make-null-lexenv)))))
 283                           `(lambda (function type ,@(lambda-vars))
 284                             (declare (ignore type))
 285                             (multiple-value-bind (high low)
 286                                 (%alien-funcall function
 287                                                 ',(make-alien-fun-type
 288                                                    :arg-types (new-arg-types)
 289                                                    :result-type new-result-type)
 290                                                 ,@(new-args))
 291                               (logior low (ash high 32))))))
 292                        (t
 293                         `(lambda (function type ,@(lambda-vars))
 294                           (declare (ignore type))
 295                           (%alien-funcall function
 296                            ',(make-alien-fun-type
 297                               :arg-types (new-arg-types)
 298                               :result-type result-type)
 299                            ,@(new-args))))))
 300         (sb!c::give-up-ir1-transform))))
 301
 302 (define-vop (foreign-symbol-sap)
 303   (:translate foreign-symbol-sap)
 304   (:policy :fast-safe)
 305   (:args)
 306   (:arg-types (:constant simple-string))
 307   (:info foreign-symbol)
 308   (:results (res :scs (sap-reg)))
 309   (:result-types system-area-pointer)
 310   (:generator 2
 311     (inst lr res  (make-fixup foreign-symbol :foreign))))
 312
 313 #!+linkage-table
 314 (define-vop (foreign-symbol-dataref-sap)
 315   (:translate foreign-symbol-dataref-sap)
 316   (:policy :fast-safe)
 317   (:args)
 318   (:arg-types (:constant simple-string))
 319   (:info foreign-symbol)
 320   (:results (res :scs (sap-reg)))
 321   (:result-types system-area-pointer)
 322   (:temporary (:scs (non-descriptor-reg)) addr)
 323   (:generator 2
 324     (inst lr addr (make-fixup foreign-symbol :foreign-dataref))
 325     (loadw res addr)))
 326
 327 (define-vop (call-out)
 328   (:args (function :scs (sap-reg) :target cfunc)
 329          (args :more t))
 330   (:results (results :more t))
 331   (:ignore args results)
 332   (:save-p t)
 333   (:temporary (:sc any-reg :offset cfunc-offset
 334                    :from (:argument 0) :to (:result 0)) cfunc)
 335   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
 336   (:temporary (:scs (non-descriptor-reg)) temp)
 337   (:vop-var vop)
 338   (:generator 0
 339     (let ((cur-nfp (current-nfp-tn vop)))
 340       (when cur-nfp
 341         (store-stack-tn nfp-save cur-nfp))
 342       (inst lr temp (make-fixup "call_into_c" :foreign))
 343       (inst mtctr temp)
 344       (move cfunc function)
 345       (inst bctrl)
 346       (when cur-nfp
 347         (load-stack-tn cur-nfp nfp-save)))))
 348
 349
 350 (define-vop (alloc-number-stack-space)
 351   (:info amount)
 352   (:results (result :scs (sap-reg any-reg)))
 353   (:temporary (:scs (unsigned-reg) :to (:result 0)) temp)
 354   (:generator 0
 355     (unless (zerop amount)
 356       ;; FIXME: I don't understand why we seem to be adding
 357       ;; NUMBER-STACK-DISPLACEMENT twice here.  Weird.  -- CSR,
 358       ;; 2003-08-20
 359       (let ((delta (- (logandc2 (+ amount number-stack-displacement
 360                                    +stack-alignment-bytes+)
 361                                 +stack-alignment-bytes+))))
 362         (cond ((>= delta (ash -1 16))
 363                (inst stwu nsp-tn nsp-tn delta))
 364               (t
 365                (inst lr temp delta)
 366                (inst stwux  nsp-tn nsp-tn temp)))))
 367     (unless (location= result nsp-tn)
 368       ;; They are only location= when the result tn was allocated by
 369       ;; make-call-out-tns above, which takes the number-stack-displacement
 370       ;; into account itself.
 371       (inst addi result nsp-tn number-stack-displacement))))
 372
 373 (define-vop (dealloc-number-stack-space)
 374   (:info amount)
 375   (:policy :fast-safe)
 376   (:generator 0
 377     (unless (zerop amount)
 378       (let ((delta (logandc2 (+ amount number-stack-displacement
 379                                 +stack-alignment-bytes+)
 380                              +stack-alignment-bytes+)))
 381         (cond ((< delta (ash 1 16))
 382                (inst addi nsp-tn nsp-tn delta))
 383               (t
 384                (inst lwz nsp-tn nsp-tn 0)))))))
 385
 386 #-sb-xc-host
 387 (progn
 388   (defun alien-callback-accessor-form (type sap offset)
 389     ;; Unaligned access is slower, but possible, so this is nice and simple.
 390     `(deref (sap-alien (sap+ ,sap ,offset) (* ,type))))
 391
 392   ;;; The "Mach-O Runtime Conventions" document for OS X almost specifies
 393   ;;; the calling convention (it neglects to mention that the linkage
 394   ;;; area is 24 bytes).
 395   (defconstant n-foreign-linkage-area-bytes 24)
 396
 397   ;;; Returns a vector in static space containing machine code for the
 398   ;;; callback wrapper
 399   (defun alien-callback-assembler-wrapper (index result-type argument-types)
 400     (flet ((make-gpr (n)
 401              (make-random-tn :kind :normal :sc (sc-or-lose 'any-reg) :offset n))
 402            (make-fpr (n)
 403              (make-random-tn :kind :normal :sc (sc-or-lose 'double-reg) :offset n)))
 404       (let* ((segment (make-segment)))
 405         (assemble (segment)
 406           ;; To save our arguments, we follow the algorithm sketched in the
 407           ;; "PowerPC Calling Conventions" section of that document.
 408           (let ((words-processed 0)
 409                 (gprs (mapcar #'make-gpr '(3 4 5 6 7 8 9 10)))
 410                 (fprs (mapcar #'make-fpr '(1 2 3 4 5 6 7 8 9 10 11 12 13)))
 411                 (stack-pointer (make-gpr 1)))
 412             (labels ((out-of-registers-error ()
 413                        (error "Too many arguments in callback"))
 414                      (save-arg (type words)
 415                        (let ((integerp (not (alien-float-type-p type)))
 416                              (offset (+ (* words-processed n-word-bytes)
 417                                         n-foreign-linkage-area-bytes)))
 418                          (cond (integerp
 419                                 (loop repeat words
 420                                    for gpr = (pop gprs)
 421                                    do
 422                                      (if gpr
 423                                          (inst stw gpr stack-pointer offset)
 424                                          (out-of-registers-error))
 425                                      (incf words-processed)))
 426                              ;; The handling of floats is a little ugly
 427                              ;; because we hard-code the number of words
 428                                ;; for single- and double-floats.
 429                                ((alien-single-float-type-p type)
 430                                 (pop gprs)
 431                                 (let ((fpr (pop fprs)))
 432                                   (if fpr
 433                                       (inst stfs fpr stack-pointer offset)
 434                                       (out-of-registers-error)))
 435                                 (incf words-processed))
 436                                ((alien-double-float-type-p type)
 437                                 (setf gprs (cddr gprs))
 438                                 (let ((fpr (pop fprs)))
 439                                   (if fpr
 440                                       (inst stfd fpr stack-pointer offset)
 441                                       (out-of-registers-error)))
 442                                 (incf words-processed 2))
 443                                (t
 444                                 (bug "Unknown alien floating point type: ~S" type))))))
 445               (mapc #'save-arg
 446                     argument-types
 447                     (mapcar (lambda (arg)
 448                               (ceiling (alien-type-bits arg) n-word-bits))
 449                             argument-types))))
 450           ;; Set aside room for the return area just below sp, then
 451           ;; actually call funcall3: funcall3 (call-alien-function,
 452           ;; index, args, return-area)
 453           ;;
 454           ;; INDEX is fixnumized, ARGS and RETURN-AREA don't need to be
 455           ;; because they're word-aligned. Kinda gross, but hey ...
 456           (let* ((n-return-area-words
 457                   (ceiling (or (alien-type-bits result-type) 0) n-word-bits))
 458                  (n-return-area-bytes (* n-return-area-words n-word-bytes))
 459                  ;; FIXME: magic constant, and probably n-args-bytes
 460                  (args-size (* 3 n-word-bytes))
 461                  ;; FIXME: n-frame-bytes?
 462                  (frame-size (logandc2 (+ n-foreign-linkage-area-bytes
 463                                           n-return-area-bytes
 464                                           args-size
 465                                           +stack-alignment-bytes+)
 466                                        +stack-alignment-bytes+)))
 467             (destructuring-bind (sp r0 arg1 arg2 arg3 arg4)
 468                 (mapcar #'make-gpr '(1 0 3 4 5 6))
 469               (flet ((load-address-into (reg addr)
 470                        (let ((high (ldb (byte 16 16) addr))
 471                              (low (ldb (byte 16 0) addr)))
 472                          (inst li reg high)
 473                          (inst slwi reg reg 16)
 474                          (inst ori reg reg low))))
 475                 ;; Setup the args
 476                 (load-address-into
 477                  arg1 (get-lisp-obj-address #'enter-alien-callback))
 478                 (inst li arg2 (fixnumize index))
 479                 (inst addi arg3 sp n-foreign-linkage-area-bytes)
 480                 ;; FIXME: This was (- (* RETURN-AREA-SIZE N-WORD-BYTES)), while
 481                 ;; RETURN-AREA-SIZE was (* N-RETURN-AREA-WORDS N-WORD-BYTES):
 482                 ;; I assume the intention was (- N-RETURN-AREA-BYTES), but who knows?
 483                 ;; --NS 2005-06-11
 484                 (inst addi arg4 sp (- n-return-area-bytes))
 485                 ;; FIXME! FIXME FIXME: What does this FIXME refer to?
 486                 ;; Save sp, setup the frame
 487                 (inst mflr r0)
 488                 (inst stw r0 sp (* 2 n-word-bytes)) ; FIXME: magic constant
 489                 (inst stwu sp sp (- frame-size))
 490                 ;; Make the call
 491                 (load-address-into r0 (foreign-symbol-address "funcall3"))
 492                 (inst mtlr r0)
 493                 (inst blrl))
 494               ;; We're back!  Restore sp and lr, load the return value from just
 495               ;; under sp, and return.
 496               (inst lwz sp sp 0)
 497               (inst lwz r0 sp (* 2 n-word-bytes))
 498               (inst mtlr r0)
 499               (loop with gprs = (mapcar #'make-gpr '(3 4))
 500                  repeat n-return-area-words
 501                  for gpr = (pop gprs)
 502                  for offset downfrom (- n-word-bytes) by n-word-bytes
 503                  do
 504                    (unless gpr
 505                      (bug "Out of return registers in alien-callback trampoline."))
 506                    (inst lwz gpr sp offset))
 507               (inst blr))))
 508         (finalize-segment segment)
 509         ;; Now that the segment is done, convert it to a static
 510         ;; vector we can point foreign code to.
 511         (let ((buffer (sb!assem::segment-buffer segment)))
 512           (make-static-vector (length buffer)
 513                               :element-type '(unsigned-byte 8)
 514                               :initial-contents buffer))))))