X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fppc%2Fmacros.lisp;h=e566001c1f5f4d77b3dfb4bb0bc1e794ec02f28d;hb=95591ed483dbb8c0846c129953acac1554f28809;hp=6eace04569b2fbfae6ae45f0fe399d993bd7082b;hpb=d294785c8e313384513208c1d93a44c3f22a0464;p=sbcl.git diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp index 6eace04..e566001 100644 --- a/src/compiler/ppc/macros.lisp +++ b/src/compiler/ppc/macros.lisp @@ -94,7 +94,7 @@ (defmacro emit-return-pc (label) "Emit a return-pc header word. LABEL is the label to use for this return-pc." `(progn - (align n-lowtag-bits) + (emit-alignment n-lowtag-bits) (emit-label ,label) (inst lra-header-word))) @@ -252,62 +252,36 @@ ;;;; Error Code -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun emit-error-break (vop kind code values) - (let ((vector (gensym))) - `((let ((vop ,vop)) - (when vop - (note-this-location vop :internal-error))) - (inst unimp ,kind) - (with-adjustable-vector (,vector) - (write-var-integer (error-number-or-lose ',code) ,vector) - ,@(mapcar #'(lambda (tn) - `(let ((tn ,tn)) - (write-var-integer (make-sc-offset (sc-number - (tn-sc tn)) - (tn-offset tn)) - ,vector))) - values) - (inst byte (length ,vector)) - (dotimes (i (length ,vector)) - (inst byte (aref ,vector i)))) - (align word-shift))))) - -(defmacro error-call (vop error-code &rest values) +(defun emit-error-break (vop kind code values) + (assemble () + (when vop + (note-this-location vop :internal-error)) + (inst unimp kind) + (with-adjustable-vector (vector) + (write-var-integer code vector) + (dolist (tn values) + (write-var-integer (make-sc-offset (sc-number (tn-sc tn)) + (or (tn-offset tn) 0)) + vector)) + (inst byte (length vector)) + (dotimes (i (length vector)) + (inst byte (aref vector i))) + (emit-alignment word-shift)))) + +(defun error-call (vop error-code &rest values) + #!+sb-doc "Cause an error. ERROR-CODE is the error to cause." - (cons 'progn - (emit-error-break vop error-trap error-code values))) - + (emit-error-break vop error-trap (error-number-or-lose error-code) values)) -(defmacro cerror-call (vop label error-code &rest values) - "Cause a continuable error. If the error is continued, execution resumes at - LABEL." - `(progn - ,@(emit-error-break vop cerror-trap error-code values) - (inst b ,label))) - -(defmacro generate-error-code (vop error-code &rest values) +(defun generate-error-code (vop error-code &rest values) + #!+sb-doc "Generate-Error-Code Error-code Value* Emit code for an error with the specified Error-Code and context Values." - `(assemble (*elsewhere*) - (let ((start-lab (gen-label))) - (emit-label start-lab) - (error-call ,vop ,error-code ,@values) - start-lab))) - -(defmacro generate-cerror-code (vop error-code &rest values) - "Generate-CError-Code Error-code Value* - Emit code for a continuable error with the specified Error-Code and - context Values. If the error is continued, execution resumes after - the GENERATE-CERROR-CODE form." - (with-unique-names (continue error) - `(let ((,continue (gen-label))) - (emit-label ,continue) - (assemble (*elsewhere*) - (let ((,error (gen-label))) - (emit-label ,error) - (cerror-call ,vop ,continue ,error-code ,@values) - ,error))))) + (assemble (*elsewhere*) + (let ((start-lab (gen-label))) + (emit-label start-lab) + (emit-error-break vop error-trap (error-number-or-lose error-code) values) + start-lab))) ;;;; PSEUDO-ATOMIC