Skip to content
Snippets Groups Projects
Commit 1354cc77 authored by wlott's avatar wlott
Browse files

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
...@@ -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)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment