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