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
40e50149
Commit
40e50149
authored
34 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Removed primitive-type-vops for fixnum, 'cause fixnum now comes in two
pieces.
parent
9f13f1a4
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/type-vops.lisp
+148
-3
148 additions, 3 deletions
compiler/mips/type-vops.lisp
with
148 additions
and
3 deletions
compiler/mips/type-vops.lisp
+
148
−
3
View file @
40e50149
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.1
0
1990/0
4/24 02:56:47
wlott Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/type-vops.lisp,v 1.1
1
1990/0
5/06 05:27:31
wlott Exp $
;;;
;;; This file contains the VM definition of type testing and checking VOPs
;;; for the RT.
...
...
@@ -109,8 +109,6 @@
(
inst
bne
temp
zero-tn
err-lab
)
(
move
result
value
t
))))
(
primitive-type-vop
check-fixnum
(
:check
)
fixnum
)
(
define-vop
(
fixnump
simple-type-predicate
)
(
:ignore
type-code
)
(
:translate
ext:fixnump
)
...
...
@@ -218,6 +216,153 @@
(
frob
integerp
check-integer
di:object-not-integer-error
vm:even-fixnum-type
vm:odd-fixnum-type
vm:bignum-type
))
;;;; Other integer ranges.
;;; A (signed-byte 32) can be represented with either fixnum or a bignum with
;;; exactly one digit.
(
define-vop
(
signed-byte-32-p
hairy-type-predicate
)
(
:translate
signed-byte-32-p
)
(
:generator
45
(
let
((
not-target
(
gen-label
)))
(
multiple-value-bind
(
yep
nope
)
(
if
not-p
(
values
not-target
target
)
(
values
target
not-target
))
(
inst
and
temp
obj
#x3
)
(
inst
beq
temp
zero-tn
yep
)
(
test-simple-type
obj
temp
nope
t
vm:bignum-type
)
(
loadw
temp
obj
0
vm:other-pointer-type
)
(
inst
srl
temp
temp
(
1+
vm:type-bits
))
(
if
not-p
(
inst
bne
temp
zero-tn
target
)
(
inst
beq
temp
zero-tn
target
))
(
inst
nop
)
(
emit-label
not-target
)))))
(
define-vop
(
check-signed-byte-32
check-hairy-type
)
(
:generator
45
(
let
((
nope
(
generate-error-code
di:object-not-signed-byte-32-error
obj
))
(
yep
(
gen-label
)))
(
inst
and
temp
obj
#x3
)
(
inst
beq
temp
zero-tn
yep
)
(
test-simple-type
obj
temp
nope
t
vm:bignum-type
)
(
loadw
temp
obj
0
vm:other-pointer-type
)
(
inst
srl
temp
temp
(
1+
vm:type-bits
))
(
inst
bne
temp
zero-tn
nope
)
(
inst
nop
)
(
emit-label
yep
)
(
move
res
obj
))))
;;; An (unsigned-byte 32) can be represented with either a positive fixnum, a
;;; bignum with exactly one positive digit, or a bignum with exactly two digits
;;; and the second digit all zeros.
(
define-vop
(
unsigned-byte-32-p
hairy-type-predicate
)
(
:translate
unsigned-byte-32-p
)
(
:generator
45
(
let
((
not-target
(
gen-label
))
(
single-word
(
gen-label
))
(
fixnum
(
gen-label
)))
(
multiple-value-bind
(
yep
nope
)
(
if
not-p
(
values
not-target
target
)
(
values
target
not-target
))
;; Is it a fixnum?
(
inst
and
temp
obj
#x3
)
(
inst
beq
temp
zero-tn
fixnum
)
;; If not, is it a bignum?
(
test-simple-type
obj
temp
nope
t
vm:bignum-type
)
;; Get the number of digits.
(
loadw
temp
obj
0
vm:other-pointer-type
)
(
inst
srl
temp
temp
vm:type-bits
)
;; Is it one?
(
inst
addu
temp
-1
)
(
inst
beq
temp
single-word
)
;; If it's other than two, we can't be an (unsigned-byte 32)
(
inst
addu
temp
-1
)
(
inst
bne
temp
nope
)
;; Get the second digit.
(
loadw
temp
obj
(
1+
vm:bignum-digits-offset
)
vm:other-pointer-type
)
;; All zeros, its an (unsigned-byte 32).
(
inst
beq
temp
yep
)
(
inst
nop
)
;; Otherwise, it isn't.
(
inst
b
nope
)
(
inst
nop
)
(
emit-label
single-word
)
;; Get the single digit.
(
loadw
temp
obj
vm:bignum-digits-offset
vm:other-pointer-type
)
;; positive implies (unsigned-byte 32).
(
inst
bgez
temp
yep
)
(
inst
nop
)
;; Otherwise, nope.
(
inst
b
nope
)
(
inst
nop
)
(
emit-label
fixnum
)
;; positive fixnums are (unsigned-byte 32).
(
if
not-p
(
inst
bltz
obj
target
)
(
inst
bgez
obj
target
))
(
inst
nop
)
(
emit-label
not-target
)))))
(
define-vop
(
check-unsigned-byte-32
check-hairy-type
)
(
:generator
45
(
let
((
nope
(
generate-error-code
di:object-not-unsigned-byte-32-error
obj
))
(
yep
(
gen-label
))
(
fixnum
(
gen-label
))
(
single-word
(
gen-label
)))
;; Is it a fixnum?
(
inst
and
temp
obj
#x3
)
(
inst
beq
temp
zero-tn
fixnum
)
;; If not, is it a bignum?
(
test-simple-type
obj
temp
nope
t
vm:bignum-type
)
;; Get the number of digits.
(
loadw
temp
obj
0
vm:other-pointer-type
)
(
inst
srl
temp
temp
vm:type-bits
)
;; Is it one?
(
inst
addu
temp
-1
)
(
inst
beq
temp
single-word
)
;; If it's other than two, we can't be an (unsigned-byte 32)
(
inst
addu
temp
-1
)
(
inst
bne
temp
nope
)
;; Get the second digit.
(
loadw
temp
obj
(
1+
vm:bignum-digits-offset
)
vm:other-pointer-type
)
;; All zeros, its an (unsigned-byte 32).
(
inst
beq
temp
yep
)
(
inst
nop
)
;; Otherwise, it isn't.
(
inst
b
nope
)
(
inst
nop
)
(
emit-label
single-word
)
;; Get the single digit.
(
loadw
temp
obj
vm:bignum-digits-offset
vm:other-pointer-type
)
;; positive implies (unsigned-byte 32).
(
inst
bgez
temp
yep
)
(
inst
nop
)
;; Otherwise, nope.
(
inst
b
nope
)
(
inst
nop
)
(
emit-label
fixnum
)
;; positive fixnums are (unsigned-byte 32).
(
inst
bltz
obj
nope
)
(
inst
nop
)
(
emit-label
yep
)
(
move
res
obj
))))
;;;; List/symbol types:
;;;
...
...
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