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

Last change on this file since 15237 was 13067, checked in by rme, 10 years ago

Update copyright notices.

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