From c74db2c858eada25fbf0ee96a1a92d811ae1686a Mon Sep 17 00:00:00 2001 From: wlott <wlott> Date: Mon, 2 Jul 1990 04:47:40 +0000 Subject: [PATCH] Extracted make-symbol from the automatic allocators and fixed it to set the symbols function slot to be the undefined function. --- compiler/mips/alloc.lisp | 26 +++++++++++++++++++++++++- compiler/mips/parms.lisp | 5 ++--- 2 files changed, 27 insertions(+), 4 deletions(-) diff --git a/compiler/mips/alloc.lisp b/compiler/mips/alloc.lisp index a99468040..397374971 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.8 1990/06/09 13:54:24 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/alloc.lisp,v 1.9 1990/07/02 04:47:03 wlott Exp $ ;;; ;;; Allocation VOPs for the MIPS port. ;;; @@ -104,6 +104,30 @@ (storew null-tn result vm:code-entry-points-slot vm:other-pointer-type) (storew null-tn result vm:code-debug-info-slot vm:other-pointer-type)))) +(define-vop (make-symbol) + (:args (name :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg) :type random) ndescr temp) + (:temporary (:scs (descriptor-reg) :to (:result 0) :target real-result) + result) + (:results (real-result :scs (descriptor-reg))) + (:policy :fast-safe) + (:translate make-symbol) + (:generator 37 + (pseudo-atomic (ndescr) + (inst addu result alloc-tn vm:other-pointer-type) + (inst addu alloc-tn alloc-tn (pad-data-block vm:symbol-size)) + (inst li temp (logior (ash (1- vm:symbol-size) vm:type-bits) + vm:symbol-header-type)) + (storew temp result 0 vm:other-pointer-type) + (inst li temp vm:unbound-marker-type) + (storew temp result vm:symbol-value-slot vm:other-pointer-type) + (load-symbol-value temp lisp::*the-undefined-function*) + (storew temp result vm:symbol-function-slot vm:other-pointer-type) + (storew null-tn result vm:symbol-plist-slot vm:other-pointer-type) + (storew name result vm:symbol-name-slot vm:other-pointer-type) + (storew null-tn result vm:symbol-package-slot vm:other-pointer-type) + (move real-result result)))) + ;;;; Automatic allocators for primitive objects. diff --git a/compiler/mips/parms.lisp b/compiler/mips/parms.lisp index 604f139bd..3529b0ec5 100644 --- a/compiler/mips/parms.lisp +++ b/compiler/mips/parms.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman (FAHLMAN@CMUC). ;;; ********************************************************************** ;;; -;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.58 1990/06/29 11:09:34 wlott Exp $ +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/parms.lisp,v 1.59 1990/07/02 04:47:40 wlott Exp $ ;;; ;;; This file contains some parameterizations of various VM ;;; attributes for the MIPS. This file is separate from other stuff so @@ -410,8 +410,7 @@ :init :arg)) (define-primitive-object (symbol :lowtag other-pointer-type - :header symbol-header-type - :alloc-trans make-symbol) + :header symbol-header-type) (value :set-trans set :setf-vop set :init :unbound) -- GitLab