source: branches/working-0711/ccl/level-1/ppc-trap-support.lisp @ 12944

Last change on this file since 12944 was 11069, checked in by gz, 11 years ago

remove more unused files, bootstrap another backend change from the trunk that shouldn't affect anything here, plus some formatting changes, all to make diffs more managable

  • 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.