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

Initial revision

parent e86b4304
No related branches found
No related tags found
No related merge requests found
;;; -*- 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))
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