Skip to content

Commit

Permalink
0.9.2.45:
Browse files Browse the repository at this point in the history
	another slice of whitespace canonicalization
	(Anyone who ends up here with "cvs annotate" probably
		wants to look at the "tabby" tagged version.)
  • Loading branch information
William Harold Newman committed Jul 14, 2005
1 parent f1ffbf9 commit 52cfe54
Show file tree
Hide file tree
Showing 102 changed files with 10,442 additions and 10,443 deletions.
78 changes: 39 additions & 39 deletions src/compiler/hppa/alloc.lisp
Expand Up @@ -8,7 +8,7 @@
(:temporary (:scs (descriptor-reg) :type list) ptr)
(:temporary (:scs (descriptor-reg)) temp)
(:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result)
res)
res)
(:info num)
(:results (result :scs (descriptor-reg)))
(:variant-vars star)
Expand All @@ -21,35 +21,35 @@
(move (tn-ref-tn things) result))
(t
(macrolet
((maybe-load (tn)
(once-only ((tn tn))
`(sc-case ,tn
((any-reg descriptor-reg zero null)
,tn)
(control-stack
(load-stack-tn temp ,tn)
temp)))))
(let* ((cons-cells (if star (1- num) num))
(alloc (* (pad-data-block cons-size) cons-cells)))
(pseudo-atomic (:extra alloc)
(move alloc-tn res)
(inst dep list-pointer-lowtag 31 3 res)
(move res ptr)
(dotimes (i (1- cons-cells))
(storew (maybe-load (tn-ref-tn things)) ptr
cons-car-slot list-pointer-lowtag)
(setf things (tn-ref-across things))
(inst addi (pad-data-block cons-size) ptr ptr)
(storew ptr ptr
(- cons-cdr-slot cons-size)
list-pointer-lowtag))
(storew (maybe-load (tn-ref-tn things)) ptr
cons-car-slot list-pointer-lowtag)
(storew (if star
(maybe-load (tn-ref-tn (tn-ref-across things)))
null-tn)
ptr cons-cdr-slot list-pointer-lowtag))
(move res result)))))))
((maybe-load (tn)
(once-only ((tn tn))
`(sc-case ,tn
((any-reg descriptor-reg zero null)
,tn)
(control-stack
(load-stack-tn temp ,tn)
temp)))))
(let* ((cons-cells (if star (1- num) num))
(alloc (* (pad-data-block cons-size) cons-cells)))
(pseudo-atomic (:extra alloc)
(move alloc-tn res)
(inst dep list-pointer-lowtag 31 3 res)
(move res ptr)
(dotimes (i (1- cons-cells))
(storew (maybe-load (tn-ref-tn things)) ptr
cons-car-slot list-pointer-lowtag)
(setf things (tn-ref-across things))
(inst addi (pad-data-block cons-size) ptr ptr)
(storew ptr ptr
(- cons-cdr-slot cons-size)
list-pointer-lowtag))
(storew (maybe-load (tn-ref-tn things)) ptr
cons-car-slot list-pointer-lowtag)
(storew (if star
(maybe-load (tn-ref-tn (tn-ref-across things)))
null-tn)
ptr cons-cdr-slot list-pointer-lowtag))
(move res result)))))))


(define-vop (list list-or-list*)
Expand All @@ -63,7 +63,7 @@

(define-vop (allocate-code-object)
(:args (boxed-arg :scs (any-reg))
(unboxed-arg :scs (any-reg)))
(unboxed-arg :scs (any-reg)))
(:results (result :scs (descriptor-reg)))
(:temporary (:scs (non-descriptor-reg)) ndescr)
(:temporary (:scs (any-reg) :from (:argument 0)) boxed)
Expand Down Expand Up @@ -111,21 +111,21 @@
(:generator 10
(let ((size (+ length closure-info-offset)))
(pseudo-atomic (:extra (pad-data-block size))
(inst move alloc-tn result)
(inst dep fun-pointer-lowtag 31 3 result)
(inst li (logior (ash (1- size) n-widetag-bits) closure-header-widetag) temp)
(storew temp result 0 fun-pointer-lowtag)))
(inst move alloc-tn result)
(inst dep fun-pointer-lowtag 31 3 result)
(inst li (logior (ash (1- size) n-widetag-bits) closure-header-widetag) temp)
(storew temp result 0 fun-pointer-lowtag)))
(storew function result closure-fun-slot fun-pointer-lowtag)))

;;; The compiler likes to be able to directly make value cells.
;;;
;;;
(define-vop (make-value-cell)
(:args (value :to :save :scs (descriptor-reg any-reg)))
(:temporary (:scs (non-descriptor-reg)) temp)
(:results (result :scs (descriptor-reg)))
(:generator 10
(with-fixed-allocation
(result temp value-cell-header-widetag value-cell-size))
(result temp value-cell-header-widetag value-cell-size))
(storew value result value-cell-value-slot other-pointer-lowtag)))


Expand All @@ -149,8 +149,8 @@
(inst move alloc-tn result)
(inst dep lowtag 31 3 result)
(when type
(inst li (logior (ash (1- words) n-widetag-bits) type) temp)
(storew temp result 0 lowtag)))))
(inst li (logior (ash (1- words) n-widetag-bits) type) temp)
(storew temp result 0 lowtag)))))

(define-vop (var-alloc)
(:args (extra :scs (any-reg)))
Expand Down

0 comments on commit 52cfe54

Please sign in to comment.