source: trunk/source/compiler/ARM/arm-disassemble.lisp @ 15111

Last change on this file since 15111 was 15111, checked in by gb, 8 years ago

ARM-specific changes, mostly.

When running lisp code (in almost all cases), keep the constant 0.0d0
in the d7 register (and therefore 0.0s0 in s14 and s15). We use d7 as
a vector header when saving non-volatile FPRs on the stack; we
actually only modify s14, so we now restore s14 after it's been used
this way. The value used in the header in lisp and kernel code is
loaded from PC-relative memory, which means that we no longer use
fmsr/fmdrr or similar instructions.

When starting a lisp thread or entering one via a callback, initialize
d7.

This all basically means that we can get 0.0[d|s]0 into an FPR (or
exploit the fact that it's already in one) a bit easier, and that's
generally a good thing. It's an ABI change, which means that the
FASL and image versions (for the ARM port only) changed; new binaries
are included in this commit.

The kernel changes to support the use of d7 are mostly pretty obvious.
In working on them, I noticed that "local labels" and "macro labels"
were in the same namespace, and we were only avoiding conflicts by
accident. For 10 years or so. (I also noticed that GAS doesn't fully
support PC-relative operands, so did that by hand.)

File size: 23.5 KB
Line 
1;;;-*- Mode: Lisp; Package: (ARM :use CL) -*-
2;;;
3;;;   Copyright (C) 2005-2009 Clozure Associates and contributors.
4;;;   This file is part of Clozure CL.
5;;;
6;;;   Clozure CL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License   known as the LLGPL and distributed with Clozure CL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL
9;;;   which is distributed with Clozure CL as the file "LGPL".  Where these
10;;;   conflict  the preamble takes precedence.
11;;;
12;;;   Clozure CL is referenced in the preamble as the "LIBRARY."
13;;;
14;;;   The LLGPL is also available online at
15;;;   http://opensource.franz.com/preamble.html
16
17(eval-when (:compile-toplevel :load-toplevel :execute)
18(require "ARM-ASM")
19)
20
21(defparameter *hide-spjump-internals* t)
22
23(defstruct (arm-disassembled-instruction (:conc-name adi-))
24  (opcode 0 :type (unsigned-byte 32))
25  (labeled nil)
26  (mnemonic nil)
27  (condition-name nil)
28  (operands nil))
29
30(defun arm-gpr-name (regno)
31  `(:gpr ,regno))
32
33(defun arm-fprd-name (regno)
34  `(:double ,regno))
35
36(defun arm-fprs-name (regno)
37  `(:single ,regno))
38
39
40
41(defun find-arm-instruction-template (opcode)
42  (dotimes (i (length arm::*arm-instruction-table*))
43    (let* ((template (svref arm::*arm-instruction-table* i))
44           (value (arm::arm-instruction-template-val template))
45           (masks  (arm::arm-instruction-template-mask-list template)))
46      (if
47        (if (atom masks)
48          (= (logand opcode masks) value)
49          (dolist (mask masks)
50            (if (atom mask)
51              (if (= (logand opcode mask) value)
52                (return t))
53              (if (= (logand opcode (cdr mask)) (car mask))
54                (return t)))))
55        (return template)))))
56
57
58(defun extract-arm-rd-operand (opcodes i)
59  (let* ((opcode (adi-opcode (svref opcodes i))))
60    (arm-gpr-name (ldb (byte 4 12) opcode))))
61
62(defun extract-arm-rn-operand (opcodes i)
63  (let* ((opcode (adi-opcode (svref opcodes i))))
64    (arm-gpr-name (ldb (byte 4 16) opcode))))
65
66(defun extract-arm-rs-operand (opcodes i)
67  (let* ((opcode (adi-opcode (svref opcodes i))))
68    (arm-gpr-name (ldb (byte 4 8) opcode))))
69
70(defun extract-arm-fpaddr-operand (opcodes i)
71  (let* ((opcode (adi-opcode (svref opcodes i)))
72         (offset (ash (ldb (byte 8 0) opcode) 2))
73         (rn (ldb (byte 4 16) opcode)))
74    (unless (logbitp 23 opcode)
75      (setq offset (- offset)))
76    (cond ((eql rn arm::pc)
77           (let* ((target (+ i 2 (ash offset -2))))
78             (when (and (>= target 0)
79                        (< target (uvsize opcodes)))
80               (setf (adi-labeled (uvref opcodes target)) t))
81             `(:= (:label ,target))))
82          (t `(:@ ,(arm-gpr-name rn) (:$ ,offset))))))
83
84(defun extract-arm-@rn-operand (opcodes i)
85  (let* ((opcode (adi-opcode (svref opcodes i))))
86    `(:@ ,(arm-gpr-name (ldb (byte 4 16) opcode)))))
87         
88 
89
90(defparameter *arm-shift-ops* #(:lsl :lsr :asr :ror))
91
92
93(defun extract-arm-shifter-operand (opcodes i)
94  (let* ((opcode (adi-opcode (svref opcodes i))))
95    (if (logbitp 25 opcode)
96      (let* ((count (ash (ldb (byte 4 8) opcode) 1))
97             (value (arm::arm-rotate-left (ldb (byte 8 0) opcode) (logand 31 (- 32 count)))))
98        `(:$ ,value))
99      (let* ((rn (arm-gpr-name (ldb (byte 4 0) opcode)))
100             (register-shifted (logbitp 4 opcode)))
101        (if register-shifted
102          `(,(svref *arm-shift-ops* (ldb (byte 2 5) opcode))
103            ,rn
104            ,(arm-gpr-name (ldb (byte 4 8) opcode)))
105          (let* ((shift-type (ldb (byte 2 5) opcode))
106                 (shift-count (ldb (byte 5 7) opcode)))
107            (if (and (eql shift-type 0)
108                     (eql shift-count 0))
109              rn
110              (if (and (eql shift-type 3)
111                       (eql shift-count 0))
112                `(:rrx ,rn)
113                `(,(svref *arm-shift-ops* shift-type)
114                  ,rn
115                  (:$ ,shift-count))))))))))
116
117             
118
119(defun extract-arm-m12-operand (opcodes i)
120  (let* ((opcode (adi-opcode (svref opcodes i))))
121    (let* ((immediate (not (logbitp 25 opcode)))
122           (disp (ldb (byte 12 0) opcode))
123           (p (logbitp 24 opcode))
124           (u (logbitp 23 opcode))
125           (w (logbitp 21 opcode))
126           (rnval (ldb (byte 4 16) opcode))
127           (rn (arm-gpr-name rnval)))
128      (cond (immediate
129              (unless u (setq disp (- disp)))
130              (if (and u
131                       p
132                       (not w)
133                       (eql arm::fn rnval)
134                       (eql (mod (- disp arm::misc-data-offset) 4) 0))
135                `(:@ ,rn (:constant ,(ash (- disp arm::misc-data-offset) -2)))
136                (if (and p (not w) (eql arm::pc rnval) (not (logtest 3 disp)))
137                  (let* ((target (+ i 2 (ash disp -2))))
138                    (when (< target (uvsize opcodes))
139                      (setf (adi-labeled (uvref opcodes target)) t))
140                    `(:= (:label ,target)))
141                  (if p
142                    (if w
143                      `(:@! ,rn (:$ ,disp))
144                      `(:@ ,rn (:$ ,disp)))
145                    `(:@+ ,rn (:$ ,disp))))))
146            (t
147             (let* ((shift-op (ldb (byte 2 5) opcode))
148                    (shift-count (ldb (byte 5 7) opcode))
149                    (rm (arm-gpr-name (ldb (byte 4 0) opcode)))
150                    (memop
151                     (if p
152                       (if w
153                         (if u :+@! :-@!)
154                         (if u :+@ :-@))
155                       (if u :@+ :@-))))
156               (if (and (zerop shift-count) (zerop shift-op))
157                 `(,memop ,rn ,rm)
158                 (if (and (eql 3 shift-op) (zerop shift-count))
159                   `(,memop ,rn (:rrx ,rm))
160                   `(,memop ,rn (,(svref *arm-shift-ops* shift-op)
161                                 ,rm
162                                 (:$ ,shift-count)))))))))))
163
164
165(defun extract-arm-reglist-operand (opcodes i)
166  (let* ((opcode (adi-opcode (svref opcodes i))))
167    (let* ((mask (ldb (byte 16 0) opcode))
168           (regs ()))
169      (declare (type (unsigned-byte 16) i))
170      (do* ((i 15 (1- i)))
171           ((< i 0) `(:reglist ,regs))
172        (declare ((signed-byte 4) i))
173        (when (logbitp i mask)
174          (push i regs))))))
175
176(defun extract-arm-rnw-operand (opcodes i)
177  (let* ((opcode (adi-opcode (svref opcodes i))))
178    (let* ((regname (arm-gpr-name (ldb (byte 4 16) opcode))))
179      (if (logbitp 21 opcode)
180        `(:! ,regname)
181        regname))))
182
183(defun extract-arm-uuoa-operand (opcodes i)
184  (let* ((opcode (adi-opcode (svref opcodes i))))
185    (arm-gpr-name (ldb (byte 4 8) opcode))))
186
187(defun extract-arm-uuo-unary-operand (opcodes i)
188  (let* ((opcode (adi-opcode (svref opcodes i))))
189    `(:$ ,(ldb (byte 8 12) opcode))))
190
191(defun extract-arm-uuob-operand (opcodes i)
192  (let* ((opcode (adi-opcode (svref opcodes i))))
193    (arm-gpr-name (ldb (byte 4 12) opcode))))
194
195(defun extract-arm-uuoc-operand (opcodes i)
196  (let* ((opcode (adi-opcode (svref opcodes i))))
197    (arm-gpr-name (ldb (byte 4 16) opcode))))
198
199(defun extract-arm-fpux-operand (opcodes i)
200  (let* ((opcode (adi-opcode (svref opcodes i))))
201    (case (ldb (byte 4 16) opcode)
202      (0 :fpsid)
203      (1 :fpscr)
204      (8 :fpexc)
205      (t (list :fpu (ldb (byte 4 16) opcode))))))
206
207(defun extract-arm-imm16-operand (opcodes i)
208  (let* ((opcode (adi-opcode (svref opcodes i))))
209    `(:$
210      ,(dpb (ldb (byte 4 16) opcode)
211         (byte 4 12)
212         (ldb (byte 12 0) opcode)))))
213
214(defun extract-arm-rm-operand (opcodes i)
215  (let* ((opcode (adi-opcode (svref opcodes i))))
216    (arm-gpr-name (ldb (byte 4 0) opcode))))
217
218(defun extract-arm-b-operand (opcodes i)
219  (let* ((adi (svref opcodes i))
220         (opcode (adi-opcode adi))
221         (b-field (ldb (byte 24 0) opcode)))
222    (when (logbitp 23 b-field)
223      (setq b-field (- b-field (ash 1 24))))
224    (let* ((target (+ i 2 b-field)))
225      (when (and (>= target 0)
226                 (< target (length opcodes)))
227        (let* ((target-op (svref opcodes target))
228               (target-op-label (adi-labeled target-op)))
229          (cond  ((and target-op-label
230                       (not (eq t target-op-label)))
231                  (when *hide-spjump-internals*
232                    (setf (adi-mnemonic adi)
233                          (if (logbitp 24 opcode)
234                            "bla"
235                            "ba")))
236                  `(:spname ,target-op-label))
237                 (t
238                  (setf (adi-labeled (svref opcodes target)) t)
239                  `(:label ,target))))))))
240
241
242
243(defun extract-arm-m8-operand (opcodes i)
244  (let* ((opcode (adi-opcode (svref opcodes i))))
245    (let* ((immediate (logbitp 22 opcode))
246           (disp (dpb (ldb (byte 4 8) opcode)
247                      (byte 4 4)
248                      (ldb (byte 4 0) opcode)))
249           (p (logbitp 24 opcode))
250           (u (logbitp 23 opcode))
251           (w (logbitp 21 opcode))
252           (rnval (ldb (byte 4 16) opcode))
253           (rn (arm-gpr-name rnval)))
254      (cond (immediate
255             (unless u (setq disp (- disp)))
256             (if p
257               (if w
258                 `(:@! ,rn (:$ ,disp))
259                 `(:@ ,rn (:$ ,disp)))
260               `(:@+ ,rn (:$ ,disp))))
261            (t
262             (let* ((rm (arm-gpr-name (ldb (byte 4 0) opcode))))
263               `(,(if p
264                      (if w
265                        (if u :+@! :-@!)
266                        (if u :+@ :-@))
267                      (if u :@+ :@-)) ,rn ,rm)))))))
268
269(defun extract-arm-dd-operand (opcodes i)
270  (let* ((opcode (adi-opcode (svref opcodes i))))
271    (arm-fprd-name (ldb (byte 4 12) opcode))))
272
273(defun extract-arm-dm-operand (opcodes i)
274  (let* ((opcode (adi-opcode (svref opcodes i))))
275    (arm-fprd-name (ldb (byte 4 0) opcode))))
276
277(defun extract-arm-sd-operand (opcodes i)
278  (let* ((opcode (adi-opcode (svref opcodes i))))
279    (arm-fprs-name (logior (ash (ldb (byte 4 12) opcode) 1)
280                           (ldb (byte 1 22) opcode)))))
281
282(defun extract-arm-sm-operand (opcodes i)
283  (let* ((opcode (adi-opcode (svref opcodes i))))
284    (arm-fprs-name (logior (ash (ldb (byte 4 0) opcode) 1)
285                           (ldb (byte 1 5) opcode)))))
286
287(defun extract-arm-dn-operand (opcodes i)
288  (let* ((opcode (adi-opcode (svref opcodes i))))
289    (arm-fprd-name (ldb (byte 4 16) opcode))))
290
291(defun extract-arm-sn-operand (opcodes i)
292  (let* ((opcode (adi-opcode (svref opcodes i))))
293    (arm-fprs-name (logior (ash (ldb (byte 4 16) opcode) 1)
294                           (ldb (byte 1 7) opcode)))))
295
296(defun extract-arm-srcount-operand (opcodes i)
297  (let* ((opcode (adi-opcode (svref opcodes i))))
298    (ldb (byte 8 0) opcode)))
299
300(defun extract-arm-drcount-operand (opcodes i)
301  (let* ((opcode (adi-opcode (svref opcodes i))))
302    (ldb (byte 7 1) opcode)))
303
304(defun extract-arm-spentry-operand (opcodes i)
305  (let* ((opcode (adi-opcode (svref opcodes i)))
306         (val (ldb (byte 12 0) opcode)))
307    `(:spname ,(or (arm::arm-subprimitive-name val)
308                   (format nil "??? subprim ~d" val)))))
309 
310
311(defparameter *arm-operand-extract-functions*
312  #(extract-arm-rd-operand
313    extract-arm-rn-operand
314    extract-arm-shifter-operand
315    extract-arm-m12-operand
316    extract-arm-reglist-operand
317    extract-arm-rnw-operand
318    extract-arm-uuoa-operand
319    extract-arm-uuo-unary-operand
320    extract-arm-uuob-operand
321    extract-arm-rm-operand
322    extract-arm-b-operand
323    obsolete
324    extract-arm-m8-operand
325    extract-arm-dd-operand
326    extract-arm-dm-operand
327    extract-arm-sd-operand
328    extract-arm-sm-operand
329    extract-arm-dn-operand
330    extract-arm-sn-operand
331    extract-arm-rd-operand                  ;rde
332    extract-arm-rs-operand
333    extract-arm-fpaddr-operand
334    extract-arm-@rn-operand
335    extract-arm-uuoc-operand
336    extract-arm-fpux-operand
337    extract-arm-imm16-operand
338    extract-arm-srcount-operand
339    extract-arm-drcount-operand
340    extract-arm-spentry-operand
341    ))
342
343(defun make-adi-vector (code-vector)
344  (let* ((n (uvsize code-vector))
345         (v (make-array n)))
346    (declare (fixnum n) (simple-vector v))
347    (dotimes (i n v)
348      (setf (svref v i)
349            (make-arm-disassembled-instruction :opcode (uvref code-vector i))))))
350
351(defun process-adi-vector (adi-vector)
352  (let* ((n (length adi-vector))
353         (data nil)
354         (data-count 0))
355    (declare (fixnum n))
356    (do* ((i 0 (1+ i)))
357         ((= i n) adi-vector)
358      (declare (fixnum i))
359      (let* ((adi (svref adi-vector i))
360             (opcode (adi-opcode adi)))
361        (cond (data (setq data-count opcode data nil))
362              ((> data-count 0)
363               (setf (adi-mnemonic adi) ":word"
364                     (adi-operands adi) (list (adi-opcode adi)))
365               (decf data-count))
366              ((= opcode 0)
367               (setq data t)
368               (incf i))
369              (t
370               (let* ((template (find-arm-instruction-template opcode)))
371                 (if (null template)
372                   (setf (adi-mnemonic adi) :???
373                         (adi-operands adi) (list opcode))
374                   (collect ((operands))
375                     (setf (adi-mnemonic adi)
376                           (arm::arm-instruction-template-name template))
377                     (unless (logtest (arm::encode-arm-instruction-flag :non-conditional) (arm::arm-instruction-template-flags template))
378                       (let* ((cond (ldb (byte 4 28) opcode))
379                              (cond-name (if (< cond 14) (arm::lookup-arm-condition-value cond))))
380                         (when cond-name
381                           (if (logtest (arm::encode-arm-instruction-flag :prefer-separate-cond) (arm::arm-instruction-template-flags template))
382                             (operands `(:? ,cond-name))
383                             (setf (adi-condition-name adi) cond-name)))))
384                     
385                     (dolist (type (arm::arm-instruction-template-operand-types template))
386                       (operands (funcall (svref *arm-operand-extract-functions* type) adi-vector i)))
387                     (setf (adi-operands adi) (operands)))))))))))
388
389(defparameter *arm-gpr-names*
390  #("imm0" "imm1" "nargs" "rcontext" "arg_z" "arg_y" "arg_x" "temp0"
391    "temp1" "temp2" "vsp" "fn" "allocptr" "sp" "lr" "pc"))
392
393
394
395(defun disassemble-arm-xfunction (xfunction &optional (stream *debug-io*) (*hide-spjump-internals* *hide-spjump-internals*))
396  (let* ((adi-vector (process-adi-vector (make-adi-vector (uvref xfunction 1))))
397         (functionp (typep xfunction 'function)) ;not cross-compiling
398         (previous-source-note nil)
399         (pc-counter 0))
400    (labels ((format-spname (name stream)
401               (let* ((string (string name))
402                      (n (length string))
403                      (copy (make-string n)))
404                 (declare (dynamic-extent copy))
405                 (dotimes (i n (format stream "~a" copy))
406                   (let* ((ch (char string i)))
407                     (setf (schar copy i)
408                           (if (< i 3)
409                             ch
410                             (char-downcase ch))))))))     
411      (when functionp
412        (let ((source-note (function-source-note xfunction)))
413          (when source-note
414            ;; Fetch text from file if don't already have it
415            (ensure-source-note-text source-note)
416            (if (source-note-filename source-note)
417              (format t ";; Source: ~S:~D-~D"
418                      (source-note-filename source-note)
419                      (source-note-start-pos source-note)
420                      (source-note-end-pos source-note))
421              (let* ((source-text (source-note-text source-note)))
422                (when source-text
423                  (format t ";;; ~A" (string-sans-most-whitespace source-text 100))))))))
424      (dotimes (i (length adi-vector))
425        (when functionp
426          (let ((source-note (find-source-note-at-pc xfunction (* i 4))))
427            (unless (eql (source-note-file-range source-note)
428                         (source-note-file-range previous-source-note))
429              (setf previous-source-note source-note)
430              (let* ((source-text (source-note-text source-note))
431                     (text (if source-text
432                             (string-sans-most-whitespace source-text 100)
433                             "#<no source text>")))
434                (format stream "~&~%;;; ~A" text)
435                (setq pc-counter 3)))))
436        (let* ((info (svref adi-vector i))
437               (labeled (adi-labeled info)))
438          (when labeled
439            (setq pc-counter 0)
440            (if (eq t labeled)
441              (format stream "~&L~d~&" (ash i 2))
442              (if *hide-spjump-internals*
443                (return)
444                (format-spname labeled stream))))
445          (let* ((name (adi-mnemonic info))
446                 (use-fixnum-syntax nil))           
447            (when name
448              (let* ((condition-name (or (adi-condition-name info) "")))
449                (format stream "~&  (~a~a" name condition-name))
450              (let* ((ngpr 0)
451                     (nnode 0))
452                (declare (fixnum ngpr nnode))
453                (dolist (op (adi-operands info))
454                  (when (and (consp op) (eq (car op) :gpr))
455                    (incf ngpr)
456                    (when (logbitp (cadr op) arm-node-regs)
457                      (incf nnode))))
458                (unless (zerop ngpr)
459                  (setq use-fixnum-syntax (eql nnode ngpr))))
460              (labels ((format-operand (operand &optional toplevel)
461                         (write-char #\space stream)
462                         (if (atom operand)
463                           (if (and (typep operand 'integer)
464                                    (> (abs operand) 100))
465                             (format stream "#x~x" operand)
466                             (format stream "~d" operand))
467                           (ecase (car operand)
468                             (:= (format stream "(:=")
469                                 (format-operand (cadr operand))
470                                 (write-char #\) stream))
471                             (:label
472                              (let* ((target (if (< (cadr operand) (length adi-vector))
473                                               (svref adi-vector (cadr operand))))
474                                     (target-labeled (and target (adi-labeled target)))
475                                     (target-label (and (not (eq target-labeled t))
476                                                        target-labeled)))
477                                (if target-label
478                                  (format stream "~a" target-label)
479                                  (format stream "L~d" (ash (cadr operand) 2)))))
480                             (:constant (format stream "~s" (list 'quote (uvref xfunction (cadr operand)))))
481                             ((:lsl :lsr :asr :ror :rrx)
482                              (format stream "(:~a" (string-downcase (car operand)))
483                              (dolist (sub (cdr operand))
484                                (format-operand sub))
485                              (write-char #\) stream))
486                             (:spname
487                              (format-spname (cadr operand) stream))
488                             (:$
489                              (let* ((val (cadr operand)))
490                                (cond ((eql val arm::nil-value)
491                                       (format stream "'nil"))
492                                      ((and toplevel
493                                           use-fixnum-syntax
494                                           (typep val 'integer)
495                                           (not (logtest arm::fixnummask val)))
496                                       (let* ((unboxed (ash val (- arm::fixnumshift))))
497                                         (if (> (abs unboxed) 100)
498                                           (format stream "'#x~x" unboxed)
499                                           (format stream "'~d" unboxed))))
500                                      (t
501                                       (progn
502                                         (format stream "(:$")
503                                         (format-operand val)
504                                         (write-char #\) stream))))))
505                             (:? (format stream "(:? ~a)" (cadr operand)))
506                             (:gpr (format stream "~a" (svref *arm-gpr-names* (cadr operand))))
507                             (:single
508                              (if (eql (cadr operand)
509                                       (hard-regspec-value arm::single-float-zero))
510                                (format stream "single-float-zero")
511                                (format stream "s~d" (cadr operand))))
512                              (:double
513                              (if (eql (cadr operand)
514                                       (hard-regspec-value arm::double-float-zero))
515                                (format stream "double-float-zero")
516                                (format stream "d~d" (cadr operand))))
517                             (:reglist (format stream "~a"
518                                               (mapcar (lambda (r)
519                                                         (svref *arm-gpr-names* r))
520                                                       (cadr operand))))
521                             ((:@ :@! :+@ :+@! :-@ :-@! :@+ :@-)
522                              (format stream "(~s" (car operand))
523                              (dolist (sub (cdr operand))
524                                (format-operand sub))
525                              (write-char #\) stream))
526                             (:!
527                              (format stream "(:!")
528                              (format-operand (cadr operand))
529                              (write-char #\) stream))))))
530                (dolist (op (adi-operands info))
531                  (format-operand op t))
532                (write-char #\) stream)
533                (when (eql (incf pc-counter) 4)
534                  (setq pc-counter 0)
535                  (format stream "~40t;[~d]" (* i 4)))))))))))
536
537                             
538                       
539             
540(defun arm-xdisassemble (function)
541  (disassemble-arm-xfunction function *standard-output*))
542
543;;; Help arithmetic-error handlers
544(defun arithmetic-error-operation-from-instruction (template)
545  (let* ((name (make-keyword (string-upcase (arm::arm-instruction-template-name template)))))
546    (case name
547      ((:fdivs :fdivd) '/)
548      ((:fmuls :fmuld) '*)
549      ((:fadds :faddd) '+)
550      ((:fsubs :fsubd) '-)
551      (t 'coerce))))
552
553(defun arithmetic-error-operands-from-instruction (template instruction regvals xp)
554  (let* ((adi (make-arm-disassembled-instruction :opcode instruction))
555         (adi-vector (vector adi))
556         (parsed-ops (mapcar (lambda (type)
557                               (funcall (svref *arm-operand-extract-functions* type) adi-vector 0))
558                             (arm::arm-instruction-template-operand-types template)))
559         (singles (make-array 32 :element-type 'single-float))
560         (doubles (make-array 16 :element-type 'double-float)))
561    (declare (dynamic-extent singles doubles))
562    (%copy-ivector-to-ivector regvals 4 singles 0 (* 32 4))
563    (%copy-ivector-to-ivector regvals 4 doubles 4 (* 16 8))
564    (collect ((opvals))
565      (dolist (op (cdr parsed-ops))
566        (ecase (car op)
567          (:double (opvals (aref doubles (cadr op))))
568          (:single (opvals (aref singles (cadr op))))
569          (:gpr (opvals (xp-gpr-signed-long xp (cadr op))))))
570      (when (null (cddr parsed-ops))
571        (opvals (case (caar parsed-ops)
572                  (:single 'single-float)
573                  (:double 'double-float))))
574      (opvals))))
575   
576   
577#+arm-target
578(defun disassemble-lines (function)
579  (declare (ignore function))
580  (error "DISASSEMBLE-LINES isn't implemented yet for ARM."))
Note: See TracBrowser for help on using the repository browser.