[movitz-cvs] CVS update: movitz/losp/muerte/symbols.lisp

[Frode Vatvedt Fjeld]

Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory common-lisp.net:/tmp/cvs-serv23234

Modified Files:
	symbols.lisp 
Log Message:
A small change in strategy for allocating memory.

Date: Mon Mar 22 11:38:20 2004
Author: ffjeld

Index: movitz/losp/muerte/symbols.lisp
diff -u movitz/losp/muerte/symbols.lisp:1.2 movitz/losp/muerte/symbols.lisp:1.3
--- movitz/losp/muerte/symbols.lisp:1.2	Mon Jan 19 06:23:47 2004
+++ movitz/losp/muerte/symbols.lisp	Mon Mar 22 11:38:20 2004
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Tue Sep  4 23:55:41 2001
 ;;;;                
-;;;; $Id: symbols.lisp,v 1.2 2004/01/19 11:23:47 ffjeld Exp $
+;;;; $Id: symbols.lisp,v 1.3 2004/03/22 16:38:20 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -120,8 +120,20 @@
      (not (eq (movitz-accessor symbol movitz-symbol function-value)
 	      (load-global-constant movitz::unbound-function))))))
 
+(defun %other-to-symbol (x)
+  (with-inline-assembly (:returns :eax)
+    (:compile-form (:result-mode :eax) x)
+    (:leal (:eax 2) :ecx)
+    (:testb 7 :cl)
+    (:jnz '(:sub-program ()
+	    (:compile-form (:result-mode :ignore)
+	     (error "Not an other heap-object: ~S" x))
+	    (:jmp 'continue)))
+   continue
+    (:addl 1 :eax)))
+
 (defun make-symbol (name)
-  (let ((symbol (inline-malloc #.(bt:sizeof 'movitz::movitz-symbol) :tag :symbol)))
+  (let ((symbol (%other-to-symbol (malloc-clumps 3))))
     (setf-movitz-accessor (symbol movitz-symbol package) nil)
     (setf-movitz-accessor (symbol movitz-symbol hash-key) (sxhash name))
     (setf (symbol-flags symbol) 0