Skip to content
Snippets Groups Projects
Commit f8744a25 authored by pw's avatar pw
Browse files

Changes so far for DEC alpha support. Not done yet.

parent 4b96ae74
No related branches found
No related tags found
No related merge requests found
;;; Being hacked to add IEEE support
;;; -*- Package: ALPHA; Log: C.Log -*-
;;;
;;; **********************************************************************
......@@ -5,7 +6,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.2 1994/10/31 04:39:51 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.3 1997/06/07 19:04:38 pw Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -13,6 +14,7 @@
;;;
;;; Written by Rob MacLachlan
;;; Conversion by Sean Hallgren
;;; IEEE variants by Paul Werkowski
;;;
(in-package "ALPHA")
......@@ -147,32 +149,43 @@
(:vop-var vop)
(:save-p :compute-only))
;;; Need to insure that ops that can cause traps do not clobber an
;;; argument register with invalid results. This so the software
;;; trap handler can re-execute the instruction and produce correct
;;; IEEE result. The :from :load hopefully does that.
(macrolet ((frob (name sc ptype)
`(define-vop (,name float-op)
(:args (x :scs (,sc))
(y :scs (,sc)))
(:results (r :scs (,sc)))
(:results (r :scs (,sc) :from :load))
(:arg-types ,ptype ,ptype)
(:result-types ,ptype))))
(frob single-float-op single-reg single-float)
(frob double-float-op double-reg double-float))
;; This is resumption-safe with underflow traps enabled,
;; with software handling and (notyet) dynamic rounding mode.
(macrolet ((frob (op sinst sname scost dinst dname dcost)
`(progn
(define-vop (,sname single-float-op)
(:translate ,op)
(:variant-cost ,scost)
(:generator ,scost
(inst ,sinst x y r)))
(inst ,sinst x y r)
(note-this-location vop :internal-error)
(inst trapb)))
(define-vop (,dname double-float-op)
(:translate ,op)
(:variant-cost ,dcost)
(:generator ,dcost
(inst ,dinst x y r))))))
(frob + adds +/single-float 2 addt +/double-float 2)
(frob - subs -/single-float 2 subt -/double-float 2)
(frob * muls */single-float 4 mult */double-float 5)
(frob / divs //single-float 12 divt //double-float 19))
(inst ,dinst x y r)
(note-this-location vop :internal-error)
(inst trapb))))))
;; Not sure these cost number are right. +*- about same / is 4x
(frob + adds_su +/single-float 1 addt_su +/double-float 1)
(frob - subs_su -/single-float 1 subt_su -/double-float 1)
(frob * muls_su */single-float 1 mult_su */double-float 1)
(frob / divs_su //single-float 4 divt_su //double-float 4))
(macrolet ((frob (name inst translate sc type)
`(define-vop (,name)
......@@ -213,6 +226,7 @@
(if complement
(inst cmptle x y temp)
(inst cmptlt x y temp)))
(inst trapb)
(if (if complement (not not-p) not-p)
(inst fbeq temp target)
(inst fbne temp target))))
......@@ -497,19 +511,23 @@
(defknown ((setf floating-point-modes)) (float-modes)
float-modes)
;;; Modes bits are (byte 12 52) of fpcr. Grab and return in low bits.
(define-vop (floating-point-modes)
(:results (res :scs (unsigned-reg)))
(:result-types unsigned-num)
(:translate floating-point-modes)
(:policy :fast-safe)
(:vop-var vop)
(:temporary (:sc unsigned-stack) temp)
(:temporary (:sc single-reg) temp1)
(:generator 3
(:temporary (:sc double-stack) temp)
(:temporary (:sc double-reg) temp1)
(:generator 5
(let ((nfp (current-nfp-tn vop)))
(inst excb)
(inst mf_fpcr temp1 temp1 temp1)
(inst sts temp1 (* word-bytes (tn-offset temp)) nfp)
(loadw res nfp (tn-offset temp)))))
(inst excb)
(inst stt temp1 (* word-bytes (tn-offset temp)) nfp)
(inst ldl res (* (1+ (tn-offset temp)) vm:word-bytes) nfp)
(inst srl res 49 res))))
(define-vop (set-floating-point-modes)
(:args (new :scs (unsigned-reg) :target res))
......@@ -518,12 +536,16 @@
(:result-types unsigned-num)
(:translate (setf floating-point-modes))
(:policy :fast-safe)
(:temporary (:sc unsigned-stack) temp)
(:temporary (:sc single-reg) temp1)
(:temporary (:sc double-stack) temp)
(:temporary (:sc double-reg) temp1)
(:vop-var vop)
(:generator 3
(:generator 8
(let ((nfp (current-nfp-tn vop)))
(storew new nfp (tn-offset temp))
(inst lds temp1 (* word-bytes (tn-offset temp)) nfp)
(inst sll new 49 res)
(inst stl zero-tn (* (tn-offset temp) vm:word-bytes) nfp)
(inst stl res (* (1+ (tn-offset temp)) vm:word-bytes) nfp)
(inst ldt temp1 (* (tn-offset temp) vm:word-bytes) nfp)
(inst excb)
(inst mt_fpcr temp1 temp1 temp1)
(inst excb)
(move res new))))
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/insts.lisp,v 1.3 1994/10/31 04:39:51 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/insts.lisp,v 1.4 1997/06/07 19:04:39 pw Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -415,6 +415,35 @@
(define-fp-operate subs #x16 #x081)
(define-fp-operate subt #x16 #x0a1)
;;; IEEE support
(defconstant +su+ #x500) ; software, underflow enabled
(defconstant +sui+ #x700) ; software, inexact & underflow enabled
(defconstant +sv+ #x500) ; software, interger overflow enabled
(defconstant +svi+ #x700)
(defconstant +rnd+ #x0c0) ; dynamic rounding mode
(defconstant +sud+ #x5c0)
(defconstant +svid+ #x7c0)
(defconstant +suid+ #x7c0)
(define-fp-operate cvtqs_su #x16 (logior +su+ #x0bc) 2)
(define-fp-operate cvtqt_su #x16 (logior +su+ #x0be) 2)
(define-fp-operate cvtts_su #x16 (logior +su+ #x0ac) 2)
(define-fp-operate adds_su #x16 (logior +su+ #x080))
(define-fp-operate addt_su #x16 (logior +su+ #x0a0))
(define-fp-operate divs_su #x16 (logior +su+ #x083))
(define-fp-operate divt_su #x16 (logior +su+ #x0a3))
(define-fp-operate muls_su #x16 (logior +su+ #x082))
(define-fp-operate mult_su #x16 (logior +su+ #x0a2))
(define-fp-operate subs_su #x16 (logior +su+ #x081))
(define-fp-operate subt_su #x16 (logior +su+ #x0a1))
(define-instruction excb (segment)
(:emitter (emit-lword segment #x63ff0400)))
(define-instruction trapb (segment)
(:emitter (emit-lword segment #x63ff0000)))
(define-instruction gentrap (segment code)
(:printer call-pal ((palcode #xaa0000)))
(:emitter
......
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/parms.lisp,v 1.2 1994/10/31 04:39:51 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/parms.lisp,v 1.3 1997/06/07 19:04:40 pw Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -96,23 +96,31 @@
(defconstant double-float-digits
(+ (byte-size double-float-significand-byte) word-bits 1))
(defconstant float-inexact-trap-bit (ash 1 0))
(defconstant float-underflow-trap-bit (ash 1 1))
(defconstant float-overflow-trap-bit (ash 1 2))
(defconstant float-divide-by-zero-trap-bit (ash 1 3))
(defconstant float-invalid-trap-bit (ash 1 4))
(defconstant float-round-to-nearest 0)
(defconstant float-round-to-zero 1)
(defconstant float-round-to-positive 2)
(defconstant float-round-to-negative 3)
(defconstant float-rounding-mode (byte 2 7))
(defconstant float-sticky-bits (byte 5 27))
(defconstant float-traps-byte (byte 5 0))
(defconstant float-exceptions-byte (byte 5 27))
(defconstant float-condition-bit (ash 1 26))
(defconstant float-fast-bit 0) ; No fast mode on HPPA.
;; Values in 17f code seem to be same as HPPA. These values are from
;; DEC Assembly Language Programmers guide. The active bits are
;; actually in (byte 12 52) of the fpcr. (byte 6 52) contain the
;; exception flags. Bit 63 is the bitwise logor of all exceptions.
;; The enable and exception bytes are in a software control word
;; manipulated via OS functions and the bits in the SCP match those
;; defs. This mapping follows <machine/fpu.h>
(defconstant float-inexact-trap-bit (ash 1 4)) ; rw
(defconstant float-underflow-trap-bit (ash 1 3)) ; rw
(defconstant float-overflow-trap-bit (ash 1 2)) ; ro
(defconstant float-divide-by-zero-trap-bit (ash 1 1)) ; ro
(defconstant float-invalid-trap-bit (ash 1 0)) ; ro
(defconstant float-round-to-zero 0)
(defconstant float-round-to-negative 1)
(defconstant float-round-to-nearest 2)
(defconstant float-round-to-positive 3)
;; These aren't quite correct yet. Work in progress.
(defconstant float-rounding-mode (byte 2 58)) ; hardware fpcr
(defconstant float-exceptions-byte (byte 6 52)) ; hardware fpcr
(defconstant float-sticky-bits (byte 6 17)) ; software (clear only)
(defconstant float-traps-byte (byte 6 1)) ; software fp control word
(defconstant float-condition-bit (ash 1 63)) ; summary - not used??
(defconstant float-fast-bit 0)
); eval-when
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment