source: trunk/source/level-1/ppc-trap-support.lisp @ 11887

Last change on this file since 11887 was 10959, checked in by gb, 11 years ago

Replace uses of target::nil-value with (CCL::TARGET-NIL-VALUE) and
target::t-value with (CCL::TARGET-T-VALUE).

This was very slightly hard to bootstrap (the new backend-lowmem-bias
had to be in effect and typically 0), so I'll start checking in images
in a minute.

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 45.4 KB
Line 
1;;; ppc-trap-support
2;;;
3;;;   Copyright (C) 1994-2001 Digitool, Inc
4;;;   This file is part of OpenMCL. 
5;;;
6;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
7;;;   License , known as the LLGPL and distributed with OpenMCL as the
8;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
9;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
10;;;   conflict, the preamble takes precedence. 
11;;;
12;;;   OpenMCL 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;;; Support for PPC traps, this includes the event-poll trap
18;;; and all the trxxx traps for type checks & arg count checks.
19
20(in-package "CCL")
21
22(eval-when (:compile-toplevel :execute)
23  (require "NUMBER-MACROS")
24
25 
26  (defparameter *ppc-instruction-fields*
27    `((:opcode . ,(byte 6 26))
28      (:rt . ,(byte 5 21))
29      (:to . ,(byte 5 21))
30      (:ra . ,(byte 5 16))
31      (:rb . ,(byte 5 11))
32      (:d . ,(byte 16 0))
33      (:ds . ,(byte 14 2))
34      (:ds-xo . ,(byte 2 0))
35      (:sh . ,(byte 5 11))
36      (:mb . ,(byte 5 6))
37      (:me . ,(byte 5 1))
38      (:mb6 . ,(byte 6 5))
39      (:me6 . ,(byte 6 5))
40      (:sh6 . ,(byte 1 1))
41      (:x-minor . ,(byte 10 1))
42      (:fulltag32 . ,(byte ppc32::ntagbits 0))
43      (:lisptag32 . ,(byte ppc32::nlisptagbits 0))
44      (:fulltag64 . ,(byte ppc64::ntagbits 0))
45      (:lisptag64 . ,(byte ppc64::nlisptagbits 0))
46      (:lowtag64 . ,(byte ppc64::nlowtagbits 0))))
47 
48  (defun ppc-instruction-field (field-name)
49    (or (cdr (assoc field-name *ppc-instruction-fields*))
50        (error "Unknown PPC instruction field: ~s" field-name)))
51 
52  (defun ppc-instruction-field-mask (field-spec)
53    (let* ((name (if (atom field-spec) field-spec (car field-spec)))
54           (value (if (atom field-spec) -1 (cadr field-spec))))
55      (dpb value (ppc-instruction-field name) 0)))
56
57  #+darwinppc-target
58  (progn
59    (def-foreign-type nil
60        (:struct :darwin-ppc-float-state
61                 (:fpregs (:array :double 32))
62                 (:fpscr-pad (:unsigned 32))
63                 (:fpscr (:unsigned 32))))
64    (def-foreign-type nil
65        (:struct :darwin-ppc-vector-state
66                 (:save-vr (:array (:array (:unsigned 32) 4) 32))
67                 (:save-vscr (:array (:unsigned 32) 4))
68                 (:save-pad5 (:array (:unsigned 32) 4))
69                 (:save-vrvalid (:unsigned 32))
70                 (:save-pad6 (:array (:unsigned 32) 7))))
71    #+ppc64-target
72    (progn
73      (def-foreign-type nil
74          (:struct :darwin-ppc-exception-state64
75                   (:dar (:unsigned 64))
76                   (:dsisr (:unsigned 32))
77                   (:exception (:unsigned 32))
78                   (:pad1 (:array (:unsigned 32) 4))))
79      (def-foreign-type nil
80          ;; The real record type is defined with
81          ;; #pragma pack(4) in effect.
82          ;; The :struct parser should really accept
83          ;; some option to deal with that, but Apple
84          ;; should also stop mis-aligning things.
85          (:struct :darwin-ppc-thread-state64
86                   (:srr0 (:unsigned 64))
87                   (:srr1 (:unsigned 64))
88                   (:r0  (:unsigned 64))
89                   (:r1  (:unsigned 64))
90                   (:r2  (:unsigned 64))
91                   (:r3  (:unsigned 64))
92                   (:r4  (:unsigned 64))
93                   (:r5  (:unsigned 64))
94                   (:r6  (:unsigned 64))
95                   (:r7  (:unsigned 64))
96                   (:r8  (:unsigned 64))
97                   (:r9  (:unsigned 64))
98                   (:r10  (:unsigned 64))
99                   (:r11  (:unsigned 64))
100                   (:r12 (:unsigned 64))
101                   (:r13  (:unsigned 64))
102                   (:r14  (:unsigned 64))
103                   (:r15  (:unsigned 64))
104                   (:r16  (:unsigned 64))
105                   (:r17  (:unsigned 64))
106                   (:r18  (:unsigned 64))
107                   (:r19  (:unsigned 64))
108                   (:r20  (:unsigned 64))
109                   (:r21  (:unsigned 64))
110                   (:r22  (:unsigned 64))
111                   (:r23  (:unsigned 64))
112                   (:r24  (:unsigned 64))
113                   (:r25  (:unsigned 64))
114                   (:r26  (:unsigned 64))
115                   (:r27  (:unsigned 64))
116                   (:r28  (:unsigned 64))
117                   (:r29  (:unsigned 64))
118                   (:r30  (:unsigned 64))
119                   (:r31  (:unsigned 64))
120                   (:cr   (:unsigned 32))
121                   (:xer  (:unsigned 32))
122                   (:xer-low (:unsigned 32))
123                   (:lr   (:unsigned 32))
124                   (:lr-low (:unsigned 32))
125                   (:ctr  (:unsigned 32))
126                   (:ctr-low (:unsigned 32))
127                   (:vrsave (:unsigned 32))))
128      (def-foreign-type nil
129          (:struct :darwin-sigaltstack64
130                   (:ss-sp (:* :void))
131                   (:ss-size (:unsigned 64))
132                   (:ss-flags (:unsigned 32))))
133      (def-foreign-type nil
134          (:struct :darwin-mcontext64
135                   (:es (:struct :darwin-ppc-exception-state64))
136                   (:ss (:struct :darwin-ppc-thread-state64))
137                   (:fs (:struct :darwin-ppc-float-state))
138                   (:vs (:struct :darwin-ppc-vector-state))))
139      (def-foreign-type nil
140          (:struct :darwin-ucontext64
141                   (:uc-onstack (:signed 32))
142                   (:uc-sigmask (:signed 32))
143                   (:uc-stack (:struct :darwin-sigaltstack64))
144                   (:uc-link (:* (:struct :darwin-ucontext64)))
145                   (:uc-mcsize (:signed 64))
146                   (:uc-mcontext64 (:* (:struct :darwin-mcontext64)))))
147      )
148    #+ppc32-target
149    (progn
150      (def-foreign-type nil
151          (:struct :darwin-ppc-exception-state32
152                   (:dar (:unsigned 32))
153                   (:dsisr (:unsigned 32))
154                   (:exception (:unsigned 32))
155                   (:pad0 (:unsigned 32))
156                   (:pad1 (:array (:unsigned 32) 4))))
157      (def-foreign-type nil
158          (:struct :darwin-ppc-thread-state32
159                   (:srr0 (:unsigned 32))
160                   (:srr1 (:unsigned 32))
161                   (:r0  (:unsigned 32))
162                   (:r1  (:unsigned 32))
163                   (:r2  (:unsigned 32))
164                   (:r3  (:unsigned 32))
165                   (:r4  (:unsigned 32))
166                   (:r5  (:unsigned 32))
167                   (:r6  (:unsigned 32))
168                   (:r7  (:unsigned 32))
169                   (:r8  (:unsigned 32))
170                   (:r9  (:unsigned 32))
171                   (:r10  (:unsigned 32))
172                   (:r11  (:unsigned 32))
173                   (:r12 (:unsigned 32))
174                   (:r13  (:unsigned 32))
175                   (:r14  (:unsigned 32))
176                   (:r15  (:unsigned 32))
177                   (:r16  (:unsigned 32))
178                   (:r17  (:unsigned 32))
179                   (:r18  (:unsigned 32))
180                   (:r19  (:unsigned 32))
181                   (:r20  (:unsigned 32))
182                   (:r21  (:unsigned 32))
183                   (:r22  (:unsigned 32))
184                   (:r23  (:unsigned 32))
185                   (:r24  (:unsigned 32))
186                   (:r25  (:unsigned 32))
187                   (:r26  (:unsigned 32))
188                   (:r27  (:unsigned 32))
189                   (:r28  (:unsigned 32))
190                   (:r29  (:unsigned 32))
191                   (:r30  (:unsigned 32))
192                   (:r31  (:unsigned 32))
193                   (:cr   (:unsigned 32))
194                   (:xer  (:unsigned 32))
195                   (:lr   (:unsigned 32))
196                   (:ctr  (:unsigned 32))
197                   (:mq (:unsigned 32)) ; ppc 601!
198                   (:vrsave (:unsigned 32))))
199      (def-foreign-type nil
200          (:struct :darwin-sigaltstack32
201                   (:ss-sp (:* :void))
202                   (:ss-size (:unsigned 32))
203                   (:ss-flags (:unsigned 32))))
204      (def-foreign-type nil
205          (:struct :darwin-mcontext32
206                   (:es (:struct :darwin-ppc-exception-state32))
207                   (:ss (:struct :darwin-ppc-thread-state32))
208                   (:fs (:struct :darwin-ppc-float-state))
209                   (:vs (:struct :darwin-ppc-vector-state))))
210      (def-foreign-type nil
211          (:struct :darwin-ucontext32
212                   (:uc-onstack (:signed 32))
213                   (:uc-sigmask (:signed 32))
214                   (:uc-stack (:struct :darwin-sigaltstack32))
215                   (:uc-link (:* (:struct :darwin-ucontext32)))
216                   (:uc-mcsize (:signed 32))
217                   (:uc-mcontext32 (:* (:struct :darwin-mcontext32)))))
218      )
219    )
220     
221                   
222           
223
224  (defmacro with-xp-registers-and-gpr-offset ((xp register-number) (registers offset) &body body)
225    (let* ((regform  #+linuxppc-target
226                     `(pref ,xp :ucontext.uc_mcontext.regs)
227                     #+darwinppc-target
228                     (target-arch-case
229                      ;; Gak.  Apple gratuitously renamed things
230                      ;; for Leopard.  Hey, it's not as if anyone
231                      ;; has better things to do than to deal with
232                      ;; this crap ...
233                      (:ppc32 `(pref ,xp :darwin-ucontext32.uc-mcontext32.ss))
234                      (:ppc64 `(pref ,xp :darwin-ucontext64.uc-mcontext64.ss)))))
235    `(with-macptrs ((,registers ,regform))
236      (let ((,offset (xp-gpr-offset ,register-number)))
237        ,@body))))
238
239  (defmacro RA-field (instr)
240    `(ldb (byte 5 16) ,instr))
241
242  (defmacro RB-field (instr)
243    `(ldb (byte 5 11) ,instr))
244
245  (defmacro D-field (instr)
246    `(ldb (byte 16 0) ,instr))
247
248  (defmacro RS-field (instr)
249    `(ldb (byte 5 21) ,instr))
250 
251  (defmacro lisp-reg-p (reg)
252    `(>= ,reg ppc::fn))
253 
254  (defmacro ppc-lap-word (instruction-form)
255    (uvref (uvref (compile nil
256                           `(lambda (&lap 0)
257                             (ppc-lap-function () ((?? 0))
258                              ,instruction-form)))
259                 
260                  0) #+ppc32-host 0 #+ppc64-host 1))
261 
262  (defmacro ppc-instruction-mask (&rest fields)
263    `(logior ,@(mapcar #'ppc-instruction-field-mask (cons :opcode fields))))
264 
265  ) 
266
267
268
269(defun xp-gpr-offset (register-number)
270  (unless (and (fixnump register-number)
271               (<= -2 (the fixnum register-number))
272               (< (the fixnum register-number) 48))
273    (setq register-number (require-type register-number '(integer -2 48))))
274  (the fixnum 
275    (* (the fixnum #+linuxppc-target register-number
276                   #+darwinppc-target (+ register-number 2))
277       target::node-size)))
278
279
280
281(defun xp-gpr-lisp (xp register-number)
282  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
283    (values (%get-object registers offset))))
284
285(defun (setf xp-gpr-lisp) (value xp register-number)
286  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
287    (%set-object registers offset value)))
288
289(defun xp-gpr-signed-long (xp register-number)
290  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
291    (values (%get-signed-long registers offset))))
292
293(defun xp-gpr-signed-doubleword (xp register-number)
294  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
295    (values (%%get-signed-longlong registers offset))))
296 
297
298(defun xp-gpr-macptr (xp register-number)
299  (with-xp-registers-and-gpr-offset (xp register-number) (registers offset)
300    (values (%get-ptr registers offset))))
301
302(defun xp-argument-list (xp)
303  (let ((nargs (xp-gpr-lisp xp ppc::nargs))     ; tagged as a fixnum (how convenient)
304        (arg-x (xp-gpr-lisp xp ppc::arg_x))
305        (arg-y (xp-gpr-lisp xp ppc::arg_y))
306        (arg-z (xp-gpr-lisp xp ppc::arg_z)))
307    (cond ((eql nargs 0) nil)
308          ((eql nargs 1) (list arg-z))
309          ((eql nargs 2) (list arg-y arg-z))
310          (t (let ((args (list arg-x arg-y arg-z)))
311               (if (eql nargs 3)
312                 args
313                 (let ((vsp (xp-gpr-macptr xp ppc::vsp)))
314                   (dotimes (i (- nargs 3))
315                     (push (%get-object vsp (* i target::node-size)) args))
316                   args)))))))
317   
318(defun xp-fpscr-info (xp)
319  (let* ((fpscr #+(and linuxppc-target 32-bit-target) (%get-unsigned-long (pref xp :ucontext.uc_mcontext.regs) (ash #$PT_FPSCR 2))
320                #+(and linuxppc-target 64-bit-target)
321                (%get-unsigned-long (pref xp :ucontext.uc_mcontext.fp_regs) (ash 65 2))
322                #+(and darwinppc-target ppc32-target)
323                (pref xp :darwin-ucontext32.uc-mcontext32.fs.fpscr)
324                #+(and darwinppc-target ppc64-target)
325                (pref xp :darwin-ucontext64.uc-mcontext64.fs.fpscr)))
326    (values (ldb (byte 24 8) fpscr) (ldb (byte 8 0) fpscr))))
327
328#+linuxppc-target
329(defun xp-double-float (xp fpr)
330  #+32-bit-target
331  (%get-double-float (pref xp :ucontext.uc_mcontext.regs) (+ (ash #$PT_FPR0 2)  (ash fpr 3)))
332  #+64-bit-target
333  (%get-double-float (pref xp :ucontext.uc_mcontext.fp_regs) (ash fpr 3))
334  )
335
336#+darwinppc-target
337(defun xp-double-float (xp fpr)
338  (%get-double-float
339     #+ppc32-target (pref xp :darwin-ucontext32.uc-mcontext32.fs)
340     #+ppc64-target (pref xp :darwin-ucontext64.uc-mcontext64.fs)
341     (ash fpr 3)))
342
343
344(defparameter *trap-lookup-tries* 5)
345
346
347
348(defun %scan-for-instr (mask opcode fn pc-index tries)
349  (let ((code-vector (and fn (uvref fn 0)))
350        (offset 0))
351    (declare (fixnum offset))
352    (flet ((get-instr ()
353             (if code-vector
354               (let ((index (+ pc-index offset)))
355                 (when (< index 0) (return-from %scan-for-instr nil))
356                 (uvref code-vector index))
357               (%get-long pc-index (the fixnum (* 4 offset))))))
358      (declare (dynamic-extent #'get-instr))
359      (dotimes (i tries)
360        (decf offset)
361        (let ((instr (get-instr)))
362          (when (match-instr instr mask opcode)
363            (return instr))
364          (when (codevec-header-p instr)
365            (return nil)))))))
366
367
368
369
370
371
372(defun return-address-offset (xp fn machine-state-offset)
373  (with-macptrs ((regs (pref xp #+linuxppc-target :ucontext.uc_mcontext.regs
374                                #+(and darwinppc-target ppc32-target)
375                                :darwin-ucontext32.uc-mcontext32
376                                #+(and darwinppc-target ppc64-target)
377                                :darwin-ucontext64.uc-mcontext64)))
378    (if (functionp fn)
379      (or (%code-vector-pc (uvref fn 0) (%inc-ptr regs machine-state-offset))
380           (%get-ptr regs machine-state-offset))
381      (%get-ptr regs machine-state-offset))))
382
383(defconstant lr-offset-in-register-context
384  #+linuxppc-target (ash #$PT_LNK target::word-shift)
385  #+(and darwinppc-target ppc32-target)
386  (+ (get-field-offset :darwin-mcontext32.ss)
387     (get-field-offset :darwin-ppc-thread-state32.lr))
388  #+(and darwinppc-target ppc64-target)
389  (+ (get-field-offset :darwin-mcontext64.ss)
390     (get-field-offset :darwin-ppc-thread-state64.lr)))
391
392(defconstant pc-offset-in-register-context
393  #+linuxppc-target (ash #$PT_NIP target::word-shift)
394  #+(and darwinppc-target ppc32-target)
395  (+ (get-field-offset :darwin-mcontext32.ss)
396     (get-field-offset :darwin-ppc-thread-state32.srr0))
397  #+(and darwinppc-target ppc64-target)
398  (+ (get-field-offset :darwin-mcontext64.ss)
399     (get-field-offset :darwin-ppc-thread-state64.srr0)))
400
401;;; When a trap happens, we may have not yet created control
402;;; stack frames for the functions containing PC & LR.
403;;; If that is the case, we add fake-stack-frame's to *fake-stack-frames*
404;;; There are 4 cases:
405;;;
406;;; PC in FN
407;;;   Push 1 stack frame: PC/FN
408;;;   This might miss one recursive call, but it won't miss any variables
409;;; PC in NFN
410;;;   Push 2 stack frames:
411;;;   1) PC/NFN/VSP
412;;;   2) LR/FN/VSP
413;;;   This might think some of NFN's variables are part of FN's stack frame,
414;;;   but that's the best we can do.
415;;; LR in FN
416;;;   Push 1 stack frame: LR/FN
417;;; None of the above
418;;;   Push no new stack frames
419;;;
420;;; The backtrace support functions in "ccl:l1;l1-lisp-threads.lisp" know how
421;;; to find the fake stack frames and handle them as arguments.
422(defun funcall-with-xp-stack-frames (xp trap-function thunk)
423  (cond ((null trap-function)
424         ; Maybe inside a subprim from a lisp function
425         (let* ((fn (xp-gpr-lisp xp ppc::fn))
426                (lr (return-address-offset
427                     xp fn lr-offset-in-register-context)))
428           (if (fixnump lr)
429             (let* ((sp (xp-gpr-lisp xp ppc::sp))
430                    (vsp (xp-gpr-lisp xp ppc::vsp))
431                    (frame (%cons-fake-stack-frame sp sp fn lr vsp xp *fake-stack-frames*))
432                    (*fake-stack-frames* frame))
433               (declare (dynamic-extent frame))
434               (funcall thunk frame))
435             (funcall thunk (xp-gpr-lisp xp ppc::sp)))))
436        ((eq trap-function (xp-gpr-lisp xp ppc::fn))
437         (let* ((sp (xp-gpr-lisp xp ppc::sp))
438                (fn trap-function)
439                (lr (return-address-offset
440                     xp fn pc-offset-in-register-context))
441                (vsp (xp-gpr-lisp xp ppc::vsp))
442                (frame (%cons-fake-stack-frame sp sp fn lr vsp xp *fake-stack-frames*))
443                (*fake-stack-frames* frame))
444           (declare (dynamic-extent frame))
445           (funcall thunk frame)))
446        ((eq trap-function (xp-gpr-lisp xp ppc::nfn))
447         (let* ((sp (xp-gpr-lisp xp ppc::sp))
448                (fn (xp-gpr-lisp xp ppc::fn))
449                (lr (return-address-offset
450                     xp fn lr-offset-in-register-context))
451                (vsp (xp-gpr-lisp xp ppc::vsp))
452                (lr-frame (%cons-fake-stack-frame sp sp fn lr vsp xp))
453                (pc-fn trap-function)
454                (pc-lr (return-address-offset
455                        xp pc-fn pc-offset-in-register-context))
456                (pc-frame (%cons-fake-stack-frame sp lr-frame pc-fn pc-lr vsp xp *fake-stack-frames*))
457                (*fake-stack-frames* pc-frame))
458           (declare (dynamic-extent lr-frame pc-frame))
459           (funcall thunk pc-frame)))
460        (t (funcall thunk (xp-gpr-lisp xp ppc::sp)))))
461
462
463
464;;; Enter here from handle-trap in "lisp-exceptions.c".
465;;; xp is a pointer to an ExceptionInformationPowerPC record.
466;;; the-trap is the trap instruction that got us here.
467;;; fn-reg is either fn, nfn or 0. If it is fn or nfn, then
468;;; the trap occcurred in that register's code vector.
469;;; If it is 0, then the trap occurred somewhere else.
470;;; pc-index is either the index in fn-reg's code vector
471;;; or, if fn-reg is 0, the address of the PC at the trap instruction.
472;;; This code parallels the trap decoding code in
473;;; "lisp-exceptions.c" that runs if (symbol-value 'cmain)
474;;; is not a macptr.
475;;; Some of these could probably call %err-disp instead of error,
476;;; but I was too lazy to look them up.
477
478#+ppc32-target
479(defcallback xcmain (:without-interrupts t
480                                        :address xp 
481                                        :unsigned-fullword fn-reg 
482                                        :address pc-or-index 
483                                        :unsigned-fullword the-trap
484                                        :signed-fullword  arg-0
485                                        :signed-fullword arg-1)
486  ;; twgti nargs,0
487  ;; time for event polling.
488  ;; This used to happen a lot so we test for it first.
489  (let ((fn (unless (eql fn-reg 0) (xp-gpr-lisp xp fn-reg))))
490    (with-xp-stack-frames (xp fn frame-ptr)
491      (if (eql the-trap (ppc-lap-word (twgti nargs 0)))
492        (cmain)
493        (with-error-reentry-detection
494          (let ((pc-index (if (eql fn-reg 0) pc-or-index (%ptr-to-int pc-or-index)))
495                instr ra temp rs condition)
496            (cond
497              ((= the-trap #$SIGBUS)
498               (%error (make-condition 'invalid-memory-access
499                                       :address arg-0
500                                       :write-p (not (zerop arg-1)))
501                       ()
502                       frame-ptr))             
503             ;; tweqi RA nil-value - resolve-eep, or resolve-foreign-variable
504              ((and (match-instr the-trap
505                                 (ppc-instruction-mask  :opcode :to :d)
506                                 (ppc-lap-word (tweqi ?? (target-nil-value))))
507                    (setq instr (scan-for-instr
508                                 (ppc-instruction-mask :opcode :d)
509                                 (ppc-lap-word (lwz ??
510                                                    (+ 4 ppc32::misc-data-offset)
511                                                    ??))
512                                               fn pc-index)))
513               (let* ((eep-or-fv (xp-gpr-lisp xp (RA-field instr))))
514                 (etypecase eep-or-fv
515                   (external-entry-point
516                    (resolve-eep eep-or-fv)
517                    (setf (xp-gpr-lisp xp (RA-field the-trap))
518                          (eep.address eep-or-fv)))
519                   (foreign-variable
520                    (resolve-foreign-variable eep-or-fv)
521                    (setf (xp-gpr-lisp xp (RA-field the-trap))
522                          (fv.addr eep-or-fv))))))
523             ;; twnei RA,N; RA = nargs
524             ;; nargs check, no optional or rest involved
525              ((match-instr the-trap
526                           (ppc-instruction-mask :opcode :to :ra)
527                           (ppc-lap-word (twnei nargs ??)))
528              (%error (if (< (xp-GPR-signed-long xp ppc::nargs) (D-field the-trap))
529                        'too-few-arguments
530                        'too-many-arguments )
531                      (list :nargs (ash (xp-GPR-signed-long xp ppc::nargs)
532                                        (- ppc32::fixnumshift))
533                            :fn  fn)
534                      frame-ptr))
535             
536             ;; twnei RA,N; RA != nargs, N = fulltag_node/immheader
537             ;; type check; look for "lbz rt-imm,-3(ra-node)"
538             ((and (or (match-instr the-trap
539                                    (ppc-instruction-mask :opcode :to :fulltag32)
540                                    (ppc-lap-word (twnei ?? ppc32::fulltag-nodeheader)))
541                       (match-instr the-trap
542                                    (ppc-instruction-mask :opcode :to :fulltag32)
543                                    (ppc-lap-word (twnei ?? ppc32::fulltag-immheader))))
544                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :d)
545                                               (ppc-lap-word (lbz ?? ppc32::misc-subtag-offset ??))
546                                               fn pc-index))
547                   (lisp-reg-p (setq ra (RA-field instr))))
548              (let* ((typecode (D-field the-trap))
549                     (type-tag (logand typecode ppc32::fulltagmask))
550                     (type-name (svref (if (eql type-tag ppc32::fulltag-nodeheader)
551                                         *nodeheader-types*
552                                         *immheader-types*)
553                                       (ldb (byte (- ppc32::num-subtag-bits ppc32::ntagbits) ppc32::ntagbits) typecode))))
554                (%error (make-condition 'type-error
555                                        :format-control (%rsc-string $XWRONGTYPE)
556                                        :datum (xp-GPR-lisp xp ra)
557                                        :expected-type type-name)
558                        nil
559                        frame-ptr)))
560
561             ;; twnei RA,N; RA != nargs, N = subtag_character
562             ;; type check; look for "clrlwi rs-node,ra-imm,24" = "rlwinm rs,ra,0,24,31"
563             ((and (match-instr the-trap
564                                (ppc-instruction-mask :opcode :to :d)
565                                (ppc-lap-word (twnei ?? ppc32::subtag-character)))
566                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :rb :mb :me)
567                                               (ppc-lap-word (rlwinm ?? ?? 0 24 31))
568                                               fn pc-index))
569                   (lisp-reg-p (setq rs (RS-field instr))))
570              (%error (make-condition 'type-error
571                                        :datum (xp-GPR-lisp xp rs)
572                                        :expected-type 'character)
573                        nil
574                        frame-ptr))
575
576             ;; twnei RA,N; RA != nargs, N != fulltag_node/immheader
577             ;; (since that case was handled above.)
578             ;; type check; look for "clrlwi rs-node,ra-imm,29/30" = "rlwinm rs,ra,0,29/30,31"
579             ((and (match-instr the-trap
580                                (ppc-instruction-mask :opcode :to) 
581                                (ppc-lap-word (twnei ?? ??)))
582                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :rb (:mb 28) :me)
583                                               (ppc-lap-word (rlwinm ?? ?? 0 28 31))                                               
584                                               fn pc-index))
585                   (or (eql (- 32 ppc32::ntagbits) (setq temp (ldb #.(ppc-instruction-field :mb) instr)))
586                       (eql (- 32 ppc32::nlisptagbits) temp))
587                   (lisp-reg-p (setq rs (RS-field instr))))
588              (let* ((tag (logand the-trap ppc32::tagmask))
589                     (type-name 
590                      (case tag
591                        (#.ppc32::tag-fixnum 'fixnum)
592                        (#.ppc32::tag-list (if (eql temp (- 32 ppc32::ntagbits)) 'cons 'list))
593                        (#.ppc32::tag-misc 'uvector)
594                        (#.ppc32::tag-imm 'immediate))))                                     
595                (%error (make-condition 'type-error
596                                        :datum (xp-GPR-lisp xp rs)
597                                        :expected-type type-name)
598                        nil
599                        frame-ptr)))
600             
601             ;; twlgti RA,N; RA = nargs (xy = 01)
602             ;; twllti RA,N; RA = nargs (xy = 10)
603             ;; nargs check, optional or rest involved
604             ((and (match-instr the-trap
605                                (ppc-instruction-mask :opcode (:to #x1c) :ra)
606                                (ppc-lap-word (twi ?? ppc::nargs ??)))
607                   (or (eql #b01 (setq temp (ldb #.(ppc-instruction-field :to) the-trap)))
608                       (eql #b10 temp)))
609              (%error (if (eql temp #b10)
610                        'too-few-arguments
611                        'too-many-arguments)
612                      (list :nargs (ash (xp-GPR-signed-long xp ppc::nargs)
613                                        (- ppc32::fixnumshift))
614                            :fn  fn)
615                      frame-ptr))
616             
617             ;; tweqi RA,N; N = unbound
618             ;; symeval boundp check; look for "lwz RA,symbol.vcell(nodereg)"
619             ((and (match-instr the-trap
620                                (ppc-instruction-mask :opcode :to :d)                               
621                                (ppc-lap-word (tweqi ?? ppc32::unbound-marker)))
622                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :d)
623                                               (ppc-lap-word (lwz ?? ppc32::symbol.vcell ??))                                               
624                                               fn pc-index))
625                   (lisp-reg-p (setq ra (RA-field instr))))
626              (setf (xp-GPR-lisp xp (RA-field the-trap))
627                    (%kernel-restart-internal $xvunbnd (list (xp-GPR-lisp xp ra)) frame-ptr)))
628             ;; tweqi RA,N: n = (%slot-unbound-marker)
629             ;; slot-unbound trap.  Look for preceding "lwzx RA,rx,ry".
630             ;; rx = slots-vector, ry = scaled index in slots vector.
631             ((and (match-instr the-trap
632                                (ppc-instruction-mask :opcode :to :d)
633                                (ppc-lap-word (tweqi ?? ppc32::slot-unbound-marker)))
634                   (setq instr (scan-for-instr (ppc-instruction-mask
635                                                :opcode :rt  :x-minor)
636                                               (dpb
637                                                (RA-field the-trap)
638                                                (byte 5 21)
639                                                (ppc-lap-word
640                                                 (lwzx ?? ?? ??)))
641                                               fn pc-index)))
642              (setq *error-reentry-count* 0)  ; succesfully reported error
643
644              ;; %SLOT-UNBOUND-TRAP will decode the arguments further,
645              ;; then call the generic function SLOT-UNBOUND.  That
646              ;; might return a value; if so, set the value of the
647              ;; register that caused the trap to that value.
648              (setf (xp-gpr-lisp xp (ra-field the-trap))
649                    (%slot-unbound-trap (xp-gpr-lisp xp (RA-field instr))
650                                        (ash (- (xp-gpr-signed-long xp (RB-field instr))
651                                                ppc32::misc-data-offset)
652                                             (- ppc32::word-shift))
653                                        frame-ptr)))
654             ;; twlge RA,RB
655             ;; vector bounds check; look for "lwz immreg, misc_header_offset(nodereg)"
656             ((and (match-instr the-trap
657                                (ppc-instruction-mask :opcode :to :x-minor)                               
658                                (ppc-lap-word (twlge 0 0)))
659                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode #|:d|#)
660                                               (ppc-lap-word (lwz ?? ?? #|ppc32::misc-header-offset|# ??))
661                                               fn pc-index))
662                   (lisp-reg-p (setq ra (RA-field instr))))
663              (%error (%rsc-string $xarroob)
664                      (list (xp-GPR-lisp xp (RA-field the-trap))
665                            (xp-GPR-lisp xp ra))
666                      frame-ptr))
667             ;; twi 27 ra d - array header rank check
668             ((and (match-instr the-trap
669                                (ppc-instruction-mask :opcode :to)
670                                (ppc-lap-word (twi 27 ?? ??)))
671                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :d)
672                                               (ppc-lap-word (lwz ?? ppc32::arrayH.rank ??))
673                                               fn pc-index))
674                   (lisp-reg-p (setq ra (RA-field instr))))
675              (%error (%rsc-string $xndims)
676                      (list (xp-gpr-lisp xp ra)
677                            (ash (ldb (byte 16 0) the-trap) (- ppc32::fixnumshift)))
678                      frame-ptr))
679             ;; tw 27 ra rb - array flags check
680             ((and (match-instr the-trap
681                                (ppc-instruction-mask :opcode :to :x-minor)
682                                (ppc-lap-word (tw 27 ?? ??)))
683                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :d)
684                                               (ppc-lap-word (lwz ?? ppc32::arrayH.flags ??))
685                                               fn pc-index))
686                   (lisp-reg-p (setq ra (RA-field instr)))
687                   (let* ((expected (xp-gpr-lisp xp (RB-field the-trap)))
688                          (expected-subtype (ldb
689                                             ppc32::arrayH.flags-cell-subtag-byte
690                                             expected))
691                          (expect-simple (=
692                                          (ldb ppc32::arrayH.flags-cell-bits-byte
693                                               expected)
694                                          (ash 1 $arh_simple_bit)))
695                          (type-name
696                           (case expected-subtype
697                             (#.ppc32::subtag-double-float-vector 'double-float))))
698
699                     (and type-name expect-simple
700                          (setq condition
701                                (make-condition 'type-error
702                                                :datum (xp-gpr-lisp xp ra)
703                                                :expected-type
704                                                `(simple-array ,type-name))))))
705              (%error condition nil frame-ptr))
706                               
707             ;; Unknown trap
708             (t (%error "Unknown trap: #x~x~%xp: ~s, fn: ~s, pc: #x~x"
709                        (list the-trap xp fn (ash pc-index ppc32::fixnumshift))
710                        frame-ptr)))))))))
711
712#+ppc64-target
713(defcallback xcmain (:without-interrupts t
714                                        :address xp 
715                                        :unsigned-fullword fn-reg 
716                                        :address pc-or-index 
717                                        :unsigned-fullword the-trap
718                                        :signed-doubleword  arg0
719                                        :signed-doubleword arg1)
720  ;; tdgti nargs,0
721  ;; time for event polling.
722  ;; This used to happen a lot so we test for it first.
723  (let ((fn (unless (eql fn-reg 0) (xp-gpr-lisp xp fn-reg))))
724    (with-xp-stack-frames (xp fn frame-ptr)
725      (if (eql the-trap (ppc-lap-word (tdgti nargs 0)))
726        (cmain)
727        (with-error-reentry-detection
728          (let ((pc-index (if (eql fn-reg 0) pc-or-index (%ptr-to-int pc-or-index)))
729                instr ra temp rs condition)
730            (cond
731              ;; tdeqi RA nil-value - resolve-eep, or resolve-foreign-variable
732              ((and (match-instr the-trap
733                                 (ppc-instruction-mask  :opcode :to :d)
734                                 (ppc-lap-word (tdeqi ?? (target-nil-value))))
735                    (setq instr (scan-for-instr
736                                 (ppc-instruction-mask :opcode :ds :ds-xo)
737                                 (ppc-lap-word (ld ??
738                                                    (+ 8 ppc64::misc-data-offset)
739                                                    ??))
740                                               fn pc-index)))
741               (let* ((eep-or-fv (xp-gpr-lisp xp (RA-field instr))))
742                 (etypecase eep-or-fv
743                   (external-entry-point
744                    (resolve-eep eep-or-fv)
745                    (setf (xp-gpr-lisp xp (RA-field the-trap))
746                          (eep.address eep-or-fv)))
747                   (foreign-variable
748                    (resolve-foreign-variable eep-or-fv)
749                    (setf (xp-gpr-lisp xp (RA-field the-trap))
750                          (fv.addr eep-or-fv))))))
751              ((= the-trap #$SIGBUS)
752               (%error (make-condition 'invalid-memory-access
753                                       :address arg0
754                                       :write-p (not (zerop arg1)))
755                       ()
756                       frame-ptr))
757              ;; tdnei RA,N; RA = nargs
758              ;; nargs check, no optional or rest involved
759              ((match-instr the-trap
760                           (ppc-instruction-mask :opcode :to :ra)
761                           (ppc-lap-word (tdnei nargs ??)))
762              (%error (if (< (xp-GPR-signed-doubleword xp ppc::nargs) (D-field the-trap))
763                        'too-few-arguments
764                        'too-many-arguments )
765                      (list :nargs (ash (xp-GPR-signed-doubleword xp ppc::nargs)
766                                        (- ppc64::fixnumshift))
767                            :fn  fn)
768                      frame-ptr))
769             
770             ;; tdnei RA,N; RA != nargs, N = lowtag_node/immheader
771             ;; type check; look for "lbz rt-imm,-5(ra-node)"
772             ((and (or (match-instr the-trap
773                                    (ppc-instruction-mask :opcode :to :lowtag64)
774                                    (ppc-lap-word (tdnei ?? ppc64::lowtag-nodeheader)))
775                       (match-instr the-trap
776                                    (ppc-instruction-mask :opcode :rt :lowtag64)
777                                    (ppc-lap-word (tdnei ?? ppc64::lowtag-immheader))))
778                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :d)
779                                               (ppc-lap-word (lbz ?? ppc64::misc-subtag-offset ??))
780                                               fn pc-index))
781                   (lisp-reg-p (setq ra (RA-field instr))))
782              (let* ((typecode (D-field the-trap))
783                     (type-tag (logand typecode ppc64::lowtagmask))
784                     (type-name (svref (if (eql type-tag ppc64::lowtag-nodeheader)
785                                         *nodeheader-types*
786                                         *immheader-types*)
787                                       (ash typecode (- ppc64::nlowtagbits)))))
788                (%error (make-condition 'type-error
789                                        :format-control (%rsc-string $XWRONGTYPE)
790                                        :datum (xp-GPR-lisp xp ra)
791                                        :expected-type type-name)
792                        nil
793                        frame-ptr)))
794             ;; tdnei RA,N; RA != nargs, N = subtag_character type
795             ;; check; look for "clrldi rs-node,ra-imm,56" = "rldicl
796             ;; rs,ra,0,55"
797             ((and (match-instr the-trap
798                                (ppc-instruction-mask :opcode :rt :d)
799                                (ppc-lap-word (tdnei ?? ppc64::subtag-character)))
800                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :sh :mb6 :sh6)
801                                               (ppc-lap-word (rldicl ?? ?? 0 56))
802                                               fn pc-index))
803                   (lisp-reg-p (setq rs (RS-field instr))))
804              (%error (make-condition 'type-error
805                                        :datum (xp-GPR-lisp xp rs)
806                                        :expected-type 'character)
807                        nil
808                        frame-ptr))
809
810             ;; tdnei RA,N; RA != nargs, N = ppc64::tag-fixnum.  type
811             ;; check; look for "clrldi rs-node,ra-imm,61" = "rldicl
812             ;; rs,ra,61"
813             ((and (match-instr the-trap
814                                (ppc-instruction-mask :opcode :rt)
815                                (ppc-lap-word (tdnei ?? ppc64::tag-fixnum)))
816                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :sh :mb6 :sh6)
817                                               (ppc-lap-word (rldicl ?? ?? 0 61))                                               
818                                               fn pc-index))
819
820                   (lisp-reg-p (setq rs (RS-field instr))))
821                (%error (make-condition 'type-error
822                                        :datum (xp-GPR-lisp xp rs)
823                                        :expected-type 'fixnum)
824                        nil
825                        frame-ptr))
826             ;; tdi 3,RA,ppc64::fulltag-cons; RA != nargs type check;
827             ;; look for "clrldi rs-node,ra-imm,60" = "rldicl
828             ;; rs,ra,60"
829             ((and (match-instr the-trap
830                                (ppc-instruction-mask :opcode :to :d)
831                                (ppc-lap-word (tdi 3 ?? ppc64::fulltag-cons)))
832                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :sh :mb6 :sh6)
833                                               (ppc-lap-word (rldicl ?? ?? 0 60))                                               
834                                               fn pc-index))
835
836                   (lisp-reg-p (setq rs (RS-field instr))))
837                (%error (make-condition 'type-error
838                                        :datum (xp-GPR-lisp xp rs)
839                                        :expected-type 'list)
840                        nil
841                        frame-ptr))             
842             ;; tdnei RA,ppc64::fulltag-cons; RA != nargs type check;
843             ;; look for "clrldi rs-node,ra-imm,60" = "rldicl
844             ;; rs,ra,60"
845             ((and (match-instr the-trap
846                                (ppc-instruction-mask :opcode :to :d)
847                                (ppc-lap-word (tdnei ?? ppc64::fulltag-cons)))
848                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :sh :mb6 :sh6)
849                                               (ppc-lap-word (rldicl ?? ?? 0 60))                                               
850                                               fn pc-index))
851
852                   (lisp-reg-p (setq rs (RS-field instr))))
853                (%error (make-condition 'type-error
854                                        :datum (xp-GPR-lisp xp rs)
855                                        :expected-type 'cons)
856                        nil
857                        frame-ptr))
858             ;; tdnei RA,ppc64::subtag-single-float; RA != nargs type check;
859             ;; look for "clrldi rs-node,ra-imm,60" = "rldicl
860             ;; rs,ra,60"
861             ((and (match-instr the-trap
862                                (ppc-instruction-mask :opcode :to :d)
863                                (ppc-lap-word (tdnei ?? ppc64::subtag-single-float)))
864                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :sh :mb6 :sh6)
865                                               (ppc-lap-word (rldicl ?? ?? 0 60))                                               
866                                               fn pc-index))
867
868                   (lisp-reg-p (setq rs (RS-field instr))))
869                (%error (make-condition 'type-error
870                                        :datum (xp-GPR-lisp xp rs)
871                                        :expected-type 'short-float)
872                        nil
873                        frame-ptr))
874             ;; tdnei RA,ppc64::fulltag-misc; RA != nargs type check;
875             ;; look for "clrldi rs-node,ra-imm,60" = "rldicl
876             ;; rs,ra,60"
877             ((and (match-instr the-trap
878                                (ppc-instruction-mask :opcode :to :d)
879                                (ppc-lap-word (tdnei ?? ppc64::fulltag-misc)))
880                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :sh :mb6 :sh6)
881                                               (ppc-lap-word (rldicl ?? ?? 0 60))                                               
882                                               fn pc-index))
883
884                   (lisp-reg-p (setq rs (RS-field instr))))
885                (%error (make-condition 'type-error
886                                        :datum (xp-GPR-lisp xp rs)
887                                        :expected-type 'uvector)
888                        nil
889                        frame-ptr))
890             ;; tdlgti RA,N; RA = nargs (xy = 01)
891             ;; tdllti RA,N; RA = nargs (xy = 10)
892             ;; nargs check, optional or rest involved
893             ((and (match-instr the-trap
894                                (ppc-instruction-mask :opcode (:to #x1c) :ra)
895                                (ppc-lap-word (tdi ?? ppc::nargs ??)))
896                   (or (eql #b01 (setq temp (ldb #.(ppc-instruction-field :to) the-trap)))
897                       (eql #b10 temp)))
898              (%error (if (eql temp #b10)
899                        'too-few-arguments
900                        'too-many-arguments)
901                      (list :nargs (ash (xp-GPR-signed-doubleword xp ppc::nargs)
902                                        (- ppc64::fixnumshift))
903                            :fn  fn)
904                      frame-ptr))
905             
906             ;; tdeqi RA,N; N = unbound
907             ;; symeval boundp check; look for "ld RA,symbol.vcell(nodereg)"
908             ((and (match-instr the-trap
909                                (ppc-instruction-mask :opcode :to :d) 
910                                (ppc-lap-word (tdeqi ?? ppc64::unbound-marker)))
911                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :ds :ds-xo)
912                                               (ppc-lap-word (ld ?? ppc64::symbol.vcell ??))                                               
913                                               fn pc-index))
914                   (lisp-reg-p (setq ra (RA-field instr))))
915              (setf (xp-GPR-lisp xp (RA-field the-trap))
916                    (%kernel-restart-internal $xvunbnd (list (xp-GPR-lisp xp ra)) frame-ptr)))
917             ;; tdeqi RA,N: n = (%slot-unbound-marker)
918             ;; slot-unbound trap.  Look for preceding "ldx RA,rx,ry".
919             ;; rx = slots-vector, ry = scaled index in slots vector.
920             ((and (match-instr the-trap
921                                (ppc-instruction-mask :opcode :to :d)
922                                (ppc-lap-word (tdeqi ?? ppc64::slot-unbound-marker)))
923                   (setq instr (scan-for-instr (ppc-instruction-mask
924                                                :opcode :rt  :x-minor)
925                                               (dpb
926                                                (RA-field the-trap)
927                                                (byte 5 21)
928                                                (ppc-lap-word
929                                                 (ldx ?? ?? ??)))
930                                               fn pc-index)))
931              (setq *error-reentry-count* 0)  ; succesfully reported error
932              ;; %SLOT-UNBOUND-TRAP will decode the arguments further,
933              ;; then call the generic function SLOT-UNBOUND.  That
934              ;; might return a value; if so, set the value of the
935              ;; register that caused the trap to that value.
936              (setf (xp-gpr-lisp xp (ra-field the-trap))
937                    (%slot-unbound-trap (xp-gpr-lisp xp (RA-field instr))
938                                        (ash (- (xp-gpr-signed-doubleword xp (RB-field instr))
939                                                ppc64::misc-data-offset)
940                                             (- ppc64::word-shift))
941                                        frame-ptr)))
942             ;; tdlge RA,RB
943             ;; vector bounds check; look for "ld immreg, misc_header_offset(nodereg)"
944             ((and (match-instr the-trap
945                                (ppc-instruction-mask :opcode :to :x-minor)
946                                (ppc-lap-word (tdlge ?? ??)))
947                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode #|:d|# :ds-xo)
948                                               (ppc-lap-word (ld ?? ?? #|ppc32::misc-header-offset|# ??))
949                                               fn pc-index))
950                   (lisp-reg-p (setq ra (RA-field instr))))
951              (%error (%rsc-string $xarroob)
952                      (list (xp-GPR-lisp xp (RA-field the-trap))
953                            (xp-GPR-lisp xp ra))
954                      frame-ptr))
955             ;; tdi 27 ra d - array header rank check
956             ((and (match-instr the-trap
957                                (ppc-instruction-mask :opcode :to)
958                                (ppc-lap-word (tdi 27 ?? ??)))
959                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :ds :ds-xo)
960                                               (ppc-lap-word (ld ?? ppc64::arrayH.rank ??))
961                                               fn pc-index))
962                   (lisp-reg-p (setq ra (RA-field instr))))
963              (%error (%rsc-string $xndims)
964                      (list (xp-gpr-lisp xp ra)
965                            (ash (ldb (byte 16 0) the-trap) (- ppc64::fixnumshift)))
966                      frame-ptr))
967             ;; td 27 ra rb - array flags check
968             ((and (match-instr the-trap
969                                (ppc-instruction-mask :opcode :to :x-minor)
970                                (ppc-lap-word (td 27 ?? ??)))
971                   (setq instr (scan-for-instr (ppc-instruction-mask :opcode :ds :ds-xo)
972                                               (ppc-lap-word (ld ?? ppc64::arrayH.flags ??))
973                                               fn pc-index))
974                   (lisp-reg-p (setq ra (RA-field instr)))
975                   (let* ((expected (xp-gpr-lisp xp (RB-field the-trap)))
976                          (expected-subtype (ldb
977                                             ppc64::arrayH.flags-cell-subtag-byte
978                                             expected))
979                          (expect-simple (=
980                                          (ldb ppc64::arrayH.flags-cell-bits-byte
981                                               expected)
982                                          (ash 1 $arh_simple_bit)))
983                          (type-name
984                           (case expected-subtype
985                             (#.ppc64::subtag-double-float-vector 'double-float))))
986
987                     (and type-name expect-simple
988                          (setq condition
989                                (make-condition 'type-error
990                                                :datum (xp-gpr-lisp xp ra)
991                                                :expected-type
992                                                `(simple-array ,type-name))))))
993              (%error condition nil frame-ptr))
994                               
995             ;; Unknown trap
996             (t (%error "Unknown trap: #x~x~%xp: ~s, fn: ~s, pc: #x~x"
997                        (list the-trap xp fn (ash pc-index ppc64::fixnumshift))
998                        frame-ptr)))))))))
999
1000
1001
1002
1003
Note: See TracBrowser for help on using the repository browser.