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
d01310f2
Commit
d01310f2
authored
Nov 02, 2009
by
rtoy
Browse files
Revert previous changes. They were supposed to go on
amd64-dd-branch.
parent
695d7d4c
Changes
21
Expand all
Hide whitespace changes
Inline
Side-by-side
code/pred.lisp
View file @
d01310f2
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.6
1
2009/11/02
02:51:57
rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pred.lisp,v 1.6
2
2009/11/02
15:05:06
rtoy Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -127,39 +127,6 @@
primitive-predicates
))))
(
frob
))
;;; FIXME: The next four functions are for bootstrapping double-double
;;; for AMD64. This works around the recursive known function problem
;;; when compiling the predicate functions for double-double. This
;;; should be eventually removed when double-double float support for
;;; the compiler is working.
(
defun
double-double-float-p
(
x
)
(
let*
((
addr
(
kernel:get-lisp-obj-address
x
))
(
ptr
(
logandc2
addr
#x7
)))
(
when
(
=
1
(
logand
addr
1
))
(
=
26
(
ldb
(
byte
8
0
)
(
sys:sap-ref-32
(
sys:int-sap
ptr
)
0
))))))
(
defun
complex-double-double-float-p
(
x
)
(
let*
((
addr
(
kernel:get-lisp-obj-address
x
))
(
ptr
(
logandc2
addr
#x7
)))
(
when
(
=
1
(
logand
addr
1
))
(
=
42
(
ldb
(
byte
8
0
)
(
sys:sap-ref-32
(
sys:int-sap
ptr
)
0
))))))
(
defun
simple-array-double-double-float-p
(
x
)
(
let*
((
addr
(
kernel:get-lisp-obj-address
x
))
(
ptr
(
logandc2
addr
#x7
)))
(
when
(
=
1
(
logand
addr
1
))
(
=
106
(
ldb
(
byte
8
0
)
(
sys:sap-ref-32
(
sys:int-sap
ptr
)
0
))))))
(
defun
simple-array-complex-double-double-float-p
(
x
)
(
let*
((
addr
(
kernel:get-lisp-obj-address
x
))
(
ptr
(
logandc2
addr
#x7
)))
(
when
(
=
1
(
logand
addr
1
))
(
=
118
(
ldb
(
byte
8
0
)
(
sys:sap-ref-32
(
sys:int-sap
ptr
)
0
))))))
;;;; TYPE-OF -- public.
;;;
...
...
code/sap.lisp
View file @
d01310f2
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sap.lisp,v 1.2
0
2009/11/02
02:51:58
rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/sap.lisp,v 1.2
1
2009/11/02
15:05:06
rtoy Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -77,16 +77,10 @@
(
declare
(
type
system-area-pointer
sap
))
(
sap-int
sap
))
#-
amd64
(
defun
int-sap
(
int
)
"Converts an integer into a System Area Pointer."
(
declare
(
type
(
unsigned-byte
#-
alpha
#.
vm:word-bits
#+
alpha
64
)
int
))
(
int-sap
int
))
#+
amd64
(
defun
int-sap
(
int
)
"Converts an integer into a System Area Pointer."
(
declare
(
type
(
unsigned-byte
64
)
int
))
(
int-sap
int
))
(
defun
sap-ref-8
(
sap
offset
)
"Returns the 8-bit byte at OFFSET bytes from SAP."
...
...
code/unix-glibc2.lisp
View file @
d01310f2
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.5
0
2009/11/02
02:51:58
rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.5
1
2009/11/02
15:05:06
rtoy Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -265,7 +265,7 @@
(
defconstant
ms_invalidate
2
)
;; The return value from mmap that means mmap failed.
(
defconstant
map_failed
(
int-sap
#+
amd64
0
#-
amd64
(
1-
(
ash
1
vm:word-bits
))))
(
defconstant
map_failed
(
int-sap
(
1-
(
ash
1
vm:word-bits
))))
(
defun
unix-mmap
(
addr
length
prot
flags
fd
offset
)
(
declare
(
type
(
or
null
system-area-pointer
)
addr
)
...
...
compiler/amd64/float.lisp
View file @
d01310f2
This diff is collapsed.
Click to expand it.
compiler/amd64/parms.lisp
View file @
d01310f2
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/amd64/parms.lisp,v 1.
4
2009/11/02
02:51:58
rtoy
Exp
$"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/amd64/parms.lisp,v 1.
5
2009/11/02
15:05:06
rtoy
Rel
$"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -55,8 +55,7 @@
;;;; Machine Architecture parameters:
(
export
'
(
word-bits
byte-bits
char-bits
word-shift
word-bytes
char-bytes
float-sign-shift
(
export
'
(
word-bits
byte-bits
word-shift
word-bytes
float-sign-shift
single-float-bias
single-float-exponent-byte
single-float-significand-byte
single-float-normal-exponent-min
...
...
@@ -77,8 +76,6 @@
float-imprecise-trap-bit
float-invalid-trap-bit
float-divide-by-zero-trap-bit
))
#+
double-double
(
export
'
(
double-double-float-digits
))
(
eval-when
(
compile
load
eval
)
...
...
@@ -89,12 +86,6 @@
(
defconstant
byte-bits
8
"Number of bits per byte where a byte is the smallest addressable object."
)
(
defconstant
char-bits
#-
unicode
8
#+
unicode
16
"Number of bits needed to represent a character"
)
(
defconstant
char-bytes
(
truncate
char-bits
byte-bits
)
"Number of bytes needed to represent a character"
)
(
defconstant
word-shift
(
1-
(
integer-length
(
/
word-bits
byte-bits
)))
"Number of bits to shift between word addresses and byte addresses."
)
...
...
@@ -143,10 +134,6 @@
(
defconstant
long-float-digits
(
+
(
byte-size
long-float-significand-byte
)
32
1
))
#+
double-double
(
defconstant
double-double-float-digits
(
*
2
double-float-digits
))
;;; pfw -- from i486 microprocessor programmers reference manual
(
defconstant
float-invalid-trap-bit
(
ash
1
0
))
(
defconstant
float-denormal-trap-bit
(
ash
1
1
))
...
...
@@ -160,26 +147,16 @@
(
defconstant
float-round-to-positive
2
)
(
defconstant
float-round-to-zero
3
)
;; NOTE: These actually match the SSE2 MXCSR register definitions. We
;; need to do it this way because the interface assumes the modes are
;; in the same order as the MXCSR register.
(
defconstant
float-rounding-mode
(
byte
2
13
))
(
defconstant
float-sticky-bits
(
byte
6
0
))
(
defconstant
float-traps-byte
(
byte
6
7
))
(
defconstant
float-exceptions-byte
(
byte
6
0
))
(
defconstant
float-precision-24-bit
0
)
(
defconstant
float-precision-53-bit
2
)
(
defconstant
float-precision-64-bit
3
)
#-
sse2
(
progn
(
defconstant
float-rounding-mode
(
byte
2
10
))
(
defconstant
float-sticky-bits
(
byte
6
16
))
(
defconstant
float-traps-byte
(
byte
6
0
))
(
defconstant
float-exceptions-byte
(
byte
6
16
))
(
defconstant
float-precision-control
(
byte
2
8
))
(
defconstant
float-fast-bit
0
)
; No fast mode on x86
)
#+
sse2
(
progn
;; SSE2 has a flush-to-zero flag, which we use as the fast bit. Some
;; versions of sse2 also have a denormals-are-zeros flag. We don't
;; currently use denormals-are-zeroes for anything.
(
defconstant
float-fast-bit
(
ash
1
15
))
)
)
; eval-when
...
...
@@ -194,15 +171,9 @@
;;; Where to put the different spaces.
;;;
(
defconstant
target-read-only-space-start
#x10000000
)
(
defconstant
target-static-space-start
#+
FreeBSD
#x28F00000
#-
FreeBSD
#x28000000
)
(
defconstant
target-dynamic-space-start
#+
linux
#x58100000
#-
linux
#x48000000
)
(
defconstant
target-foreign-linkage-space-start
#+
linux
#x58000000
#-
linux
#xB0000000
)
(
defconstant
target-static-space-start
#x28000000
)
(
defconstant
target-dynamic-space-start
#x48000000
)
(
defconstant
target-foreign-linkage-space-start
#xB0000000
)
(
defconstant
target-foreign-linkage-entry-size
16
)
;In bytes. Duh.
;;; Given that NIL is the first thing allocated in static space, we
...
...
@@ -334,20 +305,6 @@
lisp::*cmucl-lib*
lisp::*cmucl-core-path*
;; Weak hash table support
:key
:value
:key-and-value
:key-or-value
;; Used by CGC.
*x86-cgc-active-p*
;; Foreign linkage stuff
lisp::*linkage-table-data*
system::*global-table*
*current-region-free-pointer*
*current-region-end-addr*
;; Spare symbols. Rename these when you need to add some static
;; symbols and don't want to do a cross-compile.
spare-8
...
...
@@ -359,6 +316,13 @@
spare-2
spare-1
;; Used by CGC.
*x86-cgc-active-p*
;; Foreign linkage stuff
lisp::*linkage-table-data*
system::*global-table*
*current-region-free-pointer*
*current-region-end-addr*
*static-blue-bag*
; Must be last or change C code
...
...
compiler/amd64/type-vops.lisp
View file @
d01310f2
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/amd64/type-vops.lisp,v 1.
2
2009/11/02
02:51:58
rtoy
Exp
$"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/amd64/type-vops.lisp,v 1.
3
2009/11/02
15:05:06
rtoy
Rel
$"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -32,7 +32,7 @@
(
defparameter
function-header-types
(
list
funcallable-instance-header-type
(
list
funcallable-instance-header-type
dylan-function-header-type
byte-code-function-type
byte-code-closure-type
function-header-type
closure-function-header-type
closure-header-type
))
...
...
compiler/amd64/vm.lisp
View file @
d01310f2
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/amd64/vm.lisp,v 1.
3
2009/11/02
02:51:58
rtoy
Exp
$"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/amd64/vm.lisp,v 1.
4
2009/11/02
15:05:07
rtoy
Rel
$"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -215,17 +215,13 @@
(
sap-stack
stack
)
; System area pointers.
(
single-stack
stack
)
; single-floats
(
double-stack
stack
:element-size
2
)
; double-floats.
#+
double-double
(
double-double-stack
stack
:element-size
4
)
; double-double-float
#+
long-float
(
long-stack
stack
:element-size
3
)
; long-floats.
(
complex-single-stack
stack
:element-size
2
)
; complex-single-floats
(
complex-double-stack
stack
:element-size
4
)
; complex-double-floats
#+
long-float
(
complex-long-stack
stack
:element-size
6
)
; complex-long-floats
#+
double-double
(
complex-double-double-stack
stack
:element-size
8
)
; complex-double-double-floats
;; **** Magic SCs.
(
ignore-me
noise
)
...
...
@@ -322,14 +318,6 @@
:save-p
t
:alternate-scs
(
long-stack
))
#+
double-double
(
double-double-reg
float-registers
:locations
(
0
2
4
6
)
:element-size
2
:constant-scs
()
:save-p
t
:alternate-scs
(
double-double-stack
))
(
complex-single-reg
float-registers
:locations
(
0
2
4
6
)
:element-size
2
...
...
@@ -351,13 +339,6 @@
:constant-scs
()
:save-p
t
:alternate-scs
(
complex-long-stack
))
#+
double-double
(
complex-double-double-reg
float-registers
:locations
(
0
4
)
:element-size
4
:constant-scs
()
:save-p
t
:alternate-scs
(
complex-double-double-stack
))
;; A catch or unwind block.
(
catch-block
stack
:element-size
vm:catch-block-size
)
...
...
compiler/float-tran.lisp
View file @
d01310f2
...
...
@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(
ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.13
4
2009/11/02
02:51:58
rtoy Exp $"
)
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/float-tran.lisp,v 1.13
5
2009/11/02
15:05:06
rtoy Exp $"
)
;;;
;;; **********************************************************************
;;;
...
...
@@ -82,8 +82,6 @@
(
movable
foldable
flushable
))
(
defknown
%complex-double-float
(
number
)
(
complex
double-float
)
(
movable
foldable
flushable
))
#+
double-double
(
defknown
%complex-double-double-float
(
number
)
(
complex
double-double-float
)
(
movable
foldable
flushable
))
...
...
lisp/Config.amd64
View file @
d01310f2
...
...
@@ -2,52 +2,17 @@ PATH1 = ../../src/lisp
vpath %.h $(PATH1)
vpath %.c $(PATH1)
vpath %.S $(PATH1)
# Enable support for :linkage-table feature.
ifdef FEATURE_LINKAGE_TABLE
CPP_DEFINE_OPTIONS += -DLINKAGE_TABLE
endif
# Enable support for generational GC
ifdef FEATURE_GENCGC
CPP_DEFINE_OPTIONS += -DGENCGC
GC_SRC := gencgc.c
else
GC_SRC := cgc.c
CPP_DEFINE_OPTIONS += -DWANT_CGC
endif
ifeq ($(filter 2% 3%, $(shell $(CC) -dumpversion)),)
CPP_INCLUDE_OPTIONS := -iquote . -iquote $(PATH1)
else
CPP_INCLUDE_OPTIONS := -I. -I$(PATH1) -I-
endif
CPPFLAGS := $(CPP_DEFINE_OPTIONS) $(CPP_INCLUDE_OPTIONS)
CFLAGS += -Wstrict-prototypes -Wall -g
ASFLAGS = -g
CPPFLAGS = -I. -I$(PATH1) -I-
CC = gcc
LD = ld
CPP = cpp
CFLAGS += -m64 -Wstrict-prototypes -Wall -g
ASFLAGS = -g
CFLAGS = -m64 -rdynamic -Wstrict-prototypes -Wall -g -DGENCGC -DLINKAGE_TABLE
ASFLAGS = -g -DGENCGC -DLINKAGE_TABLE
NM = $(PATH1)/linux-nm
UNDEFSYMPATTERN = -Xlinker -u -Xlinker &
ASSEM_SRC = amd64-assem.S linux-stubs.S
ARCH_SRC = amd64-arch.c
OS_SRC = Linux-os.c os-common.c elf.c
e_rem_pio2.c k_rem_pio2.c
OS_SRC = Linux-os.c os-common.c elf.c
OS_LINK_FLAGS = -rdynamic -Xlinker --export-dynamic -Xlinker -Map -Xlinker foo
OS_LIBS = -ldl
GC_SRC = gencgc.c
DEPEND = $(CC) -MM -E
DEPEND_FLAGS =
# This no longer has aliasing problems, so no need to use
# -ffloat-store and -fno-strict-aliasing anymore.
e_rem_pio2.o : e_rem_pio2.c
$(CC) -c $(CFLAGS) $(CPPFLAGS) $<
lisp/Linux-os.c
View file @
d01310f2
...
...
@@ -15,7 +15,7 @@
* GENCGC support by Douglas Crosher, 1996, 1997.
* Alpha support by Julian Dolby, 1999.
*
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.4
5
2009/11/02
02:51:58
rtoy Exp $
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.4
6
2009/11/02
15:05:07
rtoy Exp $
*
*/
...
...
@@ -153,52 +153,45 @@ os_sigcontext_fpu_modes(ucontext_t *scp)
#endif
#ifdef __x86_64
unsigned
long
*
os_sigcontext
_reg
(
ucontext_t
*
c
,
int
offset
)
int
*
sc
_reg
(
ucontext_t
*
c
,
int
offset
)
{
switch
(
offset
)
{
case
0
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RAX
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RAX
];
case
2
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RCX
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RCX
];
case
4
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RDX
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RDX
];
case
6
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RBX
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RBX
];
case
8
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RSP
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RSP
];
case
10
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RBP
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RBP
];
case
12
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RSI
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RSI
];
case
14
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_RDI
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_RDI
];
case
16
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R8
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R8
];
case
18
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R9
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R9
];
case
20
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R10
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R10
];
case
22
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R11
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R11
];
case
24
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R12
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R12
];
case
26
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R13
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R13
];
case
28
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R14
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R14
];
case
30
:
return
(
unsigned
long
*
)
&
c
->
uc_mcontext
.
gregs
[
REG_R15
];
return
&
c
->
uc_mcontext
.
gregs
[
REG_R15
];
}
return
(
unsigned
long
*
)
0
;
return
(
int
*
)
0
;
}
unsigned
long
*
os_sigcontext_pc
(
ucontext_t
*
scp
)
{
return
(
unsigned
long
*
)
&
scp
->
uc_mcontext
.
gregs
[
REG_RIP
];
}
#endif
os_vm_address_t
...
...
@@ -305,12 +298,7 @@ sigsegv_handler_tramp(void)
void
sigsegv_handler
(
HANDLER_ARGS
)
{
long
fault_addr
=
#ifdef i386
context
->
uc_mcontext
.
cr2
;
#else
context
->
uc_mcontext
.
gregs
[
REG_CR2
];
#endif
int
fault_addr
=
context
->
uc_mcontext
.
cr2
;
#ifdef RED_ZONE_HIT
if
(
os_control_stack_overflow
((
void
*
)
fault_addr
,
context
))
...
...
@@ -434,7 +422,6 @@ os_dlsym(const char *sym_name, lispobj lib_list)
}
}
#ifdef i386
void
restore_fpu
(
ucontext_t
*
context
)
{
...
...
@@ -457,27 +444,3 @@ restore_fpu(ucontext_t *context)
#endif
}
}
#else
void
restore_fpu
(
ucontext_t
*
context
)
{
if
(
context
->
uc_mcontext
.
fpregs
)
{
short
cw
=
context
->
uc_mcontext
.
fpregs
->
cwd
;
DPRINTF
(
0
,
(
stderr
,
"restore_fpu: cw = %08x
\n
"
,
cw
));
__asm__
__volatile__
(
"fldcw %0"
:
:
"m"
(
*&
cw
));
#ifdef FEATURE_SSE2
if
(
fpu_mode
==
SSE2
)
{
struct
_fpstate
*
fpstate
;
unsigned
int
mxcsr
;
fpstate
=
(
struct
_fpstate
*
)
context
->
uc_mcontext
.
fpregs
;
if
(
fpstate
->
magic
!=
0xffff
)
{
mxcsr
=
fpstate
->
mxcsr
;
DPRINTF
(
0
,
(
stderr
,
"restore_fpu: mxcsr (raw) = %04x
\n
"
,
mxcsr
));
__asm__
__volatile__
(
"ldmxcsr %0"
::
"m"
(
*&
mxcsr
));
}
}
#endif
}
}
#endif
lisp/Linux-os.h
View file @
d01310f2
/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.h,v 1.
29
2009/11/02
02:51:58
rtoy
Exp
$
/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.h,v 1.
30
2009/11/02
15:05:07
rtoy
Rel
$
This code was written as part of the CMU Common Lisp project at
Carnegie Mellon University, and has been placed in the public domain.
...
...
@@ -26,9 +26,6 @@
#include <asm/unistd.h>
#include <errno.h>
#define __USE_GNU
#include <sys/ucontext.h>
typedef
caddr_t
os_vm_address_t
;
/* like hpux */
typedef
size_t
os_vm_size_t
;
/* like hpux */
typedef
off_t
os_vm_offset_t
;
/* like hpux */
...
...
lisp/amd64-arch.c
View file @
d01310f2
/* x86-arch.c -*- Mode: C; comment-column: 40 -*-
*
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/amd64-arch.c,v 1.1
0
2009/11/02
02:51:58
rtoy
Exp
$
* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/amd64-arch.c,v 1.1
1
2009/11/02
15:05:07
rtoy
Rel
$
*
*/
...
...
@@ -12,7 +12,6 @@
#include "os.h"
#include "internals.h"
#include "arch.h"
#define __USE_GNU
#include "lispregs.h"
#include "signal.h"
#include "alloc.h"
...
...
@@ -40,22 +39,22 @@ arch_init(fpu_mode_t mode)
*/
void
arch_skip_instruction
(
os_
context
_t
*
context
)
arch_skip_instruction
(
struct
sig
context
*
context
)
{
int
vlen
,
code
;
DPRINTF
(
0
,
(
stderr
,
"[arch_skip_inst at %x>]
\n
"
,
SC_PC
(
context
)
));
DPRINTF
(
0
,
(
stderr
,
"[arch_skip_inst at %x>]
\n
"
,
context
->
sc_pc
));
/* Get and skip the lisp error code. */
code
=
*
(
char
*
)
SC_PC
(
context
)
++
;
code
=
*
(
char
*
)
context
->
sc_pc
++
;
switch
(
code
)
{
case
trap_Error
:
case
trap_Cerror
:
/* Lisp error arg vector length */
vlen
=
*
(
char
*
)
SC_PC
(
context
)
++
;
vlen
=
*
(
char
*
)
context
->
sc_pc
++
;
/* Skip lisp error arg data bytes */
while
(
vlen
--
>
0
)
SC_PC
(
context
)
++
;
((
char
*
)
context
->
sc_pc
)
++
;
break
;
case
trap_Breakpoint
:
...
...
@@ -72,23 +71,23 @@ arch_skip_instruction(os_context_t *context)
break
;
}
DPRINTF
(
0
,
(
stderr
,
"[arch_skip_inst resuming at %x>]
\n
"
,
SC_PC
(
context
)
));
DPRINTF
(
0
,
(
stderr
,
"[arch_skip_inst resuming at %x>]
\n
"
,
context
->
sc_pc
));
}
unsigned
char
*
arch_internal_error_arguments
(
os_
context
_t
*
context
)
arch_internal_error_arguments
(
struct
sig
context
*
context
)
{
return
(
unsigned
char
*
)
(
SC_PC
(
context
)
+
1
);
return
(
unsigned
char
*
)
(
context
->
sc_pc
+
1
);
}
boolean
arch_pseudo_atomic_atomic
(
os_
context
_t
*
context
)
arch_pseudo_atomic_atomic
(
struct
sig
context
*
context
)
{
return
SymbolValue
(
PSEUDO_ATOMIC_ATOMIC
);
}
void
arch_set_pseudo_atomic_interrupted
(
os_
context
_t
*
context
)
arch_set_pseudo_atomic_interrupted
(
struct
sig
context
*
context
)
{
SetSymbolValue
(
PSEUDO_ATOMIC_INTERRUPTED
,
make_fixnum
(
1
));
}
...
...
@@ -129,9 +128,9 @@ unsigned int single_step_save3;
#endif
void
arch_do_displaced_inst
(
os_
context
_t
*
context
,
unsigned
long
orig_inst
)
arch_do_displaced_inst
(
struct
sig
context
*
context
,
unsigned
long
orig_inst
)
{
unsigned
int
*
pc
=
(
unsigned
int
*
)
SC_PC
(
context
)
;
unsigned
int
*
pc
=
(
unsigned
int
*
)
context
->
sc_pc
;
/*
* Put the original instruction back.
...
...
@@ -140,8 +139,8 @@ arch_do_displaced_inst(os_context_t *context, unsigned long orig_inst)
*
((
char
*
)
pc
)
=
orig_inst
&
0xff
;
*
((
char
*
)
pc
+
1
)
=
(
orig_inst
&
0xff00
)
>>
8
;
#ifdef
SC_EFLAGS
SC_EFLAGS
(
context
)
|=
0x100
;
#ifdef
__linux__
context
->
eflags
|=
0x100
;
#else
/*
...
...
@@ -160,7 +159,7 @@ arch_do_displaced_inst(os_context_t *context, unsigned long orig_inst)
single_stepping
=
(
unsigned
int
*
)
pc
;
#ifndef __linux__
(
unsigned
int
*
)
SC_PC
(
context
)
=
(
char
*
)
pc
-
9
;