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
596b7a7e
Commit
596b7a7e
authored
34 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Added floating point stuff.
parent
8068b974
No related branches found
No related tags found
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
compiler/rt/insts.lisp
+289
-0
289 additions, 0 deletions
compiler/rt/insts.lisp
with
289 additions
and
0 deletions
compiler/rt/insts.lisp
+
289
−
0
View file @
596b7a7e
...
@@ -17,6 +17,10 @@
...
@@ -17,6 +17,10 @@
(
use-package
"ASSEM"
)
(
use-package
"ASSEM"
)
(
use-package
"EXT"
)
(
use-package
"EXT"
)
;;;; Resources:
(
define-resources
memory
float-status
high
low
)
;;;; Formats.
;;;; Formats.
...
@@ -781,3 +785,288 @@
...
@@ -781,3 +785,288 @@
(
define-compute-instruction
compute-lra-from-code
(
define-compute-instruction
compute-lra-from-code
(
+
(
label-position
label
)
(
+
(
label-position
label
)
(
component-header-length
)))
(
component-header-length
)))
;;;; 68881 instruction set details:
;;; The low 7 bits of the 68881 instructions.
;;;
(
defconstant
mc68881-opcodes
'
((
:move
.
#x00
)
(
:int
.
#x01
)
(
:sinh
.
#x02
)
(
:intrz
.
#x03
)
(
:sqrt
.
#x04
)
(
:lognp1
.
#x06
)
(
:etoxm1
.
#x08
)
(
:tanh
.
#x09
)
(
:atan
.
#x0A
)
(
:asin
.
#x0C
)
(
:atanh
.
#x0D
)
(
:sin
.
#x0E
)
(
:tan
.
#x0F
)
(
:etox
.
#x10
)
(
:twotox
.
#x11
)
(
:tentox
.
#x12
)
(
:logn
.
#x14
)
(
:log10
.
#x15
)
(
:log2
.
#x16
)
(
:abs
.
#x18
)
(
:cosh
.
#x19
)
(
:neg
.
#x1A
)
(
:acos
.
#x1C
)
(
:cos
.
#x1D
)
(
:getexp
.
#x1E
)
(
:getman
.
#x1F
)
(
:div
.
#x20
)
(
:mod
.
#x21
)
(
:add
.
#x22
)
(
:mul
.
#x23
)
(
:sgldiv
.
#x24
)
(
:rem
.
#x25
)
(
:scale
.
#x26
)
(
:sglmul
.
#x27
)
(
:sub
.
#x28
)
(
:sincos
.
#x30
)
(
:cmp
.
#x38
)
(
:tst
.
#x3A
)))
;;; Names of interesting 68881 control registers.
;;;
(
defconstant
mc68881-control-regs
'
((
:fpsr
.
2
)
(
:fpcr
.
4
)
(
:fpiar
.
1
)))
;;; The encoding of operand format in memory (bits 10..12 in the 68881
;;; instruction.)
;;;
(
defconstant
mc68881-operand-types
'
((
:integer
.
0
)
; 32 bit integer.
(
:single
.
1
)
; 32 bit float.
(
:double
.
5
)))
; 64 bit float.
;;; Bits 13..15 in the 68881 instruction. Controls where operands are found.
;;;
(
defconstant
mc68881-instruction-classes
'
((
:freg-to-freg
.
0
)
(
:mem-to-freg
.
2
)
(
:freg-to-mem
.
3
)
(
:mem-to-scr
.
4
)
(
:scr-to-mem
.
5
)))
;;; Length in words of memory data to transfer. This is part of the RT
;;; hardware assist protocol, and is placed in the low two bits of the address
;;; to the store instruction.
;;;
(
defconstant
mc68881-operand-lengths
'
((
nil
.
0
)
; No transfer...
(
:integer
.
1
)
(
:single
.
1
)
(
:double
.
2
)))
;;; RT hardware assist protocol for whether to read or write memory, here
;;; represented as a function of the mc68881 instruction class.
;;;
(
defconstant
mc68881-transfer-control-field-alist
'
((
:freg-to-freg
.
0
)
(
:mem-to-freg
.
0
)
(
:freg-to-mem
.
#x3c0000
)
(
:mem-to-scr
.
0
)
(
:scr-to-mem
.
#x3c0000
)))
(
defun
mc68881-fp-reg-p
(
object
)
(
and
(
tn-p
object
)
(
eq
(
sb-name
(
sc-sb
(
tn-sc
object
)))
'mc68881-float-registers
)))
(
define-argument-type
mc68881-fp-reg
:type
'
(
satisfies
mc68881-fp-reg-p
)
:function
tn-offset
)
;;; This is really a ST (store word) instruction, but we have magic extra
;;; arguments to represent the reading and writing of the FP registers. R3
;;; will already have been set up with the high bits of the FP instruction by a
;;; preceding CAL.
;;;
(
define-format
(
mc68881-inst
32
)
(
fpn
(
byte
0
0
)
:read
t
:write
t
)
(
fpm
(
byte
0
0
)
:read
t
)
(
op
(
byte
8
24
)
:default
#xDD
)
(
r2
(
byte
4
20
)
:read
t
)
(
r3
(
byte
4
16
)
:read
t
)
(
i
(
byte
16
0
)))
;;; DO-68881-INST -- Internal
;;;
;;; Utility used to emit a 68881 operation. We emit the CAU that sets up
;;; the high bits of the operation in Temp, and we return the low bits that
;;; should be passed as the I field of the actual FP operation instruction.
;;;
(
defun
do-68881-inst
(
op
temp
&key
fpn
fpm
(
class
:freg-to-freg
)
data
optype
creg
)
(
assert
(
if
fpm
(
and
(
mc68881-fp-reg-p
fpm
)
(
not
(
or
optype
data
))
(
eql
class
:freg-to-freg
)
(
tn-p
data
)
(
eq
(
sb-name
(
sc-sb
(
tn-sc
data
)))
'registers
)
optype
)
(
not
(
eql
class
:freg-to-freg
))))
(
assert
(
if
fpn
(
mc68881-fp-reg-p
fpn
)
creg
))
(
let*
((
opcode
(
logior
#xFC000000
(
or
(
cdr
(
assoc
class
mc68881-transfer-control-field-alist
))
(
error
"Unknown instruction class ~S."
class
))
(
ash
(
cdr
(
assoc
class
mc68881-instruction-classes
))
15
)
(
ash
(
if
fpm
(
tn-offset
fpm
)
(
or
(
cdr
(
assoc
optype
mc68881-operand-types
))
(
error
"Unknown operation type ~S."
optype
)))
12
)
(
ash
(
if
fpn
(
tn-offset
fpn
)
(
or
(
cdr
(
assoc
creg
mc68881-control-regs
))
(
error
"Unknown control register ~S."
creg
)))
9
)
(
ash
(
or
(
cdr
(
assoc
op
mc68881-opcodes
))
(
error
"Unknown opcode ~S."
op
))
2
)
(
or
(
cdr
(
assoc
optype
mc68881-operand-lengths
))
(
error
"Unknown operation type ~S."
optype
))))
(
low
(
logand
opcode
#xFFFF
))
(
high
(
+
(
logand
(
ash
opcode
-16
)
#xFFFF
)
(
if
(
eql
(
logand
low
#x8000
)
0
)
0
1
))))
(
inst
cau
temp
high
)
low
))
(
define-instruction
(
mc68881-binop-inst
)
(
mc68881-inst
(
fpn
:argument
mc68881-fp-reg
)
(
fpm
:argument
mc68881-fp-reg
)
(
r2
:constant
null-offset
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
;;; This pseudo-instruction emits a floating-point binop on the 68881. FPN is
;;; the destination float register (and second arg) FPM is the source float
;;; register. Op is the 68881 opcode. Temp is a sap-reg (i.e. non-zero,
;;; non-descriptor) register that we form the FP instruction in.
;;;
(
define-pseudo-instruction
mc68881-binop
64
(
fpn
fpm
op
temp
)
(
inst
mc68881-binop-inst
fpn
fpm
temp
(
do-68881-inst
op
temp
:fpm
fpm
:fpn
fpn
)))
;;; Unop is like binop, but we don't read FPN before we write it.
;;;
(
define-instruction
(
mc68881-unop-inst
)
(
mc68881-inst
(
fpn
:argument
mc68881-fp-reg
:read
nil
)
(
fpm
:argument
mc68881-fp-reg
)
(
r2
:constant
null-offset
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
define-pseudo-instruction
mc68881-unop
64
(
fpn
fpm
op
temp
)
(
inst
mc68881-unop-inst
fpn
fpm
temp
(
do-68881-inst
op
temp
:fpm
fpm
:fpn
fpn
)))
;;; Compare is like binop, but we don't write FPN.
;;;
(
define-instruction
(
mc68881-compare-inst
)
(
mc68881-inst
(
fpn
:argument
mc68881-fp-reg
:write
nil
)
(
fpm
:argument
mc68881-fp-reg
)
(
r2
:constant
null-offset
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
define-pseudo-instruction
mc68881-compare
64
(
fpn
fpm
op
temp
)
(
inst
mc68881-compare-inst
fpn
fpm
temp
(
do-68881-inst
op
temp
:fpm
fpm
:fpn
fpn
)))
;;; Move FPM to FPN.
;;;
(
define-pseudo-instruction
mc68881-move
64
(
fpn
fpm
temp
)
(
inst
mc68881-unop
fpn
fpm
:move
temp
))
(
define-format
(
s
16
)
(
op
(
byte
12
4
))
(
n
(
byte
4
0
)))
;;; This is a "setcb 8", which is used to wait for a result from the FPA to
;;; appear in memory (or something...)
;;;
(
define-instruction
(
mc68881-wait
)
(
s
(
op
:constant
#x97F
)
(
n
:constant
8
)))
(
define-instruction
(
mc68881-load-inst
:use
(
memory
))
(
mc68881-inst
(
fpn
:argument
mc68881-fp-reg
:read
nil
)
(
fpm
:constant
0
)
(
r2
:argument
register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
define-pseudo-instruction
mc68881-load
64
(
fpn
data
optype
temp
)
(
inst
mc68881-load-inst
fpn
data
temp
(
do-68881-inst
:move
temp
:fpn
fpn
:data
data
:optype
optype
:class
:mem-to-freg
)))
(
define-instruction
(
mc68881-store-inst
:clobber
(
memory
))
(
mc68881-inst
(
fpn
:argument
mc68881-fp-reg
:write
nil
)
(
fpm
:constant
0
)
(
r2
:argument
register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
define-pseudo-instruction
mc68881-store
64
(
fpn
data
optype
temp
)
(
inst
mc68881-store-inst
fpn
data
temp
(
do-68881-inst
:move
temp
:fpn
fpn
:data
data
:optype
optype
:class
:freg-to-mem
)))
(
define-instruction
(
mc68881-load-status-inst
:use
(
memory
)
:clobber
(
float-status
))
(
mc68881-inst
(
fpn
:constant
0
)
(
fpm
:constant
0
)
(
r2
:argument
register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
define-pseudo-instruction
mc68881-load-status
64
(
creg
data
temp
)
(
inst
mc68881-load-status-inst
data
temp
(
do-68881-inst
:move
temp
:creg
creg
:data
data
:optype
:integer
:class
:mem-to-scr
)))
(
define-instruction
(
mc68881-store-status-inst
:clobber
(
memory
)
:use
(
float-status
))
(
mc68881-inst
(
fpn
:constant
0
)
(
fpm
:constant
0
)
(
r2
:argument
register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
define-pseudo-instruction
mc68881-store-status
64
(
creg
data
temp
)
(
inst
mc68881-store-status-inst
data
temp
(
do-68881-inst
:move
temp
:creg
creg
:data
data
:optype
:integer
:class
:scr-to-mem
)))
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