Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package Registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
f8744a25
Commit
f8744a25
authored
27 years ago
by
pw
Browse files
Options
Downloads
Patches
Plain Diff
Changes so far for DEC alpha support. Not done yet.
parent
4b96ae74
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
3
Hide whitespace changes
Inline
Side-by-side
Showing
3 changed files
compiler/alpha/float.lisp
+40
-18
40 additions, 18 deletions
compiler/alpha/float.lisp
compiler/alpha/insts.lisp
+30
-1
30 additions, 1 deletion
compiler/alpha/insts.lisp
compiler/alpha/parms.lisp
+26
-18
26 additions, 18 deletions
compiler/alpha/parms.lisp
with
96 additions
and
37 deletions
compiler/alpha/float.lisp
+
40
−
18
View file @
f8744a25
;;; 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
199
4/10/31 04:39:51 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/float.lisp,v 1.
3
199
7/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
sing
le-reg
)
temp1
)
(
:generator
3
(
:temporary
(
:sc
double
-stack
)
temp
)
(
:temporary
(
:sc
doub
le-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
sing
le-reg
)
temp1
)
(
:temporary
(
:sc
double
-stack
)
temp
)
(
:temporary
(
:sc
doub
le-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
))))
This diff is collapsed.
Click to expand it.
compiler/alpha/insts.lisp
+
30
−
1
View file @
f8744a25
...
...
@@ -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
199
4/10/31 04:39:51 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/insts.lisp,v 1.
4
199
7/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
...
...
This diff is collapsed.
Click to expand it.
compiler/alpha/parms.lisp
+
26
−
18
View file @
f8744a25
...
...
@@ -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
199
4/10/31 04:39:51 ram
Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/alpha/parms.lisp,v 1.
3
199
7/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
...
...
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment