X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Finsts.lisp;h=277d010b07c9e78606102d8f87ba601f3aae3e27;hb=3c65762b927af861c9c8bc416e4cbac9a14ec0c3;hp=b7a860338203241a06105d5855320ac231aaa202;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/compiler/alpha/insts.lisp b/src/compiler/alpha/insts.lisp index b7a8603..277d010 100644 --- 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 - -;;;; 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)))) - -;;;; 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 @@ -;;;; 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))) -;;;; 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)) - -;;;; 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))))))