diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp new file mode 100644 index 0000000000000000000000000000000000000000..2eeb98dd88e3db612e43698695254d162b16d990 --- /dev/null +++ b/compiler/mips/alloc.lisp @@ -0,0 +1,72 @@ +;;; -*- Package: C -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the Spice Lisp project at +;;; Carnegie-Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of Spice Lisp, please contact +;;; Scott Fahlman (FAHLMAN@CMUC). +;;; ********************************************************************** +;;; +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.1 1990/02/27 00:16:55 wlott Exp $ +;;; +;;; Allocation VOPs for the MIPS port. +;;; +;;; Written by William Lott. +;;; + +(define-vop (list-or-list*) + (:args (things :more t)) + (:temporary (:scs (descriptor-reg) :type list) ptr) + (:temporary (:scs (descriptor-reg)) temp) + (:temporary (:scs (descriptor-reg) :type list :to (:result 0) :target result) + res) + (:temporary (:scs (non-descriptor-reg) :type random) ndescr) + (:info num) + (:results (result :scs (descriptor-reg))) + (:variant-vars star) + (:policy :safe) + (:generator 0 + (cond ((zerop num) + (move result null-tn)) + ((and star (= num 1)) + (move result (tn-ref-tn things))) + (t + (macrolet + ((store-car (tn list &optional (slot vm:cons-car-slot)) + `(let ((reg + (sc-case ,tn + ((any-reg descriptor-reg) ,tn) + (zero zero-tn) + (null null-tn) + (control-stack + (load-stack-tn temp ,tn) + temp)))) + (storew reg ,list ,slot vm:list-pointer-type)))) + (let ((cons-cells (if star (1- num) num))) + (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)) + (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))))))) + +(define-vop (list list-or-list*) + (:variant nil)) + +(define-vop (list* list-or-list*) + (:variant t))