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
1354cc77
Commit
1354cc77
authored
35 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Initial MIPS cut. Actually, a totally new file, as nothing carries over.
parent
22c06d21
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/subprim.lisp
+40
-152
40 additions, 152 deletions
compiler/mips/subprim.lisp
with
40 additions
and
152 deletions
compiler/mips/subprim.lisp
+
40
−
152
View file @
1354cc77
...
@@ -7,161 +7,49 @@
...
@@ -7,161 +7,49 @@
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;; **********************************************************************
;;;
;;;
;;; Linkage information for standard miscops, both primitive and
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/subprim.lisp,v 1.2 1990/03/18 23:47:08 wlott Exp $
;;; sub-primitive.
;;;
;;;
;;;
Written by Rob MacLachlan
;;;
Linkage information for standard static functions, and random vops.
;;;
;;;
(
in-package
'c
)
;;; Written by William Lott.
;;;
(
in-package
"C"
)
;;;; Subprimitive miscops:
#| Inline versions exist, and we can't currently support multiple
implementations, since they are accessed through %primitive.
(define-miscop 16bit-system-ref (s i))
(define-miscop 16bit-system-set (s i v))
(define-miscop 8bit-system-ref (s i))
(define-miscop 8bit-system-set (s i v))
|#
(
define-miscop
active-call-frame
())
(
define-miscop
active-catch-frame
())
(
define-miscop
alloc-array
(
n
))
(
define-miscop
alloc-bit-vector
(
n
))
(
define-miscop
alloc-code
(
n
))
(
define-miscop
alloc-function
(
n
))
(
define-miscop
alloc-g-vector
(
n
i
))
(
define-miscop
alloc-i-vector
(
n
a
))
(
define-miscop
alloc-static-g-vector
(
len
))
(
define-miscop
alloc-string
(
n
))
(
define-miscop
bit-bash
(
v1
v2
res
op
)
:results
())
(
define-miscop
break-return
(
stack
)
:results
())
(
define-miscop
call-foreign
(
cfcn
args
nargs
))
#|Inline implementation...
(define-miscop check-<= (n l))
|#
(
define-miscop
collect-garbage
()
:results
())
(
define-miscop
current-binding-pointer
())
(
define-miscop
current-stack-pointer
())
(
define-miscop
dynamic-space-in-use
())
(
define-miscop
error0
(
code
)
:results
())
(
define-miscop
error1
(
code
x
)
:results
())
(
define-miscop
error2
(
code
x
y
)
:results
())
(
define-miscop
find-character
(
string
start
end
character
))
(
define-miscop
find-character-with-attribute
(
a
b
c
d
e
))
(
define-miscop
float-long
(
x
))
(
define-miscop
float-short
(
x
))
(
define-miscop
get-allocation-space
())
(
define-miscop
get-space
(
x
))
(
define-miscop
get-type
(
x
))
(
define-miscop
get-vector-access-code
(
v
))
#|Inline implementation...
(define-miscop get-vector-subtype (v))
|#
(
define-miscop
halt
())
#|Inline implementation...
(define-miscop header-length (x))
(define-miscop header-ref (x i))
(define-miscop header-set (x i v))
|#
(
define-miscop
logdpb
(
v
s
p
n
))
(
define-miscop
logldb
(
s
p
n
))
(
define-miscop
long-float-ref
(
l
i
))
(
define-miscop
long-float-set
(
l
i
x
))
(
define-miscop
lsh
(
n
b
))
(
define-miscop
make-complex
(
re
im
))
(
define-miscop
make-immediate-type
(
obj
type
))
(
define-miscop
make-ratio
(
num
den
))
(
define-miscop
negate
(
n
))
(
define-miscop
newspace-bit
())
(
define-miscop
pointer-system-set
(
s
i
p
))
(
define-miscop
purify
()
:results
())
(
define-miscop
read-binding-stack
(
b
))
(
define-miscop
read-control-stack
(
f
))
(
define-miscop
reset-c-stack
(
sp
)
:results
())
(
define-miscop
return-to-c
(
sp
value
)
:results
())
(
define-miscop
sap-system-ref
(
s
i
))
(
define-miscop
save
(
x
y
z
))
(
define-miscop
set-allocation-space
(
space
)
:results
())
(
define-miscop
set-c-procedure-pointer
(
s
o
v
))
(
define-miscop
set-call-frame
(
p
))
(
define-miscop
set-catch-frame
(
x
))
(
define-miscop
set-vector-subtype
(
v
x
))
(
define-miscop
shrink-vector
(
v
n
))
#|Inline implementation...
(define-miscop signed-16bit-system-ref (s i))
|#
(
define-miscop
signed-32bit-system-ref
(
s
i
))
(
define-miscop
signed-32bit-system-set
(
s
i
v
)
:translate
(
setf
sap-ref-32
))
(
define-miscop
sxhash-simple-string
(
string
))
(
define-miscop
sxhash-simple-substring
(
string
length
))
(
define-miscop
syscall0
(
n
)
:results
(
res
err
))
(
define-miscop
syscall1
(
n
x
)
:results
(
res
err
))
(
define-miscop
syscall2
(
n
x
y
)
:results
(
res
err
))
(
define-miscop
syscall3
(
n
x
y
z
)
:results
(
res
err
))
(
define-miscop
syscall4
(
n
x
y
z
xx
)
:results
(
res
err
))
(
define-miscop
typed-vref
(
a
v
i
))
(
define-miscop
typed-vset
(
a
v
i
x
))
(
define-miscop
unbind-to-here
(
x
)
:results
())
(
define-miscop
unix-fork
(
code-ptr
)
:results
(
res
err
))
(
define-miscop
unix-pipe
()
:results
(
res
err
))
(
define-miscop
unix-wait
()
:results
(
res
err
))
(
define-miscop
unix-write
(
fd
buf
offset
len
)
:results
(
res
err
))
(
define-miscop
unsigned-32bit-system-ref
(
s
i
)
:translate
sap-ref-32
)
(
define-miscop
vector-length
(
vec
))
(
define-miscop
write-binding-stack
(
b
v
))
(
define-miscop
write-control-stack
(
f
v
))
(
define-vop
(
syscall
n-arg-two-value-miscop
)
(
:variant
'clc::syscall
))
(
def-primitive-translator
float-single
(
x
)
`
(
%primitive
float-short
,
x
))
;;;; Primitive miscops:
;;;; Length
(
defknown
ext:assq
(
t
list
)
list
(
foldable
flushable
))
(
define-vop
(
length/list
)
(
defknown
ext:memq
(
t
list
)
list
(
foldable
flushable
))
(
:translate
length
)
(
:args
(
object
:scs
(
descriptor-reg
)
:target
ptr
))
(
define-miscop
abs
(
num
)
:translate
abs
)
(
:arg-types
list
)
(
define-miscop
alloc-symbol
(
name
)
:translate
make-symbol
)
(
:temporary
(
:scs
(
descriptor-reg
)
:from
(
:argument
0
))
ptr
)
(
define-miscop
ash
(
i
n
)
:translate
ash
)
(
:temporary
(
:scs
(
non-descriptor-reg
)
:type
random
)
temp
)
(
define-miscop
assq
(
key
alist
)
:translate
ext:assq
)
(
:temporary
(
:scs
(
any-reg
)
:type
fixnum
:to
(
:result
0
)
:target
result
)
(
define-miscop
atan
(
x
)
:translate
atan
)
count
)
(
define-miscop
cos
(
x
)
:translate
cos
)
(
:results
(
result
:scs
(
any-reg
descriptor-reg
)))
(
define-miscop
decode-float
(
f
)
:results
(
frac
exp
sign
)
:translate
decode-float
)
(
:policy
:fast-safe
)
(
define-miscop
denominator
(
n
)
:translate
denominator
)
(
:node-var
node
)
(
define-miscop
exp
(
x
)
:translate
exp
)
(
:generator
50
(
define-miscop
gcd
(
x
y
)
:translate
gcd
)
(
let
((
done
(
gen-label
))
(
define-miscop
get-real-time
()
:translate
get-internal-real-time
)
(
loop
(
gen-label
))
(
define-miscop
get-run-time
()
:translate
get-internal-run-time
)
(
not-list
(
generate-cerror-code
node
di:object-not-list-error
(
define-miscop
imagpart
(
z
)
:translate
imagpart
)
object
)))
(
define-miscop
integer-length
(
i
)
:translate
integer-length
)
(
move
ptr
object
)
(
define-miscop
last
(
l
)
:translate
last
)
(
inst
beq
ptr
null-tn
done
)
(
define-miscop
log
(
n
)
:translate
log
)
(
move
count
zero-tn
)
(
define-miscop
logcount
(
i
)
:translate
logcount
)
(
simple-test-simple-type
ptr
temp
not-list
t
vm:list-pointer-type
)
(
define-miscop
memq
(
item
list
)
:translate
ext:memq
)
(
define-miscop
nthcdr
(
n
l
)
:translate
nthcdr
)
(
emit-label
loop
)
(
define-miscop
numerator
(
n
)
:translate
numerator
)
(
loadw
ptr
ptr
vm:cons-cdr-slot
vm:list-pointer-type
)
(
define-miscop
put
(
sym
prop
val
)
:translate
%put
)
(
inst
addiu
count
count
(
fixnum
1
))
(
define-miscop
realpart
(
z
)
:translate
realpart
)
(
simple-test-simple-type
ptr
temp
loop
nil
vm:list-pointer-type
)
(
define-miscop
sap-int
(
sap
)
:translate
sap-int
)
(
define-miscop
scale-float
(
f
exp
)
:translate
scale-float
)
(
cerror-call
done
di:object-not-list-error
ptr
)
(
define-miscop
sin
(
x
)
:translate
sin
)
(
define-miscop
sqrt
(
x
)
:translate
sqrt
)
(
emit-label
done
)
(
define-miscop
tan
(
x
)
:translate
tan
)
(
move
result
count
))))
(
define-vop
(
list
n-arg-miscop
)
(
:variant
'list
))
(
define-static-function
length
(
object
))
(
define-vop
(
list*
n-arg-miscop
)
(
:variant
'list*
))
;;; Continuation to allow %sp-byte-blt for now...
(
defknown
lisp::%sp-byte-blt
(
t
index
t
index
index
)
void
())
(
define-miscop
byte-blt
(
src
src-start
dst
dst-start
dst-end
)
:translate
lisp::%sp-byte-blt
)
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