X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fhppa%2Finsts.lisp;h=d04c641d35451114f9960e296fcc525f8156e2e8;hb=69d60b456b07a0256f08df0d02484f361ce5737c;hp=4e03d54a5b47c031e5a109cef73d4f13af270f35;hpb=8a19c6876412b8ad1cf729297c2a373d63a0d0ec;p=sbcl.git diff --git a/src/compiler/hppa/insts.lisp b/src/compiler/hppa/insts.lisp index 4e03d54..d04c641 100644 --- a/src/compiler/hppa/insts.lisp +++ b/src/compiler/hppa/insts.lisp @@ -1,10 +1,18 @@ +;;;; the instruction set definition for HPPA + +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. + (in-package "SB!VM") -;;; (def-assembler-params -;;; :scheduler-p nil) (eval-when (:compile-toplevel :load-toplevel :execute) (setf sb!assem:*assem-scheduler-p* nil)) - ;;;; Utility functions. @@ -14,7 +22,7 @@ (null null-offset) (zero zero-offset) (t - (assert (eq (sb-name (sc-sb (tn-sc tn))) 'registers)) + (aver (eq (sb-name (sc-sb (tn-sc tn))) 'registers)) (tn-offset tn)))) (defun fp-reg-tn-encoding (tn) @@ -136,9 +144,9 @@ dstate)))) (defparameter float-reg-symbols - (coerce - (loop for n from 0 to 31 collect (make-symbol (format nil "$F~d" n))) - 'vector)) + #.(coerce + (loop for n from 0 to 31 collect (make-symbol (format nil "$F~d" n))) + 'vector)) (sb!disassem:define-arg-type fp-reg :printer #'(lambda (value stream dstate) @@ -390,21 +398,19 @@ (cond (length-only (values 0 (1+ length) nil nil)) (t - (sb!kernel:copy-from-system-area sap (* n-byte-bits (1+ offset)) - vector (* n-word-bits - vector-data-offset) - (* length n-byte-bits)) + (sb!kernel:copy-ub8-from-system-area sap (1+ offset) + vector 0 length) (collect ((sc-offsets) (lengths)) (lengths 1) ; the length byte (let* ((index 0) - (error-number (sb!c::read-var-integer vector index))) + (error-number (sb!c:read-var-integer vector index))) (lengths index) (loop (when (>= index length) (return)) (let ((old-index index)) - (sc-offsets (sb!c::read-var-integer vector index)) + (sc-offsets (sb!c:read-var-integer vector index)) (lengths (- index old-index)))) (values error-number (1+ length) @@ -415,19 +421,19 @@ (declare (ignore inst)) (flet ((nt (x) (if stream (sb!disassem:note x dstate)))) (case (break-im5 chunk dstate) - (#.sb!vm:error-trap + (#.error-trap (nt "Error trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.sb!vm:cerror-trap + (#.cerror-trap (nt "Cerror trap") (sb!disassem:handle-break-args #'snarf-error-junk stream dstate)) - (#.sb!vm:breakpoint-trap + (#.breakpoint-trap (nt "Breakpoint trap")) - (#.sb!vm:pending-interrupt-trap + (#.pending-interrupt-trap (nt "Pending interrupt trap")) - (#.sb!vm:halt-trap + (#.halt-trap (nt "Halt trap")) - (#.sb!vm:fun-end-breakpoint-trap + (#.fun-end-breakpoint-trap (nt "Function end breakpoint trap")) ))) @@ -495,7 +501,7 @@ (declare (type (or fixup (signed-byte 14)))) (cond ((fixup-p disp) (note-fixup segment :load disp) - (assert (or (null (fixup-offset disp)) (zerop (fixup-offset disp)))) + (aver (or (null (fixup-offset disp)) (zerop (fixup-offset disp)))) 0) (t (dpb (ldb (byte 13 0) disp) @@ -559,7 +565,7 @@ (declare (type (or fixup (signed-byte 5)) disp)) (cond ((fixup-p disp) (note-fixup segment :load-short disp) - (assert (or (null (fixup-offset disp)) (zerop (fixup-offset disp)))) + (aver (or (null (fixup-offset disp)) (zerop (fixup-offset disp)))) 0) (t (dpb (ldb (byte 4 0) disp) @@ -641,7 +647,7 @@ (declare (type (or fixup (signed-byte 21) (unsigned-byte 21)) value)) (cond ((fixup-p value) (note-fixup segment :hi value) - (assert (or (null (fixup-offset value)) (zerop (fixup-offset value)))) + (aver (or (null (fixup-offset value)) (zerop (fixup-offset value)))) 0) (t (logior (ash (ldb (byte 5 2) value) 16) @@ -684,7 +690,7 @@ (declare (type (or fixup (signed-byte 17)) disp)) (cond ((fixup-p disp) (note-fixup segment :branch disp) - (assert (or (null (fixup-offset disp)) (zerop (fixup-offset disp)))) + (aver (or (null (fixup-offset disp)) (zerop (fixup-offset disp)))) (values 0 0 0)) (t (values (ldb (byte 5 11) disp) @@ -702,7 +708,7 @@ (emit-back-patch segment 4 #'(lambda (segment posn) (let ((disp (label-relative-displacement target posn))) - (assert (<= (- (ash 1 16)) disp (1- (ash 1 16)))) + (aver (<= (- (ash 1 16)) disp (1- (ash 1 16)))) (multiple-value-bind (w1 w2 w) (decompose-branch-disp segment disp) @@ -770,7 +776,7 @@ (emit-back-patch segment 4 #'(lambda (segment posn) (let ((disp (label-relative-displacement target posn))) - (assert (<= (- (ash 1 11)) disp (1- (ash 1 11)))) + (aver (<= (- (ash 1 11)) disp (1- (ash 1 11)))) (let ((w1 (logior (ash (ldb (byte 10 0) disp) 1) (ldb (byte 1 10) disp))) (w (ldb (byte 1 11) disp))) @@ -1117,7 +1123,7 @@ (result-encoding double-p) (fp-reg-tn-encoding result) (when side - (assert double-p) + (aver double-p) (setf double-p nil)) (emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base) (reg-tn-encoding index) 0 (if scale 1 0) 0 0 0 @@ -1136,7 +1142,7 @@ (value-encoding double-p) (fp-reg-tn-encoding value) (when side - (assert double-p) + (aver double-p) (setf double-p nil)) (emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base) (reg-tn-encoding index) 0 (if scale 1 0) 0 0 1 @@ -1156,7 +1162,7 @@ (result-encoding double-p) (fp-reg-tn-encoding result) (when side - (assert double-p) + (aver double-p) (setf double-p nil)) (emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base) (short-disp-encoding segment disp) 0 @@ -1177,7 +1183,7 @@ (value-encoding double-p) (fp-reg-tn-encoding value) (when side - (assert double-p) + (aver double-p) (setf double-p nil)) (emit-fp-load/store segment (if double-p #x0B #x09) (reg-tn-encoding base) (short-disp-encoding segment disp) 0 @@ -1220,7 +1226,7 @@ (multiple-value-bind (to-encoding to-double-p) (fp-reg-tn-encoding to) - (assert (eq from-double-p to-double-p)) + (aver (eq from-double-p to-double-p)) (emit-fp-class-0-inst segment #x0C from-encoding 0 (+ 2 (or (position op funops) (error "Bogus FUNOP: ~S" op))) @@ -1259,7 +1265,7 @@ (multiple-value-bind (r2-encoding r2-double-p) (fp-reg-tn-encoding r2) - (assert (eq r1-double-p r2-double-p)) + (aver (eq r1-double-p r2-double-p)) (emit-fp-class-0-inst segment #x0C r1-encoding r2-encoding 0 (if r1-double-p 1 0) 2 0 0 cond))))) @@ -1292,11 +1298,11 @@ (multiple-value-bind (r2-encoding r2-double-p) (fp-reg-tn-encoding r2) - (assert (eq r1-double-p r2-double-p)) + (aver (eq r1-double-p r2-double-p)) (multiple-value-bind (result-encoding result-double-p) (fp-reg-tn-encoding result) - (assert (eq r1-double-p result-double-p)) + (aver (eq r1-double-p result-double-p)) (emit-fp-class-0-inst segment #x0C r1-encoding r2-encoding (or (position op fbinops) (error "Bogus FBINOP: ~S" op))