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
57f8cef5
Commit
57f8cef5
authored
33 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Fixed fash-ash to actually work.
parent
3b1c5234
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/rt/arith.lisp
+22
-24
22 additions, 24 deletions
compiler/rt/arith.lisp
with
22 additions
and
24 deletions
compiler/rt/arith.lisp
+
22
−
24
View file @
57f8cef5
...
...
@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/arith.lisp,v 1.
7
1991/04/2
1 19:47:51
wlott Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/rt/arith.lisp,v 1.
8
1991/04/2
2 07:29:42
wlott Exp $
;;;
;;; This file contains the VM definition arithmetic VOPs for the IBM RT.
;;;
...
...
@@ -219,41 +219,39 @@
(
define-vop
(
fast-ash
)
(
:note
"inline ASH"
)
(
:args
(
number
:scs
(
signed-reg
unsigned-reg
)
:to
:save
)
(
amount
:scs
(
signed-reg
immediate
)))
(
:args
(
number
:scs
(
signed-reg
unsigned-reg
)
:to
(
:result
0
)
:target
result
)
(
amount
-arg
:scs
(
signed-reg
immediate
)
:target
amount
))
(
:arg-types
(
:or
signed-num
unsigned-num
)
signed-num
)
(
:results
(
result
:scs
(
signed-reg
unsigned-reg
)))
(
:result-types
(
:or
signed-num
unsigned-num
))
(
:translate
ash
)
(
:policy
:fast-safe
)
(
:temporary
(
:sc
non-descriptor-reg
)
ndesc
)
(
:temporary
(
:sc
non-descriptor-reg
:from
(
:argument
1
))
amount
)
(
:generator
12
(
sc-case
amount
(
sc-case
amount
-arg
(
signed-reg
(
let
((
positive
(
gen-label
))
(
shift-right
(
gen-label
))
(
done
(
gen-label
)))
(
inst
c
amount
0
)
(
inst
bncx
:lt
positive
)
(
inst
neg
ndesc
amount
)
(
inst
c
ndesc
32
)
;; If less than 32, goto done while shifting.
(
inst
bcx
:lt
done
)
(
sc-case
number
(
signed-reg
(
move
result
number
)
(
inst
sar
result
ndesc
))
(
unsigned-reg
(
move
result
number
)
(
inst
sr
result
ndesc
)))
;; 32 or greater case.
;; Copy the amount and check to see if it's positive.
(
inst
oil
amount
amount-arg
0
)
(
inst
bnc
:lt
positive
)
;; We want to shift to the right, so make the amount positive.
(
inst
neg
amount
)
(
inst
c
amount
32
)
;; If less than 32, do the shifting.
(
inst
bc
:lt
shift-right
)
;; 32 or greater, we just shift by 31.
(
inst
li
amount
31
)
(
emit-label
shift-right
)
(
move
result
number
)
(
inst
bx
done
)
(
sc-case
number
(
signed-reg
(
move
result
number
)
(
inst
sar
result
31
))
(
inst
sar
result
amount
))
(
unsigned-reg
(
move
result
number
)
(
inst
sr
result
31
)))
(
inst
sr
result
amount
)))
(
emit-label
positive
)
;; The result-type assures us that this shift will not overflow.
...
...
@@ -263,7 +261,7 @@
(
emit-label
done
)))
(
immediate
(
let
((
amount
(
tn-value
amount
)))
(
let
((
amount
(
tn-value
amount
-arg
)))
(
cond
((
minusp
amount
)
(
sc-case
number
(
unsigned-reg
...
...
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