1 ;;;; the VOPs and other necessary machine specific support
2 ;;;; routines for call-out to C
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; This software is derived from the CMU CL system, which was
8 ;;;; written at Carnegie Mellon University and released into the
9 ;;;; public domain. The software is in the public domain and is
10 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
11 ;;;; files for more information.
15 ;; The MOVE-ARG vop is going to store args on the stack for
16 ;; call-out. These tn's will be used for that. move-arg is normally
17 ;; used for things going down the stack but C wants to have args
18 ;; indexed in the positive direction.
20 (defstruct (arg-state (:copier nil
))
24 (declaim (freeze-type arg-state
))
26 (defconstant max-int-args
#.
(length *c-call-register-arg-offsets
*))
27 (defconstant max-xmm-args
#+win32
4 #-win32
8)
29 (defun int-arg (state prim-type reg-sc stack-sc
)
30 (let ((reg-args (max (arg-state-register-args state
)
31 #+win32
(arg-state-xmm-args state
))))
32 (cond ((< reg-args max-int-args
)
33 (setf (arg-state-register-args state
) (1+ reg-args
))
34 (make-wired-tn* prim-type reg-sc
35 (nth reg-args
*c-call-register-arg-offsets
*)))
37 (let ((frame-size (arg-state-stack-frame-size state
)))
38 (setf (arg-state-stack-frame-size state
) (1+ frame-size
))
39 (make-wired-tn* prim-type stack-sc frame-size
))))))
41 (define-alien-type-method (integer :arg-tn
) (type state
)
42 (if (alien-integer-type-signed type
)
43 (int-arg state
'signed-byte-64 signed-reg-sc-number signed-stack-sc-number
)
44 (int-arg state
'unsigned-byte-64 unsigned-reg-sc-number unsigned-stack-sc-number
)))
46 (define-alien-type-method (system-area-pointer :arg-tn
) (type state
)
47 (declare (ignore type
))
48 (int-arg state
'system-area-pointer sap-reg-sc-number sap-stack-sc-number
))
50 (defun float-arg (state prim-type reg-sc stack-sc
)
51 (let ((xmm-args (max (arg-state-xmm-args state
)
52 #+win32
(arg-state-register-args state
))))
53 (cond ((< xmm-args max-xmm-args
)
54 (setf (arg-state-xmm-args state
) (1+ xmm-args
))
55 (make-wired-tn* prim-type reg-sc
56 (nth xmm-args
*float-regs
*)))
58 (let ((frame-size (arg-state-stack-frame-size state
)))
59 (setf (arg-state-stack-frame-size state
) (1+ frame-size
))
60 (make-wired-tn* prim-type stack-sc frame-size
))))))
62 (define-alien-type-method (double-float :arg-tn
) (type state
)
63 (declare (ignore type
))
64 (float-arg state
'double-float double-reg-sc-number double-stack-sc-number
))
66 (define-alien-type-method (single-float :arg-tn
) (type state
)
67 (declare (ignore type
))
68 (float-arg state
'single-float single-reg-sc-number single-stack-sc-number
))
70 (defstruct (result-state (:copier nil
))
72 (declaim (freeze-type result-state
))
74 (defun result-reg-offset (slot)
79 (define-alien-type-method (integer :result-tn
) (type state
)
80 (let ((num-results (result-state-num-results state
)))
81 (setf (result-state-num-results state
) (1+ num-results
))
82 (multiple-value-bind (ptype reg-sc
)
83 (if (alien-integer-type-signed type
)
84 (values 'signed-byte-64 signed-reg-sc-number
)
85 (values 'unsigned-byte-64 unsigned-reg-sc-number
))
86 (make-wired-tn* ptype reg-sc
(result-reg-offset num-results
)))))
88 (define-alien-type-method (integer :naturalize-gen
) (type alien
)
89 (if (<= (alien-type-bits type
) 32)
90 (if (alien-integer-type-signed type
)
91 `(sign-extend ,alien
,(alien-type-bits type
))
92 `(logand ,alien
,(1- (ash 1 (alien-type-bits type
)))))
95 (define-alien-type-method (system-area-pointer :result-tn
) (type state
)
96 (declare (ignore type
))
97 (let ((num-results (result-state-num-results state
)))
98 (setf (result-state-num-results state
) (1+ num-results
))
99 (make-wired-tn* 'system-area-pointer sap-reg-sc-number
100 (result-reg-offset num-results
))))
102 (define-alien-type-method (double-float :result-tn
) (type state
)
103 (declare (ignore type
))
104 (let ((num-results (result-state-num-results state
)))
105 (setf (result-state-num-results state
) (1+ num-results
))
106 (make-wired-tn* 'double-float double-reg-sc-number num-results
)))
108 (define-alien-type-method (single-float :result-tn
) (type state
)
109 (declare (ignore type
))
110 (let ((num-results (result-state-num-results state
)))
111 (setf (result-state-num-results state
) (1+ num-results
))
112 (make-wired-tn* 'single-float single-reg-sc-number num-results
)))
114 (define-alien-type-method (values :result-tn
) (type state
)
115 (let ((values (alien-values-type-values type
)))
116 (when (> (length values
) 2)
117 (error "Too many result values from c-call."))
118 (mapcar (lambda (type)
119 (invoke-alien-type-method :result-tn type state
))
122 (defun make-call-out-tns (type)
123 (let ((arg-state (make-arg-state)))
125 (dolist (arg-type (alien-fun-type-arg-types type
))
126 (arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state
)))
127 (values (make-wired-tn* 'positive-fixnum any-reg-sc-number rsp-offset
)
128 (* (arg-state-stack-frame-size arg-state
) n-word-bytes
)
130 (invoke-alien-type-method :result-tn
131 (alien-fun-type-result-type type
)
132 (make-result-state))))))
135 (deftransform %alien-funcall
((function type
&rest args
) * * :node node
)
136 (aver (sb-c:constant-lvar-p type
))
137 (let* ((type (sb-c:lvar-value type
))
138 (env (sb-c::node-lexenv node
))
139 (arg-types (alien-fun-type-arg-types type
))
140 (result-type (alien-fun-type-result-type type
)))
141 (aver (= (length arg-types
) (length args
)))
142 (if (or (some #'(lambda (type)
143 (and (alien-integer-type-p type
)
144 (> (sb-alien::alien-integer-type-bits type
) 64)))
146 (and (alien-integer-type-p result-type
)
147 (> (sb-alien::alien-integer-type-bits result-type
) 64)))
148 (collect ((new-args) (lambda-vars) (new-arg-types))
149 (dolist (type arg-types
)
150 (let ((arg (gensym)))
152 (cond ((and (alien-integer-type-p type
)
153 (> (sb-alien::alien-integer-type-bits type
) 64))
154 ;; CLH: FIXME! This should really be
155 ;; #xffffffffffffffff. nyef says: "Passing
156 ;; 128-bit integers to ALIEN functions on x86-64
157 ;; believed to be broken."
158 (new-args `(logand ,arg
#xffffffff
))
159 (new-args `(ash ,arg -
64))
160 (new-arg-types (parse-alien-type '(unsigned 64) env
))
161 (if (alien-integer-type-signed type
)
162 (new-arg-types (parse-alien-type '(signed 64) env
))
163 (new-arg-types (parse-alien-type '(unsigned 64) env
))))
166 (new-arg-types type
)))))
167 (cond ((and (alien-integer-type-p result-type
)
168 (> (sb-alien::alien-integer-type-bits result-type
) 64))
169 (let ((new-result-type
170 (let ((sb-alien::*values-type-okay
* t
))
172 (if (alien-integer-type-signed result-type
)
173 '(values (unsigned 64) (signed 64))
174 '(values (unsigned 64) (unsigned 64)))
176 `(lambda (function type
,@(lambda-vars))
177 (declare (ignore type
))
178 (multiple-value-bind (low high
)
179 (%alien-funcall function
180 ',(make-alien-fun-type
181 :arg-types
(new-arg-types)
182 :result-type new-result-type
)
184 (logior low
(ash high
64))))))
186 `(lambda (function type
,@(lambda-vars))
187 (declare (ignore type
))
188 (%alien-funcall function
189 ',(make-alien-fun-type
190 :arg-types
(new-arg-types)
191 :result-type result-type
)
193 (sb-c::give-up-ir1-transform
))))
195 ;;; The ABI is vague about how signed sub-word integer return values
196 ;;; are handled, but since gcc versions >=4.3 no longer do sign
197 ;;; extension in the callee, we need to do it in the caller. FIXME:
198 ;;; If the value to be extended is known to already be of the target
199 ;;; type at compile time, we can (and should) elide the extension.
200 (defknown sign-extend
((signed-byte 64) t
) fixnum
201 (foldable flushable movable
))
203 (defoptimizer (sign-extend derive-type
) ((x size
))
204 (when (sb-c:constant-lvar-p size
)
205 (specifier-type `(signed-byte ,(sb-c:lvar-value size
)))))
207 (define-vop (sign-extend)
208 (:translate sign-extend
)
210 (:args
(val :scs
(signed-reg)))
211 (:arg-types signed-num
(:constant fixnum
))
213 (:results
(res :scs
(signed-reg)))
214 (:result-types fixnum
)
216 (inst movsx
`(,(ecase size
(8 :byte
) (16 :word
) (32 :dword
)) :qword
) res val
)))
219 (defun sign-extend (x size
)
220 (declare (type (signed-byte 64) x
))
222 (8 (sign-extend x size
))
223 (16 (sign-extend x size
))
224 (32 (sign-extend x size
))))
226 ;;; Note that if jumping _to_ the linkage entry, the jump is to the JMP instruction
227 ;;; at entry + 0, but if jumping _via_ the linkage index, we can jump to [entry+8]
228 ;;; which holds the ultimate address to jump to.
229 (define-vop (foreign-symbol-sap)
230 (:translate foreign-symbol-sap
)
233 (:arg-types
(:constant simple-string
))
234 (:info foreign-symbol
)
235 (:results
(res :scs
(sap-reg)))
236 (:result-types system-area-pointer
)
239 #-immobile-space
; non-relocatable alien linkage table
240 (inst mov res
(make-fixup foreign-symbol
:foreign
))
241 #+immobile-space
; relocatable alien linkage table
242 (cond ((sb-c::code-immobile-p vop
)
243 (inst lea res
(rip-relative-ea (make-fixup foreign-symbol
:foreign
))))
245 (inst mov res
(thread-slot-ea thread-alien-linkage-table-base-slot
))
246 (inst lea res
(ea (make-fixup foreign-symbol
:alien-code-linkage-index
) res
))))))
248 (define-vop (foreign-symbol-dataref-sap)
249 (:translate foreign-symbol-dataref-sap
)
252 (:arg-types
(:constant simple-string
))
253 (:info foreign-symbol
)
254 (:results
(res :scs
(sap-reg)))
255 (:result-types system-area-pointer
)
258 #-immobile-space
; non-relocatable alien linkage table
259 (inst mov res
(ea (make-fixup foreign-symbol
:foreign-dataref
)))
260 #+immobile-space
; relocatable alien linkage table
261 (cond ((sb-c::code-immobile-p vop
)
262 (inst mov res
(rip-relative-ea (make-fixup foreign-symbol
:foreign-dataref
))))
264 (inst mov res
(thread-slot-ea thread-alien-linkage-table-base-slot
))
265 (inst mov res
(ea (make-fixup foreign-symbol
:alien-data-linkage-index
) res
))))))
268 (defconstant thread-saved-csp-offset
(- (1+ sb-vm
::thread-header-slots
)))
270 (eval-when (#-sb-xc
:compile-toplevel
:load-toplevel
:execute
)
271 (defun destroyed-c-registers ()
272 ;; Safepoints do not save interrupt contexts to be scanned during
273 ;; GCing, it only looks at the stack, so if a register isn't
274 ;; spilled it won't be visible to the GC.
278 (let ((gprs (list '#:rcx
'#:rdx
#-win32
'#:rsi
#-win32
'#:rdi
279 '#:r8
'#:r9
'#:r10
'#:r11
))
282 (loop for gpr in gprs
283 for offset
= (symbol-value (intern (concatenate 'string
(symbol-name gpr
) "-OFFSET") "SB-VM"))
284 collect
`(:temporary
(:sc any-reg
:offset
,offset
:from
:eval
:to
:result
)
285 ,(car (push gpr vars
))))
286 (loop for float to
15
287 for varname
= (format nil
"FLOAT~D" float
)
288 collect
`(:temporary
(:sc single-reg
:offset
,float
:from
:eval
:to
:result
)
289 ,(car (push (make-symbol varname
) vars
))))
290 `((:ignore
,@vars
))))))
292 (define-vop (call-out)
293 (:args
(function :scs
(sap-reg)
296 (:results
(results :more t
))
297 ;; RBX is used to first load the address, allowing the debugger to
298 ;; determine which alien was accessed in case it's undefined.
299 (:temporary
(:sc sap-reg
:offset rbx-offset
:from
(:argument
0)) rbx
)
300 (:temporary
(:sc unsigned-reg
:offset rax-offset
:to
:result
) rax
)
302 (:temporary
(:sc unsigned-stack
:from
:eval
:to
:result
) pc-save
)
304 (:temporary
(:sc unsigned-reg
:offset r15-offset
:from
:eval
:to
:result
) r15
)
309 (emit-c-call vop rax rbx args
310 sb-alien
::*alien-fun-type-varargs-default
*
311 #+sb-safepoint pc-save
313 #+win32
(:ignore r15
)
314 .
#.
(destroyed-c-registers))
316 ;;; Calls to C can generally be made without loading a register
317 ;;; with the function. We receive the function name as an info argument.
318 (define-vop (call-out-named)
319 (:args
(args :more t
))
320 (:results
(results :more t
))
321 (:info c-symbol varargsp
)
322 (:temporary
(:sc unsigned-reg
:offset rax-offset
:to
:result
) rax
)
324 (:temporary
(:sc unsigned-stack
:from
:eval
:to
:result
) pc-save
)
326 (:temporary
(:sc unsigned-reg
:offset r15-offset
:from
:eval
:to
:result
) r15
)
330 (:temporary
(:sc unsigned-reg
:offset rbx-offset
:from
:eval
:to
:result
) rbx
)
334 (emit-c-call vop rax c-symbol args varargsp
335 #+sb-safepoint pc-save
337 .
#.
(destroyed-c-registers))
341 (defconstant win64-seh-direct-thunk-addr win64-seh-data-addr
)
342 (defconstant win64-seh-indirect-thunk-addr
(+ win64-seh-data-addr
8)))
344 (defun emit-c-call (vop rax fun args varargsp
#+sb-safepoint pc-save
#+win32 rbx
)
345 (declare (ignorable varargsp
))
346 ;; Current PC - don't rely on function to keep it in a form that
349 (let ((label (gen-label)))
350 ;; This looks unnecessary. GC can look at the stack word physically below
351 ;; the CSP-around-foreign-call, which must be a PC pointing into the lisp caller.
352 ;; A more interesting question would arise if we had callee-saved registers
353 ;; within lisp code, which we don't at the moment. If we did, those
354 ;; wouldn't be anywhere on the stack unless C code decides to save them.
355 (inst lea rax
(rip-relative-ea label
))
358 (when (sb-c:msan-unpoison sb-c
:*compilation
*)
359 (inst mov rax
(thread-slot-ea thread-msan-param-tls-slot
))
360 ;; Unpoison parameters
361 (do ((n 0 (+ n n-word-bytes
))
362 (arg args
(tn-ref-across arg
)))
364 ;; KLUDGE: assume all parameters are 8 bytes or less
365 (inst mov
:qword
(ea n rax
) 0)))
367 ;; ABI: AL contains amount of arguments passed in XMM registers
371 (loop for tn-ref
= args then
(tn-ref-across tn-ref
)
373 count
(eq (sb-name (sc-sb (tn-sc (tn-ref-tn tn-ref
))))
376 ;; Store SP in thread struct, unless the enclosing block says not to
378 (when (policy (sb-c::vop-node vop
) (/= sb-c
:insert-safepoints
0))
379 (inst mov
(thread-slot-ea thread-saved-csp-offset
) rsp-tn
))
381 #+win32
(inst sub rsp-tn
#x20
) ;MS_ABI: shadow zone
383 ;; From immobile space we use the "CALL rel32" format to the linkage
384 ;; table jump, and from dynamic space we use "CALL [ea]" format
385 ;; where ea is the address of the linkage table entry's operand.
386 ;; So while the former is a jump to a jump, we can optimize out
387 ;; one jump in an ELF executable.
388 ;; N.B.: if you change how the call is emitted, you will also have to adjust
389 ;; the UNDEFINED-ALIEN-TRAMP lisp asm routine to recognize the various shapes
390 ;; this instruction sequence can take.
392 (pseudo-atomic (:elide-if
(not (call-out-pseudo-atomic-p vop
)))
393 (inst call
(if (tn-p fun
)
395 #-immobile-space
(ea (make-fixup fun
:foreign
8))
397 (cond ((sb-c::code-immobile-p vop
) (make-fixup fun
:foreign
))
399 ;; Pick r10 as the lowest unused clobberable register.
400 ;; RAX has a designated purpose, and RBX is nonvolatile (not always
401 ;; spilled by Lisp because a C function has to save it if used)
402 (inst mov r10-tn
(thread-slot-ea thread-alien-linkage-table-base-slot
))
403 (ea (make-fixup fun
:alien-code-linkage-index
8) r10-tn
))))))
405 ;; On win64, calls go through one of the thunks defined in set_up_win64_seh_data().
409 (inst mov rax win64-seh-direct-thunk-addr
)
412 ;; RBX is loaded with the address of the word containing the address in the alien
413 ;; linkage table of the alien function to call. This informs UNDEFINED-ALIEN-TRAMP
414 ;; which table cell was referenced, if undefined.
415 #+immobile-space
; relocatable table
416 (cond ((sb-c::code-immobile-p vop
)
417 (inst lea rbx
(rip-relative-ea (make-fixup fun
:foreign
8))))
419 (inst mov rbx
(make-fixup fun
:alien-code-linkage-index
8))
420 (inst add rbx
(thread-slot-ea thread-alien-linkage-table-base-slot
))))
421 ;; else, wired table base address
422 #-immobile-space
(inst mov rbx
(make-fixup fun
:foreign
8))
423 (inst mov rax win64-seh-indirect-thunk-addr
)
426 ;; For the undefined alien error
427 (note-this-location vop
:internal-error
)
428 #+win32
(inst add rsp-tn
#x20
) ;MS_ABI: remove shadow space
430 ;; Zero the saved CSP, unless this code shouldn't ever stop for GC
432 (when (policy (sb-c::vop-node vop
) (/= sb-c
:insert-safepoints
0))
433 (inst xor
(thread-slot-ea thread-saved-csp-offset
) rsp-tn
)))
435 (define-vop (alloc-number-stack-space)
437 (:results
(result :scs
(sap-reg any-reg
)))
438 (:result-types system-area-pointer
)
440 (aver (location= result rsp-tn
))
441 (unless (zerop amount
)
442 (let ((delta (align-up amount
8)))
443 (inst sub rsp-tn delta
)))
444 ;; C stack must be 16 byte aligned
445 (inst and rsp-tn -
16)
446 (move result rsp-tn
)))
448 (macrolet ((alien-stack-ptr ()
449 #+sb-thread
`(thread-slot-ea ,(symbol-thread-slot '*alien-stack-pointer
*))
450 #-sb-thread
'(static-symbol-value-ea '*alien-stack-pointer
*)))
451 (define-vop (alloc-alien-stack-space)
453 (:results
(result :scs
(sap-reg any-reg
)))
454 (:result-types system-area-pointer
)
456 (aver (not (location= result rsp-tn
)))
457 (unless (zerop amount
)
458 (let ((delta (align-up amount
8)))
459 (inst sub
:qword
(alien-stack-ptr) delta
)))
460 (inst mov result
(alien-stack-ptr)))))
465 (defun alien-callback-accessor-form (type sp offset
)
466 `(deref (sap-alien (sap+ ,sp
,offset
) (* ,type
))))
469 (defun alien-callback-assembler-wrapper (index result-type argument-types
)
470 (labels ((make-tn-maker (sc-name)
472 (make-random-tn :kind
:normal
473 :sc
(sc-or-lose sc-name
)
475 (let* ((segment (make-segment))
478 #-
(and win32 sb-thread
) (rdi rdi-tn
)
479 #-
(and win32 sb-thread
) (rsi rsi-tn
)
483 #+(and win32 sb-thread
) (r8 r8-tn
)
486 ;; How many arguments have been copied
488 ;; How many arguments have been copied from the stack
489 (stack-argument-count #-win32 0 #+win32 4)
490 (gprs (mapcar (make-tn-maker 'any-reg) *c-call-register-arg-offsets*))
491 (fprs (mapcar (make-tn-maker 'double-reg)
492 ;; Only 8 first XMM registers are used for
494 (subseq *float-regs* 0 #-win32 8 #+win32 4))))
495 (assemble (segment 'nil)
496 ;; Make room on the stack for arguments.
498 (inst sub rsp (* n-word-bytes (length argument-types))))
499 ;; Copy arguments from registers to stack
500 (dolist (type argument-types)
501 (let ((integerp (not (alien-float-type-p type)))
502 ;; A TN pointing to the stack location where the
503 ;; current argument should be stored for the purposes
504 ;; of ENTER-ALIEN-CALLBACK.
505 (target-tn (ea (* arg-count n-word-bytes) rsp))
506 ;; A TN pointing to the stack location that contains
507 ;; the next argument passed on the stack.
508 (stack-arg-tn (ea (* (+ 1 (length argument-types) stack-argument-count)
512 (let ((gpr (pop gprs)))
514 ;; Argument not in register, copy it from the old
515 ;; stack location to a temporary register.
517 (incf stack-argument-count)
519 (inst mov gpr stack-arg-tn))
520 ;; Copy from either argument register or temporary
521 ;; register to target.
522 (inst mov target-tn gpr)))
523 ((or (alien-single-float-type-p type)
524 (alien-double-float-type-p type))
525 (let ((fpr (pop fprs)))
528 ;; Copy from float register to target location.
529 (inst movq target-tn fpr))
531 ;; Not in float register. Copy from stack to
532 ;; temporary (general purpose) register, and
533 ;; from there to the target location.
534 (incf stack-argument-count)
535 (inst mov rax stack-arg-tn)
536 (inst mov target-tn rax)))))
538 (bug "Unknown alien floating point type: ~S" type)))))
542 ;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index)
543 (inst mov rdx (fixnumize index))
544 ;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
546 ;; add room on stack for return value
547 (inst sub rsp (if (evenp arg-count)
550 ;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
558 (inst mov rax (foreign-symbol-address "funcall_alien_callback"))
561 ;; Back! Restore frame
566 ;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index)
567 (inst mov #-win32 rdi #+win32 rcx (fixnumize index))
568 ;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
569 (inst mov #-win32 rsi #+win32 rdx rsp)
570 ;; add room on stack for return value
571 (inst sub rsp (if (evenp arg-count)
574 ;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
575 (inst mov #-win32 rdx #+win32 r8 rsp)
579 #+win32 (inst sub rsp #x20)
580 #+win32 (inst and rsp #x-20)
582 #+immobile-space (inst call (static-symbol-value-ea 'callback-wrapper-trampoline))
583 ;; do this without MAKE-FIXUP because fixup'ing does not happen when
584 ;; assembling callbacks (probably could, but ...)
586 (inst call (ea (+ (foreign-symbol-address "callback_wrapper_trampoline") 8)))
587 ;; Back! Restore frame
590 ;; Result now on top of stack, put it in the right register
592 ((or (alien-integer-type-p result-type)
593 (alien-pointer-type-p result-type)
594 (alien-type-= #.(parse-alien-type 'system-area-pointer nil)
596 (inst mov rax [rsp]))
597 ((or (alien-single-float-type-p result-type
)
598 (alien-double-float-type-p result-type
))
599 (inst movq xmm0
[rsp]))
600 ((alien-void-type-p result-type))
602 (error "Unrecognized alien type: ~A" result-type)))
604 ;; Pop the arguments and the return value from the stack to get
605 ;; the return address at top of stack.
607 (inst add rsp (* (+ arg-count
608 ;; Plus the return value and make sure it's aligned
609 (if (evenp arg-count)
615 (finalize-segment segment)
616 ;; Now that the segment is done, convert it to a static
617 ;; vector we can point foreign code to.
618 (let ((buffer (sb-assem:segment-buffer segment)))
619 (make-static-vector (length buffer)
620 :element-type '(unsigned-byte 8)
621 :initial-contents buffer)))))