0.pre7.58:

[sbcl.git] / src / compiler / alpha / insts.lisp

diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp
index b7a8603..277d010 100644 (file)
--- a/src/compiler/alpha/insts.lisp
+++ b/src/compiler/alpha/insts.lisp
@@ -1,20 +1,15 @@
-;;; -*- Package: ALPHA -*-
-;;;
-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
-
-;;;
-;;; **********************************************************************
-;;;
-;;; This file contains the instruction set definition for the Alpha.
-;;;
-;;; Written by Sean Hallgren.
-;;;
+;;; the instruction set definition for the Alpha
 
-(in-package "SB!VM")
+;;;; 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)
@@ -22,9 +17,8 @@
 ;;; ../x86/insts contains the invocation
 ;;; (setf sb!disassem:*disassem-inst-alignment-bytes* 1)
 ;;; which apparently was another use of def-assembler-params
-
 \f
-;;;; Utility functions.
+;;;; utility functions
 
 (defun reg-tn-encoding (tn)
   (declare (type tn tn)
@@ -45,9 +39,8 @@
      (unless (eq (sb-name (sc-sb (tn-sc tn))) 'float-registers)
        (error "~S isn't a floating-point register." tn))
      (tn-offset tn))))
-
 \f
-;;;; Initial disassembler setup.
+;;;; initial disassembler setup
 
 ;; XXX find out what this was supposed to do
 ;; (sb!disassem:set-disassem-params :instruction-alignment 32)
@@ -97,7 +90,8 @@
 
 
 \f
-;;;; Define-instruction-formats for disassembler.
+;;;; DEFINE-INSTRUCTION-FORMATs for the disassembler
+
 (sb!disassem:define-instruction-format
     (memory 32 :default-printer '(:name :tab ra "," disp "(" rb ")"))
   (op   :field (byte 6 26))
@@ -152,7 +146,8 @@
   (palcode :field (byte 26 0)))
 
 \f
-;;;; Emitters.
+;;;; emitters
+
 (define-bitfield-emitter emit-word 16
   (byte 16 0))
 
@@ -180,9 +175,9 @@
 
 (define-bitfield-emitter emit-pal 32
   (byte 6 26) (byte 26 0))
-
 \f
-;;;; Macros for instructions.
+;;;; macros for instructions
+
 (macrolet ((define-memory (name op &optional fixup float)
              `(define-instruction ,name (segment ra disp rb ,@(if fixup
                                                                   '(&optional type)))
@@ -445,7 +440,7 @@
 (define-instruction gentrap (segment code)
   (:printer call-pal ((palcode #xaa0000)))
   (:emitter
-   (emit-lword segment #x000080)
+   (emit-lword segment #x000081)        ;actually bugchk
    (emit-lword segment code)))
 
 (define-instruction-macro move (src dst)
@@ -542,17 +537,17 @@
        (emit-lword segment
                  (logior type
                          (ash (+ posn (component-header-length))
-                              (- type-bits word-shift)))))))
+                              (- n-widetag-bits word-shift)))))))
 
-(define-instruction function-header-word (segment)
+(define-instruction simple-fun-header-word (segment)
   (:cost 0)
   (:emitter
-   (emit-header-data segment function-header-type)))
+   (emit-header-data segment simple-fun-header-widetag)))
 
 (define-instruction lra-header-word (segment)
   (:cost 0)
   (:emitter
-   (emit-header-data segment return-pc-header-type)))
+   (emit-header-data segment return-pc-header-widetag)))
 
 (defun emit-compute-inst (segment vop dst src label temp calc)
   (declare (ignore temp))
@@ -597,7 +592,7 @@
   (:emitter
    (emit-compute-inst segment vop dst src label temp
                      #'(lambda (label posn delta-if-after)
-                         (- other-pointer-type
+                         (- other-pointer-lowtag
                             (label-position label posn delta-if-after)
                             (component-header-length))))))