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
91a213f8
Commit
91a213f8
authored
34 years ago
by
chiles
Browse files
Options
Downloads
Patches
Plain Diff
Random typos and misnomers.
parent
f9ea2c92
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
assembly/rt/assem-rtns.lisp
+17
-10
17 additions, 10 deletions
assembly/rt/assem-rtns.lisp
with
17 additions
and
10 deletions
assembly/rt/assem-rtns.lisp
+
17
−
10
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
)
...
...
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