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

Added more gengc stuff.

parent a332872f
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;; ;;;
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.22 1992/12/16 19:41:18 wlott Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.23 1993/05/07 07:27:37 wlott Exp $")
;;; ;;;
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
...@@ -81,9 +81,24 @@ ...@@ -81,9 +81,24 @@
(define-vop (list* list-or-list*) (define-vop (list* list-or-list*)
(:variant t)) (:variant t))
#+gengc
(def-source-transform list (&rest args)
(iterate repeat ((args args))
(if args
`(cons ,(car args) ,(repeat (cdr args)))
nil)))
#+gengc
(def-source-transform list* (arg &rest others)
(iterate repeat ((args (cons arg others)))
(if (cdr args)
`(cons ,(car args) ,(repeat (cdr args)))
(car args))))
;;;; Special purpose inline allocators. ;;;; Special purpose inline allocators.
#-gengc
(define-vop (allocate-code-object) (define-vop (allocate-code-object)
(:args (boxed-arg :scs (any-reg)) (:args (boxed-arg :scs (any-reg))
(unboxed-arg :scs (any-reg))) (unboxed-arg :scs (any-reg)))
...@@ -95,8 +110,7 @@ ...@@ -95,8 +110,7 @@
(:generator 100 (:generator 100
(inst li ndescr (lognot lowtag-mask)) (inst li ndescr (lognot lowtag-mask))
(inst addu boxed boxed-arg (inst addu boxed boxed-arg
(fixnum (1+ #-gengc code-trace-table-offset-slot (fixnum (1+ code-trace-table-offset-slot)))
#+gengc code-debug-info-slot)))
(inst and boxed ndescr) (inst and boxed ndescr)
(inst srl unboxed unboxed-arg word-shift) (inst srl unboxed unboxed-arg word-shift)
(inst addu unboxed unboxed lowtag-mask) (inst addu unboxed unboxed lowtag-mask)
...@@ -104,7 +118,6 @@ ...@@ -104,7 +118,6 @@
(inst sll ndescr boxed (- type-bits word-shift)) (inst sll ndescr boxed (- type-bits word-shift))
(inst or ndescr code-header-type) (inst or ndescr code-header-type)
#-gengc
(pseudo-atomic (pa-flag) (pseudo-atomic (pa-flag)
(inst or result alloc-tn other-pointer-type) (inst or result alloc-tn other-pointer-type)
(storew ndescr result 0 other-pointer-type) (storew ndescr result 0 other-pointer-type)
...@@ -112,17 +125,34 @@ ...@@ -112,17 +125,34 @@
(storew null-tn result code-entry-points-slot other-pointer-type) (storew null-tn result code-entry-points-slot other-pointer-type)
(inst addu alloc-tn boxed) (inst addu alloc-tn boxed)
(inst addu alloc-tn unboxed)) (inst addu alloc-tn unboxed))
#+gengc
(without-scheduling ()
(inst or result alloc-tn other-pointer-type)
(storew ndescr alloc-tn 0)
(storew unboxed alloc-tn code-code-size-slot)
(storew null-tn alloc-tn code-entry-points-slot)
(inst addu alloc-tn boxed)
(inst addu alloc-tn unboxed))
(storew null-tn result code-debug-info-slot other-pointer-type))) (storew null-tn result code-debug-info-slot other-pointer-type)))
#+gengc
(define-vop (allocate-code-object)
(:args (boxed :scs (any-reg))
(unboxed :scs (any-reg)))
(:results (result :scs (descriptor-reg)))
(:temporary (:sc any-reg :offset a0-offset :to (:result 0) :target result)
words)
(:temporary (:sc non-descriptor-reg :offset nl0-offset) lowtag)
(:temporary (:sc any-reg :offset nl1-offset) header)
(:temporary (:sc any-reg :offset nl2-offset) first-word)
(:generator 100
(inst li lowtag (lognot lowtag-mask))
(inst addu words boxed (fixnum (1+ code-debug-info-slot)))
(inst and words lowtag)
(inst addu first-word unboxed (fixnum 1))
(inst and first-word lowtag)
(inst sll header words (- type-bits 2))
(inst or header code-header-type)
(inst addu words first-word)
(inst jal (make-fixup 'large-alloc :assembly-routine))
(inst li lowtag other-pointer-type)
(move result words)
(storew null-tn result code-entry-points-slot other-pointer-type)
(storew null-tn result code-debug-info-slot other-pointer-type)))
(define-vop (make-fdefn) (define-vop (make-fdefn)
(:policy :fast-safe) (:policy :fast-safe)
(:translate make-fdefn) (:translate make-fdefn)
...@@ -143,6 +173,8 @@ ...@@ -143,6 +173,8 @@
(:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) temp)
(:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
(:results (result :scs (descriptor-reg))) (:results (result :scs (descriptor-reg)))
#+gengc
(:ignore function length temp pa-flag result)
(:generator 10 (:generator 10
#-gengc #-gengc
(let ((size (+ length closure-info-offset))) (let ((size (+ length closure-info-offset)))
...@@ -152,15 +184,7 @@ ...@@ -152,15 +184,7 @@
(storew temp result 0 function-pointer-type)) (storew temp result 0 function-pointer-type))
(storew function result closure-function-slot function-pointer-type)) (storew function result closure-function-slot function-pointer-type))
#+gengc #+gengc
(let ((size (+ length closure-info-offset))) (error "MAKE-CLOSURE vop used in gengc system?")))
(inst li temp (logior (ash (1- size) type-bits) closure-header-type))
(without-scheduling ()
(inst or result alloc-tn function-pointer-type)
(storew temp alloc-tn)
(inst addu alloc-tn (pad-data-block size)))
(inst addu temp function
(- (* function-code-offset word-bytes) function-pointer-type))
(storew temp result closure-entry-point-slot function-pointer-type))))
;;; The compiler likes to be able to directly make value cells. ;;; The compiler likes to be able to directly make value cells.
;;; ;;;
...@@ -189,7 +213,7 @@ ...@@ -189,7 +213,7 @@
(:ignore name) (:ignore name)
(:results (result :scs (descriptor-reg))) (:results (result :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) temp) (:temporary (:scs (non-descriptor-reg)) temp)
(:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) #-gengc (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
(:generator 4 (:generator 4
#-gengc #-gengc
(pseudo-atomic (pa-flag :extra (pad-data-block words)) (pseudo-atomic (pa-flag :extra (pad-data-block words))
...@@ -207,6 +231,7 @@ ...@@ -207,6 +231,7 @@
(storew temp alloc-tn)) (storew temp alloc-tn))
(inst addu alloc-tn (pad-data-block words)))))) (inst addu alloc-tn (pad-data-block words))))))
#-gengc
(define-vop (var-alloc) (define-vop (var-alloc)
(:args (extra :scs (any-reg))) (:args (extra :scs (any-reg)))
(:arg-types positive-fixnum) (:arg-types positive-fixnum)
...@@ -215,20 +240,36 @@ ...@@ -215,20 +240,36 @@
(:results (result :scs (descriptor-reg))) (:results (result :scs (descriptor-reg)))
(:temporary (:scs (any-reg)) header) (:temporary (:scs (any-reg)) header)
(:temporary (:scs (non-descriptor-reg)) bytes) (:temporary (:scs (non-descriptor-reg)) bytes)
#-gengc (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag) (:temporary (:sc non-descriptor-reg :offset nl4-offset) pa-flag)
(:generator 6 (:generator 6
(inst addu bytes extra (* (1+ words) word-bytes)) (inst addu bytes extra (* (1+ words) word-bytes))
(inst sll header bytes (- type-bits 2)) (inst sll header bytes (- type-bits 2))
(inst addu header header (+ (ash -2 type-bits) type)) (inst addu header header (+ (ash -2 type-bits) type))
(inst srl bytes bytes lowtag-bits) (inst srl bytes bytes lowtag-bits)
(inst sll bytes bytes lowtag-bits) (inst sll bytes bytes lowtag-bits)
#-gengc
(pseudo-atomic (pa-flag) (pseudo-atomic (pa-flag)
(inst or result alloc-tn lowtag)
(storew header result 0 lowtag)
(inst addu alloc-tn alloc-tn bytes))
#+gengc
(without-scheduling ()
(inst or result alloc-tn lowtag) (inst or result alloc-tn lowtag)
(storew header result 0 lowtag) (storew header result 0 lowtag)
(inst addu alloc-tn alloc-tn bytes)))) (inst addu alloc-tn alloc-tn bytes))))
#+gengc
(define-vop (var-alloc)
(:args (extra :scs (any-reg) :target nargs))
(:arg-types positive-fixnum)
(:info name words type lowtag)
(:results (result :scs (descriptor-reg)))
(:temporary (:sc non-descriptor-reg :offset nl0-offset) nl0)
(:temporary (:sc non-descriptor-reg :offset nl1-offset) nl1)
(:temporary (:sc non-descriptor-reg :offset nl2-offset) nl2)
(:temporary (:sc any-reg :offset nargs-offset) nargs)
(:temporary (:sc descriptor-reg :offset a0-offset :target result
:from (:argument 0) :to (:result 0))
a0)
(:ignore name nl2)
(:generator 10
(inst addu nargs extra (fixnum words))
(inst sll nl1 nargs (- type-bits word-shift))
(inst addu nl1 (+ (ash -1 type-bits) type))
(inst jal (make-fixup 'var-alloc :assembly-routine))
(inst li nl0 lowtag)
(move result a0)))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment