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
e86b4304
Commit
e86b4304
authored
35 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Initial cut at rewrite for mips. Not finished, but at least the VOPs will
be there.
parent
168d60f7
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/mips/nlx.lisp
+151
-81
151 additions, 81 deletions
compiler/mips/nlx.lisp
with
151 additions
and
81 deletions
compiler/mips/nlx.lisp
+
151
−
81
View file @
e86b4304
...
...
@@ -7,6 +7,8 @@
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/nlx.lisp,v 1.2 1990/02/27 00:12:10 wlott Exp $
;;;
;;; This file contains the definitions of VOPs used for non-local exit
;;; (throw, lexical exit, etc.)
;;;
...
...
@@ -31,53 +33,133 @@
;;; use with the Save/Restore-Dynamic-Environment VOPs.
;;;
(
defun
make-dynamic-state-tns
()
(
make-n-tns
3
*any-primitive-type*
))
(
make-n-tns
4
*any-primitive-type*
))
(
define-vop
(
save-dynamic-state
)
(
:results
(
catch
:scs
(
descriptor-reg
))
(
special
:scs
(
descriptor-reg
))
(
number
:scs
(
descriptor-reg
))
(
eval
:scs
(
descriptor-reg
)))
#+
nil
(
:generator
13
(
load-
global
catch
clc
::current-catch-block
)
(
inst
lr
special
bs-tn
)
(
inst
cau
eval
zero-tn
clc::t-16
)
(
inst
l
e
val
eval
(
+
clc
::*eval-stack-top*
-offset
clc::symbol-value
)
)))
(
load-
symbol-value
catch
lisp
::
*
current-catch-block
*
)
(
move
special
bs
p
-tn
)
(
move
number
nsp-tn
)
(
load-symbol-
val
ue
eval
lisp
::*eval-stack-top*
)))
(
define-vop
(
restore-dynamic-state
one-arg-no-value-miscop
)
(
define-vop
(
restore-dynamic-state
)
(
:args
(
catch
:scs
(
descriptor-reg
))
(
special
:scs
(
descriptor-reg
)
:target
a0
)
(
special
:scs
(
descriptor-reg
))
(
number
:scs
(
descriptor-reg
))
(
eval
:scs
(
descriptor-reg
)))
(
:temporary
(
:scs
(
descriptor-reg
))
temp
)
(
:variant-vars
)
#+
nil
(
:temporary
(
:scs
(
descriptor-reg
))
symbol
value
)
(
:generator
10
(
store-global
catch
clc::current-catch-block
temp
)
(
inst
cau
temp
zero-tn
clc::t-16
)
(
inst
st
eval
temp
(
+
clc::*eval-stack-top*-offset
clc::symbol-value
))
(
let
((
skip
(
gen-label
)))
(
inst
c
special
bs-tn
)
(
inst
bb
:eq
skip
)
(
unless
(
location=
special
a0
)
(
inst
lr
a0
special
))
(
inst
miscop
'clc::unbind-to-here
)
(
emit-label
skip
))))
(
let
((
done
(
gen-label
))
(
skip
(
gen-label
))
(
loop
(
gen-label
)))
(
store-symbol-value
catch
lisp::*current-catch-block*
)
(
store-symbol-value
eval
lisp::*eval-stack-top*
)
(
move
nsp-tn
number
)
(
inst
beq
special
bsp-tn
done
)
(
nop
)
(
emit-label
loop
)
(
loadw
symbol
bsp-tn
(
-
binding-symbol-slot
binding-size
))
(
inst
beq
symbol
zero-tn
skip
)
(
loadw
value
bsp-tn
(
-
binding-value-slot
binding-size
))
(
storew
value
symbol
vm:symbol-value-slot
vm:other-pointer-type
)
(
storew
zero-tn
bsp-tn
(
-
binding-symbol-slot
binding-size
))
(
emit-label
skip
)
(
inst
addiu
bsp-tn
bsp-tn
(
*
-2
vm:word-bytes
))
(
inst
bne
bsp-tn
special
loop
)
(
nop
)
(
emit-label
done
))))
(
define-vop
(
current-stack-pointer
)
(
:results
(
res
:scs
(
any-reg
descriptor-reg
)))
#+
nil
(
:generator
1
(
inst
lr
res
sp-tn
)))
(
move
res
c
sp-tn
)))
;;;; Unwind miscop VOPs:
(
define-vop
(
unwind
three-arg-no-value-miscop
)
(
:variant
'clc::unwind
)
(
:translate
%continue-unwind
))
(
define-vop
(
unwind
)
(
:translate
%continue-unwind
)
(
:args
(
block-arg
:target
block
)
(
start
:target
args
)
(
count
:target
nargs
))
(
:temporary
(
:sc
any-reg
:offset
(
first
register-arg-offsets
)
:from
(
:argument
0
))
block
)
(
:temporary
(
:sc
any-reg
:offset
args-offset
:from
(
:argument
1
))
args
)
(
:temporary
(
:sc
any-reg
:offset
nargs-offset
:from
(
:argument
2
))
nargs
)
(
:temporary
(
:scs
(
any-reg
)
:type
fixnum
)
cur-uwp
target-uwp
next-uwp
)
(
:temporary
(
:scs
(
descriptor-reg
))
return-pc
)
(
:temporary
(
:scs
(
interior-reg
)
:type
interior
)
lip
)
(
:node-var
node
)
(
:generator
0
(
let
((
error
(
generate-error-code
node
di:invalid-unwind-error
))
(
do-uwp
(
gen-label
))
(
do-exit
(
gen-label
)))
(
move
block
block-arg
)
(
inst
beq
block
zero-tn
error
)
(
move
args
start
)
(
move
nargs
count
)
(
load-symbol-value
cur-uwp
lisp::*current-unwind-protect-block*
)
(
loadw
target-uwp
block
vm:unwind-block-current-uwp-slot
)
(
inst
bne
cur-uwp
target-uwp
do-uwp
)
(
nop
)
(
move
cur-uwp
block
)
(
emit-label
do-exit
)
(
loadw
cont-tn
cur-uwp
vm:unwind-block-current-cont-slot
)
(
loadw
code-tn
cur-uwp
vm:unwind-block-current-code-slot
)
(
loadw
return-pc
cur-uwp
vm:unwind-block-entry-pc-slot
)
(
lisp-return
return-pc
lip
)
(
emit-label
do-uwp
)
(
loadw
next-uwp
cur-uwp
vm:unwind-block-current-uwp-slot
)
(
b
do-exit
)
(
store-symbol-value
next-uwp
lisp::*current-unwind-protect-block*
))))
(
define-vop
(
throw
)
(
:args
(
target
)
(
start
)
(
count
))
(
:temporary
(
:scs
(
any-reg
)
:type
fixnum
)
catch
)
(
:temporary
(
:scs
(
descriptor-reg
))
tag
)
(
:node-var
node
)
(
:generator
0
(
let
((
loop
(
gen-label
))
(
exit
(
gen-label
))
(
error
(
generate-error-code
node
di:unseen-throw-tag-error
target
)))
(
load-symbol-value
catch
lisp::*current-catch-block*
)
(
emit-label
loop
)
(
inst
bne
catch
zero-tn
error
)
(
loadw
tag
catch
vm:catch-block-tag-slot
)
(
inst
beq
tag
target
exit
)
(
nop
)
(
b
loop
)
(
loadw
catch
catch
vm:catch-block-previous-catch-slot
)
(
emit-label
exit
)
;; ### Need to call unwind somehow.
)))
(
define-vop
(
throw
three-arg-no-value-miscop
)
(
:variant
'clc::throw
))
;;;; Unwind block hackery:
...
...
@@ -91,16 +173,14 @@
(
:results
(
block
:scs
(
descriptor-reg
)))
(
:temporary
(
:scs
(
descriptor-reg
))
temp
)
(
:temporary
(
:scs
(
descriptor-reg
)
:target
block
)
result
)
#+
nil
(
:generator
22
(
inst
ai
result
cont-tn
(
*
(
tn-offset
tn
)
4
))
(
load-global
temp
clc::current-unwind-protect-block
)
(
storew
temp
result
system:%unwind-block-current-uwp
)
(
storew
cont-tn
result
system:%unwind-block-current-cont
)
(
storew
env-tn
result
system:%unwind-block-current-env
)
(
storew
entry-offset
result
system:%unwind-block-entry-pc
)
(
unless
(
location=
result
block
)
(
inst
lr
block
result
))))
(
inst
addiu
result
cont-tn
(
*
(
tn-offset
tn
)
vm:word-bytes
))
(
load-symbol-value
temp
lisp::*current-unwind-protect-block*
)
(
storew
temp
result
vm:unwind-block-current-uwp-slot
)
(
storew
cont-tn
result
vm:unwind-block-current-cont-slot
)
(
storew
code-tn
result
vm:unwind-block-current-code-slot
)
(
storew
entry-offset
result
vm:unwind-block-entry-pc-slot
)
(
move
block
result
)))
;;; Like Make-Unwind-Block, except that we also store in the specified tag, and
...
...
@@ -113,22 +193,20 @@
(
:results
(
block
:scs
(
descriptor-reg
)))
(
:temporary
(
:scs
(
descriptor-reg
))
temp
)
(
:temporary
(
:scs
(
descriptor-reg
)
:target
block
)
result
)
#+
nil
(
:generator
44
(
inst
ai
result
cont-tn
(
*
(
tn-offset
tn
)
4
))
(
load-global
temp
clc::current-unwind-protect-block
)
(
storew
temp
result
system:%unwind-block-current-uwp
)
(
storew
cont-tn
result
system:%unwind-block-current-cont
)
(
storew
env-tn
result
system:%unwind-block-current-env
)
(
storew
entry-offset
result
system:%unwind-block-entry-pc
)
(
storew
tag
result
system:%catch-block-tag
)
(
load-global
temp
clc::current-catch-block
)
(
storew
temp
result
system:%catch-block-previous-catch
)
(
store-global
result
clc::current-catch-block
temp
)
(
unless
(
location=
result
block
)
(
inst
lr
block
result
))))
(
inst
addiu
result
cont-tn
(
*
(
tn-offset
tn
)
vm:word-bytes
))
(
load-symbol-value
temp
lisp::*current-unwind-protect-block*
)
(
storew
temp
result
vm:catch-block-current-uwp-slot
)
(
storew
cont-tn
result
vm:catch-block-current-cont-slot
)
(
storew
code-tn
result
vm:catch-block-current-code-slot
)
(
storew
entry-offset
result
vm:catch-block-entry-pc-slot
)
(
storew
tag
result
vm:catch-block-tag-slot
)
(
load-symbol-value
temp
lisp::*current-catch-block-slot*
)
(
storew
temp
result
vm:catch-block-previous-catch-slot
)
(
store-symbol-value
result
lisp::*current-catch-block*
)
(
move
block
result
)))
;;; Just set the current unwind-protect to TN's address. This instantiates an
...
...
@@ -136,30 +214,29 @@
;;;
(
define-vop
(
set-unwind-protect
)
(
:args
(
tn
))
(
:temporary
(
:scs
(
descriptor-reg
))
temp
new-uwp
)
#+
nil
(
:temporary
(
:scs
(
descriptor-reg
))
new-uwp
)
(
:generator
7
(
inst
a
i
new-uwp
cont-tn
(
*
(
tn-offset
tn
)
4
))
(
store-
global
new-uwp
clc
::current-unwind-protect-block
temp
)))
(
inst
a
ddiu
new-uwp
cont-tn
(
*
(
tn-offset
tn
)
vm:word-bytes
))
(
store-
symbol-value
new-uwp
lisp
::
*
current-unwind-protect-block
*
)))
(
define-vop
(
unlink-unwind-block
)
(
:temporary
(
:scs
(
descriptor-reg
))
block
temp
)
(
:variant-vars
global
slot
)
(
define-vop
(
unlink-catch-block
)
(
:temporary
(
:scs
(
descriptor-reg
))
block
)
(
:policy
:fast-safe
)
#+
nil
(
:translate
%catch-breakup
)
(
:generator
17
(
load-global
block
global
)
(
loadw
block
block
slot
)
(
store-global
block
global
temp
)))
(
define-vop
(
unlink-catch-block
unlink-unwind-block
)
(
:variant
clc::current-catch-block
system:%catch-block-previous-catch
)
(
:translate
%catch-breakup
))
(
load-symbol-value
block
lisp::*current-catch-block*
)
(
loadw
block
block
vm:catch-block-previous-catch-slot
)
(
store-symbol-value
block
lisp::*current-catch-block*
)))
(
define-vop
(
unlink-unwind-protect
unlink-unwind-block
)
(
:variant
clc::current-unwind-protect-block
system:%unwind-block-current-uwp
)
(
:translate
%unwind-protect-breakup
))
(
define-vop
(
unlink-unwind-protect
)
(
:temporary
(
:scs
(
descriptor-reg
))
block
)
(
:policy
:fast-safe
)
(
:translate
%unwind-protect-breakup
)
(
:generator
17
(
load-symbol-value
block
lisp::*current-unwind-protect-block*
)
(
loadw
block
block
vm:unwind-block-current-uwp-slot
)
(
store-symbol-value
block
lisp::*current-unwind-protect-block*
)))
;;;; NLX entry VOPs:
...
...
@@ -168,15 +245,12 @@
;;; operands.
;;;
(
define-vop
(
nlx-entry
two-arg-no-value-miscop
)
(
:args
(
top
:scs
(
descriptor-reg
)
:target
a0
)
(
define-vop
(
nlx-entry
)
(
:args
(
top
:scs
(
descriptor-reg
))
(
start
)
(
count
))
(
:results
(
values
:more
t
))
(
:info
nvals
)
(
:ignore
start
count
values
nl0
nl1
a2
a3
misc-pc
)
(
:variant-vars
)
(
:save-p
:force-to-stack
)
#+
nil
(
:generator
30
...
...
@@ -186,13 +260,10 @@
(
inst
cal
a1
zero-tn
nvals
)))
(
define-vop
(
nlx-entry-multiple
two-arg-two-value-miscop
)
(
:args
(
top
:scs
(
descriptor-reg
)
:target
a0
)
(
define-vop
(
nlx-entry-multiple
)
(
:args
(
top
:scs
(
descriptor-reg
))
(
start
)
(
count
))
(
:ignore
start
count
nl0
nl1
a2
a3
misc-pc
)
(
:variant-vars
)
(
:save-p
:force-to-stack
)
#+
nil
(
:generator
30
...
...
@@ -211,5 +282,4 @@
(
:save-p
:force-to-stack
)
(
:results
(
block
)
(
start
)
(
count
))
(
:ignore
block
start
count
)
#+
nil
(
:generator
0
))
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