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
94cd35ae
Commit
94cd35ae
authored
30 years ago
by
ram
Browse files
Options
Downloads
Patches
Plain Diff
s-context => sigcontext
parent
7105f86f
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
code/sparc-svr4-vm.lisp
+40
-40
40 additions, 40 deletions
code/sparc-svr4-vm.lisp
with
40 additions
and
40 deletions
code/sparc-svr4-vm.lisp
+
40
−
40
View file @
94cd35ae
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-svr4-vm.lisp,v 1.
1
1994/10/
19 23:25:06
ram Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sparc-svr4-vm.lisp,v 1.
2
1994/10/
20 15:29:29
ram Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -18,12 +18,12 @@
(
use-package
"UNIX"
)
(
export
'
(
fixup-code-object
internal-error-arguments
s
-
context-program-counter
s
-
context-register
s
-
context-float-register
s
-
context-floating-point-modes
s
ig
context-program-counter
s
ig
context-register
s
ig
context-float-register
s
ig
context-floating-point-modes
extern-alien-name
sanctify-for-execution
))
;;;; The s
-
context structure.
;;;; The s
ig
context structure.
(
def-alien-type
sigset
(
struct
sigset
...
...
@@ -40,7 +40,7 @@
; Because the fpu structure contains doubles, it must be aligned on
; 8 byte bounderies, consequently so must struct mcontext and struct
; ucontext.
(
def-alien-type
s
-
context
(
def-alien-type
s
ig
context
(
struct
nil
(
uc-flags
unsigned-long
)
(
uc-link
system-area-pointer
)
...
...
@@ -125,14 +125,14 @@
;;; INTERNAL-ERROR-ARGUMENTS -- interface.
;;;
;;; Given the s
-
context, extract the internal error arguments from the
;;; Given the s
ig
context, extract the internal error arguments from the
;;; instruction stream.
;;;
(
defun
internal-error-arguments
(
scp
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
;(write "SCP = ") (write scp)
;(write "slot = ") (write (slot scp 'uc-pc))
(
let*
((
pc
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
let*
((
pc
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
slot
scp
'uc-pc
)))
(
bad-inst
(
sap-ref-32
pc
0
))
(
op
(
ldb
(
byte
2
30
)
bad-inst
))
...
...
@@ -150,8 +150,8 @@
(
values
#.
(
error-number-or-lose
'unknown-error
)
nil
)))))
(
defun
args-for-unimp-inst
(
scp
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
let*
((
pc
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
let*
((
pc
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
slot
scp
'uc-pc
)))
(
length
(
sap-ref-8
pc
4
))
(
vector
(
make-array
length
:element-type
'
(
unsigned-byte
8
))))
...
...
@@ -172,13 +172,13 @@
(
values
error-number
(
sc-offsets
))))))
(
defun
args-for-tagged-add-inst
(
scp
bad-inst
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
let*
((
rs1
(
ldb
(
byte
5
14
)
bad-inst
))
(
op1
(
di::make-lisp-obj
(
s
-
context-register
scp
rs1
))))
(
op1
(
di::make-lisp-obj
(
s
ig
context-register
scp
rs1
))))
(
if
(
fixnump
op1
)
(
if
(
zerop
(
ldb
(
byte
1
13
)
bad-inst
))
(
let*
((
rs2
(
ldb
(
byte
5
0
)
bad-inst
))
(
op2
(
di::make-lisp-obj
(
s
-
context-register
scp
rs2
))))
(
op2
(
di::make-lisp-obj
(
s
ig
context-register
scp
rs2
))))
(
if
(
fixnump
op2
)
(
values
#.
(
error-number-or-lose
'unknown-error
)
nil
)
(
values
#.
(
error-number-or-lose
'object-not-fixnum-error
)
...
...
@@ -203,24 +203,24 @@
(
list
(
c::make-sc-offset
sparc:descriptor-reg-sc-number
reg
)))))
;;;; s
-
context access functions.
;;;; s
ig
context access functions.
;;; s
-
context-PROGRAM-COUNTER -- Interface.
;;; s
ig
context-PROGRAM-COUNTER -- Interface.
;;;
(
defun
s
-
context-program-counter
(
scp
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
defun
s
ig
context-program-counter
(
scp
)
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
slot
scp
'uc-pc
)
))
;;; s
-
context-REGISTER -- Interface.
;;; s
ig
context-REGISTER -- Interface.
;;;
;;; An escape register saves the value of a register for a frame that someone
;;; interrupts.
;;;
(
defun
s
-
context-register
(
scp
index
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
defun
s
ig
context-register
(
scp
index
)
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
if
(
zerop
index
)
0
(
if
(
<
index
16
)
...
...
@@ -228,9 +228,9 @@
(
deref
(
slot
(
slot
(
slot
scp
'uc-regs
)
'regs2
)
'uc-sp
)
(
-
index
16
))
))))
(
defun
%set-s
-
context-register
(
scp
index
new
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
defun
%set-s
ig
context-register
(
scp
index
new
)
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
if
(
zerop
index
)
0
(
if
(
<
index
16
)
...
...
@@ -240,25 +240,25 @@
))
new
)
(
defsetf
s
-
context-register
%set-s
-
context-register
)
(
defsetf
s
ig
context-register
%set-s
ig
context-register
)
;;; s
-
context-FLOAT-REGISTER -- Interface
;;; s
ig
context-FLOAT-REGISTER -- Interface
;;;
;;; Like s
-
context-REGISTER, but returns the value of a float register.
;;; Like s
ig
context-REGISTER, but returns the value of a float register.
;;; Format is the type of float to return.
;;;
(
defun
s
-
context-float-register
(
scp
index
format
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
defun
s
ig
context-float-register
(
scp
index
format
)
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
let
((
sap
(
alien-sap
(
slot
scp
'fpregs
))))
(
ecase
format
(
single-float
(
system:sap-ref-single
sap
(
*
index
vm:word-bytes
)))
(
double-float
(
system:sap-ref-double
sap
(
*
index
vm:word-bytes
)))))))
;;;
(
defun
%set-s
-
context-float-register
(
scp
index
format
new-value
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
defun
%set-s
ig
context-float-register
(
scp
index
format
new-value
)
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
let
((
sap
(
alien-sap
(
slot
scp
'fpregs
))))
(
ecase
format
(
single-float
...
...
@@ -266,17 +266,17 @@
(
double-float
(
setf
(
sap-ref-double
sap
(
*
index
vm:word-bytes
))
new-value
))))))
;;;
(
defsetf
s
-
context-float-register
%set-s
-
context-float-register
)
(
defsetf
s
ig
context-float-register
%set-s
ig
context-float-register
)
;;; s
-
context-FLOATING-POINT-MODES -- Interface
;;; s
ig
context-FLOATING-POINT-MODES -- Interface
;;;
;;; Given a s
-
context pointer, return the floating point modes word in the
;;; Given a s
ig
context pointer, return the floating point modes word in the
;;; same format as returned by FLOATING-POINT-MODES.
;;;
(
defun
s
-
context-floating-point-modes
(
scp
)
(
declare
(
type
(
alien
(
*
s
-
context
))
scp
))
(
with-alien
((
scp
(
*
s
-
context
)
scp
))
(
defun
s
ig
context-floating-point-modes
(
scp
)
(
declare
(
type
(
alien
(
*
s
ig
context
))
scp
))
(
with-alien
((
scp
(
*
s
ig
context
)
scp
))
(
slot
scp
'fsr
)))
...
...
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