From 07831fffadc9d7992df078ba1534bb4cefbc5abf Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Wed, 28 Feb 1990 18:23:33 +0000 Subject: [PATCH] Wrap the pseudo-atomic around the entire list or list* form. We have to do this to make sure all the cons cells remain positioned the same relative to each other. Don't use vm:pad-data-block to round the size of a cons cell when writing into the cdr of the previous cell because it converts from words to bytes. --- compiler/mips/alloc.lisp | 36 ++++++++++++++++++------------------ 1 file changed, 18 insertions(+), 18 deletions(-) diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp index ca002adcf..8ba8c4bbc 100644 --- a/compiler/mips/alloc.lisp +++ b/compiler/mips/alloc.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.2 1990/02/27 11:30:27 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.3 1990/02/28 18:23:33 wlott Exp $ ;;; ;;; Allocation VOPs for the MIPS port. ;;; @@ -49,24 +49,24 @@ (pseudo-atomic (ndescr) (inst addiu res alloc-tn vm:list-pointer-type) (inst addiu alloc-tn alloc-tn - (* (vm:pad-data-block vm:cons-size) cons-cells))) - (move ptr res) - (dotimes (i (1- cons-cells)) + (* (vm:pad-data-block vm:cons-size) cons-cells)) + (move ptr res) + (dotimes (i (1- cons-cells)) + (store-car (tn-ref-tn things) ptr) + (setf things (tn-ref-across things)) + (inst addiu ptr ptr (vm:pad-data-block vm:cons-size)) + (storew ptr ptr + (- vm:cons-cdr-slot vm:cons-size) + vm:list-pointer-type)) (store-car (tn-ref-tn things) ptr) - (setf things (tn-ref-across things)) - (inst addiu ptr ptr (vm:pad-data-block vm:cons-size)) - (storew ptr ptr - (- vm:cons-cdr-slot (vm:pad-data-block vm:cons-size)) - vm:list-pointer-type)) - (store-car (tn-ref-tn things) ptr) - (cond (star - (setf things (tn-ref-across things)) - (store-car (tn-ref-tn things) ptr vm:cons-cdr-slot)) - (t - (storew null-tn ptr - vm:cons-cdr-slot vm:list-pointer-type))) - (assert (null (tn-ref-across things))) - (move result res))))))) + (cond (star + (setf things (tn-ref-across things)) + (store-car (tn-ref-tn things) ptr vm:cons-cdr-slot)) + (t + (storew null-tn ptr + vm:cons-cdr-slot vm:list-pointer-type))) + (assert (null (tn-ref-across things))) + (move result res)))))))) (define-vop (list list-or-list*) (:variant nil)) -- GitLab