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

Extracted make-symbol from the automatic allocators and fixed it to set the

symbols function slot to be the undefined function.
parent b9ef001a
No related branches found
No related tags found
No related merge requests found
......@@ -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.
......
......@@ -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)
......
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