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
2cbcd5e5
Commit
2cbcd5e5
authored
33 years ago
by
ram
Browse files
Options
Downloads
Patches
Plain Diff
First cut at semantic annotation. Mainly lifetime info at this point.
parent
2bdec47d
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
+108
-82
108 additions, 82 deletions
compiler/rt/insts.lisp
with
108 additions
and
82 deletions
compiler/rt/insts.lisp
+
108
−
82
View file @
2cbcd5e5
...
@@ -7,7 +7,7 @@
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
;;;
(
ext:file-comment
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/insts.lisp,v 1.
8
1991/0
7
/2
3
1
2
:1
4:00
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/insts.lisp,v 1.
9
1991/0
8
/2
5
1
8
:1
5:51
ram Exp $"
)
;;;
;;;
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
...
@@ -24,49 +24,55 @@
...
@@ -24,49 +24,55 @@
;;;; Resources:
;;;; Resources:
(
define-resources
memory
float-status
high
low
)
(
define-resources
memory
float-status
mq
cc
)
;;;; Formats.
;;;; Formats.
(
define-format
(
j1
16
)
(
define-format
(
j1
16
:use
(
cc
)
)
(
op
(
byte
4
12
))
(
op
(
byte
4
12
))
(
sub-op
(
byte
1
11
))
(
sub-op
(
byte
1
11
))
(
n
(
byte
3
8
))
(
n
(
byte
3
8
))
(
j1
(
byte
8
0
)))
(
j1
(
byte
8
0
)))
(
define-format
(
x
16
)
(
define-format
(
x
16
:clobber
(
cc
)
)
(
op
(
byte
4
12
))
(
op
(
byte
4
12
))
(
r1
(
byte
4
8
))
(
r1
(
byte
4
8
)
:write
t
)
(
r2
(
byte
4
4
))
(
r2
(
byte
4
4
)
:read
t
)
(
r3
(
byte
4
0
)))
(
r3
(
byte
4
0
)
:read
t
))
(
define-format
(
d-short
16
)
(
op
(
byte
4
12
))
(
i
(
byte
4
8
))
(
r2
(
byte
4
4
))
(
r3
(
byte
4
0
)))
(
define-format
(
r
16
)
(
define-format
(
r
16
:clobber
(
cc
))
(
op
(
byte
8
8
))
(
r2
(
byte
4
4
)
:read
t
:write
t
)
(
r3
(
byte
4
0
)
:read
t
))
(
define-format
(
r-immed
16
:clobber
(
cc
))
(
op
(
byte
8
8
))
(
op
(
byte
8
8
))
(
r2
(
byte
4
4
))
(
r2
(
byte
4
4
)
:read
t
:write
t
)
(
r3
(
byte
4
0
)))
(
r3
(
byte
4
0
)))
(
define-format
(
bi
32
)
(
define-format
(
bi
32
:use
(
cc
))
(
op
(
byte
8
24
))
(
op
(
byte
8
24
))
(
r2
(
byte
4
20
))
(
r2
(
byte
4
20
))
(
bi
(
byte
20
0
)))
(
bi
(
byte
20
0
)))
(
define-format
(
ba
32
)
(
define-format
(
ba
32
:attributes
(
assembly-call
)
)
(
op
(
byte
8
24
))
(
op
(
byte
8
24
))
(
ba
(
byte
24
0
)))
(
ba
(
byte
24
0
)))
(
define-format
(
d
32
)
(
define-format
(
d
32
:clobber
(
cc
)
)
(
op
(
byte
8
24
))
(
op
(
byte
8
24
))
(
r2
(
byte
4
20
))
(
r2
(
byte
4
20
)
:write
t
)
(
r3
(
byte
4
16
))
(
r3
(
byte
4
16
)
:read
t
)
(
i
(
byte
16
0
)))
(
i
(
byte
16
0
)))
(
define-format
(
d-short
16
:clobber
(
cc
))
(
op
(
byte
4
12
))
(
i
(
byte
4
8
))
(
r2
(
byte
4
4
)
:write
t
)
(
r3
(
byte
4
0
)
:read
t
))
;;;; Special argument types and fixups.
;;;; Special argument types and fixups.
...
@@ -162,15 +168,15 @@
...
@@ -162,15 +168,15 @@
;;;
;;;
(
define-instruction
(
stc
)
(
define-instruction
(
stc
)
(
d-short
(
op
:constant
1
)
(
d-short
(
op
:constant
1
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
(
i
:argument
(
unsigned-byte
4
)))
(
i
:argument
(
unsigned-byte
4
)))
(
d-short
(
op
:constant
1
)
(
d-short
(
op
:constant
1
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
(
i
:constant
0
))
(
i
:constant
0
))
(
d
(
op
:constant
#xDE
)
(
d
(
op
:constant
#xDE
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
i
:argument
(
signed-byte
16
))))
...
@@ -182,7 +188,7 @@
...
@@ -182,7 +188,7 @@
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
)))
(
i
:argument
(
signed-byte
16
)))
(
r
(
op
:constant
#xEB
)
(
r
(
op
:constant
#xEB
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
nil
)
(
r3
:argument
register
)))
(
r3
:argument
register
)))
;;; load-half-algebraic.
;;; load-half-algebraic.
...
@@ -204,14 +210,14 @@
...
@@ -204,14 +210,14 @@
;;;
;;;
(
define-instruction
(
sth
)
(
define-instruction
(
sth
)
(
d-short
(
op
:constant
2
)
(
d-short
(
op
:constant
2
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
;; We want the instruction to take byte indexes, but we plug the
;; We want the instruction to take byte indexes, but we plug the
;; index into the instruction as a half-word index.
;; index into the instruction as a half-word index.
(
i
:argument
(
member
0
2
4
6
8
10
12
14
16
18
20
22
24
26
28
30
)
(
i
:argument
(
member
0
2
4
6
8
10
12
14
16
18
20
22
24
26
28
30
)
:function
(
lambda
(
x
)
(
ash
x
-1
))))
:function
(
lambda
(
x
)
(
ash
x
-1
))))
(
d
(
op
:constant
#xDC
)
(
d
(
op
:constant
#xDC
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
i
:argument
(
signed-byte
16
))))
...
@@ -238,22 +244,21 @@
...
@@ -238,22 +244,21 @@
;;;
;;;
(
define-instruction
(
st
)
(
define-instruction
(
st
)
(
d-short
(
op
:constant
3
)
(
d-short
(
op
:constant
3
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
;; We want the instruction to take byte indexes, but we plug the
;; We want the instruction to take byte indexes, but we plug the
;; index into the instruction as a word index.
;; index into the instruction as a word index.
(
i
:argument
(
member
0
4
8
12
16
20
24
28
32
36
40
44
48
52
56
60
)
(
i
:argument
(
member
0
4
8
12
16
20
24
28
32
36
40
44
48
52
56
60
)
:function
(
lambda
(
x
)
(
ash
x
-2
))))
:function
(
lambda
(
x
)
(
ash
x
-2
))))
(
d-short
(
op
:constant
3
)
(
d-short
(
op
:constant
3
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
(
i
:constant
0
))
(
i
:constant
0
))
(
d
(
op
:constant
#xDD
)
(
d
(
op
:constant
#xDD
)
(
r2
:argument
register
)
(
r2
:argument
register
:read
t
:write
nil
)
(
r3
:argument
address-register
)
(
r3
:argument
address-register
)
(
i
:argument
(
signed-byte
16
))))
(
i
:argument
(
signed-byte
16
))))
;;;; Address computation.
;;;; Address computation.
...
@@ -272,7 +277,7 @@
...
@@ -272,7 +277,7 @@
(
i
:argument
(
signed-byte
16
)))
(
i
:argument
(
signed-byte
16
)))
(
d
(
op
:constant
#xC8
)
(
d
(
op
:constant
#xC8
)
(
r2
:argument
register
)
(
r2
:argument
register
)
(
r3
:argument
(
integer
0
0
))
(
r3
:argument
(
integer
0
0
)
:read
nil
)
(
i
:argument
(
signed-byte
16
)))
(
i
:argument
(
signed-byte
16
)))
(
d
(
op
:constant
#xC8
)
(
d
(
op
:constant
#xC8
)
(
r2
:argument
register
)
(
r2
:argument
register
)
...
@@ -302,7 +307,7 @@
...
@@ -302,7 +307,7 @@
(
i
:argument
(
unsigned-byte
16
)))
(
i
:argument
(
unsigned-byte
16
)))
(
d
(
op
:constant
#xD8
)
(
d
(
op
:constant
#xD8
)
(
r2
:argument
register
)
(
r2
:argument
register
)
(
r3
:argument
(
integer
0
0
))
(
r3
:argument
(
integer
0
0
)
:read
nil
)
(
i
:argument
(
unsigned-byte
16
)))
(
i
:argument
(
unsigned-byte
16
)))
(
d
(
op
:constant
#xD8
)
(
d
(
op
:constant
#xD8
)
(
r2
:argument
register
)
(
r2
:argument
register
)
...
@@ -330,32 +335,39 @@
...
@@ -330,32 +335,39 @@
;;; increment.
;;; increment.
;;;
;;;
(
define-instruction
(
inc
)
(
define-instruction
(
inc
)
(
r
(
op
:constant
#x91
)
(
r-immed
(
r2
:argument
register
)
(
op
:constant
#x91
)
(
r3
:argument
(
unsigned-byte
4
))))
(
r2
:argument
register
)
(
r3
:argument
(
unsigned-byte
4
))))
;;; decrement
;;; decrement
;;;
;;;
(
define-instruction
(
dec
)
(
define-instruction
(
dec
)
(
r
(
op
:constant
#x93
)
(
r-immed
(
r2
:argument
register
)
(
op
:constant
#x93
)
(
r3
:argument
(
unsigned-byte
4
))))
(
r2
:argument
register
)
(
r3
:argument
(
unsigned-byte
4
))))
;;; load-immediate-short.
;;; load-immediate-short.
;;;
;;;
(
define-instruction
(
lis
)
(
define-instruction
(
lis
)
(
r
(
op
:constant
#xA4
)
(
r-immed
(
r2
:argument
register
)
(
op
:constant
#xA4
)
(
r3
:argument
(
unsigned-byte
4
))))
(
r2
:argument
register
:read
nil
)
(
r3
:argument
(
unsigned-byte
4
))))
;;;; Arithmetics.
;;;; Arithmetics.
(
macrolet
((
define-math-inst
(
name
&key
two-regs
short-immediate
immediate
(
macrolet
((
define-math-inst
(
name
&key
two-regs
unary
short-immediate
function
(
signed
t
))
immediate
function
(
signed
t
)
`
(
define-instruction
(
,
name
)
(
use
nil
use-p
)
(
clobber
nil
clobber-p
))
`
(
define-instruction
(
,
name
,@
(
when
use-p
`
(
:use
,
use
))
,@
(
when
clobber-p
`
(
:clobber
,
clobber
)))
,@
(
when
two-regs
,@
(
when
two-regs
`
((
r
(
op
:constant
,
two-regs
)
`
((
r
(
op
:constant
,
two-regs
)
(
r2
:argument
register
)
(
r2
:argument
register
)
...
@@ -363,10 +375,18 @@
...
@@ -363,10 +375,18 @@
(
r
(
op
:constant
,
two-regs
)
(
r
(
op
:constant
,
two-regs
)
(
r2
:argument
register
)
(
r2
:argument
register
)
(
r3
:same-as
r2
))))
(
r3
:same-as
r2
))))
,@
(
when
unary
`
((
r
(
op
:constant
,
unary
)
(
r2
:argument
register
:read
nil
)
(
r3
:argument
register
))
(
r
(
op
:constant
,
unary
)
(
r2
:argument
register
:read
nil
)
(
r3
:same-as
r2
))))
,@
(
when
short-immediate
,@
(
when
short-immediate
`
((
r
(
op
:constant
,
short-immediate
)
`
((
r-immed
(
r2
:argument
register
)
(
op
:constant
,
short-immediate
)
(
r3
:argument
(
unsigned-byte
4
)))))
(
r2
:argument
register
)
(
r3
:argument
(
unsigned-byte
4
)))))
,@
(
when
immediate
,@
(
when
immediate
`
((
d
(
op
:constant
,
immediate
)
`
((
d
(
op
:constant
,
immediate
)
(
r2
:argument
register
)
(
r2
:argument
register
)
...
@@ -382,24 +402,24 @@
...
@@ -382,24 +402,24 @@
,@
(
if
function
`
(
:function
,
function
)))))))))
,@
(
if
function
`
(
:function
,
function
)))))))))
(
define-math-inst
a
:two-regs
#xE1
:short-immediate
#x90
:immediate
#xC1
)
(
define-math-inst
a
:two-regs
#xE1
:short-immediate
#x90
:immediate
#xC1
)
(
define-math-inst
ae
:two-regs
#xF1
:immediate
#xD1
)
(
define-math-inst
ae
:two-regs
#xF1
:immediate
#xD1
:use
(
cc
)
)
(
define-math-inst
abs
:
two-regs
#xE0
)
(
define-math-inst
abs
:
unary
#xE0
)
(
define-math-inst
neg
:
two-regs
#xE4
)
;Arithmetic negation (two's complement).
(
define-math-inst
neg
:
unary
#xE4
)
;Arithmetic negation (two's complement).
(
define-math-inst
s
:two-regs
#xE2
:short-immediate
#x92
(
define-math-inst
s
:two-regs
#xE2
:short-immediate
#x92
:immediate
#xC1
:function
-
)
:immediate
#xC1
:function
-
)
(
define-math-inst
sf
:two-regs
#xB2
:immediate
#xD2
)
(
define-math-inst
sf
:two-regs
#xB2
:immediate
#xD2
)
(
define-math-inst
se
:two-regs
#xF2
)
(
define-math-inst
se
:two-regs
#xF2
:use
(
cc
)
)
(
define-math-inst
d
:two-regs
#xB6
)
(
define-math-inst
d
:two-regs
#xB6
:use
(
cc
mq
)
:clobber
(
cc
mq
)
)
(
define-math-inst
m
:two-regs
#xE6
)
(
define-math-inst
m
:two-regs
#xE6
:use
(
cc
mq
)
:clobber
(
cc
mq
)
)
(
define-math-inst
exts
:
two-regs
#xB1
)
(
define-math-inst
exts
:
unary
#xB1
)
(
define-math-inst
clrbl
:short-immediate
#x99
)
(
define-math-inst
clrbl
:short-immediate
#x99
)
(
define-math-inst
clrbu
:short-immediate
#x98
)
(
define-math-inst
clrbu
:short-immediate
#x98
)
(
define-math-inst
setbl
:short-immediate
#x9B
)
(
define-math-inst
setbl
:short-immediate
#x9B
)
(
define-math-inst
setbu
:short-immediate
#x9A
)
(
define-math-inst
setbu
:short-immediate
#x9A
)
(
define-math-inst
not
:
two-regs
#xF4
)
;Logical not.
(
define-math-inst
not
:
unary
#xF4
)
;Logical not.
(
define-math-inst
n
:two-regs
#xE5
)
(
define-math-inst
n
:two-regs
#xE5
)
(
define-math-inst
nilz
:immediate
#xC5
:signed
nil
)
(
define-math-inst
nilz
:immediate
#xC5
:signed
nil
)
(
define-math-inst
nilo
:immediate
#xC6
:signed
nil
)
(
define-math-inst
nilo
:immediate
#xC6
:signed
nil
)
...
@@ -423,11 +443,12 @@
...
@@ -423,11 +443,12 @@
;;;
;;;
(
define-instruction
(
c
)
(
define-instruction
(
c
)
(
r
(
op
:constant
#xB4
)
(
r
(
op
:constant
#xB4
)
(
r2
:argument
register
)
(
r2
:argument
register
:write
nil
)
(
r3
:argument
register
))
(
r3
:argument
register
))
(
r
(
op
:constant
#x94
)
(
r-immed
(
r2
:argument
register
)
(
op
:constant
#x94
)
(
r3
:argument
(
unsigned-byte
4
)))
(
r2
:argument
register
:write
nil
)
(
r3
:argument
(
unsigned-byte
4
)))
(
d
(
op
:constant
#xD4
)
(
d
(
op
:constant
#xD4
)
(
r2
:constant
0
)
(
r2
:constant
0
)
(
r3
:argument
register
)
(
r3
:argument
register
)
...
@@ -439,7 +460,7 @@
...
@@ -439,7 +460,7 @@
;;;
;;;
(
define-instruction
(
cl
)
(
define-instruction
(
cl
)
(
r
(
op
:constant
#xB3
)
(
r
(
op
:constant
#xB3
)
(
r2
:argument
register
)
(
r2
:argument
register
:write
nil
)
(
r3
:argument
register
))
(
r3
:argument
register
))
(
d
(
op
:constant
#xD3
)
(
d
(
op
:constant
#xD3
)
(
r2
:constant
0
)
(
r2
:constant
0
)
...
@@ -454,38 +475,43 @@
...
@@ -454,38 +475,43 @@
(
r
(
op
:constant
#xB8
)
(
r
(
op
:constant
#xB8
)
(
r2
:argument
register
)
(
r2
:argument
register
)
(
r3
:argument
register
))
(
r3
:argument
register
))
(
r
(
op
:constant
#xA8
)
(
r-immed
(
r2
:argument
register
)
(
op
:constant
#xA8
)
(
r3
:argument
(
unsigned-byte
4
)))
(
r2
:argument
register
:write
nil
)
(
r
(
op
:constant
#xA9
)
(
r3
:argument
(
unsigned-byte
4
)))
(
r2
:argument
register
)
(
r-immed
(
r3
:argument
(
integer
16
31
)
(
op
:constant
#xA9
)
:function
(
lambda
(
x
)
(
-
x
16
)))))
(
r2
:argument
register
:write
nil
)
(
r3
:argument
(
integer
16
31
)
:function
(
lambda
(
x
)
(
-
x
16
)))))
(
define-instruction
(
sl
)
(
define-instruction
(
sl
)
(
r
(
op
:constant
#xBA
)
(
r
(
op
:constant
#xBA
)
(
r2
:argument
register
)
(
r2
:argument
register
)
(
r3
:argument
register
))
(
r3
:argument
register
))
(
r
(
op
:constant
#xAA
)
(
r-immed
(
r2
:argument
register
)
(
op
:constant
#xAA
)
(
r3
:argument
(
unsigned-byte
4
)))
(
r2
:argument
register
)
(
r
(
op
:constant
#xAB
)
(
r3
:argument
(
unsigned-byte
4
)))
(
r2
:argument
register
)
(
r-immed
(
r3
:argument
(
integer
16
31
)
(
op
:constant
#xAB
)
:function
(
lambda
(
x
)
(
-
x
16
)))))
(
r2
:argument
register
)
(
r3
:argument
(
integer
16
31
)
:function
(
lambda
(
x
)
(
-
x
16
)))))
(
define-instruction
(
sar
)
(
define-instruction
(
sar
)
(
r
(
op
:constant
#xB0
)
(
r
(
op
:constant
#xB0
)
(
r2
:argument
register
)
(
r2
:argument
register
)
(
r3
:argument
register
))
(
r3
:argument
register
))
(
r
(
op
:constant
#xA0
)
(
r-immed
(
r2
:argument
register
)
(
op
:constant
#xA0
)
(
r3
:argument
(
unsigned-byte
4
)))
(
r2
:argument
register
)
(
r
(
op
:constant
#xA1
)
(
r3
:argument
(
unsigned-byte
4
)))
(
r2
:argument
register
)
(
r-immed
(
r3
:argument
(
integer
16
31
)
(
op
:constant
#xA1
)
:function
(
lambda
(
x
)
(
-
x
16
)))))
(
r2
:argument
register
)
(
r3
:argument
(
integer
16
31
)
:function
(
lambda
(
x
)
(
-
x
16
)))))
;;;; Branch instructions.
;;;; Branch instructions.
...
@@ -512,7 +538,7 @@
...
@@ -512,7 +538,7 @@
(
r2
:argument
branch-condition
)
(
r2
:argument
branch-condition
)
(
bi
:argument
relative-label
))
(
bi
:argument
relative-label
))
(
r
(
op
:constant
,
register-op
)
(
r
(
op
:constant
,
register-op
)
(
r2
:argument
branch-condition
)
(
r2
:argument
branch-condition
:read
nil
:write
nil
)
(
r3
:argument
register
)))))
(
r3
:argument
register
)))))
;; branch-on-condition-bit-immediate.
;; branch-on-condition-bit-immediate.
...
...
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