Skip to content
GitLab
Projects
Groups
Snippets
/
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
cmucl
cmucl
Commits
b90e144d
Commit
b90e144d
authored
Aug 06, 2013
by
Carl Shapiro
Browse files
Use movxz in load-type to avoid byte-register restrictions.
parent
19aa444c
Changes
4
Hide whitespace changes
Inline
Side-by-side
src/compiler/x86/cell.lisp
View file @
b90e144d
...
...
@@ -198,7 +198,7 @@
(
:args
(
function
:scs
(
descriptor-reg
)
:target
result
)
(
fdefn
:scs
(
descriptor-reg
)))
(
:temporary
(
:sc
unsigned-reg
)
raw
)
(
:temporary
(
:sc
byte
-reg
)
type
)
(
:temporary
(
:sc
unsigned
-reg
)
type
)
(
:results
(
result
:scs
(
descriptor-reg
)))
(
:generator
38
(
load-type
type
function
(
-
function-pointer-type
))
...
...
src/compiler/x86/macros.lisp
View file @
b90e144d
...
...
@@ -110,10 +110,10 @@
(
n-offset
offset
))
(
ecase
(
backend-byte-order
*target-backend*
)
(
:little-endian
`
(
inst
mov
,
n-target
`
(
inst
mov
zx
,
n-target
(
make-ea
:byte
:base
,
n-source
:disp
,
n-offset
)))
(
:big-endian
`
(
inst
mov
,
n-target
`
(
inst
mov
zx
,
n-target
(
make-ea
:byte
:base
,
n-source
:disp
(
+
,
n-offset
3
)))))))
(
defmacro
load-foreign-data-symbol
(
reg
name
)
...
...
src/compiler/x86/system.lisp
View file @
b90e144d
...
...
@@ -39,50 +39,48 @@
(
define-vop
(
get-type
)
(
:translate
get-type
)
(
:policy
:fast-safe
)
(
:args
(
object
:scs
(
descriptor-reg
)))
(
:temporary
(
:sc
unsigned-reg
:offset
eax-offset
:to
(
:result
0
))
eax
)
(
:results
(
result
:scs
(
unsigned-reg
)))
(
:args
(
object
:scs
(
descriptor-reg
)
:to
(
:eval
1
)))
(
:results
(
result
:scs
(
unsigned-reg
)
:from
(
:eval
0
)))
(
:result-types
positive-fixnum
)
(
:generator
6
(
inst
mov
eax
object
)
(
inst
and
al-tn
lowtag-mask
)
(
inst
cmp
al-tn
other-pointer-type
)
;; Pick off objects with headers.
(
inst
mov
result
object
)
(
inst
and
result
lowtag-mask
)
(
inst
cmp
result
other-pointer-type
)
(
inst
jmp
:e
other-ptr
)
(
inst
cmp
al-tn
function-pointer-type
)
(
inst
cmp
result
function-pointer-type
)
(
inst
jmp
:e
function-ptr
)
;;
p
ick off structure
s
and list pointers
(
inst
test
al-tn
1
)
(
inst
jmp
:n
e
done
)
;;
P
ick off structure and list pointers
.
(
inst
test
result
1
)
(
inst
jmp
:n
z
done
)
;;
p
ick off fixnums
(
inst
and
al-tn
3
)
(
inst
jmp
:
e
done
)
;;
P
ick off fixnums
.
(
inst
and
result
3
)
(
inst
jmp
:
z
done
)
;; must be an other immediate
(
inst
mov
eax
object
)
;; Must be an other immediate.
(
inst
mov
result
object
)
(
inst
and
result
type-mask
)
(
inst
jmp
done
)
FUNCTION-PTR
(
load-type
al-tn
object
(
-
vm:function-pointer-type
))
(
load-type
result
object
(
-
vm:function-pointer-type
))
(
inst
jmp
done
)
OTHER-PTR
(
load-type
al-tn
object
(
-
vm:other-pointer-type
))
DONE
(
inst
movzx
result
al-tn
)))
(
load-type
result
object
(
-
vm:other-pointer-type
))
DONE
))
(
define-vop
(
function-subtype
)
(
:translate
function-subtype
)
(
:policy
:fast-safe
)
(
:args
(
function
:scs
(
descriptor-reg
)))
(
:temporary
(
:sc
byte-reg
:from
(
:eval
0
)
:to
(
:eval
1
))
temp
)
(
:results
(
result
:scs
(
unsigned-reg
)))
(
:result-types
positive-fixnum
)
(
:generator
6
(
load-type
temp
function
(
-
vm:function-pointer-type
))
(
inst
movzx
result
temp
)))
(
load-type
result
function
(
-
vm:function-pointer-type
))))
(
define-vop
(
set-function-subtype
)
(
:translate
(
setf
function-subtype
))
...
...
src/compiler/x86/values.lisp
View file @
b90e144d
...
...
@@ -58,23 +58,21 @@
(
:results
(
start
:scs
(
any-reg
))
(
count
:scs
(
any-reg
)))
(
:temporary
(
:sc
descriptor-reg
:from
(
:argument
0
)
:to
(
:result
1
))
list
)
(
:temporary
(
:sc
descriptor-reg
:to
(
:result
1
))
nil-temp
)
(
:temporary
(
:sc
unsigned-reg
:offset
eax-offset
:to
(
:result
1
))
eax
)
(
:temporary
(
:sc
unsigned-reg
:to
(
:result
1
))
temp
)
(
:vop-var
vop
)
(
:save-p
:compute-only
)
(
:generator
0
(
move
list
arg
)
(
move
start
esp-tn
)
; WARN pointing 1 below
(
inst
mov
nil-temp
nil-value
)
LOOP
(
inst
cmp
list
nil-
temp
)
(
inst
cmp
list
nil-
value
)
(
inst
jmp
:e
done
)
(
pushw
list
cons-car-slot
list-pointer-type
)
(
loadw
list
list
cons-cdr-slot
list-pointer-type
)
(
inst
mov
eax
list
)
(
inst
and
al-tn
lowtag-mask
)
(
inst
cmp
al-tn
list-pointer-type
)
(
inst
mov
temp
list
)
(
inst
and
temp
lowtag-mask
)
(
inst
cmp
temp
list-pointer-type
)
(
inst
jmp
:e
loop
)
(
error-call
vop
bogus-argument-to-values-list-error
list
)
...
...
Write
Preview
Supports
Markdown
0%
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!
Cancel
Please
register
or
sign in
to comment