-;;; -*- 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)
;;; ../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)
(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)
\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))
(palcode :field (byte 26 0)))
\f
-;;;; Emitters.
+;;;; emitters
+
(define-bitfield-emitter emit-word 16
(byte 16 0))
(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)))
(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)
(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))
(: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))))))