src/compiler/arm/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 (defconstant +number-stack-alignment-mask+ 7)
  15
  16 (defconstant +max-register-args+ 4)
  17
  18 (defun my-make-wired-tn (prim-type-name sc-name offset)
  19   (make-wired-tn (primitive-type-or-lose prim-type-name)
  20                  (sc-number-or-lose sc-name)
  21                  offset))
  22
  23 (defstruct arg-state
  24   (num-register-args 0)
  25   #!-arm-softfp
  26   (fp-registers 0)
  27   (stack-frame-size 0))
  28
  29 (defstruct (result-state (:copier nil))
  30   (num-results 0))
  31
  32 (defun result-reg-offset (slot)
  33   (ecase slot
  34     (0 nargs-offset)
  35     (1 nl3-offset)))
  36
  37 (defun register-args-offset (index)
  38   (elt '(#.ocfp-offset #.nargs-offset #.nl2-offset #.nl3-offset)
  39        index))
  40
  41 (defun int-arg (state prim-type reg-sc stack-sc)
  42   (let ((reg-args (arg-state-num-register-args state)))
  43     (cond ((< reg-args +max-register-args+)
  44            (setf (arg-state-num-register-args state) (1+ reg-args))
  45            (my-make-wired-tn prim-type reg-sc (register-args-offset reg-args)))
  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 #!+arm-softfp
  61 (define-alien-type-method (single-float :arg-tn) (type state)
  62   (declare (ignore type))
  63   (int-arg state 'single-float 'unsigned-reg 'single-stack))
  64
  65 #!-arm-softfp
  66 (define-alien-type-method (single-float :arg-tn) (type state)
  67   (declare (ignore type))
  68   (let ((register (arg-state-fp-registers state)))
  69     (cond ((> register 15)
  70            (let ((frame-size (arg-state-stack-frame-size state)))
  71              (setf (arg-state-stack-frame-size state) (1+ frame-size))
  72              (my-make-wired-tn 'single-float 'single-stack frame-size)))
  73           (t
  74            (incf (arg-state-fp-registers state))
  75            (my-make-wired-tn 'single-float 'single-reg register)))))
  76
  77 #!+arm-softfp
  78 (define-alien-type-method (double-float :arg-tn) (type state)
  79   (declare (ignore type))
  80   (let* ((register (arg-state-num-register-args state))
  81          ;; The registers used are aligned, only r0-r1 and r2-r3 pairs
  82          ;; can be used.
  83          (register (+ register (logand register 1))))
  84     (cond ((> (+ register 2) +max-register-args+)
  85            (setf (arg-state-num-register-args state) +max-register-args+)
  86            (let ((frame-size (arg-state-stack-frame-size state)))
  87              (setf (arg-state-stack-frame-size state) (+ frame-size 2))
  88              (my-make-wired-tn 'double-float 'double-stack frame-size)))
  89           (t
  90            (setf (arg-state-num-register-args state) (+ register 2))
  91            (list
  92             (my-make-wired-tn 'unsigned-byte-32 'unsigned-reg
  93                               (register-args-offset register))
  94             (my-make-wired-tn 'unsigned-byte-32 'unsigned-reg
  95                               (register-args-offset (1+ register)))
  96             'move-double-to-int-args)))))
  97
  98 #!-arm-softfp
  99 (define-alien-type-method (double-float :arg-tn) (type state)
 100   (declare (ignore type))
 101   (let ((register (setf (arg-state-fp-registers state)
 102                         (logandc2 (+ (arg-state-fp-registers state) 1) 1))))
 103     (cond ((> register 15)
 104            (let ((frame-size
 105                    ;; align
 106                    (setf (arg-state-stack-frame-size state)
 107                          (logandc2 (+ (arg-state-stack-frame-size state) 1) 1))))
 108              (setf (arg-state-stack-frame-size state) (+ frame-size 2))
 109              (my-make-wired-tn 'double-float 'double-stack frame-size)))
 110           (t
 111            (incf (arg-state-fp-registers state) 2)
 112            (my-make-wired-tn 'double-float 'double-reg register)))))
 113
 114 (define-alien-type-method (integer :result-tn) (type state)
 115   (let ((num-results (result-state-num-results state)))
 116     (setf (result-state-num-results state) (1+ num-results))
 117     (multiple-value-bind (ptype reg-sc)
 118         (if (alien-integer-type-signed type)
 119             (values 'signed-byte-32 'signed-reg)
 120             (values 'unsigned-byte-32 'unsigned-reg))
 121       (my-make-wired-tn ptype reg-sc
 122                         (result-reg-offset num-results)))))
 123
 124 (define-alien-type-method (system-area-pointer :result-tn) (type state)
 125   (declare (ignore type state))
 126   (my-make-wired-tn 'system-area-pointer 'sap-reg nargs-offset))
 127
 128 #!+arm-softfp
 129 (define-alien-type-method (single-float :result-tn) (type state)
 130   (declare (ignore type state))
 131   (my-make-wired-tn 'single-float 'unsigned-reg nargs-offset))
 132
 133 #!-arm-softfp
 134 (define-alien-type-method (single-float :result-tn) (type state)
 135   (declare (ignore type state))
 136   (my-make-wired-tn 'single-float 'single-reg 0))
 137
 138 #!+arm-softfp
 139 (define-alien-type-method (double-float :result-tn) (type state)
 140   (declare (ignore type state))
 141   (list (my-make-wired-tn 'unsigned-byte-32 'unsigned-reg nargs-offset)
 142         (my-make-wired-tn 'unsigned-byte-32 'unsigned-reg nl3-offset)
 143         'move-int-args-to-double))
 144
 145 #!-arm-softfp
 146 (define-alien-type-method (double-float :result-tn) (type state)
 147   (declare (ignore type state))
 148   (my-make-wired-tn 'double-float 'double-reg 0))
 149
 150 (define-alien-type-method (values :result-tn) (type state)
 151   (let ((values (alien-values-type-values type)))
 152     (when (> (length values) 2)
 153       (error "Too many result values from c-call."))
 154     (mapcar (lambda (type)
 155               (invoke-alien-type-method :result-tn type state))
 156             values)))
 157
 158 (defun make-call-out-tns (type)
 159   (let ((arg-state (make-arg-state)))
 160     (collect ((arg-tns))
 161       (dolist (arg-type (alien-fun-type-arg-types type))
 162         (arg-tns (invoke-alien-type-method :arg-tn arg-type arg-state)))
 163       (values (make-normal-tn *fixnum-primitive-type*)
 164               (* (arg-state-stack-frame-size arg-state) n-word-bytes)
 165               (arg-tns)
 166               (invoke-alien-type-method :result-tn
 167                                         (alien-fun-type-result-type type)
 168                                         (make-result-state))))))
 169 \f
 170 (define-vop (foreign-symbol-sap)
 171   (:translate foreign-symbol-sap)
 172   (:policy :fast-safe)
 173   (:args)
 174   (:arg-types (:constant simple-string))
 175   (:info foreign-symbol)
 176   (:temporary (:sc interior-reg) lip)
 177   (:results (res :scs (sap-reg)))
 178   (:result-types system-area-pointer)
 179   (:generator 2
 180     (let ((fixup-label (gen-label)))
 181       (inst load-from-label res lip fixup-label)
 182       (assemble (*elsewhere*)
 183         (emit-label fixup-label)
 184         (inst word (make-fixup foreign-symbol :foreign))))))
 185
 186 #!+linkage-table
 187 (define-vop (foreign-symbol-dataref-sap)
 188   (:translate foreign-symbol-dataref-sap)
 189   (:policy :fast-safe)
 190   (:args)
 191   (:arg-types (:constant simple-string))
 192   (:info foreign-symbol)
 193   (:temporary (:sc interior-reg) lip)
 194   (:results (res :scs (sap-reg)))
 195   (:result-types system-area-pointer)
 196   (:generator 2
 197     (let ((fixup-label (gen-label)))
 198       (inst load-from-label res lip fixup-label)
 199       (inst ldr res (@ res))
 200       (assemble (*elsewhere*)
 201         (emit-label fixup-label)
 202         (inst word (make-fixup foreign-symbol :foreign-dataref))))))
 203
 204 (define-vop (call-out)
 205   (:args (function :scs (sap-reg sap-stack))
 206          (args :more t))
 207   (:results (results :more t))
 208   (:ignore args results)
 209   (:save-p t)
 210   (:temporary (:sc any-reg :offset r8-offset
 211                    :from (:argument 0) :to (:result 0)) cfunc)
 212   (:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
 213   (:temporary (:sc any-reg) temp)
 214   (:temporary (:sc interior-reg) lip)
 215   (:vop-var vop)
 216   (:generator 0
 217     (let ((call-into-c-fixup (gen-label))
 218           (cur-nfp (current-nfp-tn vop)))
 219       (assemble (*elsewhere*)
 220         (emit-label call-into-c-fixup)
 221         (inst word (make-fixup "call_into_c" :foreign)))
 222       (when cur-nfp
 223         (store-stack-tn nfp-save cur-nfp))
 224       (inst load-from-label temp lip call-into-c-fixup)
 225       (sc-case function
 226         (sap-reg (move cfunc function))
 227         (sap-stack
 228          (load-stack-offset cfunc cur-nfp function)))
 229       (inst blx temp)
 230       (when cur-nfp
 231         (load-stack-tn cur-nfp nfp-save)))))
 232
 233 (define-vop (alloc-number-stack-space)
 234   (:info amount)
 235   (:result-types system-area-pointer)
 236   (:results (result :scs (sap-reg any-reg)))
 237   (:generator 0
 238     (unless (zerop amount)
 239       (let ((delta (logandc2 (+ amount +number-stack-alignment-mask+)
 240                              +number-stack-alignment-mask+)))
 241         (composite-immediate-instruction sub nsp-tn nsp-tn delta)
 242         (move result nsp-tn)))))
 243
 244 (define-vop (dealloc-number-stack-space)
 245   (:info amount)
 246   (:policy :fast-safe)
 247   (:generator 0
 248     (unless (zerop amount)
 249       (let ((delta (logandc2 (+ amount +number-stack-alignment-mask+)
 250                              +number-stack-alignment-mask+)))
 251         (composite-immediate-instruction add nsp-tn nsp-tn delta)))))
 252 ;;;
 253
 254 #!+arm-softfp
 255 (define-vop (move-double-to-int-args)
 256   (:args (double :scs (double-reg)))
 257   (:results (lo-bits :scs (unsigned-reg))
 258             (hi-bits :scs (unsigned-reg)))
 259   (:arg-types double-float)
 260   (:result-types unsigned-num unsigned-num)
 261   (:policy :fast-safe)
 262   (:generator 1
 263     (inst fmrrd lo-bits hi-bits double)))
 264
 265 #!+arm-softfp
 266 (define-vop (move-int-args-to-double)
 267   (:args (lo-bits :scs (unsigned-reg))
 268          (hi-bits :scs (unsigned-reg)))
 269   (:results (double :scs (double-reg)))
 270   (:arg-types unsigned-num unsigned-num)
 271   (:result-types double-float)
 272   (:policy :fast-safe)
 273   (:generator 1
 274     (inst fmdrr double lo-bits hi-bits)))
 275
 276 ;;; long-long support
 277 (deftransform %alien-funcall ((function type &rest args) * * :node node)
 278   (aver (sb!c::constant-lvar-p type))
 279   (let* ((type (sb!c::lvar-value type))
 280          (env (sb!c::node-lexenv node))
 281          (arg-types (alien-fun-type-arg-types type))
 282          (result-type (alien-fun-type-result-type type)))
 283     (aver (= (length arg-types) (length args)))
 284     (if (or (some (lambda (type)
 285                     (and (alien-integer-type-p type)
 286                          (> (sb!alien::alien-integer-type-bits type) 32)))
 287                   arg-types)
 288             (and (alien-integer-type-p result-type)
 289                  (> (sb!alien::alien-integer-type-bits result-type) 32)))
 290         (collect ((new-args) (lambda-vars) (new-arg-types))
 291                  (loop with i = 0
 292                        for type in arg-types
 293                        for arg = (gensym)
 294                        do
 295                        (lambda-vars arg)
 296                        (cond ((and (alien-integer-type-p type)
 297                                    (> (sb!alien::alien-integer-type-bits type) 32))
 298                               (when (oddp i)
 299                                 ;; long-long is only passed in pairs of r0-r1 and r2-r3,
 300                                 ;; and the stack is double-word aligned
 301                                 (incf i)
 302                                 (new-args 0)
 303                                 (new-arg-types (parse-alien-type '(signed 8) env)))
 304                               (incf i 2)
 305                               (new-args `(logand ,arg #xffffffff))
 306                               (new-args `(ash ,arg -32))
 307                               (new-arg-types (parse-alien-type '(unsigned 32) env))
 308                               (if (alien-integer-type-signed type)
 309                                   (new-arg-types (parse-alien-type '(signed 32) env))
 310                                   (new-arg-types (parse-alien-type '(unsigned 32) env))))
 311                              (t
 312                               (incf i (cond ((or (alien-double-float-type-p type)
 313                                                  #!-arm-softfp (alien-single-float-type-p type))
 314                                              #!+arm-softfp 2
 315                                              #!-arm-softfp 0)
 316                                             (t
 317                                              1)))
 318                               (new-args arg)
 319                               (new-arg-types type))))
 320                  (cond ((and (alien-integer-type-p result-type)
 321                              (> (sb!alien::alien-integer-type-bits result-type) 32))
 322                         (let ((new-result-type
 323                                 (let ((sb!alien::*values-type-okay* t))
 324                                   (parse-alien-type
 325                                    (if (alien-integer-type-signed result-type)
 326                                        '(values (unsigned 32) (signed 32))
 327                                        '(values (unsigned 32) (unsigned 32)))
 328                                    env))))
 329                           `(lambda (function type ,@(lambda-vars))
 330                              (declare (ignore type))
 331                              (multiple-value-bind (low high)
 332                                  (%alien-funcall function
 333                                                  ',(make-alien-fun-type
 334                                                     :arg-types (new-arg-types)
 335                                                     :result-type new-result-type)
 336                                                  ,@(new-args))
 337                                (logior low (ash high 32))))))
 338                        (t
 339                         `(lambda (function type ,@(lambda-vars))
 340                            (declare (ignore type))
 341                            (%alien-funcall function
 342                                            ',(make-alien-fun-type
 343                                               :arg-types (new-arg-types)
 344                                               :result-type result-type)
 345                                            ,@(new-args))))))
 346         (sb!c::give-up-ir1-transform))))
 347 \f
 348 ;;; Callback
 349 #-sb-xc-host
 350 (defun alien-callback-accessor-form (type sap offset)
 351   (let ((parsed-type type))
 352     (if (alien-integer-type-p parsed-type)
 353         (let ((bits (sb!alien::alien-integer-type-bits parsed-type)))
 354                (let ((byte-offset
 355                       (cond ((< bits n-word-bits)
 356                              (- n-word-bytes
 357                                 (ceiling bits n-byte-bits)))
 358                             (t 0))))
 359                  `(deref (sap-alien (sap+ ,sap
 360                                           ,(+ byte-offset offset))
 361                                     (* ,type)))))
 362         `(deref (sap-alien (sap+ ,sap ,offset) (* ,type))))))
 363
 364 #-sb-xc-host
 365 (defun alien-callback-assembler-wrapper (index result-type argument-types)
 366   (flet ((make-tn (offset &optional (sc-name 'any-reg))
 367            (make-random-tn :kind :normal
 368                            :sc (sc-or-lose sc-name)
 369                            :offset offset)))
 370     (let* ((segment (make-segment))
 371            ;; How many arguments have been copied
 372            (arg-count 0)
 373            ;; How many arguments have been copied from the stack
 374            (stack-argument-count 0)
 375            (r0-tn (make-tn 0))
 376            (r1-tn (make-tn 1))
 377            (r2-tn (make-tn 2))
 378            (r3-tn (make-tn 3))
 379            (r4-tn (make-tn 4))
 380            (temp-tn (make-tn 5))
 381            (nsp-save-tn (make-tn 6))
 382            #!-arm-softfp
 383            (fp-registers 0)
 384            (gprs (list r0-tn r1-tn r2-tn r3-tn))
 385            (frame-size
 386              (loop for type in argument-types
 387                    sum (* n-word-bytes
 388                           (if (or (alien-double-float-type-p type)
 389                                   (and (alien-integer-type-p type)
 390                                        (eql (alien-type-bits type) 64)))
 391                               2
 392                               1)))))
 393       (setf frame-size (logandc2 (+ frame-size +number-stack-alignment-mask+)
 394                                  +number-stack-alignment-mask+))
 395       (assemble (segment)
 396         (emit-word segment #xe92d4ff8) ;; stmfd sp!, {r3-r11, lr}
 397         (move nsp-save-tn nsp-tn)
 398
 399         ;; Make room on the stack for arguments.
 400         (when (plusp frame-size)
 401           (inst sub nsp-tn nsp-tn frame-size))
 402         ;; Copy arguments
 403         (dolist (type argument-types)
 404           (let ((target-tn (@ nsp-tn (* arg-count n-word-bytes)))
 405                 ;; A TN pointing to the stack location that contains
 406                 ;; the next argument passed on the stack.
 407                 ;; 10 is the amount of registers saved by stmfd above.
 408                 (stack-arg-tn (@ nsp-save-tn (* (+ 10 stack-argument-count)
 409                                                 n-word-bytes))))
 410             (cond ((or (and (alien-integer-type-p type)
 411                             (not (eql (alien-type-bits type) 64)))
 412                        (alien-pointer-type-p type)
 413                        (alien-type-= #.(parse-alien-type 'system-area-pointer nil)
 414                                      type)
 415                        #!+arm-softfp
 416                        (alien-single-float-type-p type))
 417                    (let ((gpr (pop gprs)))
 418                      (cond (gpr
 419                             (inst str gpr target-tn))
 420                            (t
 421                             (incf stack-argument-count)
 422                             (inst ldr temp-tn stack-arg-tn)
 423                             (inst str temp-tn target-tn))))
 424                    (incf arg-count))
 425                   ((or #!+arm-softfp
 426                        (alien-double-float-type-p type)
 427                        ;; long-long
 428                        (alien-integer-type-p type))
 429                    (let ((left (length gprs)))
 430                      (case left
 431                        ((2 3 4)
 432                         (when (= left 3)
 433                           (pop gprs))
 434                         (inst str (pop gprs) (@ nsp-tn (* arg-count n-word-bytes)))
 435                         (incf arg-count)
 436                         (inst str (pop gprs) (@ nsp-tn (* arg-count n-word-bytes)))
 437                         (incf arg-count))
 438                        (t
 439                         (pop gprs)
 440                         ;; two-word aligned
 441                         (setf stack-argument-count
 442                               (logandc2 (+ stack-argument-count 1) 1))
 443                         (inst ldr temp-tn (@ nsp-save-tn (* (+ 10 stack-argument-count)
 444                                                             n-word-bytes)))
 445                         (inst str temp-tn (@ nsp-tn (* arg-count n-word-bytes)))
 446                         (incf arg-count)
 447                         (inst ldr temp-tn (@ nsp-save-tn (* (+ 11 stack-argument-count)
 448                                                             n-word-bytes)))
 449                         (inst str temp-tn (@ nsp-tn (* arg-count n-word-bytes)))
 450                         (incf stack-argument-count 2)
 451                         (incf arg-count)))))
 452                   #!-arm-softfp
 453                   ((alien-double-float-type-p type)
 454                    (setf fp-registers (logandc2 (+ fp-registers 1) 1))
 455                    (cond
 456                      ((> fp-registers 15)
 457                       ;; align
 458                       (setf stack-argument-count
 459                             (logandc2 (+ stack-argument-count 1) 1))
 460                       (inst ldr temp-tn (@ nsp-save-tn (* (+ 10 stack-argument-count)
 461                                                           n-word-bytes)))
 462                       (inst str temp-tn (@ nsp-tn (* arg-count n-word-bytes)))
 463                       (incf arg-count)
 464                       (inst ldr temp-tn (@ nsp-save-tn (* (+ 11 stack-argument-count)
 465                                                           n-word-bytes)))
 466                       (inst str temp-tn (@ nsp-tn (* arg-count n-word-bytes)))
 467                       (incf stack-argument-count 2)
 468                       (incf arg-count))
 469                      (t
 470                       (inst fstd (make-tn fp-registers 'double-reg) target-tn)
 471                       (incf fp-registers 2)
 472                       (incf arg-count 2))))
 473                   #!-arm-softfp
 474                   ((alien-single-float-type-p type)
 475                    (cond ((> fp-registers 15)
 476                           (incf stack-argument-count)
 477                           (inst ldr temp-tn stack-arg-tn)
 478                           (inst str temp-tn target-tn))
 479                          (t
 480                           (inst fsts (make-tn fp-registers 'single-reg) target-tn)
 481                           (incf fp-registers 1)))
 482                    (incf arg-count 1))
 483                   (t
 484                    (bug "Unknown alien floating point type: ~S" type)))))
 485         ;; arg0 to FUNCALL3 (function)
 486         ;;
 487         ;; Indirect the access to ENTER-ALIEN-CALLBACK through
 488         ;; the symbol-value slot of SB-ALIEN::*ENTER-ALIEN-CALLBACK*
 489         ;; to ensure it'll work even if the GC moves ENTER-ALIEN-CALLBACK.
 490         ;; Skip any SB-THREAD TLS magic, since we don't expect anyone
 491         ;; to rebind the variable. -- JES, 2006-01-01
 492         (load-immediate-word r0-tn (+ nil-value (static-symbol-offset
 493                                                  'sb!alien::*enter-alien-callback*)))
 494         (loadw r0-tn r0-tn symbol-value-slot other-pointer-lowtag)
 495         ;; arg0 to ENTER-ALIEN-CALLBACK (trampoline index)
 496         (inst mov r1-tn (fixnumize index))
 497         ;; arg1 to ENTER-ALIEN-CALLBACK (pointer to argument vector)
 498         (inst mov r2-tn nsp-tn)
 499         ;; add room on stack for return value
 500         (inst sub nsp-tn nsp-tn 8)
 501         ;; arg2 to ENTER-ALIEN-CALLBACK (pointer to return value)
 502         (inst mov r3-tn nsp-tn)
 503
 504         ;; Call
 505         (load-immediate-word r4-tn (foreign-symbol-address "funcall3"))
 506         (inst blx r4-tn)
 507
 508         ;; Result now on top of stack, put it in the right register
 509         (cond
 510           ((or (and (alien-integer-type-p result-type)
 511                     (not (eql (alien-type-bits result-type) 64)))
 512                (alien-pointer-type-p result-type)
 513                (alien-type-= #.(parse-alien-type 'system-area-pointer nil)
 514                              result-type)
 515                #!+arm-softfp
 516                (alien-single-float-type-p result-type))
 517            (loadw r0-tn nsp-tn))
 518           ((or #!+arm-softfp (alien-double-float-type-p result-type)
 519                ;; long-long
 520                (alien-integer-type-p result-type))
 521            (loadw r0-tn nsp-tn)
 522            (loadw r1-tn nsp-tn 1))
 523           #!-arm-softfp
 524           ((alien-single-float-type-p result-type)
 525            (inst flds (make-tn 0 'single-reg) (@ nsp-tn)))
 526           #!-arm-softfp
 527           ((alien-double-float-type-p result-type)
 528            (inst fldd (make-tn 0 'double-reg) (@ nsp-tn)))
 529           ((alien-void-type-p result-type))
 530           (t
 531            (error "Unrecognized alien type: ~A" result-type)))
 532         (move nsp-tn nsp-save-tn)
 533         (emit-word segment #xe8bd4ff8) ;; ldmfd sp!, {r3-r11, lr}
 534         (inst bx lr-tn))
 535       (finalize-segment segment)
 536       ;; Now that the segment is done, convert it to a static
 537       ;; vector we can point foreign code to.
 538       (let* ((buffer (sb!assem::segment-buffer segment))
 539              (vector (make-static-vector (length buffer)
 540                                          :element-type '(unsigned-byte 8)
 541                                          :initial-contents buffer))
 542              (sap (vector-sap vector)))
 543         (alien-funcall
 544          (extern-alien "os_flush_icache"
 545                        (function void
 546                                  system-area-pointer
 547                                  unsigned-long))
 548          sap (length buffer))
 549         vector))))