Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
91a213f8
Commit
91a213f8
authored
Apr 01, 1991
by
chiles
Browse files
Random typos and misnomers.
parent
f9ea2c92
Changes
1
Hide whitespace changes
Inline
Side-by-side
assembly/rt/assem-rtns.lisp
View file @
91a213f8
...
...
@@ -7,7 +7,7 @@
;;; Lisp, please contact Scott Fahlman (Scott.Fahlman@CS.CMU.EDU)
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/assem-rtns.lisp,v 1.
1
1991/0
2/18 15:43:33
chiles Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/assembly/rt/assem-rtns.lisp,v 1.
2
1991/0
4/01 13:38:59
chiles Exp $
;;;
(
in-package
"RT"
)
...
...
@@ -17,6 +17,7 @@
;;;; Non-local exit noise.
(
define-assembly-routine
(
unwind
(
:translate
%continue-unwind
)
(
:return-style
:none
)
(
:policy
:fast-safe
))
((
:arg
block
(
word-pointer-reg
any-reg
descriptor-reg
)
a0-offset
)
...
...
@@ -32,7 +33,7 @@
(
let
((
error
(
generate-error-code
nil
invalid-unwind-error
)))
(
inst
c
block
0
)
(
inst
b
:eq
error
))
(
inst
b
c
:eq
error
))
(
load-symbol-value
cur-uwp
lisp::*current-unwind-protect-block*
)
(
loadw
target-uwp
block
unwind-block-current-uwp-slot
)
...
...
@@ -43,7 +44,7 @@
DO-EXIT
(
loadw
fp-tn
cur-uwp
unwind-block-current-cont-slot
)
(
loadw
c
fp-tn
cur-uwp
unwind-block-current-cont-slot
)
(
loadw
code-tn
cur-uwp
unwind-block-current-code-slot
)
(
loadw
lra
cur-uwp
unwind-block-entry-pc-slot
)
(
lisp-return
lra
lip
:frob-code
nil
)
...
...
@@ -54,7 +55,8 @@
(
inst
bx
do-exit
)
(
store-symbol-value
next-uwp
lisp::*current-unwind-protect-block*
))
(
define-assembly-routine
throw
(
define-assembly-routine
(
throw
(
:return-style
:none
))
((
:arg
target
descriptor-reg
a0-offset
)
(
:arg
start
word-pointer-reg
ocfp-offset
)
(
:arg
count
any-reg
nargs-offset
)
...
...
@@ -62,6 +64,9 @@
(
:temp
tag
descriptor-reg
a2-offset
)
(
:temp
ndescr
non-descriptor-reg
nl0-offset
))
;; These are needed by UNWIND, but not by us directly.
(
declare
(
ignore
start
count
))
(
load-symbol-value
catch
lisp::*current-catch-block*
)
LOOP
...
...
@@ -93,9 +98,11 @@
(
:arg
src
any-reg
cname-offset
)
(
:arg
nvals
any-reg
nargs-offset
)
(
:temp
lip
interior-reg
lip-offset
)
(
:temp
count
any-reg
ocfp-offset
)
;; Pointer into cstack, so looks like fixnum.
(
:temp
dst
any-reg
lexenv-offset
)
(
:temp
temp
any-reg
nfp-offset
)
(
:temp
a0
descriptor-reg
a0-offset
)
(
:temp
a1
descriptor-reg
a1-offset
)
(
:temp
a2
descriptor-reg
a2-offset
))
...
...
@@ -113,7 +120,7 @@
;;
;; Copy the remaining args to the top of the stack.
(
inst
inc
src
(
*
word-bytes
register-arg-count
))
(
inst
cal
dst
fp-tn
(
*
word-bytes
register-arg-count
))
(
inst
cal
dst
c
fp-tn
(
*
word-bytes
register-arg-count
))
(
inst
s
count
nvals
(
fixnum
3
))
(
inst
bnc
:gt
done
)
LOOP
...
...
@@ -136,8 +143,8 @@
;; Clear the stack.
DONE
(
move
count
cfp-tn
)
;Put pointer to the start of values in ocfp.
(
inst
cas
csp-tn
n
arg
s
count
)
;Adjust the stack top: <ptr-to-vals>+<nvals>.
(
move
fp-tn
ocfp
)
;Restore returnee's fp.
(
inst
cas
csp-tn
n
val
s
count
)
;Adjust the stack top: <ptr-to-vals>+<nvals>.
(
move
c
fp-tn
ocfp
)
;Restore returnee's fp.
;;
;; Return.
(
lisp-return
lra
lip
))
...
...
@@ -206,7 +213,7 @@
;; The start location is the last one we copy.
(
inst
cal
srcstart
cfp-tn
(
*
register-arg-count
word-bytes
))
;; Compute the source location of the last more arg.
(
inst
ca
l
count/src
cfp-tn
nargs
-tn
)
(
inst
ca
s
count/src
nargs-tn
cfp
-tn
)
(
inst
dec
count/src
word-bytes
)
;not an exclusive end.
;; Compute destination end, which is the stack pointer minus three register
;; slots we saved and minus one to make it an inclusive end.
...
...
@@ -261,9 +268,9 @@
;; These are really args.
((
:temp
args
any-reg
nl0-offset
)
;; These are needed by the blitting code.
(
:temp
nargs/src
any-reg
nargs
-offset
)
(
:temp
nargs/src
any-reg
lra
-offset
)
(
:temp
lexenv/dst
any-reg
lexenv-offset
)
(
:temp
count
any-reg
lra
-offset
)
(
:temp
count
any-reg
nargs
-offset
)
(
:temp
temp
descriptor-reg
cname-offset
)
;; These are needed so we can get at the register args.
(
:temp
a0
descriptor-reg
a0-offset
)
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment