Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
edac2d80
Commit
edac2d80
authored
Jan 13, 1993
by
cvs2git
Browse files
This commit was manufactured by cvs2svn to create branch 'new_struct'.
parent
10b7c474
Changes
876
Expand all
Hide whitespace changes
Inline
Side-by-side
assembler/assem.lisp
deleted
100644 → 0
View file @
10b7c474
This diff is collapsed.
Click to expand it.
assembler/assembler.lisp
deleted
100644 → 0
View file @
10b7c474
This diff is collapsed.
Click to expand it.
assembler/disassemble.lisp
deleted
100644 → 0
View file @
10b7c474
;;; -*- Mode: Lisp; Package: Compiler -*-
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; The DISASSEMBLE function as described in the Common Lisp manual.
;;;
;;; Written by Don Mathis
;;;
;;;
;;; Modified 11/83 by Robert Rose to put an asterisk before lines
;;; that are branched to.
;;;
;;; Heavily Modified 1/84 to use new instruction set.
;;;
;;; Modified by David B. McDonald to disassemble the Romp instruction
;;; set.
;;;
;;; Hacked by Rob MacLachlan for the interim RT function format. Hopefully
;;; this file will die after the port.
;;;
;;; **********************************************************************
;;;
(
in-package
'compiler
:use
'
(
"LISP"
"SYSTEM"
))
(
export
'lisp::disassemble
(
find-package
'lisp
))
(
proclaim
'
(
special
romp-4bit-opcode-symbol
romp-8bit-opcode-symbol
))
;;;; The Main function, DISASSEMBLE
(
defun
disassemble
(
function
&optional
(
*standard-output*
*standard-output*
))
"The argument should be either a function object, a lambda expression, or
a symbol with a function definition. If the relevant function is not a
compiled function, it is first compiled. In any case, the compiled code
is then 'reverse assembled' and printed out in a symbolic format."
(
etypecase
function
(
function
(
ecase
(
%primitive
get-vector-subtype
function
)
((
#.
%function-entry-subtype
#.
%function-closure-entry-subtype
)
(
prin-prelim-info
function
)
(
Output-macro-instructions
function
(
branch-list
function
)))
(
#.
%function-closure-subtype
(
disassemble
(
%primitive
header-ref
function
%function-name-slot
)))))
(
symbol
(
disassemble
(
symbol-function
function
)))))
;;; PRIN-PRELIM-INFO takes a function object and extracts from it and
;;; prints out the following information:
;;; - The argument list of the function.
;;; - The number of Locals allocated by the function.
;;; - Whether the function does or does not evaluate its arguments.
(
defun
prin-prelim-info
(
function
)
(
format
t
"~%Disassembly of ~S.~%"
(
%primitive
header-ref
function
%function-name-slot
))
(
format
t
"~%Its arg list is: ~A.~%"
(
%primitive
header-ref
function
%function-entry-arglist-slot
)))
;;; OUTPUT-MACRO-INSTRUCTIONS takes a function object and prints out the
;;; corresponding macro. (Not executable macro, just macro that looks good!)
(
defun
Output-Macro-Instructions
(
function
branches
)
(
declare
(
optimize
(
speed
3
)
(
safety
0
)))
(
let*
((
byte-vector
(
%primitive
header-ref
function
%function-code-slot
))
(
offset
(
-
(
%primitive
header-ref
function
%function-offset-slot
)
i-vector-header-size
))
(
vector-length
(
length
byte-vector
)))
(
declare
(
fixnum
vector-length
))
(
do
((
i
0
))
((
=
i
vector-length
))
(
declare
(
fixnum
i
))
(
when
(
=
i
offset
)
(
format
t
"~&*** Enter here:~%"
))
(
let*
((
opcode
(
aref
byte-vector
i
))
(
symbol
(
find-symbol-name
opcode
))
(
inst-type
(
get
symbol
'romp-instruction-type
)))
(
case
inst-type
(
ji
(
print-ji-instruction
opcode
byte-vector
i
branches
)
(
setq
i
(
the
fixnum
(
+
i
2
))))
(
x
(
print-x-instruction
opcode
byte-vector
i
branches
)
(
setq
i
(
the
fixnum
(
+
i
2
))))
(
ds
(
print-ds-instruction
opcode
byte-vector
i
branches
function
)
(
setq
i
(
the
fixnum
(
+
i
2
))))
(
r
(
print-r-instruction
opcode
byte-vector
i
branches
)
(
setq
i
(
the
fixnum
(
+
i
2
))))
(
bi
(
print-bi-instruction
opcode
byte-vector
i
branches
)
(
setq
i
(
the
fixnum
(
+
i
4
))))
(
ba
(
print-ba-instruction
opcode
byte-vector
i
branches
)
(
setq
i
(
the
fixnum
(
+
i
4
))))
(
d
(
setq
i
(
the
fixnum
(
+
i
(
the
fixnum
(
print-d-instruction
opcode
byte-vector
i
branches
function
))))))
(
T
(
error
"Illegal instruction type: ~A for instruction ~A.~%"
inst-type
symbol
)))))))
(
defun
find-symbol-name
(
opcode
)
(
declare
(
fixnum
opcode
))
(
let
((
symbol
(
svref
romp-4bit-opcode-symbol
(
logand
(
the
fixnum
(
ash
opcode
-4
))
#xFF
))))
(
if
symbol
symbol
(
svref
romp-8bit-opcode-symbol
opcode
))))
;;; BRANCH-LIST is very much like output-macro-instructions,
;;; but instead of actually creating all the instructions it just
;;; creates the branch instruction labels. A list of these labels
;;; is returned.
(
defun
branch-list
(
function
)
(
let*
((
byte-vector
(
%primitive
header-ref
function
%function-code-slot
))
(
vector-length
(
length
byte-vector
))
(
branches
nil
))
(
declare
(
fixnum
vector-length
))
(
do
((
i
0
))
((
>=
i
vector-length
))
(
declare
(
fixnum
i
))
(
let*
((
opcode
(
aref
byte-vector
i
))
(
symbol
(
find-symbol-name
opcode
))
(
inst-type
(
get
symbol
'romp-instruction-type
)))
(
case
inst-type
(
ji
(
push
(
the
fixnum
(
+
i
(
the
fixnum
(
sign-extend-ji
byte-vector
i
))))
branches
)
(
setq
i
(
the
fixnum
(
+
i
2
))))
((
x
ds
r
)
(
setq
i
(
the
fixnum
(
+
i
2
))))
(
bi
(
push
(
the
fixnum
(
+
i
(
the
fixnum
(
sign-extend-bi
byte-vector
i
))))
branches
)
(
setq
i
(
the
fixnum
(
+
i
4
))))
((
ba
d
)
(
setq
i
(
the
fixnum
(
+
i
4
))))
(
T
(
error
"Unknown instruction type: ~A, for instruction ~A.~%"
inst-type
symbol
)))))
branches
))
(
defun
print-ji-instruction
(
opcode
byte-vector
index
branches
)
(
declare
(
fixnum
opcode
index
))
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
if
(
=
(
logand
opcode
#x8
)
0
)
"JNB"
"JB"
)
(
romp-condition-code
(
+
8
(
logand
opcode
#x7
)))
`
(
**address**
,
(
the
fixnum
(
+
index
(
the
fixnum
(
sign-extend-ji
byte-vector
index
)))))))
(
defun
print-x-instruction
(
opcode
byte-vector
index
branches
)
(
declare
(
fixnum
opcode
index
))
(
let*
((
rega
(
get-register-name
(
logand
opcode
#xF
)))
(
operand
(
aref
byte-vector
(
the
fixnum
(
1+
index
))))
(
regb
(
get-register-name
(
logand
(
the
fixnum
(
ash
operand
-4
))
#xF
)))
(
regc
(
get-register-name
(
logand
operand
#xF
)))
(
star
(
if
(
memq
index
branches
)
"*"
" "
)))
(
declare
(
fixnum
operand
))
(
if
(
eq
regc
'NL0
)
(
cond
((
and
(
eq
rega
'NL0
)
(
eq
regb
'NL0
))
(
format
t
"~6D~A (LR NL0 NL0) ; Padding for previous execute instruction.~%"
index
star
))
(
T
(
format
t
"~6D~A (LR ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
rega
regb
)))
(
format
t
"~6D~A (CAS ~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
rega
regb
regc
))))
(
defun
print-ds-instruction
(
opcode
byte-vector
index
branches
function
)
(
declare
(
fixnum
opcode
index
))
(
let*
((
symbol
(
find-symbol-name
opcode
))
(
operand
(
aref
byte-vector
(
the
fixnum
(
1+
index
))))
(
rega
(
get-register-name
(
logand
(
the
fixnum
(
ash
operand
-4
))
#xF
)))
(
regb
(
get-register-name
(
logand
operand
#xF
)))
(
offset
(
ash
(
logand
opcode
#xF
)
2
)))
(
declare
(
fixnum
offset
operand
))
(
cond
((
and
(
memq
symbol
'
(
ls
sts
))
(
memq
regb
'
(
ENV
CONT
)))
(
print-special-access
symbol
rega
regb
offset
function
index
branches
))
(
T
(
format
t
"~6D~A (~A ~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
(
get-register-name
(
logand
(
the
fixnum
(
ash
operand
-4
))
#xF
))
(
get-register-name
(
logand
operand
#xF
))
(
case
symbol
((
ls
sts
)
(
ash
(
logand
opcode
#xF
)
2
))
((
lhs
lhas
sths
)
(
ash
(
logand
opcode
#xF
)
1
))
(
T
(
logand
opcode
#xF
))))))))
(
defun
print-r-instruction
(
opcode
byte-vector
index
branches
)
(
declare
(
fixnum
index
opcode
))
(
let*
((
symbol
(
find-symbol-name
opcode
))
(
operand
(
aref
byte-vector
(
the
fixnum
(
1+
index
))))
(
rega
(
logand
(
the
fixnum
(
ash
operand
-4
))
#xF
))
(
regb
(
logand
operand
#xF
)))
(
declare
(
fixnum
operand
))
(
cond
((
memq
symbol
'
(
inc
dec
lis
mftbil
mftbiu
mttbil
mttbiu
ais
cis
sis
clrbl
clrbu
setbl
setbu
sari
sari16
sri
sri16
srpi
srpi16
sli
sli16
slpi
slpi16
))
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
(
get-register-name
rega
)
regb
))
((
memq
symbol
'
(
bbr
bbrx
bnbr
bnbrx
))
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
(
romp-condition-code
rega
)
(
get-register-name
regb
)))
((
memq
symbol
'
(
mts
mfs
))
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
rega
regb
))
((
memq
symbol
'
(
clrsb
setsb
))
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
rega
regb
))
(
T
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
(
get-register-name
rega
)
(
get-register-name
regb
))))))
(
defun
print-bi-instruction
(
opcode
byte-vector
index
branches
)
(
declare
(
fixnum
index
opcode
))
(
let*
((
symbol
(
find-symbol-name
opcode
))
(
cc
(
romp-condition-code
(
logand
(
ash
(
the
fixnum
(
aref
byte-vector
(
the
fixnum
(
1+
index
))))
-4
)
#xF
)))
(
label
(
the
fixnum
(
+
index
(
the
fixnum
(
sign-extend-bi
byte-vector
index
))))))
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
cc
`
(
**address**
,
label
))))
(
defun
print-ba-instruction
(
opcode
byte-vector
index
branches
)
(
declare
(
fixnum
index
opcode
))
(
let*
((
symbol
(
find-symbol-name
opcode
))
(
operand
(
the
fixnum
(
logior
(
ash
(
the
fixnum
(
aref
byte-vector
(
the
fixnum
(
1+
index
))))
16
)
(
ash
(
the
fixnum
(
aref
byte-vector
(
the
fixnum
(
+
index
2
))))
8
)
(
the
fixnum
(
aref
byte-vector
(
the
fixnum
(
+
index
3
)))))))
(
miscop
(
find-miscop-name
operand
)))
(
format
t
"~6D~A (~A ~A) ; Call miscop ~A.~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
miscop
miscop
))
4
)
(
defun
print-d-instruction
(
opcode
byte-vector
index
branches
function
)
(
declare
(
fixnum
index
opcode
))
(
let*
((
symbol
(
find-symbol-name
opcode
))
(
operand
(
aref
byte-vector
(
the
fixnum
(
1+
index
))))
(
rega
(
get-register-name
(
logand
(
the
fixnum
(
ash
operand
-4
))
#xF
)))
(
regb
(
get-register-name
(
logand
operand
#xF
)))
(
offset
(
sign-extend-d
byte-vector
index
)))
(
declare
(
fixnum
offset
operand
))
(
cond
((
eq
symbol
'ci
)
(
format
t
"~6D~A (~A ~A ~A)~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
rega
offset
)
4
)
((
and
(
memq
symbol
'
(
l
st
))
(
memq
regb
'
(
ENV
CONT
)))
(
print-special-access
symbol
rega
regb
offset
function
index
branches
)
4
)
(
T
(
format
t
"~6D~A (~A ~A ~A ~A)~A~%"
index
(
if
(
memq
index
branches
)
"*"
" "
)
(
symbol-name
symbol
)
rega
regb
offset
(
if
(
eq
(
setq
offset
(
logand
offset
#xFFFF
))
nil-16
)
" ; NIL."
(
if
(
eq
offset
t-16
)
" ; T."
""
)))
4
))))
(
defun
print-special-access
(
symbol
rega
regb
offset
function
index
branches
)
(
declare
(
fixnum
index
offset
))
(
let
((
star
(
if
(
memq
index
branches
)
"*"
" "
))
(
*print-level*
3
)
(
*print-length*
10
))
(
cond
((
not
(
eq
regb
'ENV
))
(
format
t
"~6D~A (~A ~A ~A ~A) ; Stack slot ~D.~%"
index
star
(
symbol-name
symbol
)
rega
regb
offset
(
ash
offset
-2
)))
((
=
offset
(
ash
%function-code-slot
2
))
(
format
t
"~6D~A (~A ~A ~A ~A) ; Function code.~%"
index
star
(
symbol-name
symbol
)
rega
regb
offset
))
((
=
offset
(
ash
%function-offset-slot
2
))
(
format
t
"~6D~A (~A ~A ~A ~A) ; Function offset.~%"
index
star
(
symbol-name
symbol
)
rega
regb
offset
))
(
t
(
format
t
"~6D~A (~A ~A ~A ~A) ; Constant: ~S.~%"
index
star
(
symbol-name
symbol
)
rega
regb
offset
(
%primitive
header-ref
(
%primitive
header-ref
function
%function-entry-constants-slot
)
(
ash
(
the
fixnum
(
-
offset
g-vector-header-size
))
-2
)))))))
(
defun
sign-extend-ji
(
byte-vector
index
)
(
declare
(
fixnum
index
))
(
let
((
byte
(
aref
byte-vector
(
the
fixnum
(
1+
index
)))))
(
declare
(
fixnum
byte
))
(
ash
(
if
(
=
(
logand
byte
#x80
)
0
)
byte
(
the
fixnum
(
-
(
the
fixnum
(
1+
(
logand
(
lognot
byte
)
#x7F
))))))
1
)))
(
defun
sign-extend-bi
(
byte-vector
index
)
(
declare
(
fixnum
index
))
(
let
((
int
(
logior
(
the
fixnum
(
ash
(
logand
(
the
fixnum
(
aref
byte-vector
(
the
fixnum
(
1+
index
))))
#xF
)
16
))
(
the
fixnum
(
ash
(
aref
byte-vector
(
the
fixnum
(
+
index
2
)))
8
))
(
the
fixnum
(
aref
byte-vector
(
the
fixnum
(
+
index
3
)))))))
(
declare
(
fixnum
int
))
(
ash
(
if
(
=
(
logand
int
#x80000
)
0
)
int
(
the
fixnum
(
-
(
the
fixnum
(
1+
(
logand
(
lognot
int
)
#x7FFFF
))))))
1
)))
(
defun
sign-extend-d
(
byte-vector
index
)
(
declare
(
fixnum
index
))
(
let
((
hword
(
logior
(
the
fixnum
(
ash
(
aref
byte-vector
(
the
fixnum
(
+
index
2
)))
8
))
(
the
fixnum
(
aref
byte-vector
(
the
fixnum
(
+
index
3
)))))))
(
declare
(
fixnum
hword
))
(
if
(
=
(
logand
hword
#x8000
)
0
)
hword
(
the
fixnum
(
-
(
the
fixnum
(
1+
(
logand
(
lognot
hword
)
#xFFFF
))))))))
(
defun
romp-condition-code
(
cc
)
(
if
(
<=
8
cc
16
)
(
svref
'#(
pz
lt
eq
gt
cz
reserved
ov
tb
)
(
-
cc
8
))
'??
))
(
defun
get-register-name
(
reg
)
(
svref
'#(
NL0
A0
NL1
A1
A3
A2
SP
L0
L1
L2
L3
L4
BS
CONT
ENV
PC
)
reg
))
(
defvar
miscop-cache
NIL
)
(
defun
find-miscop-name
(
index
)
(
if
(
null
miscop-cache
)
(
initialize-miscop-cache
))
(
gethash
index
miscop-cache
))
(
defun
initialize-miscop-cache
()
(
setq
miscop-cache
(
make-hash-table
:size
500
))
(
do-symbols
(
x
(
find-package
"CLC"
))
(
let
((
v
(
get
x
'lisp::%loaded-address
)))
(
when
v
(
setf
(
gethash
v
miscop-cache
)
x
))))
(
dolist
(
x
lisp::*user-defined-miscops*
)
(
setf
(
gethash
(
get
x
'lisp::%loaded-address
)
miscop-cache
)
x
)))
assembler/miscasm.lisp
deleted
100644 → 0
View file @
10b7c474
;;; -*- Mode: Lisp; Package: Compiler -*-
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; Spice Lisp is currently incomplete and under active development.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
(
in-package
'compiler
)
(
export
'
(
asm
asm-files
)
(
find-package
'compiler
))
(
defun
asm
(
f
)
(
assemble-file
(
concatenate
'simple-string
"miscops:"
f
".romp"
)))
(
defun
asm-files
()
(
asm
"abs"
)
(
asm
"allocation"
)
(
asm
"arith"
)
(
asm
"array"
)
(
asm
"byte"
)
(
asm
"call"
)
(
asm
"nlx"
)
(
asm
"compare"
)
(
asm
"divide"
)
(
asm
"gc"
)
(
asm
"gcd"
)
(
asm
"irrat"
)
(
asm
"list"
)
(
asm
"logic"
)
(
asm
"minus"
)
(
asm
"misc"
)
(
asm
"multiply"
)
(
asm
"negate"
)
(
asm
"plus"
)
(
asm
"print"
)
(
asm
"predicate"
)
(
asm
"save"
)
(
asm
"stack"
)
(
asm
"symbol"
)
(
asm
"system"
)
(
asm
"truncate"
))
assembler/rompconst.lisp
deleted
100644 → 0
View file @
10b7c474
This diff is collapsed.
Click to expand it.
assembler/ropdefs.lisp
deleted
100644 → 0
View file @
10b7c474
;;; -*- Mode: Lisp; Package: Compiler -*-
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
;;; Carnegie-Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of Spice Lisp, please contact
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;; This file defines the instruction set for the Common Lisp Romp Assembler
;;; used by the compiler.
;;; Written by David B. McDonald.
(
in-package
'Compiler
)
(
defvar
romp-4bit-opcode-symbol
(
make-array
16
))
(
defvar
romp-8bit-opcode-symbol
(
make-array
256
))
;;; Define-Romp-Instruction defines a Romp instruction to the assembler.
;;; It accepts three arguments:
;;; romp-instruction is a symbol whose pname is the name of a Romp instruction
;;; romp-inst-type specifies the underlying type of the Romp instruction.
;;; it must have one of the following values: JI, X, DS, R, BI, BA,
;;; or D.
;;; romp-code specifies the numeric op code for the instruction.
(
defmacro
Define-Romp-Instruction
(
romp-instruction
romp-inst-type
romp-code
)
`
(
progn
(
setf
(
get
',romp-instruction
'romp-instruction-type
)
',romp-inst-type
)
(
setf
(
get
',romp-instruction
'romp-operation-code
)
,
romp-code
)
,
(
case
romp-inst-type
(
ji
`
(
setf
(
svref
romp-4bit-opcode-symbol
0
)
',romp-instruction
))
((
x
ds
)
`
(
setf
(
svref
romp-4bit-opcode-symbol
,
romp-code
)
',romp-instruction
))
((
r
bi
ba
d
)
`
(
setf
(
svref
romp-8bit-opcode-symbol
,
romp-code
)
',romp-instruction
))
(
T
(
error
"Illegal instruction type: ~A, for instruction ~A (~A).~%"
romp-inst-type
romp-instruction
romp-code
)))))
;;; Define-Romp-Branch defines a Romp branch instruction to the assembler. It
;;; accepts three arguments:
;;; romp-branch is a symbol whose pname is the name of a branch instruction.
;;; romp-instruction is the underlying romp-instruction that should be used
;;; used to implement the branch instruction.
;;; condition-code specifies the bit of the condition code that should be
;;; be tested to implement the branch.
(
defmacro
Define-Romp-Branch
(
romp-branch
romp-instruction
condition-code
)
`
(
progn
(
setf
(
get
',romp-branch
'romp-branch-instruction
)
',romp-instruction
)
(
setf
(
get
',romp-branch
'romp-condition-code
)
,
condition-code
)))
;;; Define-Condition-Code associates the integer code for a particular condition
;;; code bit with a symbol. It accepts a symbol and a value.
(
defmacro
Define-Condition-Code
(
condition-code
value
)
`
(
setf
(
get
',condition-code
'condition-code
)
,
value
))
;;; Storage Access Instructions.
(
define-romp-instruction
lcs
ds
#x4
)
(
define-romp-instruction
lc
d
#xCE
)
(
define-romp-instruction
lhas
ds
#x5
)
(
define-romp-instruction
lha
d
#xCA
)
(
define-romp-instruction
lhs
r
#xEB
)
(
define-romp-instruction
lh
d
#xDA
)
(
define-romp-instruction
ls
ds
#x7
)
(
define-romp-instruction
l
d
#xCD
)
(
define-romp-instruction
lm
d
#xC9
)
(
define-romp-instruction
tsh
d
#xCF
)
(
define-romp-instruction
stcs
ds
#x1
)
(
define-romp-instruction
stc
d
#xDE
)
(
define-romp-instruction
sths
ds
#x2
)
(
define-romp-instruction
sth
d
#xDC
)
(
define-romp-instruction
sts
ds
#x3
)
(
define-romp-instruction
st
d
#xDD
)
(
define-romp-instruction
stm
d
#xD9
)
;;; Address Computation Instructions.
(
define-romp-instruction
cal
d
#xC8
)
(
define-romp-instruction
cal16
d
#xC2
)
(
define-romp-instruction
cau
d
#xD8
)
(
define-romp-instruction
cas
x
#x6
)
(
define-romp-instruction
ca16
r
#xF3
)
(
define-romp-instruction
inc
r
#x91
)
(
define-romp-instruction
dec
r
#x93
)
(
define-romp-instruction
lis
r
#xA4
)
;;; Basic Romp Branch Instructions.
(
define-romp-instruction
bala
ba
#x8A
)
(
define-romp-instruction
balax
ba
#x8B
)
(
define-romp-instruction
bali
bi
#x8C
)
(
define-romp-instruction
balix
bi
#x8D
)
(
define-romp-instruction
balr
r
#xEC
)
(
define-romp-instruction
balrx
r
#xED
)
(
define-romp-instruction
jb
ji
#x1
)
(
define-romp-instruction
bb
bi
#x8E
)
(
define-romp-instruction
bbx
bi
#x8F
)
(
define-romp-instruction
bbr
r
#xEE
)
(
define-romp-instruction
bbrx
r
#xEF
)
(
define-romp-instruction
jnb
ji
#x0
)
(
define-romp-instruction
bnb
bi
#x88
)
(
define-romp-instruction
bnbx
bi
#x89
)
(
define-romp-instruction
bnbr
r
#xE8
)
(
define-romp-instruction
bnbrx
r
#xE9
)
;;; Romp Trap Instrunctions.
(
define-romp-instruction
ti
d
#xCC
)
(
define-romp-instruction
tgte
r
#xBD
)
(
define-romp-instruction
tlt
r
#xBE
)
;;; Romp Move and Insert Instructions.
(
define-romp-instruction
mc03
r
#xF9
)
(
define-romp-instruction
mc13
r
#xFA
)
(
define-romp-instruction
mc23
r
#xFB
)
(
define-romp-instruction
mc33
r
#xFC
)
(
define-romp-instruction
mc30
r
#xFD
)
(
define-romp-instruction
mc31
r
#xFE
)
(
define-romp-instruction
mc32
r
#xFF
)
(
define-romp-instruction
mftb
r
#xBC
)
(
define-romp-instruction
mftbil
r
#x9D
)
(
define-romp-instruction
mftbiu
r
#x9C
)
(
define-romp-instruction
mttb
r
#xBF
)
(
define-romp-instruction
mttbil
r
#x9F
)
(
define-romp-instruction
mttbiu
r
#x9E
)
;;; Romp Arithmetic Instructions.
(
define-romp-instruction
a
r
#xE1
)
(
define-romp-instruction
ae
r
#xF1
)
(
define-romp-instruction
aei
d
#xD1
)
(
define-romp-instruction
ai
d
#xC1
)
(
define-romp-instruction
ais
r
#x90
)
(
define-romp-instruction
abs
r
#xE0
)
(
define-romp-instruction
onec
r
#xF4
)
(
define-romp-instruction
twoc
r
#xE4
)
(
define-romp-instruction
c
r
#xB4
)
(
define-romp-instruction
cis
r
#x94
)
(
define-romp-instruction
ci
d
#xD4
)
(
define-romp-instruction
cl
r
#xB3
)
(
define-romp-instruction
cli
d
#xD3
)
(
define-romp-instruction
exts
r
#xB1
)
(
define-romp-instruction
s
r
#xE2
)
(
define-romp-instruction
sf
r
#xB2
)
(
define-romp-instruction
se
r
#xF2
)
(
define-romp-instruction
sfi
d
#xD2
)
(
define-romp-instruction
sis
r
#x92
)
(
define-romp-instruction
d
r
#xB6
)
(
define-romp-instruction
m
r
#xE6
)
;;; Romp Logical Operations
(
define-romp-instruction
clrbl
r
#x99
)
(
define-romp-instruction
clrbu
r
#x98
)
(
define-romp-instruction
setbl
r
#x9B
)
(
define-romp-instruction
setbu
r
#x9A
)
(
define-romp-instruction
n
r
#xE5
)
(
define-romp-instruction
nilz
d
#xC5
)
(
define-romp-instruction
nilo
d
#xC6
)
(
define-romp-instruction
niuz
d
#xD5
)
(
define-romp-instruction
niuo
d
#xD6
)
(
define-romp-instruction
o
r
#xE3
)
(
define-romp-instruction
oil
d
#xC4
)
(
define-romp-instruction
oiu
d
#xC3
)
(
define-romp-instruction
x
r
#xE7
)
(
define-romp-instruction
xil
d
#xC7
)
(
define-romp-instruction
xiu
d
#xD7
)
(
define-romp-instruction
clz
r
#xF5
)