Index: anches/ia32/level-0/X86/x86-array.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-array.lisp	(revision 8363)
+++ 	(revision )
@@ -1,243 +1,0 @@
-;;;-*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 1994-2001 Digitool, Inc
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-(in-package "CCL")
-
-(eval-when (:compile-toplevel :execute)
-  #+x8632-target
-  (require "X8632-ARCH")
-  #+x8664-target
-  (require "X8664-ARCH")
-  (require "X86-LAPMACROS"))
-
-
-
-
-
-;; rewrite in LAP someday (soon).
-(defun %init-misc (val uvector)
-  (dotimes (i (uvsize uvector) uvector)
-    (setf (uvref uvector i) val)))
-
-
-;;; Make a new vector of size newsize whose subtag matches that of oldv-arg.
-;;; Blast the contents of the old vector into the new one as quickly as
-;;; possible; leave remaining elements of new vector undefined (0).
-;;; Return new-vector.
-(defun %extend-vector (start oldv newsize)
-  (declare (fixnum start))
-  (let* ((new (%alloc-misc newsize (typecode oldv)))
-         (oldsize (uvsize oldv)))
-    (declare (fixnum oldsize))
-    (do* ((i 0 (1+ i))
-          (j start (1+ j)))
-         ((= i oldsize) new)
-      (declare (fixnum i j))
-      (setf (uvref new j) (uvref oldv i)))))
-    
-
-
-
-
-;;; argument is a vector header or an array header.  Or else.
-(defx86lapfunction %array-header-data-and-offset ((a arg_z))
-  (let ((offset arg_y)
-        (temp temp1))
-    (movq (% rsp) (% temp0))
-    (movl ($ '0) (%l offset))
-    (movq (% a) (% temp))
-    @loop
-    (movq (@ target::arrayH.data-vector (% temp)) (% a))
-    (extract-subtag a imm0)
-    (addq (@ target::arrayH.displacement (% temp)) (% offset))
-    (rcmp (% imm0) ($ target::subtag-vectorH))
-    (movq (% a) (% temp))
-    (jle @loop)
-    (push (% a))
-    (push (% offset))
-    (set-nargs 2)
-    (jmp-subprim  .SPvalues)))
-
-
-
-(defx86lapfunction %boole-clr ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq ($ 0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-set ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq ($ -1) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-c1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-c2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-and ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-ior ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-xor ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-n  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (xorq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-eqv ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (xorq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-nand ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-nor ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-andc1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (andq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-andc2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (andq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-orc1 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (orq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defx86lapfunction %boole-orc2 ((idx 8) #|(ra 0)|# (b0 arg_x) (b1 arg_y) (dest arg_z))
-  (movq (@ idx (% rsp)) (% temp0))
-  (movq (@ x8664::misc-data-offset (% b1) (% temp0)) (% imm0))
-  (notq (% imm0))
-  (orq (@ x8664::misc-data-offset (% b0) (% temp0)) (% imm0))
-  (movq (% imm0) (@ x8664::misc-data-offset (% dest) (% temp0)))
-  (single-value-return 3))
-
-(defparameter *simple-bit-boole-functions* ())
-
-(setq *simple-bit-boole-functions*
-      (vector
-       #'%boole-clr
-       #'%boole-set
-       #'%boole-1
-       #'%boole-2
-       #'%boole-c1
-       #'%boole-c2
-       #'%boole-and
-       #'%boole-ior
-       #'%boole-xor
-       #'%boole-eqv
-       #'%boole-nand
-       #'%boole-nor
-       #'%boole-andc1
-       #'%boole-andc2
-       #'%boole-orc1
-       #'%boole-orc2))
-
-(defun %simple-bit-boole (op b1 b2 result)
-  (let* ((f (svref *simple-bit-boole-functions* op)))
-    (dotimes (i (ash (the fixnum (+ (length result) 63)) -6) result)
-      (funcall f i b1 b2 result))))
-
-(defx86lapfunction %aref2 ((array arg_x) (i arg_y) (j arg_z))
-  (check-nargs 3)
-  (jmp-subprim .SParef2))
-
-(defx86lapfunction %aref3 ((array 0) (i arg_x) (j arg_y) (k arg_z))
-  (check-nargs 4)
-  (pop (% temp0))
-  (discard-reserved-frame)
-  (jmp-subprim .SParef3))
-
-(defx86lapfunction %aset2 ((array 0) (i arg_x) (j arg_y) (newval arg_z))
-  (check-nargs 4)
-  (pop (% temp0))
-  (discard-reserved-frame)
-  (jmp-subprim .SPaset2))
-
-(defx86lapfunction %aset3 ((array 8) (i 0) (j arg_x) (k arg_y) (newval arg_z))
-  (check-nargs 5)
-  (pop (% temp0))
-  (pop (% temp1))
-  (discard-reserved-frame)
-  (jmp-subprim .SPaset3))
-
-
-
-
-
-  
-
Index: anches/ia32/level-0/X86/x86-clos.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-clos.lisp	(revision 8363)
+++ 	(revision )
@@ -1,264 +1,0 @@
-;;;-*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 2006, Clozure Associates and contributors
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-(in-package "CCL")
-
-#+x8664-target ; whole file
-(progn
-
-;;; It's easier to keep this is LAP; we want to play around with its
-;;; constants.
-
-
-;;; This just maps a SLOT-ID to a SLOT-DEFINITION or NIL.
-;;; The map is a vector of (UNSIGNED-BYTE 8); this should
-;;; be used when there are fewer than 255 slots in the class.
-(defx86lapfunction %small-map-slot-id-lookup ((slot-id arg_z))
-  (movq (@ 'map (% fn)) (% temp1))
-  (svref slot-id slot-id.index arg_x)
-  (vector-length temp1 imm0)
-  (xorl (%l imm1) (%l imm1))
-  (rcmpq (% arg_x) (% imm0))
-  (movq (@ 'table (% fn)) (% temp0))
-  (ja @have-table-index)
-  (movq (% arg_x) (% imm1))
-  (shrq ($ x8664::word-shift) (% imm1))
-  (movzbl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
-  (shlq ($ x8664::word-shift) (% imm1))
-  @have-table-index
-  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
-  (single-value-return))
-
-;;; The same idea, only the map is a vector of (UNSIGNED-BYTE 32).
-(defx86lapfunction %large-map-slot-id-lookup ((slot-id arg_z))
-  (movq (@ 'map (% fn)) (% temp1))
-  (svref slot-id slot-id.index arg_x)
-  (vector-length temp1 imm0)
-  (xorl (%l imm1) (%l imm1))
-  (rcmpq (% arg_x) (% imm0))
-  (movq (@ 'table (% fn)) (% temp0))
-  (ja @have-table-index)
-  (movq (% arg_x) (% imm1))
-  (shrq ($ 1) (% imm1))
-  (movl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
-  @have-table-index
-  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %small-slot-id-value ((instance arg_y) (slot-id arg_z))
-  (movq (@ 'map (% fn)) (% temp1))
-  (svref slot-id slot-id.index arg_x)
-  (vector-length temp1 imm0)
-  (xorl (%l imm1) (%l imm1))
-  (rcmpq (% arg_x) (% imm0))
-  (movq (@ 'table (% fn)) (% temp0))
-  (ja @missing)
-  (movq (% arg_x) (% imm1))
-  (shrq ($ x8664::word-shift) (% imm1))
-  (movzbl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
-  (testl (%l imm1) (%l imm1))
-  (je @missing)
-  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
-  (movq (@ 'class (% fn)) (% arg_x))
-  (set-nargs 3)
-  (jmp (@ '%maybe-std-std-value-using-class (% fn)))
-  @missing                              ; (%slot-id-ref-missing instance id)
-  (set-nargs 2)
-  (jmp (@'%slot-id-ref-missing (% fn))))
-
-(defx86lapfunction %large-slot-id-value ((instance arg_y) (slot-id arg_z))  
-  (movq (@ 'map (% fn)) (% temp1))
-  (svref slot-id slot-id.index arg_x)
-  (vector-length temp1 imm0)
-  (xorl (%l imm1) (%l imm1))
-  (rcmpq (% arg_x) (% imm0))
-  (movq (@ 'table (% fn)) (% temp0))
-  (ja @missing)
-  (movq (% arg_x) (% imm1))
-  (shrq ($ 1) (% imm1))
-  (movl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
-  (testl (%l imm1) (%l imm1))
-  (je @missing)
-  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_z))
-  (movq (@ 'class (% fn)) (% arg_x))
-  (set-nargs 3)
-  (jmp (@ '%maybe-std-std-value-using-class (% fn)))
-  @missing                              ; (%slot-id-ref-missing instance id)
-  (set-nargs 2)
-  (jmp (@'%slot-id-ref-missing (% fn))))
-
-  
-(defx86lapfunction %small-set-slot-id-value ((instance arg_x)
-                                             (slot-id arg_y)
-                                             (new-value arg_z))
-  (movq (@ 'map (% fn)) (% temp1))
-  (svref slot-id slot-id.index imm1)
-  (vector-length temp1 imm0)
-  (rcmpq (% imm1) (% imm0))
-  (movq (@ 'table (% fn)) (% temp0))
-  (ja @missing)
-  (shrq ($ x8664::word-shift) (% rdx))
-  (movzbl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
-  (testl (%l imm1) (%l imm1))
-  (je @missing)
-  (popq (% ra0))
-  (pushq ($ 0))                         ; reserve frame
-  (pushq ($ 0))
-  (pushq (@ 'class (% fn)))
-  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_y))
-  (set-nargs 4)
-  (pushq (% ra0))
-  (jmp (@ '%maybe-std-setf-slot-value-using-class (% fn)))
-  @missing                              ; (%slot-id-set-missing instance id new-value)
-  (set-nargs 3)
-  (jmp (@ '%slot-id-set-missing (% fn))))
-
-
-(defx86lapfunction %large-set-slot-id-value ((instance arg_x)
-                                             (slot-id arg_y)
-                                             (new-value arg_z))
-  (movq (@ 'map (% fn)) (% temp1))
-  (svref slot-id slot-id.index imm1)
-  (vector-length temp1 imm0)
-  (rcmpq (% imm1) (% imm0))
-  (movq (@ 'table (% fn)) (% temp0))
-  (ja @missing)
-  (shrq ($ x8664::word-shift) (% rdx))
-  (movl (@ x8664::misc-data-offset (% temp1) (% imm1)) (%l imm1))
-  (testl (%l imm1) (%l imm1))
-  (je @missing)
-  (popq (% ra0))
-  (pushq ($ 0))                         ; reserve frame
-  (pushq ($ 0))
-  (pushq (@ 'class (% fn)))
-  (pushq (% ra0))
-  (movq (@ x8664::misc-data-offset (% temp0) (% imm1) 8) (% arg_y))
-  (set-nargs 4)
-  (jmp (@ '%maybe-std-setf-slot-value-using-class (% fn)))
-  @missing                              ; (%slot-id-set-missing instance id new-value)
-  (set-nargs 3)
-  (jmp (@'%slot-id-ref-missing (% fn))))
-
-
-;;; All of the generic function trampoline functions have to be
-;;; exactly the same size (x8664::gf-code-size) in words.  The
-;;; largest of these - the general-case *GF-PROTO* - is currently
-;;; "really" a little under 15 words, so X8664::GF-CODE-SIZE is
-;;; just a little bigger than that.
-(defparameter *gf-proto*
-  (nfunction
-   gag
-   (lambda (&lap &lexpr args)
-     (x86-lap-function 
-      gag 
-      ()
-      (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
-      (:code-size x8664::gf-code-size)
-      (movq (@ (% rsp)) (% ra0))
-      (save-frame-variable-arg-count)
-      (push-argregs)
-      (movzwl (% nargs) (%l nargs))
-      (pushq (%q nargs))
-      (movq (% rsp) (% arg_z))
-      (ref-global.l ret1valaddr imm0)
-      (cmpq (% ra0) (% imm0))
-      (je @multiple)
-      (ref-global.l lexpr-return1v ra0)
-      (jmp @call)
-      @multiple
-      (pushq (@ (+ x8664::nil-value (x8664::%kernel-global 'lexpr-return))))
-      (movq (% imm0) (% ra0))
-      @call
-      (push (% ra0))
-      (movq (@ 'dispatch-table (% fn)) (% arg_y))
-      (set-nargs 2)
-      (jmp (@ 'dcode (% fn)))  ; dcode function
-      ))))
-
-;;; is a winner - saves ~15%
-(defx86lapfunction gag-one-arg ((arg arg_z))
-  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
-  (:code-size x8664::gf-code-size)
-  (check-nargs 1)
-  (movq (@ 'dispatch-table (% fn)) (% arg_y))
-  (set-nargs 2)
-  (jmp (@ 'dcode (% fn))))
-
-(defx86lapfunction gag-two-arg ((arg0 arg_y) (arg1 arg_z))
-  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
-  (:code-size x8664::gf-code-size)
-  (check-nargs 2)
-  (movq (@ 'dispatch-table (% fn)) (% arg_x))
-  (set-nargs 3)
-  (jmp (@ 'dcode (% fn))))
-
-
-(defx86lapfunction funcallable-trampoline ()
-  (:fixed-constants (class-wrapper slots dispatch-table dcode hash))
-  (:code-size x8664::gf-code-size)
-  (jmp (@ 'dcode (% fn))))
-
-
-;;; This is in LAP so that it can reference itself in the error message.
-;;; (It needs to be cloned, so %fn will be unique to each copy.)
-;;; It can't work for this to reference any of its own constants.
-(defx86lapfunction unset-fin-trampoline ()
-  (:code-size x8664::gf-code-size)
-  (save-frame-variable-arg-count)
-  (call-subprim .SPheap-rest-arg)
-  (pop (% arg_z))
-  (movq ($ '#.$XNOFINFUNCTION) (% arg_x))
-  (movq (% fn) (% arg_y))
-  (set-nargs 3)
-  (call-subprim .SPksignalerr)
-  ;(movq ($ x8664::nil-value) (% arg_z))
-  (leave)
-  (single-value-return))
-
-
-
-(defparameter *cm-proto*
-  (nfunction
-   gag
-   (lambda (&lap &lexpr args)
-     (x86-lap-function 
-      gag 
-      ()
-      (:fixed-constants (thing dcode gf bits))
-      (movq (@ (% rsp)) (% ra0))
-      (save-frame-variable-arg-count)
-      (push-argregs)
-      (movzwl (% nargs) (%l nargs))
-      (pushq (%q nargs))
-      (movq (% rsp) (% arg_z))
-      (ref-global ret1valaddr imm0)
-      (cmpq (% ra0) (% imm0))
-      (je @multiple)
-      (ref-global lexpr-return1v ra0)
-      (jmp @call)
-      @multiple
-      (pushq (@ (+ x8664::nil-value (x8664::%kernel-global 'lexpr-return))))
-      (movq (% imm0) (% ra0))
-      @call
-      (push (% ra0))
-      (movq (@ 'thing (% fn)) (% arg_y))
-      (set-nargs 2)
-      (jmp (@ 'dcode (% fn)))))))
-
-
-
-) ; #+x8664-target
Index: anches/ia32/level-0/X86/x86-def.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-def.lisp	(revision 8363)
+++ 	(revision )
@@ -1,691 +1,0 @@
-;;; -*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 2006, Clozure Associates and contributors
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-(defx86lapfunction %function-vector-to-function ((arg arg_z))
-  (trap-unless-typecode= arg x8664::subtag-function)
-  (addb ($ (- x8664::fulltag-function x8664::fulltag-misc)) (% arg_z.b))
-  (single-value-return))
-
-(defx86lapfunction %function-to-function-vector  ((arg arg_z))
-  (trap-unless-fulltag= arg x8664::fulltag-function)
-  (subb ($ (- x8664::fulltag-function x8664::fulltag-misc)) (% arg_z.b))
-  (single-value-return))
-
-(defx86lapfunction %function-code-words ((fun arg_z))
-  (trap-unless-fulltag= fun x8664::fulltag-function)
-  (movl (@ (- x8664::node-size x8664::fulltag-function) (% fun)) (% imm0.l))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %nth-immediate ((fun arg_y) (n arg_z))
-  (trap-unless-fulltag= fun x8664::fulltag-function)
-  (movl (@ (- x8664::node-size x8664::fulltag-function) (% fun)) (% imm0.l))
-  (lea (@ (% n) (% imm0) 8) (% imm0))
-  (movq (@ (- x8664::node-size x8664::fulltag-function) (% fun) (% imm0))
-        (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %set-nth-immediate ((fun arg_x) (n arg_y) (new arg_z))
-  (trap-unless-fulltag= fun x8664::fulltag-function)
-  (movl (@ (- x8664::node-size x8664::fulltag-function) (% fun)) (% imm0.l))
-  (lea (@ (% n) (% imm0) 8) (% arg_y))
-  (subb ($ (- x8664::fulltag-function x8664::fulltag-misc)) (%b arg_x))
-  (jmp-subprim .SPgvset))
-
-(defx86lapfunction %function-code-byte ((fun arg_y) (pc arg_z))
-  (unbox-fixnum pc imm0)
-  (movzbl (@ (% fun) (% imm0)) (% imm0.l))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-
-;;; Returns 3 values: mask of registers used in the function, stack location
-;;; from which they'd be restored, relative PC at which they're saved. If
-;;; the mask is 0, the values NIL NIL NIL are returned. If either the stack
-;;; location or relative PC is #xff, both of those values will be returned
-;;; as NIL.
-(defx86lapfunction %function-register-usage ((f arg_z))
-  (check-nargs 1)
-  (trap-unless-fulltag= f x8664::fulltag-function)
-  (movzbl (@ -1 (% f)) (% imm0.l))
-  (shll ($ 8) (% imm0.l))
-  (box-fixnum imm0 arg_x)
-  (movq (% rsp) (% temp0))
-  (set-nargs 3)
-  (je @no-regs)
-  (movzbl (@ -2 (% f)) (% imm0.l))
-  (movzbl (@ -3 (% f)) (% imm1.l))
-  (cmpb ($ #xff) (% imm0.b))
-  (je @unencodable)
-  (cmpb ($ #xff) (% imm1.b))
-  (je @unencodable)
-  (box-fixnum imm0 arg_y)
-  (box-fixnum imm1 arg_z)
-  (push (% arg_x))
-  (push (% arg_y))
-  (push (% arg_z))
-  (jmp-subprim .SPvalues)
-  @unencodable
-  (push (% arg_x))
-  (pushq ($ nil))
-  (pushq ($ nil))
-  (jmp-subprim .SPvalues)
-  @no-regs
-  (pushq ($ nil))
-  (pushq ($ nil))
-  (pushq ($ nil))
-  (jmp-subprim .SPvalues))
-  
-        
-
-(defx86lapfunction %make-code-executable ((codev arg_z))
-  (single-value-return))
-
-;;; Make a new function, with PROTO's code and the specified immediates.
-;;; IMMEDIATES should contain lfun-bits as the last element.
-(defun %clone-x86-function (proto &rest immediates)
-  (declare (dynamic-extent immediates))
-  (let* ((protov (%function-to-function-vector proto))
-         (code-words (%function-code-words proto))
-         (numimms (length immediates))
-         (newv (allocate-typed-vector :function (the fixnum (+ code-words numimms)))))
-    (declare (fixnum code-words numimms))
-    (%copy-ivector-to-ivector protov 0 newv 0 (the fixnum (ash code-words target::word-shift)))
-    (do* ((k code-words (1+ k))
-          (imms immediates (cdr imms)))
-         ((null imms) (%function-vector-to-function newv))
-      (declare (fixnum k) (list imms))
-      (setf (%svref newv k) (car imms)))))
-
-(defun replace-function-code (target proto)
-  (let* ((target-words (%function-code-words target))
-         (proto-words (%function-code-words proto)))
-    (declare (fixnum target-words proto-words))
-    (if (= target-words proto-words)
-      (progn
-        (%copy-ivector-to-ivector (%function-to-function-vector proto)
-                                  0
-                                  (%function-to-function-vector target)
-                                  0
-                                  (the fixnum (ash target-words
-                                                   target::word-shift)))
-        target)
-      (error "Code size mismatch: target = ~s, proto = ~s"
-             target-words proto-words))))
-         
-
-(defx86lapfunction %get-kernel-global-from-offset ((offset arg_z))
-  (check-nargs 1)
-  (unbox-fixnum offset imm0)
-  (movq (@ target::nil-value (% imm0)) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %set-kernel-global-from-offset ((offset arg_y) (new-value arg_z))
-  (check-nargs 2)
-  (unbox-fixnum offset imm0)
-  (movq (% arg_z) (@ target::nil-value (% imm0)))
-  (single-value-return))
-
-
-(defx86lapfunction %get-kernel-global-ptr-from-offset ((offset arg_y)
-						       (ptr arg_z))
-  (check-nargs 2)
-  (unbox-fixnum offset imm0)
-  (movq (@ target::nil-value (% imm0)) (% imm0))
-  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
-  (single-value-return))
-
-
-
-
-(defx86lapfunction %fixnum-ref ((fixnum arg_y) #| &optional |# (offset arg_z))
-  (:arglist (fixnum &optional offset))
-  (check-nargs 1 2)
-  (cmpw ($ x8664::fixnumone) (% nargs))
-  (jne @2-args)
-  (movq (% offset) (% fixnum))
-  (xorl (%l offset) (%l offset))
-  @2-args
-  (unbox-fixnum offset imm0)
-  (movq (@ (% fixnum) (% imm0)) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %fixnum-ref-natural ((fixnum arg_y) #| &optional |# (offset arg_z))
-  (:arglist (fixnum &optional offset))
-  (check-nargs 1 2)
-  (cmpw ($ x8664::fixnumone) (% nargs))
-  (jne @2-args)
-  (movq (% offset) (% fixnum))
-  (xorl (%l offset) (%l offset))
-  @2-args
-  (unbox-fixnum offset imm0)
-  (movq (@ (% fixnum) (% imm0)) (% imm0))
-  (jmp-subprim .SPmakeu64))
-
-(defx86lapfunction %fixnum-set ((fixnum arg_x) (offset arg_y) #| &optional |# (new-value arg_z))
-  (:arglist (fixnum offset &optional newval))
-  (check-nargs 2 3)
-  (cmpw ($ '2) (% nargs))
-  (jne @3-args)
-  (movq (% offset) (% fixnum))
-  (xorl (%l offset) (%l offset))
-  @3-args
-  (unbox-fixnum offset imm0)
-  (movq (% new-value) (@ (% fixnum) (% imm0)))
-  (movq (% new-value) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %fixnum-set-natural ((fixnum arg_x) (offset arg_y) #| &optional |# (new-value arg_z))
-  (:arglist (fixnum offset &optional newval))
-  (check-nargs 2 3)
-  (save-simple-frame)
-  (cmpw ($ '2) (% nargs))
-  (jne @3-args)
-  (movq (% offset) (% fixnum))
-  (xorl (%l offset) (%l offset))
-  @3-args
-  (call-subprim .SPgetu64)
-  (unbox-fixnum offset imm1)
-  (movq (% imm0) (@ (% fixnum) (% imm1)))
-  (restore-simple-frame)
-  (single-value-return))
-
-
-(defx86lapfunction %current-frame-ptr ()
-  (check-nargs 0)
-  (movq (% rbp) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %current-tsp ()
-  (check-nargs 0)
-  (movq (@ (% :rcontext) x8664::tcr.save-tsp) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %%frame-backlink ((p arg_z))
-  (check-nargs 1)
-  (movq (@ (% arg_z)) (% arg_z))
-  (single-value-return))
-
-;;; Look for "lea -nnnn(%rip),%fn" AT the tra; if that's present, use
-;;; the dispacement -nnnn to find the function.  The end of the
-;;; encoded displacement is
-;;; x8664::recover-fn-from-rip-disp-offset (= 7) bytes from the tra.
-(defx86lapfunction %return-address-function ((r arg_z))
-  (extract-lisptag r imm0)
-  (cmpb ($ x8664::tag-tra) (% imm0.b))
-  (jne @fail)
-  (cmpw ($ x8664::recover-fn-from-rip-word0) (@ (% r)))
-  (jne @fail)
-  (cmpb ($ x8664::recover-fn-from-rip-byte2) (@ 2 (% r)))
-  (movslq (@ x8664::recover-fn-from-rip-disp-offset (% r)) (% imm0))
-  (jne @fail)
-  (lea (@ x8664::recover-fn-from-rip-length (% imm0) (% r)) (% arg_z))
-  (single-value-return)
-  @fail
-  (movl ($ x8664::nil-value) (% arg_z.l))
-  (single-value-return))
-
-(defx86lapfunction %return-address-offset ((r arg_z))
-  (extract-lisptag r imm0)
-  (cmpb ($ x8664::tag-tra) (% imm0.b))
-  (jne @fail)
-  (cmpw ($ x8664::recover-fn-from-rip-word0) (@ (% r)))
-  (jne @fail)
-  (cmpb ($ x8664::recover-fn-from-rip-byte2) (@ 2 (% r)))
-  (movslq (@ x8664::recover-fn-from-rip-disp-offset (% r)) (% imm0))
-  (jne @fail)
-  (negq (% imm0))
-  (leaq (@ (- (ash x8664::recover-fn-from-rip-length x8664::fixnumshift)) (% imm0) 8) (% arg_z))
-  (single-value-return)
-  @fail
-  (movl ($ x8664::nil-value) (% arg_z.l))
-  (single-value-return))
-
-;;; It's always been the case that the function associated with a
-;;; frame pointer is the caller of the function that "uses" that frame.
-(defun %cfp-lfun (p)
-  (let* ((ra (%fixnum-ref p x8664::lisp-frame.return-address)))
-    (if (eq ra (%get-kernel-global ret1valaddr))
-      (setq ra (%fixnum-ref p x8664::lisp-frame.xtra)))
-    (values (%return-address-function ra) (%return-address-offset ra))))
-
-
-
-(defx86lapfunction %uvector-data-fixnum ((uv arg_z))
-  (check-nargs 1)
-  (trap-unless-fulltag= arg_z x8664::fulltag-misc)
-  (addq ($ x8664::misc-data-offset) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %catch-top ((tcr arg_z))
-  (check-nargs 1)
-  (movl ($ x8664::nil-value) (%l arg_y))
-  (movq (@ (% :rcontext) x8664::tcr.catch-top) (% arg_z))
-  (testb (%b arg_z) (%b arg_z))
-  (cmoveq (% arg_y) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %catch-tsp ((catch arg_z))
-  (check-nargs 1)
-  (lea (@  (- (+ target::fulltag-misc
-                                 (ash 1 (1+ target::word-shift)))) (% arg_z))
-       (% arg_z))
-  (single-value-return))
-
-
-
-;;; Same as %address-of, but doesn't cons any bignums
-;;; It also left shift fixnums just like everything else.
-(defx86lapfunction %fixnum-address-of ((x arg_z))
-  (check-nargs 1)
-  (box-fixnum x arg_z)
-  (single-value-return))
-
-(defx86lapfunction %save-standard-binding-list ((bindings arg_z))
-  (movq (@ (% :rcontext) x8664::tcr.vs-area) (% imm0))
-  (movq (@ x8664::area.high (% imm0)) (% imm1))
-  (subq ($ x8664::node-size) (% imm1))
-  (movq (% bindings) (@ (% imm1)))
-  (single-value-return))
-
-(defx86lapfunction %saved-bindings-address ()
-  (movq (@ (% :rcontext) x8664::tcr.vs-area) (% imm0))
-  (movq (@ x8664::area.high (% imm0)) (% imm1))
-  (lea (@ (- x8664::node-size) (% imm1)) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %get-object ((macptr arg_y) (offset arg_z))
-  (check-nargs 2)
-  (trap-unless-typecode= macptr x8664::subtag-macptr)
-  (macptr-ptr macptr imm0)
-  (trap-unless-lisptag= offset target::tag-fixnum imm1)
-  (unbox-fixnum offset imm1)
-  (movq (@ (% imm0) (% imm1)) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %set-object ((macptr arg_x) (offset arg_y) (value arg_z))
-  (check-nargs 3)
-  (trap-unless-typecode= macptr target::subtag-macptr)
-  (macptr-ptr macptr imm0)
-  (trap-unless-lisptag= offset target::tag-fixnum imm1)
-  (unbox-fixnum offset imm1)
-  (movq (% arg_z) (@ (% imm0) (% imm1)))
-  (single-value-return))
-
-(defx86lapfunction %apply-lexpr-with-method-context ((magic arg_x)
-                                                     (function arg_y)
-                                                     (args arg_z))
-  ;; Somebody's called (or tail-called) us.
-  ;; Put magic arg in x8664::next-method-context (= x8664::temp0).
-  ;; Put function in x8664::xfn until we're ready to jump to it.
-  ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z,
-  ;;   but preserves x866::xfn/x8664::next-method-context.
-  ;; Jump to the function in x8664::xfn.
-  (popq (% ra0))
-  (movq (% magic) (% next-method-context))
-  (movq (% function) (% xfn))
-  (set-nargs 0)
-  (movq (@ (% args)) (% imm0))          ;lexpr-count
-  (movw (% imm0.w) (% nargs))
-  (leaq (@ x8664::node-size (% arg_z) (% imm0)) (% imm1))
-  (subw ($ '3) (% imm0.w))
-  (jbe @reg-only)
-  ;; Some args will be pushed; reserve a frame
-  (pushq ($ x8664::reserved-frame-marker))
-  (pushq ($ x8664::reserved-frame-marker))
-  @pushloop
-  (pushq (@ (- x8664::node-size) (% imm1)))
-  (subq ($ x8664::node-size) (% imm1))
-  (subq ($ x8664::node-size) (% imm0))
-  (jne @pushloop)
-  @three
-  (movq (@ (* x8664::node-size 3) (% arg_z)) (% arg_x))
-  @two
-  (movq (@ (* x8664::node-size 2) (% arg_z)) (% arg_y))
-  @one
-  (movq (@ (* x8664::node-size 1) (% arg_z)) (% arg_z))
-  (jmp @go)
-  @reg-only
-  (testw (% nargs) (% nargs))
-  (je @go)
-  (rcmpw (% nargs) ($ '2))
-  (je @two)
-  (jb @one)
-  (jmp @three)
-  @go
-  (push (% ra0))
-  (jmp (% xfn)))
-
-(defx86lapfunction %apply-with-method-context ((magic arg_x)
-                                               (function arg_y)
-                                               (args arg_z))
-  ;; Somebody's called (or tail-called) us.
-  ;; Put magic arg in x8664::next-method-context (= x8664::temp0).
-  ;; Put function in x8664::xfn (= x8664::temp1).
-  ;; Set nargs to 0, then spread "args" on stack (clobbers arg_x, arg_y, arg_z,
-  ;;   but preserves x8664::xfn/x8664::next-method-context.
-  ;; Jump to the function in x8664::xfn.
-  (pop (% ra0))  
-  (movq (% magic) (% x8664::next-method-context))
-  (movq (% function) (% x8664::xfn))
-  (movq (% args) (% arg_y))             ; in case of error
-  (set-nargs 0)
-  (xorl (% imm0.l) (% imm0.l))
-  (push (% imm0))                       ; reserve frame (might discard
-  (push (% imm0))                       ; it if nothing is passed on stack.)
-  (cmp-reg-to-nil arg_z)
-  (je @done)
-  @loop
-  (extract-fulltag arg_z imm1)
-  (cmpb ($ x8664::fulltag-cons) (%b imm1))
-  (jne @bad)
-  (%car arg_z arg_x)
-  (%cdr arg_z arg_z)
-  (lea (@ x8664::node-size (% imm0)) (% imm0))
-  (cmp-reg-to-nil arg_z)
-  (push (% arg_x))
-  (jne @loop)
-  @done
-  (addw (% imm0.w) (% nargs))
-  (jne @pop)
-  @discard-and-go
-  (discard-reserved-frame)
-  (jmp @go)
-  @pop
-  (cmpw ($ '1) (% nargs))
-  (pop (% arg_z))
-  (je @discard-and-go)
-  (cmpw ($ '2) (% nargs))
-  (pop (% arg_y))
-  (je @discard-and-go)
-  (cmpw ($ '3) (% nargs))
-  (pop (% arg_x))
-  (je @discard-and-go)
-  @go
-  (push (% ra0))
-  (jmp (% xfn))
-  @bad
-  (addq (% imm0) (% rsp))
-  (movq (% arg_y) (% arg_z))
-  (movq ($ (ash $XNOSPREAD x8664::fixnumshift)) (% arg_y))
-  (set-nargs 2)
-  (jmp-subprim .SPksignalerr))
-
-
-;;; The idea here is to call METHOD in the same stack frame in
-;;; which the lexpr was originally called.  The lexpr can't
-;;; have had any required arguments, %APPLY-LEXPR-TAIL-WISE
-;;; must have been tail-called, and the frame built on lexpr
-;;; entry must be in %rbp.
-(defx86lapfunction %apply-lexpr-tail-wise ((method arg_y) (args arg_z))
-  (addq ($ x8664::node-size) (% rsp))   ; discard extra return address
-  (movq (% method) (% xfn))
-  (movq (% args) (% rsp))
-  (pop (%q nargs))
-  (movq (@ x8664::lisp-frame.return-address (% rbp)) (% ra0))
-  (movq (@ 0 (% rbp)) (% rbp))
-  (rcmpw (% nargs) ($ '3))
-  (jbe @pop-regs)
-  ;; More than 3 args; some must have been pushed by caller,
-  ;; so retain the reserved frame.
-  (pop (% arg_z))
-  (pop (% arg_y))
-  (pop (% arg_x))
-  (jmp @popped)
-  @pop-regs
-  (je @pop3)
-  (rcmpw (% nargs) ($ '1))
-  (jb @discard)
-  (ja @pop2)
-  (pop (% arg_z))
-  (jmp @discard)
-  @pop3
-  (pop (% arg_z))
-  (pop (% arg_y))
-  (pop (% arg_x))
-  (jmp @discard)
-  @pop2
-  (pop (% arg_z))
-  (pop (% arg_y))
-  @discard
-  (discard-reserved-frame)
-  @popped
-  (push (% ra0))
-  (jmp (% xfn)))
-
-
-
-(defun closure-function (fun)
-  (while (and (functionp fun)  (not (compiled-function-p fun)))
-    (setq fun (%nth-immediate fun 0))
-    (when (vectorp fun)
-      (setq fun (svref fun 0))))
-  fun)
-
-;;; For use by (setf (apply ...) ...)
-;;; (apply+ f butlast last) = (apply f (append butlast (list last)))
-
-(defun apply+ (&lap function arg1 arg2 &rest other-args)
-  (x86-lap-function apply+ ()
-   (:arglist (function arg1 arg2 &rest other-args))
-   (check-nargs 3 nil)
-   (cmpw ($ '3) (% nargs))
-   (pop (% ra0))
-   (ja @no-frame)
-   (pushq ($ x8664::reserved-frame-marker))
-   (pushq ($ x8664::reserved-frame-marker))
-@no-frame         
-   (push (% arg_x))
-   (movq (% arg_z) (% temp0))           ; last
-   (movq (% arg_y) (% arg_z))           ; butlast
-   (subw ($ '2) (% nargs))              ; remove count for butlast & last
-   ;; Do .SPspreadargz inline here
-   (xorl (%l imm0) (%l imm0))
-   (movq (% arg_z) (% arg_y))           ; save in case of error
-   (cmp-reg-to-nil arg_z)
-   (je @done)
-   @loop
-   (extract-fulltag arg_z imm1)
-   (cmpb ($ x8664::fulltag-cons) (%b imm1))
-   (jne @bad)
-   (%car arg_z arg_x)
-   (%cdr arg_z arg_z)
-   (addl ($ '1) (%l imm0))
-   (cmp-reg-to-nil arg_z)   
-   (push (% arg_x))
-   (jne @loop)
-   @done
-   ;; nargs was at least 1 when we started spreading, and can't have gotten
-   ;; any smaller. 
-   (addw (%w imm0) (% nargs))
-   (movq (% temp0) (% arg_z))
-   (pop (% arg_y))
-   (pop (% arg_x))
-   (addw ($ '1) (% nargs))
-   (cmpw ($ '3) (% nargs))
-   (jne @no-discard)
-   (discard-reserved-frame)
-   @no-discard
-   (load-constant funcall temp0)
-   (push (% ra0))
-   (jmp-subprim .SPfuncall)
-   @bad                                 ; error spreading list.
-   (add (% imm0) (% rsp))               ; discard whatever's been pushed
-   (movq (% arg_y) (% arg_z))
-   (movl ($ '#.$XNOSPREAD) (%l arg_y))
-   (set-nargs 2)
-   (jmp-subprim .SPksignalerr) ))
-
-
-
-;;; This needs to:
-;;; (a) load FP arg regs from the FP-REGS argument
-;;; (b) call the .SPffcall subprimitive, which will discard the foreign stack frame
-;;;     allocated by WITH-VARIABLE-C-FRAME in %FF-CALL
-;;; (c) re-establish the same foreign stack frame and store the result regs
-;;;     (%rax/%xmm0) there
-(defx86lapfunction %do-ff-call ((nfp 0) (frame arg_x) (fp-regs arg_y) (entry arg_z))
-  (popq (% ra0))
-  (popq (% rax))
-  (movq (% rbp) (@  (% rsp)))
-  (movq (% rsp) (% rbp))
-  (movq (% ra0) (@ 8 (% rbp)))
-  (macptr-ptr fp-regs temp0)
-  (sarq ($ x8664::fixnumshift) (% rax))
-  (movq (@ (% temp0)) (% fp0))
-  (movq (@ 8 (% temp0)) (% fp1))
-  (movq (@ 16 (% temp0)) (% fp2))
-  (movq (@ 24 (% temp0)) (% fp3))
-  (movq (@ 32 (% temp0)) (% fp4))
-  (movq (@ 40 (% temp0)) (% fp5))
-  (movq (@ 48 (% temp0)) (% fp6))
-  (movq (@ 56 (% temp0)) (% fp7))
-  (call-subprim .SPffcall)
-  (movq (@ (% :rcontext) x8664::tcr.foreign-sp) (% mm5))
-  (movq (% mm5) (@ (% frame)))
-  (movq (% frame) (@ (% :rcontext) x8664::tcr.foreign-sp))
-  (movq (% rax) (@ 8 (% frame)))
-  (movq (% fp0) (@ 16 (% frame)))
-  (movl ($ nil) (%l arg_z))
-  (restore-simple-frame)
-  (single-value-return))
-  
-
-(defun %ff-call (entry &rest specs-and-vals)
-  (declare (dynamic-extent specs-and-vals))
-  (let* ((len (length specs-and-vals))
-         (total-words 0))
-    (declare (fixnum len total-words))
-    (let* ((result-spec (or (car (last specs-and-vals)) :void))
-           (nargs (ash (the fixnum (1- len)) -1))
-           (n-fp-args 0))
-      (declare (fixnum nargs n-fp-args))
-      (ecase result-spec
-        ((:address :unsigned-doubleword :signed-doubleword
-                   :single-float :double-float
-                   :signed-fullword :unsigned-fullword
-                   :signed-halfword :unsigned-halfword
-                   :signed-byte :unsigned-byte
-                   :void)
-         (do* ((i 0 (1+ i))
-               (specs specs-and-vals (cddr specs))
-               (spec (car specs) (car specs)))
-              ((= i nargs))
-           (declare (fixnum i))
-           (case spec
-             ((:address :unsigned-doubleword :signed-doubleword
-                        :single-float :double-float
-                        :signed-fullword :unsigned-fullword
-                        :signed-halfword :unsigned-halfword
-                        :signed-byte :unsigned-byte)
-              (incf total-words))
-             (t (if (typep spec 'unsigned-byte)
-                  (incf total-words spec)
-                  (error "unknown arg spec ~s" spec)))))
-         ;; It's necessary to ensure that the C frame is the youngest thing on
-         ;; the foreign stack here.
-         (%stack-block ((fp-args (* 8 8)))
-           (with-macptrs ((argptr))
-             (with-variable-c-frame
-                 total-words frame
-                 (%setf-macptr-to-object argptr frame)
-                 (let* ((gpr-offset 16)
-                        (other-offset (+ gpr-offset (* 6 8))))
-                   (declare (fixnum gpr-offset other-offset))
-                   (do* ((i 0 (1+ i))
-                         (ngpr-args 0)
-                         (specs specs-and-vals (cddr specs))
-                         (spec (car specs) (car specs))
-                         (val (cadr specs) (cadr specs)))
-                        ((= i nargs))
-                     (declare (fixnum i))
-                     (case spec
-                       (:address
-                        (incf ngpr-args)
-                        (cond ((<= ngpr-args 6)
-                               (setf (%get-ptr argptr gpr-offset) val)
-                               (incf gpr-offset 8))
-                              (t
-                               (setf (%get-ptr argptr other-offset) val)
-                               (incf other-offset 8))))
-                       ((:signed-doubleword :signed-fullword :signed-halfword
-                                            :signed-byte)
-                        (incf ngpr-args)
-                        (cond ((<= ngpr-args 6)
-                               (setf (%%get-signed-longlong argptr gpr-offset) val)
-                               (incf gpr-offset 8))
-                              (t
-                               (setf (%%get-signed-longlong argptr other-offset) val)
-                               (incf other-offset 8))))
-                       ((:unsigned-doubleword :unsigned-fullword :unsigned-halfword
-                                              :unsigned-byte)
-                        (incf ngpr-args)
-                        (cond ((<= ngpr-args 6)
-                               (setf (%%get-unsigned-longlong argptr gpr-offset) val)
-                               (incf gpr-offset 8))
-                              (t
-                               (setf (%%get-unsigned-longlong argptr other-offset) val)
-                               (incf other-offset 8))))
-                       (:double-float
-                        (cond ((< n-fp-args 8)
-                               (setf (%get-double-float fp-args (* n-fp-args 8)) val)
-                               (incf n-fp-args))
-                              (t
-                               (setf (%get-double-float argptr other-offset) val)
-                               (incf other-offset 8))))
-                       (:single-float
-                        (cond ((< n-fp-args 8)
-                               (setf (%get-single-float fp-args (* n-fp-args 8))
-                                     val)
-                               (incf n-fp-args))
-                              (t 
-                               (setf (%get-single-float argptr other-offset) val)
-                               (incf other-offset 8))))
-                       (t
-                        (let* ((p 0))
-                          (declare (fixnum p))
-                          (dotimes (i (the fixnum spec))
-                            (setf (%get-ptr argptr other-offset) (%get-ptr val p))
-                            (incf p 8)
-                            (incf other-offset 8)))))))
-                 (%do-ff-call (min n-fp-args 8) frame fp-args entry)
-                 (ecase result-spec
-                   (:void nil)
-                   (:address (%get-ptr argptr 8))
-                   (:unsigned-byte (%get-unsigned-byte argptr 8))
-                   (:signed-byte (%get-signed-byte argptr 8))
-                   (:unsigned-halfword (%get-unsigned-word argptr 8))
-                   (:signed-halfword (%get-signed-word argptr 8))
-                   (:unsigned-fullword (%get-unsigned-long argptr 8))
-                   (:signed-fullword (%get-signed-long argptr 8))
-                   (:unsigned-doubleword (%get-natural argptr 8))
-                   (:signed-doubleword (%get-signed-natural argptr 8))
-                   (:single-float (%get-single-float argptr 16))
-                   (:double-float (%get-double-float argptr 16)))))))))))
-                                 
-
-) ; #+x8664-target
-;;; end of x86-def.lisp
-
Index: anches/ia32/level-0/X86/x86-float.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-float.lisp	(revision 8363)
+++ 	(revision )
@@ -1,461 +1,0 @@
-;;;-*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 2005 Clozure Associates
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-(eval-when (:compile-toplevel :execute)
-  (require "NUMBER-MACROS")
-  (require :number-case-macro))
-
-
-;;; make a float from hi - high 24 bits mantissa (ignore implied higher bit)
-;;;                   lo -  low 28 bits mantissa
-;;;                   exp  - take low 11 bits
-;;;                   sign - sign(sign) => result
-;;; hi result - 1 bit sign: 11 bits exp: 20 hi bits of hi arg
-;;; lo result - 4 lo bits of hi arg: 28 lo bits of lo arg
-;;; no error checks, no tweaks, no nuthin 
-
-;;; sign is -1, 1, maybe zero
-
-
-
-(defx86lapfunction %make-float-from-fixnums ((float 16 )(hi 8) #|(ra 0)|#(lo arg_x) (exp arg_y) (sign arg_z))
-  (mov (% sign) (% imm1))
-  (sar ($ 63) (% imm1))
-  (shl ($ 63) (% imm1))
-  (movq (@ hi (% rsp)) (% imm0))                        ;hi
-  (andl ($ (ash (1- (ash 1 24)) x8664::fixnumshift)) (%l imm0))
-  (shl ($ (- 28 x8664::fixnumshift)) (% imm0))
-  (or (% imm0) (% imm1))
-  (unbox-fixnum lo imm0)
-  (andl ($ (1- (ash 1 28))) (%l imm0))
-  (or (% imm0) (% imm1))
-  (mov (% exp) (% imm0))
-  (shl ($ (- ieee-double-float-exponent-offset x8664::fixnumshift)) (% imm0))
-  (or (% imm0) (% imm1))
-  (movq (@ float (% rsp)) (% arg_z))
-  (mov (% imm1) (@ x8664::double-float.value (% arg_z)))
-  (single-value-return 4))
-
-
-;;; Maybe we should trap - or something - on NaNs.
-(defx86lapfunction %%double-float-abs! ((n arg_y)(val arg_z))
-  (mov (@ x8664::double-float.value (% n)) (% imm0))
-  (btr ($ 63) (% imm0))
-  (mov (% imm0) (@ x8664::double-float.value (% val)))
-  (single-value-return))
-
-
-(defx86lapfunction %short-float-abs ((n arg_z))
-  (btr ($ 63) (% n))
-  (single-value-return))
-
-
-(defx86lapfunction %double-float-negate! ((src arg_y) (res arg_z))
-  (movq (@ x8664::double-float.value (% src)) (% imm0))
-  (btcq ($ 63) (% imm0))
-  (movq (% imm0) (@ x8664::double-float.value (% res)))
-  (single-value-return))
-
-
-(defx86lapfunction %short-float-negate ((src arg_z))
-  (btcq ($ 63) (% arg_z))
-  (single-value-return))
-
-
-
-(defx86lapfunction dfloat-significand-zeros ((dfloat arg_z))
-  (movq (@ target::double-float.value (% dfloat)) (% imm1))
-  (shl ($ (1+ IEEE-double-float-exponent-width)) (% imm1))
-  (bsrq (% imm1) (% imm0))
-  (xorq ($ (1- target::nbits-in-word)) (% imm0))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-;;; This exploits the fact that the single float is already
-;;; shifted left 32 bits.  We don't want to count the tag
-;;; bit as significant, so bash the argument into a fixnum
-;;; first.
-(defx86lapfunction sfloat-significand-zeros ((sfloat arg_z))
-  (xorb (%b sfloat) (%b sfloat))
-  (shl ($ (1+ IEEE-single-float-exponent-width)) (% sfloat))
-  (bsrq (% sfloat) (% imm0))
-  (xorq ($ (1- target::nbits-in-word)) (% imm0))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %%scale-dfloat! ((float arg_x)(int arg_y)(result arg_z))
-  (unbox-fixnum int imm0)
-  (get-double-float float fp1)
-  (shl ($ IEEE-double-float-exponent-offset) (% imm0))
-  (movd (% imm0) (% fp2))
-  (mulsd (% fp2) (% fp1))
-  (put-double-float fp1 result)
-  (single-value-return))
-
-(defx86lapfunction %%scale-sfloat! ((float arg_y)(int arg_z))
-  (unbox-fixnum int imm0)
-  (shl ($ IEEE-double-float-exponent-offset) (% imm0))
-  (movd (% imm0) (% fp2))
-  (get-single-float float fp1)
-  (mulss (% fp2) (% fp1))
-  (put-single-float fp1 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %copy-double-float ((f1 arg_y) (f2 arg_z))
-  (get-double-float f1 fp1)
-  (put-double-float fp1 f2)
-  (single-value-return))
-
-(defx86lapfunction %short-float->double-float ((src arg_y) (result arg_z))
-  (get-single-float src fp1)
-  (cvtss2sd (% fp1) (% fp1))
-  (put-double-float fp1 result)
-  (single-value-return))
-
-(defx86lapfunction %double-float->short-float ((src arg_z))
-  (get-double-float src fp1)
-  (cvtsd2ss (% fp1) (% fp1))
-  (put-single-float fp1 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %int-to-sfloat ((int arg_z))
-  (int-to-single int imm0 fp1)
-  (put-single-float fp1 arg_z)
-  (single-value-return))
-  
-
-(defx86lapfunction %int-to-dfloat ((int arg_y) (dfloat arg_z))
-  (int-to-double int imm0 fp1)
-  (put-double-float fp1 arg_z)
-  (single-value-return))
-
-
-
-
-;;; Manipulate the MXCSR.  It'll fit in a fixnum, but we have to
-;;; load and store it through memory.  On x8664, we can hide the
-;;; 32-bit MXCSR value in a fixnum on the stack; on a 32-bit x86,
-;;; we might need to use a scratch location in the TCR or something.
-
-;;; Return the MXCSR as a fixnum
-(defx86lapfunction %get-mxcsr ()
-  (pushq ($ '0))
-  (stmxcsr (@ 4 (% rsp)))
-  (pop (% arg_z))
-  (shr ($ (- 32 x8664::fixnumshift)) (% arg_z))
-  (single-value-return))
-
-;;; Store the fixnum in arg_z in the MXCSR.  Just to be
-;;; on the safe side, mask the arg with X86::MXCSR-WRITE-MASK,
-;;; so that only known control and status bits are written to.
-(defx86lapfunction %set-mxcsr ((val arg_z))
-  (mov (% val) (% temp0))
-  (andl ($ '#.x86::mxcsr-write-mask) (%l temp0))
-  (shl ($ (- 32 x8664::fixnumshift)) (% temp0))
-  (push (% temp0))
-  (ldmxcsr (@ 4 (% rsp)))
-  (add ($ '1) (% rsp))
-  (single-value-return))
-
-
-;;; Get the bits that contain exception masks and rounding mode.
-
-(defun %get-mxcsr-control ()
-  (logand x86::mxcsr-control-and-rounding-mask (the fixnum (%get-mxcsr))))
-
-;;; Get the bits that describe current exceptions.
-(defun %get-mxcsr-status ()
-  (logand x86::mxcsr-status-mask (the fixnum (%get-mxcsr))))
-
-;;; Set the bits that describe current exceptions, presumably to clear them.
-(defun %set-mxcsr-status (arg)
-  (%set-mxcsr
-   (logior (logand x86::mxcsr-status-mask arg)
-           (logandc2 (%get-mxcsr) x86::mxcsr-status-mask)))
-  arg)
-
-;;; Set the bits that mask/unmask exceptions and control rounding.
-;;; Clear the bits which describe current exceptions.
-(defun %set-mxcsr-control (arg)
-  (%set-mxcsr (logand x86::mxcsr-control-and-rounding-mask arg)))
-
-;;; Return the MXCSR value in effect after the last ff-call.
-(defx86lapfunction %get-post-ffi-mxcsr ()
-  (xor (% arg_z) (% arg_z))
-  (movl (@ (% :rcontext) x8664::tcr.ffi-exception) (%l imm0))
-  (movl (%l arg_z) (@ (% :rcontext) x8664::tcr.ffi-exception))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-;;; Return the status bits from the last ff-call that represent
-;;; unmasked exceptions
-(defun %ffi-exception-status ()
-  (logior (%get-mxcsr-control)
-          (logand x86::mxcsr-status-mask (the fixnum (%get-post-ffi-mxcsr)))))
-
-
-  
-
-;;; See if the binary double-float operation OP set any enabled
-;;; exception bits in the mxcsr
-(defun %df-check-exception-2 (operation op0 op1 fp-status)
-  (declare (type (unsigned-byte 6) fp-status))
-  (unless (zerop fp-status)
-    (%set-mxcsr-status 0)
-    ;; Ensure that operands are heap-consed
-    (%fp-error-from-status fp-status
-			   operation 
-			   (%copy-double-float op0 (%make-dfloat)) 
-			   (%copy-double-float op1 (%make-dfloat)))))
-
-(defun %sf-check-exception-2 (operation op0 op1 fp-status)
-  (declare (type (unsigned-byte 6) fp-status))
-  (unless (zerop fp-status)
-    (%set-mxcsr-status 0)
-    ;; Ensure that operands are heap-consed
-    (%fp-error-from-status fp-status 
-			   operation
-			   #+32-bit-target
-			   (%copy-short-float op0 (%make-sfloat))
-			   #+64-bit-target op0
-			   #+32-bit-target
-			   (%copy-short-float op1 (%make-sfloat))
-			   #+64-bit-target op1)))
-
-(defun %df-check-exception-1 (operation op0 fp-status)
-  (declare (fixnum fp-status))
-  (unless (zerop fp-status)
-    (%set-mxcsr-status 0)
-    ;; Ensure that operands are heap-consed
-    (%fp-error-from-status fp-status 
-                           operation 
-                           (%copy-double-float op0 (%make-dfloat)))))
-
-(defun %sf-check-exception-1 (operation op0 fp-status)
-  (declare (type (unsigned-byte 6) fp-status))
-  (unless (zerop fp-status)
-    (%set-mxcsr-status 0)
-    ;; Ensure that operands are heap-consed
-    (%fp-error-from-status fp-status 
-			   operation
-			   #+32-bit-target
-			   (%copy-short-float op0 (%make-sfloat))
-			   #+64-bit-target op0)))
-
-
-(defun fp-condition-from-mxcsr (status-bits control-bits)
-  (declare (fixnum status-bits control-bits))
-  (cond 
-   ((and (logbitp x86::mxcsr-ie-bit status-bits)
-         (not (logbitp x86::mxcsr-im-bit control-bits)))
-    'floating-point-invalid-operation)
-   ((and (logbitp x86::mxcsr-oe-bit status-bits)
-         (not (logbitp x86::mxcsr-om-bit control-bits)))
-    'floating-point-overflow)
-   ((and (logbitp x86::mxcsr-ue-bit status-bits)
-         (not (logbitp x86::mxcsr-um-bit control-bits)))
-    'floating-point-underflow)
-   ((and (logbitp x86::mxcsr-ze-bit status-bits)
-         (not (logbitp x86::mxcsr-zm-bit control-bits)))
-    'division-by-zero)
-   ((and (logbitp x86::mxcsr-pe-bit status-bits)
-         (not (logbitp x86::mxcsr-pm-bit control-bits)))
-    'floating-point-inexact)))
-
-(defun %fp-error-from-status (status-bits  operation op0 &optional op1)
-  (declare (type (unsigned-byte 6) status-bits))
-  (let* ((condition-class (fp-condition-from-mxcsr status-bits (%get-mxcsr-control))))
-    (if condition-class
-      (let* ((operands (if op1 (list op0 op1) (list op0))))
-        (error (make-instance condition-class
-                              :operation operation
-                              :operands operands))))))
-
-
-
-;;; Don't we already have about 20 versions of this ?
-(defx86lapfunction %double-float-from-macptr! ((ptr arg_x) (byte-offset arg_y) (dest arg_z))
-  (macptr-ptr ptr imm0)
-  (unbox-fixnum byte-offset imm1)
-  (movsd (@ (% imm0) (% imm1)) (% fp1))
-  (put-double-float fp1 dest)
-  (single-value-return))
-
-
-(defvar *rounding-mode-alist*
-  '((:nearest . 0) (:zero . 1) (:positive . 2) (:negative . 3)))
-
-(defun get-fpu-mode (&optional (mode nil mode-p))
-  (let* ((flags (%get-mxcsr-control)))
-    (declare (fixnum flags))
-    (let* ((rounding-mode
-            (car (nth (+ (if (logbitp x86::mxcsr-rc0-bit flags) 1 0)
-                         (if (logbitp x86::mxcsr-rc1-bit flags) 2 0))
-                      *rounding-mode-alist*)))
-           (overflow (not (logbitp x86::mxcsr-om-bit flags)))
-           (underflow (not (logbitp x86::mxcsr-um-bit flags)))
-           (division-by-zero (not (logbitp x86::mxcsr-zm-bit flags)))
-           (invalid (not (logbitp x86::mxcsr-im-bit flags)))
-           (inexact (not (logbitp x86::mxcsr-pm-bit flags))))
-    (if mode-p
-      (ecase mode
-        (:rounding-mode rounding-mode)
-        (:overflow overflow)
-        (:underflow underflow)
-        (:division-by-zero division-by-zero)
-        (:invalid invalid)
-        (:inexact inexact))
-      `(:rounding-mode ,rounding-mode
-        :overflow ,overflow
-        :underflow ,underflow
-        :division-by-zero ,division-by-zero
-        :invalid ,invalid
-        :inexact ,inexact)))))
-
-;;; did we document this?
-(defun set-fpu-mode (&key (rounding-mode :nearest rounding-p)
-                          (overflow t overflow-p)
-                          (underflow t underflow-p)
-                          (division-by-zero t zero-p)
-                          (invalid t invalid-p)
-                          (inexact t inexact-p))
-  (let* ((current (%get-mxcsr-control))
-         (new current))
-    (declare (fixnum current new))
-    (when rounding-p
-      (let* ((rc-bits (or
-                       (cdr (assoc rounding-mode *rounding-mode-alist*))
-                       (error "Unknown rounding mode: ~s" rounding-mode))))
-        (declare (fixnum rc-bits))
-        (if (logbitp 0 rc-bits)
-          (bitsetf x86::mxcsr-rc0-bit new)
-          (bitclrf x86::mxcsr-rc0-bit new))
-        (if (logbitp 1 rc-bits)
-          (bitsetf x86::mxcsr-rc1-bit new)
-          (bitclrf x86::mxcsr-rc1-bit new))))
-    (when invalid-p
-      (if invalid
-        (bitclrf x86::mxcsr-im-bit new)
-        (bitsetf x86::mxcsr-im-bit new)))
-    (when overflow-p
-      (if overflow
-        (bitclrf x86::mxcsr-om-bit new)
-        (bitsetf x86::mxcsr-om-bit new)))
-    (when underflow-p
-      (if underflow
-        (bitclrf x86::mxcsr-um-bit new)
-        (bitsetf x86::mxcsr-um-bit new)))
-    (when zero-p
-      (if division-by-zero
-        (bitclrf x86::mxcsr-zm-bit new)
-        (bitsetf x86::mxcsr-zm-bit new)))
-    (when inexact-p
-      (if inexact
-        (bitclrf x86::mxcsr-pm-bit new)
-        (bitsetf x86::mxcsr-pm-bit new)))
-    (unless (= current new)
-      (%set-mxcsr-control new))
-    (%get-mxcsr)))
-
-
-
-;;; Copy a single float pointed at by the macptr in single
-;;; to a double float pointed at by the macptr in double
-
-(defx86lapfunction %single-float-ptr->double-float-ptr ((single arg_y) (double arg_z))
-  (check-nargs 2)
-  (macptr-ptr single imm0)
-  (movss (@ (% imm0)) (% fp1))
-  (cvtss2sd (% fp1) (% fp1))
-  (macptr-ptr double imm0)
-  (movsd (% fp1) (@ (% imm0)))
-  (single-value-return))
-
-;;; Copy a double float pointed at by the macptr in double
-;;; to a single float pointed at by the macptr in single.
-(defx86lapfunction %double-float-ptr->single-float-ptr ((double arg_y) (single arg_z))
-  (check-nargs 2)
-  (macptr-ptr double imm0)
-  (movsd (@ (% imm0)) (% fp1))
-  (cvtsd2ss (% fp1) (% fp1))
-  (macptr-ptr single imm0)
-  (movss (% fp1) (@ (% imm0)))
-  (single-value-return))
-
-
-(defx86lapfunction %set-ieee-single-float-from-double ((src arg_y) (macptr arg_z))
-  (check-nargs 2)
-  (macptr-ptr macptr imm0)
-  (get-double-float src fp1)
-  (cvtsd2ss (% fp1) (% fp1))
-  (movss (% fp1) (@ (% imm0)))
-  (single-value-return))
-
-(defx86lapfunction host-single-float-from-unsigned-byte-32 ((u32 arg_z))
-  (shl ($ (- 32 x8664::fixnumshift)) (% arg_z))
-  (movb ($ x8664::subtag-single-float) (% arg_z.b))
-  (single-value-return))
-
-(defx86lapfunction single-float-bits ((f arg_z))
-  (shr ($ (- 32 x8664::fixnumshift)) (% f))
-  (single-value-return))
-
-(defun double-float-bits (f)
-  (values (uvref f target::double-float.val-high-cell)
-          (uvref f target::double-float.val-low-cell)))
-
-(defun double-float-from-bits (high low)
-  (let* ((f (%make-dfloat)))
-    (setf (uvref f target::double-float.val-high-cell) high
-          (uvref f target::double-float.val-low-cell) low)
-    f))
-
-;;; Return T if n is negative, else NIL.
-(defx86lapfunction %double-float-sign ((n arg_z))
-  (movl (@ x8664::double-float.val-high (% n)) (% imm0.l))
-  (testl (% imm0.l) (% imm0.l))
-  (movl ($ x8664::t-value) (% imm0.l))
-  (movl ($ x8664::nil-value) (% arg_z.l))
-  (cmovlq (% imm0) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %short-float-sign ((n arg_z))
-  (testq (% n) (% n))
-  (movl ($ x8664::t-value) (% imm0.l))
-  (movl ($ x8664::nil-value) (% arg_z.l))
-  (cmovlq (% imm0) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %double-float-sqrt! ((n arg_y) (result arg_z))
-  (get-double-float n fp0)
-  (sqrtsd (% fp0) (% fp0))
-  (put-double-float fp0 result)
-  (single-value-return))
-
-(defx86lapfunction %single-float-sqrt ((n arg_z))
-  (get-single-float n fp0)
-  (sqrtss (% fp0) (% fp0))
-  (put-single-float fp0 arg_z)
-  (single-value-return))
-
-) ; #+x8664-target
-;;; end of x86-float.lisp
Index: anches/ia32/level-0/X86/x86-hash.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-hash.lisp	(revision 8363)
+++ 	(revision )
@@ -1,108 +1,0 @@
-;;; -*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 2006, Clozure Associates and contributors
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-;;; level-0;ppc;ppc-hash.lisp
-
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-
-(eval-when (:compile-toplevel :execute)
-  (require "HASHENV" "ccl:xdump;hashenv"))
-
-
-
-
-;;; This should stay in LAP so that it's fast
-;;; Equivalent to cl:mod when both args are positive fixnums
-
-
-(defx86lapfunction fast-mod ((number arg_y) (divisor arg_z))
-  (xorq (% imm1) (% imm1))
-  (mov (% number) (% imm0))
-  (div (% divisor))
-  (mov (% imm1) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %dfloat-hash ((key arg_z))
-  (movq (@ x8664::double-float.value (% key)) (% imm0))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %sfloat-hash ((key arg_z))
-  (mov (% key) (% imm1))
-  (movl ($ #x-80000000) (%l imm0))
-  (shr ($ 32) (% imm1))
-  (xorq (% arg_y) (% arg_y))
-  (shr ($ (- 32 x8664::fixnumshift)) (% key))
-  (rcmp (%l imm0) (%l imm1))
-  (cmoveq (% arg_y) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %macptr-hash ((key arg_z))
-  (movq (@ target::macptr.address (% key)) (% imm0))
-  (movq (% imm0) (% imm1))
-  (shlq ($ 24) (% imm1))
-  (addq (% imm1) (% imm0))
-  (movq ($ (lognot target::fixnummask)) (% arg_z))
-  (andq (% imm0) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %bignum-hash ((key arg_z))
-  (let ((header imm0)
-        (offset imm1)
-        (ndigits temp0))
-    (getvheader key header)
-    (header-length header ndigits)
-    (xorq (% offset) (% offset))
-    (let ((immhash header))
-      @loop
-      (rolq ($ 13) (% immhash))
-      (addl (@ x8664::misc-data-offset (% key) (% offset)) (%l immhash))
-      (addq ($ 4) (% offset))
-      (subq ($ '1) (% ndigits))
-      (jne  @loop)
-      (box-fixnum immhash arg_z))
-    (single-value-return)))
-
-
-(defx86lapfunction %get-fwdnum ()
-  (ref-global target::fwdnum arg_z)
-  (single-value-return))
-
-
-(defx86lapfunction %get-gc-count ()
-  (ref-global target::gc-count arg_z)
-  (single-value-return))
-
-
-;;; Setting a key in a hash-table vector needs to 
-;;; ensure that the vector header gets memoized as well
-(defx86lapfunction %set-hash-table-vector-key ((vector arg_x) (index arg_y) (value arg_z))
-  (jmp-subprim .SPset-hash-key))
-
-;;; Strip the tag bits to turn x into a fixnum
-(defx86lapfunction strip-tag-to-fixnum ((x arg_z))
-  (andb ($ (lognot x8664::fixnummask)) (%b x))
-  (single-value-return))
-
-) ; #+x8664-target
-;;; end of x86-hash.lisp
Index: anches/ia32/level-0/X86/x86-io.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-io.lisp	(revision 8363)
+++ 	(revision )
@@ -1,35 +1,0 @@
-;;; -*- Mode: Lisp; Package: CCL; -*-
-;;;
-;;;   Copyright (C) 1994-2001 Digitool, Inc
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-;;; not very smart yet
-
-(defx86lapfunction %get-errno ()
-  (movq (@ (% :rcontext) x8664::tcr.errno-loc) (% imm1))
-  (movslq (@ (% imm1)) (% imm0))
-  (movss (% fp0) (@ (% imm1)))
-  (negq (% imm0))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-) ; #+x8664-target
-; end
Index: anches/ia32/level-0/X86/x86-misc.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-misc.lisp	(revision 8363)
+++ 	(revision )
@@ -1,757 +1,0 @@
-;;; -*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 1994-2001 Digitool, Inc
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-;;; level-0;x86;x86-misc.lisp
-
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-;;; Copy N bytes from pointer src, starting at byte offset src-offset,
-;;; to ivector dest, starting at offset dest-offset.
-;;; It's fine to leave this in lap.
-;;; Depending on alignment, it might make sense to move more than
-;;; a byte at a time.
-;;; Does no arg checking of any kind.  Really.
-
-(defx86lapfunction %copy-ptr-to-ivector ((src (* 2 x8664::node-size) )
-                                         (src-byte-offset (* 1 x8664::node-size))
-                                         #|(ra 0)|#
-                                         (dest arg_x)
-                                         (dest-byte-offset arg_y)
-                                         (nbytes arg_z))
-  (let ((rsrc temp0)
-        (rsrc-byte-offset temp1))
-    (testq (% nbytes) (% nbytes))
-    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))         ; boxed src-byte-offset
-    (movq (@ src (% rsp)) (% rsrc))     ; src macptr
-    (jmp @test)
-    @loop
-    (unbox-fixnum rsrc-byte-offset imm0)
-    (addq ($ '1) (% rsrc-byte-offset))
-    (addq (@ x8664::macptr.address (% rsrc)) (% imm0))
-    (movb (@ (% imm0)) (%b imm0))
-    (unbox-fixnum dest-byte-offset imm1)
-    (addq ($ '1) (% dest-byte-offset))
-    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
-    (subq ($ '1) (% nbytes))
-    @test
-    (jne @loop)
-    (movq (% dest) (% arg_z))
-    (single-value-return 4)))
-
-(defx86lapfunction %copy-ivector-to-ptr ((src (* 2 x8664::node-size))
-                                         (src-byte-offset (* 1 x8664::node-size))
-                                         #|(ra 0)|#
-                                         (dest arg_x)
-                                         (dest-byte-offset arg_y)
-                                         (nbytes arg_z))
-  (let ((rsrc temp0)
-        (rsrc-byte-offset temp1))
-    (testq (% nbytes) (% nbytes))
-    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))
-    (movq (@ src (% rsp)) (% rsrc))
-    (jmp @test)
-    @loop
-    (unbox-fixnum rsrc-byte-offset imm0)
-    (addq ($ '1) (% rsrc-byte-offset))
-    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
-    (unbox-fixnum dest-byte-offset imm1)
-    (addq ($ '1) (% dest-byte-offset))
-    (addq (@ x8664::macptr.address (%q dest)) (% imm1))
-    (movb (%b imm0) (@ (% imm1)))
-    (subq ($ '1) (% nbytes))
-    @test
-    (jne @loop)
-    (movq (% dest) (% arg_z))
-    (single-value-return 4)))
-
-
-
-(defx86lapfunction %copy-ivector-to-ivector ((src-offset 16) 
-                                             (src-byte-offset 8)
-                                             #|(ra 0)|#
-                                             (dest arg_x)
-                                             (dest-byte-offset arg_y)
-                                             (nbytes arg_z))
-  (let ((rsrc temp0)
-        (rsrc-byte-offset temp1))
-    (movq (@ src-byte-offset (% rsp)) (% rsrc-byte-offset))
-    (movq (@ src-offset (% rsp)) (% rsrc))
-    (cmpq (% dest) (% rsrc))
-    (jne @front)
-    (cmpq (% src-byte-offset) (% dest-byte-offset))
-    (jg @back)
-    @front
-    (testq (% nbytes) (% nbytes))
-    (jmp @front-test)
-    @front-loop
-    (unbox-fixnum rsrc-byte-offset imm0)
-    (addq ($ '1) (% rsrc-byte-offset))
-    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
-    (unbox-fixnum dest-byte-offset imm1)
-    (addq ($ '1) (% dest-byte-offset))
-    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
-    (subq ($ '1) (% nbytes))
-    @front-test
-    (jne @front-loop)
-    (movq (% dest) (% arg_z))
-    (single-value-return 4)
-    @back
-    (addq (% nbytes) (% rsrc-byte-offset))
-    (addq (% nbytes) (% dest-byte-offset))
-    (testq (% nbytes) (% nbytes))
-    (jmp @back-test)
-    @back-loop
-    (subq ($ '1) (% rsrc-byte-offset))
-    (unbox-fixnum rsrc-byte-offset imm0)
-    (movb (@ x8664::misc-data-offset (% rsrc) (% imm0)) (%b imm0))
-    (subq ($ '1) (% dest-byte-offset))
-    (unbox-fixnum dest-byte-offset imm1)
-    (subq ($ '1) (% nbytes))
-    (movb (%b imm0) (@ x8664::misc-data-offset (% dest) (% imm1)))
-    @back-test
-    (jne @back-loop)
-    (movq (% dest) (% arg_z))
-    (single-value-return 4)))
-  
-
-(defx86lapfunction %copy-gvector-to-gvector ((src (* 2 x8664::node-size))
-					     (src-element (* 1 x8664::node-size))
-                                             #|(ra 0)|#
-					     (dest arg_x)
-					     (dest-element arg_y)
-					     (nelements arg_z))
-  (let ((rsrc temp0)
-        (rsrc-element imm1)
-        (val temp1))
-    (movq (@ src-element (% rsp)) (% rsrc-element))
-    (movq (@ src (% rsp)) (% rsrc))
-    (cmpq (% rsrc) (% dest))
-    (jne @front)
-    (rcmp (% rsrc-element) (% dest-element))
-    (jl @back)
-    @front
-    (testq (% nelements) (% nelements))
-    (jmp @front-test)
-    @front-loop
-    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
-    (addq ($ '1) (% rsrc-element))
-    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
-    (addq ($ '1) (% dest-element))
-    (subq ($ '1) (% nelements))
-    @front-test
-    (jne @front-loop)
-    (movq (% dest) (% arg_z))
-    (single-value-return 4)
-    @back
-    (addq (% nelements) (% rsrc-element))
-    (addq (% nelements) (% dest-element))
-    (testq (% nelements) (% nelements))
-    (jmp @back-test)
-    @back-loop
-    (subq ($ '1) (% rsrc-element))
-    (movq (@ x8664::misc-data-offset (% rsrc) (% rsrc-element)) (% val))
-    (subq ($ '1) (% dest-element))
-    (movq (% val) (@ x8664::misc-data-offset (% dest) (% dest-element)))
-    (subq ($ '1) (% nelements))
-    @back-test
-    (jne @back-loop)
-    (movq (% dest) (% arg_z))
-    (single-value-return 4)))
-
-(defx86lapfunction %heap-bytes-allocated ()
-  (movq (@ (% :rcontext) x8664::tcr.save-allocptr) (% temp1))
-  (movq (@ (% :rcontext) x8664::tcr.last-allocptr) (% temp0))
-  (cmpq ($ -16) (% temp1))
-  (movq (@ (% :rcontext) x8664::tcr.total-bytes-allocated) (% imm0))
-  (jz @go)
-  (movq (% temp0) (% temp2))
-  (subq (% temp1) (% temp0))
-  (testq (% temp2) (% temp2))
-  (jz @go)
-  (add (% temp0) (% imm0))
-  @go
-  (jmp-subprim .SPmakeu64))
-
-
-(defx86lapfunction values ()
-  (:arglist (&rest values))
-  (save-frame-variable-arg-count)
-  (push-argregs)
-  (jmp-subprim .SPnvalret))
-
-(defx86lapfunction rdtsc ()
-  (:byte #x0f)                          ;two-byte rdtsc opcode
-  (:byte #x31)                          ;is #x0f #x31
-  (shlq ($ 32) (% rdx))
-  (orq (% rdx) (% rax))
-  (imul ($ (* 2 target::node-size)) (% rax) (% arg_z))
-  (shrq ($ 1) (% arg_z))
-  (single-value-return))
-
-;;; Return all 64 bits of the time-stamp counter as an unsigned integer.
-(defx86lapfunction rdtsc64 ()
-  (:byte #x0f)                          ;two-byte rdtsc opcode
-  (:byte #x31)                          ;is #x0f #x31
-  (shlq ($ 32) (% rdx))
-  (orq (% rdx) (% rax))
-  (jmp-subprim .SPmakeu64))
-
-;;; It would be nice if (%setf-macptr macptr (ash (the fixnum value)
-;;; ash::fixnumshift)) would do this inline.
-
-(defx86lapfunction %setf-macptr-to-object ((macptr arg_y) (object arg_z))
-  (check-nargs 2)
-  (trap-unless-typecode= macptr x8664::subtag-macptr)
-  (movq (% object) (@ x8664::macptr.address (% macptr)))
-  (single-value-return))
-
-(defx86lapfunction %fixnum-from-macptr ((macptr arg_z))
-  (check-nargs 1)
-  (trap-unless-typecode= arg_z x8664::subtag-macptr)
-  (movq (@ x8664::macptr.address (% arg_z)) (% imm0))
-  (trap-unless-lisptag= imm0 x8664::tag-fixnum imm1)
-  (movq (% imm0) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %%get-unsigned-longlong ((ptr arg_y) (offset arg_z))
-  (trap-unless-typecode= ptr x8664::subtag-macptr)
-  (macptr-ptr ptr imm1)
-  (unbox-fixnum offset imm0)
-  (movq (@ (% imm1) (% imm0)) (% imm0))
-  (jmp-subprim .SPmakeu64))
-
-
-(defx86lapfunction %%get-signed-longlong ((ptr arg_y) (offset arg_z))
-  (trap-unless-typecode= ptr x8664::subtag-macptr)
-  (macptr-ptr ptr imm1)
-  (unbox-fixnum offset imm0)
-  (movq (@ (% imm1) (% imm0)) (% imm0))
-  (jmp-subprim .SPmakes64))
-
-
-
-
-(defx86lapfunction %%set-unsigned-longlong ((ptr arg_x)
-                                            (offset arg_y)
-                                            (val arg_z))
-  (save-simple-frame)
-  (trap-unless-typecode= ptr x8664::subtag-macptr)
-  (call-subprim .SPgetu64)
-  (macptr-ptr ptr ptr)
-  (unbox-fixnum offset imm1)
-  (movq (% imm0) (@ (% ptr) (% imm1)))
-  (restore-simple-frame)
-  (single-value-return))
-
-
-(defx86lapfunction %%set-signed-longlong ((ptr arg_x)
-                                          (offset arg_y)
-                                          (val arg_z))
-  (save-simple-frame)
-  (trap-unless-typecode= ptr x8664::subtag-macptr)
-  (call-subprim .SPgets64)
-  (macptr-ptr ptr ptr)
-  (unbox-fixnum offset imm1)
-  (movq (% imm0) (@ (% ptr) (% imm1)))
-  (restore-simple-frame)
-  (single-value-return))
-
-(defx86lapfunction interrupt-level ()
-  (movq (@ (% :rcontext) x8664::tcr.tlb-pointer) (% imm1))
-  (movq (@ x8664::interrupt-level-binding-index (% imm1)) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction set-interrupt-level ((new arg_z))
-  (movq (@ (% :rcontext) x8664::tcr.tlb-pointer) (% imm1))
-  (trap-unless-fixnum new)
-  (movq (% new) (@ x8664::interrupt-level-binding-index (% imm1)))
-  (single-value-return))
-
-(defx86lapfunction %current-tcr ()
-  (movq (@ (% :rcontext) x8664::tcr.linear) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %tcr-toplevel-function ((tcr arg_z))
-  (check-nargs 1)
-  (cmpq (% tcr) (@ (% :rcontext) x8664::tcr.linear))
-  (movq (% rsp) (% imm0))
-  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
-  (movq (@ x8664::area.high (% temp0)) (% imm1))
-  (jz @room)
-  (movq (@ x8664::area.active (% temp0)) (% imm0))
-  @room
-  (cmpq (% imm1) (% imm0))
-  (movl ($ x8664::nil-value) (%l arg_z))
-  (cmovneq (@ (- x8664::node-size) (% imm1)) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %set-tcr-toplevel-function ((tcr arg_y) (fun arg_z))
-  (check-nargs 2)
-  (cmpq (% tcr) (@ (% :rcontext) x8664::tcr.linear))
-  (movq (% rsp) (% imm0))
-  (movq (@ x8664::tcr.vs-area (% tcr)) (% temp0))
-  (movq (@ x8664::area.high (% temp0)) (% imm1))
-  (jz @room)
-  (movq (@ x8664::area.active (% temp0)) (% imm0))
-  @room
-  (cmpq (% imm1) (% imm0))
-  (leaq (@ (- x8664::node-size) (% imm1)) (% imm1))
-  (movq ($ 0) (@ (% imm1)))
-  (jne @have-room)
-  (movq (% imm1) (@ x8664::area.active (% temp0)))
-  (movq (% imm1) (@ x8664::tcr.save-vsp (% tcr)))
-  @have-room
-  (movq (% fun) (@ (% imm1)))
-  (single-value-return))
-
-;;; This needs to be done out-of-line, to handle EGC memoization.
-(defx86lapfunction %store-node-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
-  (movq (@ offset (% rsp)) (% temp0))
-  (save-simple-frame)
-  (call-subprim .SPstore-node-conditional)
-  (restore-simple-frame)
-  (single-value-return 3))
-
-(defx86lapfunction %store-immediate-conditional ((offset 8) #|(ra 0)|# (object arg_x) (old arg_y) (new arg_z))
-  (movq (@ offset (% rsp)) (% temp0))
-  (unbox-fixnum temp0 imm1)
-  @again
-  (movq (@ (% object) (% imm1)) (% rax))
-  (cmpq (% rax) (% old))
-  (jne @lose)
-  (lock)
-  (cmpxchgq (% new) (@ (% object) (% imm1)))
-  (jne @again)
-  (movl ($ x8664::t-value) (%l arg_z))
-  (single-value-return 3)
-  @lose
-  (movl ($ x8664::nil-value) (%l arg_z))
-  (single-value-return 3))
-
-(defx86lapfunction set-%gcable-macptrs% ((ptr x8664::arg_z))
-  @again
-  (movq (@ (+ x8664::nil-value (x8664::kernel-global gcable-pointers)))
-        (% rax))
-  (movq (% rax) (@ x8664::xmacptr.link (% ptr)))
-  (lock)
-  (cmpxchgq (% ptr) (@ (+ x8664::nil-value (x8664::kernel-global gcable-pointers))))
-  (jne @again)
-  (single-value-return))
-
-;;; Atomically increment or decrement the gc-inhibit-count kernel-global
-;;; (It's decremented if it's currently negative, incremented otherwise.)
-(defx86lapfunction %lock-gc-lock ()
-  @again
-  (movq (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))) (% rax))
-  (lea (@ '-1 (% rax)) (% temp0))
-  (lea (@ '1 (% rax)) (% arg_z))
-  (testq (% rax) (% rax))
-  (cmovsq (% temp0) (% arg_z))
-  (lock)
-  (cmpxchgq (% arg_z) (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))))
-  (jnz @again)
-  (single-value-return))
-
-;;; Atomically decrement or increment the gc-inhibit-count kernel-global
-;;; (It's incremented if it's currently negative, incremented otherwise.)
-;;; If it's incremented from -1 to 0, try to GC (maybe just a little.)
-(defx86lapfunction %unlock-gc-lock ()
-  @again
-  (movq (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count)))
-        (% rax))
-  (lea (@ '1 (% rax)) (% arg_x))
-  (cmpq ($ -1) (% rax))
-  (lea (@ '-1 (% rax)) (% arg_z))
-  (cmovleq (% arg_x) (% arg_z))
-  (lock)
-  (cmpxchgq (% arg_z) (@ (+ x8664::nil-value (x8664::kernel-global gc-inhibit-count))))
-  (jne @again)
-  (cmpq ($ '-1) (% rax))
-  (jne @done)
-  ;; The GC tried to run while it was inhibited.  Unless something else
-  ;; has just inhibited it, it should be possible to GC now.
-  (mov ($ arch::gc-trap-function-immediate-gc) (% imm0))
-  (uuo-gc-trap)
-  @done
-  (single-value-return))
-
-;;; Return true iff we were able to increment a non-negative
-;;; lock._value
-(defx86lapfunction %try-read-lock-rwlock ((lock arg_z))
-  (check-nargs 1)
-  @try
-  (movq (@ x8664::lock._value (% lock)) (% rax))
-  (movq (% rax) (% imm1))
-  (addq ($ '1) (% imm1))
-  (jle @fail)
-  (lock)
-  (cmpxchgq (% imm1) (@ x8664::lock._value (% lock)))
-  (jne @try)
-  (single-value-return)                                 ; return the lock
-@fail
-  (movl ($ x8664::nil-value) (%l arg_z))
-  (single-value-return))
-
-
-
-(defx86lapfunction unlock-rwlock ((lock arg_z))
-  (cmpq ($ 0) (@ x8664::lock._value (% lock)))
-  (jle @unlock-write)
-  @unlock-read
-  (movq (@ x8664::lock._value (% lock)) (% rax))
-  (lea (@ '-1 (% imm0)) (% imm1))
-  (lock)
-  (cmpxchgq (% imm1) (@ x8664::lock._value (% lock)))
-  (jne @unlock-read)
-  (single-value-return)
-  @unlock-write
-  ;;; If we aren't the writer, return NIL.
-  ;;; If we are and the value's about to go to 0, clear the writer field.
-  (movq (@ x8664::lock.writer (% lock)) (% imm0))
-  (cmpq (% imm0) (@ (% :rcontext) x8664::tcr.linear))
-  (jne @fail)
-  (cmpq ($ '-1) (@ x8664::lock._value (% lock)))
-  (jne @still-owner)
-  (movsd (% fpzero) (@ x8664::lock.writer (% lock)))
-  @still-owner
-  (addq ($ '1) (@ x8664::lock._value (% lock)))
-  (single-value-return)
-  @fail
-  (movl ($ x8664::nil-value) (%l arg_z))
-  (single-value-return))
-
-(defx86lapfunction %atomic-incf-node ((by arg_x) (node arg_y) (disp arg_z))
-  (check-nargs 3)
-  (unbox-fixnum disp imm1)
-  @again
-  (movq (@ (% node) (% imm1)) (% rax))
-  (lea (@ (% rax) (% by)) (% arg_z))
-  (lock)
-  (cmpxchgq (% arg_z) (@ (% node) (% imm1)))
-  (jne @again)
-  (single-value-return))
-
-(defx86lapfunction %atomic-incf-ptr ((ptr arg_z))
-  (macptr-ptr ptr ptr)
-  @again
-  (movq (@ (% ptr)) (% rax))
-  (lea (@ 1 (% rax)) (% imm1))
-  (lock)
-  (cmpxchgq (% imm1) (@ (% ptr)))
-  (jne @again)
-  (box-fixnum imm1 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %atomic-incf-ptr-by ((ptr arg_y) (by arg_z))
-  (macptr-ptr ptr ptr)
-  @again
-  (movq (@ (% ptr)) (% rax))
-  (unbox-fixnum by imm1)
-  (add (% rax) (% imm1))
-  (lock)
-  (cmpxchgq (% imm1) (@ (% ptr)))
-  (jnz @again)
-  (box-fixnum imm1 arg_z)
-  (single-value-return))
-
-
-(defx86lapfunction %atomic-decf-ptr ((ptr arg_z))
-  (macptr-ptr ptr ptr)
-  @again
-  (movq (@ (% ptr)) (% rax))
-  (lea (@ -1 (% rax)) (% imm1))
-  (lock)
-  (cmpxchgq (% imm1) (@ (% ptr)))
-  (jnz @again)
-  (box-fixnum imm1 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %atomic-decf-ptr-if-positive ((ptr arg_z))
-  (macptr-ptr ptr ptr)                  ;must be fixnum-aligned
-  @again
-  (movq (@ (% ptr)) (% rax))
-  (testq (% rax) (% rax))
-  (lea (@ -1 (% rax)) (% imm1))
-  (jz @done)
-  (lock)
-  (cmpxchgq (% imm1) (@ (% ptr)))
-  (jnz @again)
-  @done
-  (box-fixnum imm1 arg_z)
-  (single-value-return))
-
-
-(defx86lapfunction %atomic-swap-ptr ((ptr arg_y) (newval arg_z))
-  (macptr-ptr arg_y imm1)
-  (unbox-fixnum newval imm0)
-  (lock)
-  (xchgq (% imm0) (@ (% imm1)))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-;;; Try to store the fixnum NEWVAL at PTR, if and only if the old value
-;;; was equal to OLDVAL.  Return the old value
-(defx86lapfunction %ptr-store-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
-  (macptr-ptr ptr ptr)                  ;  must be fixnum-aligned
-  @again
-  (movq (@ (% ptr)) (% imm0))
-  (box-fixnum imm0 temp0)
-  (cmpq (% temp0) (% expected-oldval))
-  (jne @done)
-  (unbox-fixnum newval imm1)
-  (lock)
-  (cmpxchgq (% imm1) (@ (% ptr)))
-  (jne @again)
-  @done
-  (movq (% temp0) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %ptr-store-fixnum-conditional ((ptr arg_x) (expected-oldval arg_y) (newval arg_z))
-  (let ((address imm1))
-    (macptr-ptr ptr address)
-    @again
-    (movq (@ (% address)) (% imm0))
-    (cmpq (% imm0) (% expected-oldval))
-    (jne @done)
-    (lock)
-    (cmpxchgq (% newval) (@ (% address)))
-    (jne @again)
-    @done
-    (movq (% imm0) (% arg_z))
-    (single-value-return)))
-
-
-(defx86lapfunction %macptr->dead-macptr ((macptr arg_z))
-  (check-nargs 1)
-  (movb ($ x8664::subtag-dead-macptr) (@ x8664::misc-subtag-offset (% macptr)))
-  (single-value-return))
-
-#+are-you-kidding
-(defx86lapfunction %%apply-in-frame ((catch-count imm0) (srv temp0) (tsp-count imm0) (db-link imm0)
-                                     (parent arg_x) (function arg_y) (arglist arg_z))
-  (check-nargs 7)
-
-  ; Throw through catch-count catch frames
-  (lwz imm0 12 vsp)                      ; catch-count
-  (vpush parent)
-  (vpush function)
-  (vpush arglist)
-  (bla .SPnthrowvalues)
-
-  ; Pop tsp-count TSP frames
-  (lwz tsp-count 16 vsp)
-  (cmpi cr0 tsp-count 0)
-  (b @test)
-@loop
-  (subi tsp-count tsp-count '1)
-  (cmpi cr0 tsp-count 0)
-  (lwz tsp 0 tsp)
-@test
-  (bne cr0 @loop)
-
-  ; Pop dynamic bindings until we get to db-link
-  (lwz imm0 12 vsp)                     ; db-link
-  (lwz imm1 x8664::tcr.db-link :rcontext)
-  (cmp cr0 imm0 imm1)
-  (beq cr0 @restore-regs)               ; .SPunbind-to expects there to be something to do
-  (bla .SPunbind-to)
-
-@restore-regs
-  ; restore the saved registers from srv
-  (lwz srv 20 vsp)
-@get0
-  (svref imm0 1 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @get1)
-  (lwz save0 0 imm0)
-@get1
-  (svref imm0 2 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @get2)
-  (lwz save1 0 imm0)
-@get2
-  (svref imm0 3 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @get3)
-  (lwz save2 0 imm0)
-@get3
-  (svref imm0 4 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @get4)
-  (lwz save3 0 imm0)
-@get4
-  (svref imm0 5 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @get5)
-  (lwz save4 0 imm0)
-@get5
-  (svref imm0 6 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @get6)
-  (lwz save5 0 imm0)
-@get6
-  (svref imm0 7 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @get7)
-  (lwz save6 0 imm0)
-@get7
-  (svref imm0 8 srv)
-  (cmpwi cr0 imm0 x8664::nil-value)
-  (beq @got)
-  (lwz save7 0 imm0)
-@got
-
-  (vpop arg_z)                          ; arglist
-  (vpop temp0)                          ; function
-  (vpop parent)                         ; parent
-  (extract-lisptag imm0 parent)
-  (cmpi cr0 imm0 x8664::tag-fixnum)
-  (if (:cr0 :ne)
-    ; Parent is a fake-stack-frame. Make it real
-    (progn
-      (svref sp %fake-stack-frame.sp parent)
-      (stwu sp (- x8664::lisp-frame.size) sp)
-      (svref fn %fake-stack-frame.fn parent)
-      (stw fn x8664::lisp-frame.savefn sp)
-      (svref temp1 %fake-stack-frame.vsp parent)
-      (stw temp1 x8664::lisp-frame.savevsp sp)
-      (svref temp1 %fake-stack-frame.lr parent)
-      (extract-lisptag imm0 temp1)
-      (cmpi cr0 imm0 x8664::tag-fixnum)
-      (if (:cr0 :ne)
-        ;; must be a macptr encoding the actual link register
-        (macptr-ptr loc-pc temp1)
-        ;; Fixnum is offset from start of function vector
-        (progn
-          (svref temp2 0 fn)        ; function vector
-          (unbox-fixnum temp1 temp1)
-          (add loc-pc temp2 temp1)))
-      (stw loc-pc x8664::lisp-frame.savelr sp))
-    ;; Parent is a real stack frame
-    (mr sp parent))
-  (set-nargs 0)
-  (bla .SPspreadargz)
-  (ba .SPtfuncallgen))
-
-
-
-  
-(defx86lapfunction %%save-application ((flags arg_y) (fd arg_z))
-  (unbox-fixnum flags imm0)
-  (orq ($ arch::gc-trap-function-save-application) (% imm0))
-  (unbox-fixnum fd imm1)
-  (uuo-gc-trap)
-  (single-value-return))
-
-
-
-(defx86lapfunction %misc-address-fixnum ((misc-object arg_z))
-  (check-nargs 1)
-  (lea (@ x8664::misc-data-offset (% misc-object)) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction fudge-heap-pointer ((ptr arg_x) (subtype arg_y) (len arg_z))
-  (check-nargs 3)
-  (macptr-ptr ptr imm1) ; address in macptr
-  (lea (@ 17 (% imm1)) (% imm0))     ; 2 for delta + 15 for alignment
-  (andb ($ -16) (%b  imm0))   ; Clear low four bits to align
-  (subq (% imm0) (% imm1))  ; imm1 = -delta
-  (negw (%w imm1))
-  (movw (%w imm1) (@  -2 (% imm0)))     ; save delta halfword
-  (unbox-fixnum subtype imm1)  ; subtype at low end of imm1
-  (shlq ($ (- x8664::num-subtag-bits x8664::fixnum-shift)) (% len ))
-  (orq (% len) (% imm1))
-  (movq (% imm1) (@ (% imm0)))       ; store subtype & length
-  (lea (@ x8664::fulltag-misc (% imm0)) (% arg_z)) ; tag it, return it
-  (single-value-return))
-
-(defx86lapfunction %%make-disposable ((ptr arg_y) (vector arg_z))
-  (check-nargs 2)
-  (lea (@ (- x8664::fulltag-misc) (% vector)) (% imm0)) ; imm0 is addr = vect less tag
-  (movzwq (@ -2 (% imm0)) (% imm1))     ; get delta
-  (subq (% imm1) (% imm0))              ; vector addr (less tag)  - delta is orig addr
-  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
-  (single-value-return))
-
-
-(defx86lapfunction %vect-data-to-macptr ((vect arg_y) (ptr arg_z))
-  (lea (@ x8664::misc-data-offset (% vect)) (% imm0))
-  (movq (% imm0) (@ x8664::macptr.address (% ptr)))
-  (single-value-return))
-
-(defx86lapfunction get-saved-register-values ()
-  (movq (% rsp) (% temp0))
-  (push (% save0))
-  (push (% save1))
-  (push (% save2))
-  (push (% save3))
-  (set-nargs 4)
-  (jmp-subprim .SPvalues))
-
-
-(defx86lapfunction %current-db-link ()
-  (movq (@ (% :rcontext) x8664::tcr.db-link) (% arg_z))
-  (single-value-return))
-
-(defx86lapfunction %no-thread-local-binding-marker ()
-  (movq ($ x8664::subtag-no-thread-local-binding) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction break-event-pending-p ()
-  (xorq (% imm0) (% imm0))
-  (ref-global x8664::intflag imm1)
-  (set-global imm0 x8664::intflag)
-  (testq (% imm1) (% imm1))
-  (setne (%b imm0))
-  (andl ($ x8664::t-offset) (%l imm0))
-  (lea (@ x8664::nil-value (% imm0)) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction debug-trap-with-string ((arg arg_z))
-  (check-nargs 1)
-  (uuo-error-debug-trap-with-string)
-  (single-value-return))
-
-(defx86lapfunction %safe-get-ptr ((src arg_y) (dest arg_z))
-  (check-nargs 2)
-  (save-simple-frame)
-  (macptr-ptr src imm0)
-  (leaq (@ (:^ done) (% fn)) (% ra0))
-  (movq (% imm0) (@ (% :rcontext) x8664::tcr.safe-ref-address))
-  (movq (@ (% imm0)) (% imm0))
-  (jmp done)
-  (:tra done)
-  (recover-fn-from-rip)
-  (movq ($ 0) (@ (% :rcontext) x8664::tcr.safe-ref-address))
-  (movq (% imm0) (@ x8664::macptr.address (% dest)))
-  (restore-simple-frame)
-  (single-value-return))
-
-;;; This was intentded to work around a bug in #_nanosleep in early
-;;; Leopard test releases.  It's probably not necessary any more; is
-;;; it still called ?
-
-
-) ; #+x8664-target
-;;; end of x86-misc.lisp
Index: anches/ia32/level-0/X86/x86-numbers.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-numbers.lisp	(revision 8363)
+++ 	(revision )
@@ -1,193 +1,0 @@
-;-*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 1994-2001 Digitool, Inc
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-
-
-(defx86lapfunction %fixnum-signum ((number arg_z))
-  (movq ($ '-1) (% arg_x))
-  (movq ($ '1) (% arg_y))
-  (testq (% number) (% number))
-  (cmovsq (% arg_x) (% arg_z))
-  (cmovnsq (% arg_y) (% arg_z))
-  (single-value-return))
-
-;;; see %logcount.
-(defx86lapfunction %ilogcount ((number arg_z))
-  (let ((rshift imm0)
-        (temp imm1))
-    (unbox-fixnum number rshift)
-    (xorq (% arg_z) (% arg_z))
-    (testq (% rshift) (% rshift))
-    (jmp @test)
-    @next
-    (lea (@ -1 (% rshift)) (% temp))
-    (and (% temp) (% rshift))            ; sets flags
-    (lea (@ '1 (% arg_z)) (% arg_z))    ; doesn't set flags
-    @test
-    (jne @next)
-    (single-value-return)))
-
-(defx86lapfunction %iash ((number arg_y) (count arg_z))
-  (unbox-fixnum count imm1)
-  (unbox-fixnum number imm0)
-  (xorq (% rcx) (% rcx))                ;rcx = imm2
-  (testq (% count) (% count))
-  (jge @left)
-  (subb (% imm1.b) (% cl))
-  (sar (% cl) (% imm0))
-  (box-fixnum imm0 arg_z)
-  (single-value-return)
-  @left
-  (movb (% imm1.b) (% cl))
-  (shl (% cl) (% number))
-  (movq (% number) (% arg_z))
-  (single-value-return))
-
-(defparameter *double-float-zero* 0.0d0)
-(defparameter *short-float-zero* 0.0s0)
-
-
-(defx86lapfunction %fixnum-intlen ((number arg_z))
-  (unbox-fixnum arg_z imm0)
-  (movq (% imm0) (% imm1))
-  (notq (% imm1))
-  (testq (% imm0) (% imm0))
-  (cmovsq (% imm1) (% imm0))
-  (bsrq (% imm0) (% imm0))
-  (setne (% imm1.b))
-  (addb (% imm1.b) (% imm0.b))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-
-;;; Caller guarantees that result fits in a fixnum.
-
-(defx86lapfunction %truncate-double-float->fixnum ((arg arg_z))
-  (get-double-float arg fp1)
-  (cvttsd2si (% fp1) (% imm0))
-  (box-fixnum imm0 arg_z)  
-  (single-value-return))
-
-
-(defx86lapfunction %truncate-short-float->fixnum ((arg arg_z))
-  (get-single-float arg fp1)
-  (cvttss2si (% fp1) (% imm0))
-  (box-fixnum imm0 arg_z)  
-  (single-value-return))
-
-;;; DOES round to even
-
-(defx86lapfunction %round-nearest-double-float->fixnum ((arg arg_z))
-  (get-double-float arg fp1)
-  (cvtsd2si (% fp1) (% imm0))
-  (box-fixnum imm0 arg_z)  
-  (single-value-return))
-
-
-(defx86lapfunction %round-nearest-short-float->fixnum ((arg arg_z))
-  (get-single-float arg fp1)
-  (cvtss2si (% fp1) (% imm0))
-  (box-fixnum imm0 arg_z)  
-  (single-value-return))
-
-
-;;; We'll get a SIGFPE if divisor is 0.
-;;; Don't use %rbp.  Trust callback_for_interrupt() to preserve
-;;; the word below the stack pointer
-(defx86lapfunction %fixnum-truncate ((dividend arg_y) (divisor arg_z))
-  (unbox-fixnum divisor imm0)
-  (movq (% imm0) (@ -8 (% rsp)))
-  (unbox-fixnum dividend imm0)
-  (cqto)                                ; imm1 := sign_extend(imm0)
-  (idivq (@ -8 (% rsp)))
-  (movq (% rsp) (% temp0))
-  (box-fixnum imm1 arg_y)
-  (box-fixnum imm0 arg_z)
-  (pushq (% arg_z))
-  (pushq (% arg_y))
-  (set-nargs 2)
-  (jmp-subprim .SPvalues))
-
-(defx86lapfunction called-for-mv-p ()
-  (ref-global ret1valaddr imm0)
-  (movq (@ x8664::lisp-frame.return-address (% rbp)) (% imm1))
-  (cmpq (% imm0) (% imm1))
-  (movq ($ t) (% imm0))
-  (movq ($ nil) (% arg_z))
-  (cmoveq (% imm0) (% arg_z))
-  (single-value-return))
-
-
-;;; n1 and n2 must be positive (esp non zero)
-(defx86lapfunction %fixnum-gcd ((boxed-u arg_y) (boxed-v arg_z))
-  (let ((u imm0)
-        (v imm1)
-        (k imm2))
-    (xorl (% imm2.l) (% imm2.l))
-    (bsfq (% boxed-u) (% u))
-    (bsfq (% boxed-v) (% v))
-    (rcmp (% u) (% v))
-    (cmovlel (%l u) (%l k))
-    (cmovgl (%l v) (%l k))
-    (unbox-fixnum boxed-u u)
-    (unbox-fixnum boxed-v v)
-    (subb ($ x8664::fixnumshift) (%b k))
-    (jz @start)
-    (shrq (% cl) (% u))
-    (shrq (% cl) (% v))
-    @start
-    ;; At least one of u or v is odd at this point
-    @loop
-    ;; if u is even, shift it right one bit
-    (testb ($ 1) (%b u))
-    (jne @u-odd)
-    (shrq ($ 1) (% u))
-    (jmp @test)
-    @u-odd
-    ;; if v is even, shift it right one bit
-    (testb ($ 1) (%b v))
-    (jne @both-odd)
-    (shrq ($ 1) (% v))
-    (jmp @test-u)
-    @both-odd
-    (cmpq (% v) (% u))
-    (jb @v>u)
-    (subq (% v) (% u))
-    (shrq ($ 1) (% u))
-    (jmp @test)
-    @v>u
-    (subq (% u) (% v))
-    (shrq ($ 1) (% v))
-    @test-u
-    (testq (% u) (% u))
-    @test
-    (ja @loop)
-    (shlq (% cl) (% v))
-    (movb ($ 0) (% cl))
-    (box-fixnum v arg_z)
-    (single-value-return)))
-
-
-
-) ; #+x8664-target
-;;; End of x86-numbers.lisp
Index: anches/ia32/level-0/X86/x86-pred.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-pred.lisp	(revision 8363)
+++ 	(revision )
@@ -1,190 +1,0 @@
-;;;-*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 1994-2001 Digitool, Inc
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-(eval-when (:compile-toplevel :execute)
-  (require "X86-LAPMACROS"))
-
-
-(defx86lapfunction eql ((x arg_y) (y arg_z))
-  "Return T if OBJ1 and OBJ2 represent either the same object or
-numbers with the same type and value."
-  (check-nargs 2)
-  @top
-  @tail
-  (cmpq (% x) (% y))
-  (je @win)
-  (extract-fulltag x imm0)
-  (extract-fulltag y imm1)
-  (cmpb (% imm0.b) (% imm1.b))
-  (jnz @lose)
-  (cmpb ($ x8664::fulltag-misc) (% imm0.b))
-  (jnz @lose)
-  (getvheader x imm0)
-  (getvheader y imm1)
-  (cmpb ($ x8664::subtag-macptr) (% imm0.b))
-  (je @macptr)                          ; will need to check %imm1.b
-  (cmpq (% imm0) (% imm1))
-  (jne @lose)
-  (cmpb ($ x8664::subtag-bignum) (% imm0.b))
-  (je @bignum)
-  (cmpb ($ x8664::subtag-double-float) (% imm0.b))
-  (je @double-float)
-  (cmpb ($ x8664::subtag-complex) (% imm0.b))
-  (je @complex)
-  (cmpb ($ x8664::subtag-ratio) (% imm0.b))
-  (je @ratio)
-  @lose
-  (movq ($ nil) (% arg_z))
-  (single-value-return)
-  @macptr
-  (cmpb ($ x8664::subtag-macptr) (% imm1.b))
-  (jne @lose)
-  @double-float
-  (movq  (@ x8664::misc-data-offset (% x)) (% imm0))
-  (movq  (@ x8664::misc-data-offset (% y)) (% imm1))
-  @test
-  (cmpq (% imm0) (% imm1))
-  (movl ($ x8664::t-value) (%l imm0))
-  (lea (@ (- x8664::t-offset) (% imm0)) (% arg_z))
-  (cmovel (%l imm0) (%l arg_z))
-  (single-value-return)
-  @win
-  (movq ($ t) (% arg_z))
-  (single-value-return)
-  @ratio
-  @complex
-  (save-simple-frame)
-  (pushq (@ x8664::ratio.denom (% x)))  ; aka complex.imagpart
-  (pushq (@ x8664::ratio.denom (% y)))
-  (movq (@ x8664::ratio.numer (% x)) (% x))       ; aka complex.realpart
-  (movq (@ x8664::ratio.numer (% y)) (% y))       ; aka complex.realpart
-  (:talign 3)
-  (call @top)
-  (recover-fn-from-rip)
-  (cmp-reg-to-nil arg_z)
-  (pop (% y))
-  (pop (% x))
-  (restore-simple-frame)
-  (jnz @tail)
-  ;; lose, again
-  (movq ($ nil) (% arg_z))
-  (single-value-return)
-  @bignum
-  ;; Way back when, we got x's header into imm0.  We know that y's
-  ;; header is identical.  Use the element-count from imm0 to control
-  ;; the loop.  There's no such thing as a 0-element bignum, so the
-  ;; loop must always execute at least once.
-  (header-length imm0 temp0)
-  (xorq (% imm1) (% imm1))
-  @bignum-next
-  (movl (@ x8664::misc-data-offset (% x) (% imm1)) (% imm0.l))
-  (cmpl (@ x8664::misc-data-offset (% y) (% imm1)) (% imm0.l))
-  (jne @lose)
-  (addq ($ 4) (% imm1))
-  (sub ($ '1) (% temp0))
-  (jnz @bignum-next)
-  (movq ($ t) (% arg_z))
-  (single-value-return))
-  
-
-
-(defx86lapfunction equal ((x arg_y) (y arg_z))
-  "Return T if X and Y are EQL or if they are structured components
-  whose elements are EQUAL. Strings and bit-vectors are EQUAL if they
-  are the same length and have identical components. Other arrays must be
-  EQ to be EQUAL.  Pathnames are EQUAL if their components are."
-  (check-nargs 2)
-  @top
-  @tail
-  (cmpq (% x) (% y))
-  (je @win)
-  (extract-fulltag x imm0)
-  (extract-fulltag y imm1)
-  (cmpb (% imm0.b) (% imm1.b))
-  (jne @lose)
-  (cmpb ($ x8664::fulltag-cons) (% imm0.b))
-  (je @cons)
-  (cmpb ($ x8664::fulltag-misc) (% imm0.b))
-  (je @misc)
-  @lose
-  (movq ($ nil) (% arg_z))
-  (single-value-return)
-  @win
-  (movq ($ t) (% arg_z))
-  (single-value-return)
-  @cons
-  ;; Check to see if the CARs are EQ.  If so, we can avoid saving
-  ;; context, and can just tail call ourselves on the CDRs.
-  (%car x temp0)
-  (%car y temp1)
-  (cmpq (% temp0) (% temp1))
-  (jne @recurse)
-  (%cdr x x)
-  (%cdr y y)
-  (jmp @tail)
-  @recurse
-  (save-simple-frame)
-  (pushq (@ x8664::cons.cdr (% x)))
-  (pushq (@ x8664::cons.cdr (% y)))
-  (movq (% temp0) (% x))
-  (movq (% temp1) (% y))
-  (:talign 4)
-  (call @top)
-  (recover-fn-from-rip)
-  (cmp-reg-to-nil arg_z)
-  (pop (% y))
-  (pop (% x))
-  (restore-simple-frame)         
-  (jnz @top)
-  (movl ($ nil) (% arg_z.l))
-  (single-value-return)
-  @misc
-  ;; Both objects are uvectors of some sort.  Try EQL; if that fails,
-  ;; call HAIRY-EQUAL.
-  (save-simple-frame)
-  (pushq (% x))
-  (pushq (% y))
-  (call-symbol eql 2)
-  (cmp-reg-to-nil arg_z)
-  (jne @won-with-eql)
-  (popq (% y))
-  (popq (% x))
-  (restore-simple-frame)
-  (jump-symbol hairy-equal 2)
-  @won-with-eql
-  (restore-simple-frame)                ; discards pushed args
-  (movl ($ t) (% arg_z.l))
-  (single-value-return))
-
-(defx86lapfunction %lisp-lowbyte-ref ((thing arg_z))
-  (box-fixnum thing arg_z)
-  (andl ($ '#xff) (%l arg_z))
-  (single-value-return))
-
-
-      
-
-
-
-
-
-
-) ; #+x8664-target
Index: anches/ia32/level-0/X86/x86-symbol.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-symbol.lisp	(revision 8363)
+++ 	(revision )
@@ -1,148 +1,0 @@
-;;;-*- Mode: Lisp; Package: CCL -*-
-;;;
-;;;   Copyright (C) 1994-2001 Digitool, Inc
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-(eval-when (:compile-toplevel :execute)
-  (require "X8664-ARCH")
-  (require "X86-LAPMACROS"))
-
-;;; This assumes that macros & special-operators
-;;; have something that's not FUNCTIONP in their
-;;; function-cells.  It also assumes that NIL
-;;; isn't a true symbol, but that NILSYM is.
-(defx86lapfunction %function ((sym arg_z))
-  (check-nargs 1)
-  (let ((symaddr temp0))
-    (movq ($ (+ x8664::nil-value x8664::nilsym-offset)) (% symaddr))
-    (cmp-reg-to-nil sym)
-    (cmovneq (% sym) (% symaddr))
-    (trap-unless-fulltag= symaddr x8664::fulltag-symbol)
-    (movq (% sym) (% arg_y))
-    (movq (@ x8664::symbol.fcell (% symaddr)) (% arg_z))
-    (extract-fulltag arg_z imm0)
-    (cmpb ($ x8664::fulltag-function) (%b imm0))
-    (je.pt @ok)
-    (uuo-error-udf (% arg_y))
-    @ok
-    (single-value-return)))
-
-;;; Traps unless sym is NIL or some other symbol.  If NIL, return
-;;; nilsym
-(defx86lapfunction %symbol->symptr ((sym arg_z))
-  (let ((tag imm0 ))
-    (movq ($ (+ x8664::nil-value x8664::nilsym-offset)) (% tag))
-    (cmp-reg-to-nil sym)
-    (cmoveq (% sym) (% tag))
-    (je :done)
-    (trap-unless-fulltag= sym x8664::fulltag-symbol)
-    :done
-    (single-value-return)))
-
-;;; If symptr is NILSYM, return NIL; else typecheck and return symptr
-(defx86lapfunction %symptr->symbol ((symptr arg_z))
-  (movw ($ (ash 1 x8664::fulltag-symbol)) (% imm0.w))
-  (btw (%w symptr) (% imm0.w))
-  (jb.pt @ok)
-  (uuo-error-reg-not-tag (% symptr) ($ x8664::fulltag-symbol))
-  @ok
-  (cmpq ($ (+ x8664::nil-value x8664::nilsym-offset)) (% symptr))
-  (sete (% imm0.b))
-  (negb (% imm0.b))
-  (andl ($ x8664::nilsym-offset) (% imm0.l))
-  (subq (% imm0) (% symptr))
-  (single-value-return))
-
-
-;;; Given something whose fulltag is FULLTAG-SYMBOL, return the
-;;; underlying uvector.  This function and its inverse would
-;;; be good candidates for inlining.
-(defx86lapfunction %symptr->symvector ((symptr arg_z))
-  (subb ($ (- x8664::fulltag-symbol x8664::fulltag-misc)) (% arg_z.b))
-  (single-value-return))
-
-(defx86lapfunction %symvector->symptr ((symbol-vector arg_z))
-  (addb ($ (- x8664::fulltag-symbol x8664::fulltag-misc)) (% arg_z.b))
-  (single-value-return))
-    
-(defx86lapfunction %symptr-value ((symptr arg_z))
-  (jmp-subprim .SPspecref))
-
-(defx86lapfunction %set-symptr-value ((symptr arg_y) (val arg_z))
-  (jmp-subprim .SPspecset))
-
-;;; This gets a tagged symbol as an argument.
-;;; If there's no thread-local binding, it should return
-;;; the underlying symbol vector as a first return value.
-(defx86lapfunction %symptr-binding-address ((symptr arg_z))
-  (movq (@ x8664::symbol.binding-index (% symptr)) (% arg_y))
-  (rcmp (% arg_y) (@ (% :rcontext) x8664::tcr.tlb-limit))
-  (movq (@ (% :rcontext) x8664::tcr.tlb-pointer) (% arg_x))
-  (jae @sym)
-  (cmpb ($ x8664::no-thread-local-binding-marker) (@ (% arg_x) (% arg_y)))
-  (je @sym)
-  (shl ($ x8664::word-shift) (% arg_y))
-  (push (% arg_x))
-  (push (% arg_y))
-  (set-nargs 2)
-  (lea (@ '2 (% rsp)) (% temp0))
-  (jmp-subprim .SPvalues)
-  @sym
-  (subb ($ (- x8664::fulltag-symbol x8664::fulltag-misc)) (% arg_z.b))
-  (push (% arg_z))
-  (pushq ($ '#.x8664::symptr.vcell))
-  (set-nargs 2)
-  (lea (@ '2 (% rsp)) (% temp0))
-  (jmp-subprim .SPvalues))
-
-(defx86lapfunction %tcr-binding-location ((tcr arg_y) (sym arg_z))
-  (movq (@ x8664::symbol.binding-index (% sym)) (% arg_x))
-  (movl ($ nil) (% arg_z.l))
-  (rcmp (% arg_x) (@ x8664::tcr.tlb-limit (% tcr)))
-  (movq (@ x8664::tcr.tlb-pointer (% tcr)) (% arg_y))
-  (jae @done)
-  (lea (@ (% arg_y) (% arg_x)) (% arg_y))
-  ;; We're little-endian, so the tag is at the EA with no
-  ;; displacement
-  (cmpb ($ x8664::subtag-no-thread-local-binding) (@ (% arg_y)))
-  (cmovneq (% arg_y) (% arg_z))
-  @done
-  (single-value-return))
-
-  
-(defx86lapfunction %pname-hash ((str arg_y) (len arg_z))
-  (let ((accum imm0)
-        (offset imm1))
-    (xorq (% offset) (% offset))
-    (xorq (% accum) (% accum))
-    (cmpq ($ 0) (% len))
-    (jz.pn @done)
-    @loop8
-    (roll ($ 5) (%l accum))
-    (xorl (@ x8664::misc-data-offset (% str) (% offset) 4) (%l accum))
-    (addq ($ 1) (% offset))    
-    (subq ($ '1) (% len))
-    (jnz @loop8)
-    (shlq ($ 5) (% accum))
-    (shrq ($ (- 5 x8664::fixnumshift)) (% accum))
-    (movq (% accum) (% arg_z))
-    @done
-    (single-value-return)))
-
-) ; #+x8664-target
Index: anches/ia32/level-0/X86/x86-utils.lisp
===================================================================
--- /branches/ia32/level-0/X86/x86-utils.lisp	(revision 8363)
+++ 	(revision )
@@ -1,516 +1,0 @@
-; -*- Mode: Lisp; Package: CCL; -*-
-;;;
-;;;   Copyright (C) 1994-2001 Digitool, Inc
-;;;   This file is part of OpenMCL.  
-;;;
-;;;   OpenMCL is licensed under the terms of the Lisp Lesser GNU Public
-;;;   License , known as the LLGPL and distributed with OpenMCL as the
-;;;   file "LICENSE".  The LLGPL consists of a preamble and the LGPL,
-;;;   which is distributed with OpenMCL as the file "LGPL".  Where these
-;;;   conflict, the preamble takes precedence.  
-;;;
-;;;   OpenMCL is referenced in the preamble as the "LIBRARY."
-;;;
-;;;   The LLGPL is also available online at
-;;;   http://opensource.franz.com/preamble.html
-
-
-(in-package "CCL")
-
-#+x8664-target
-(progn
-
-(defx86lapfunction %address-of ((arg arg_z))
-  ;; %address-of a fixnum is a fixnum, just for spite.
-  ;; %address-of anything else is the address of that thing as an integer.
-  (testb ($ x8664::fixnummask) (%b arg))
-  (je @done)
-  (movq (% arg) (% imm0))
-  (jmp-subprim .SPmakeu64)
-  @done
-  (single-value-return))
-
-;;; "areas" are fixnum-tagged and, for the most part, so are their
-;;; contents.
-
-;;; The nilreg-relative global all-areas is a doubly-linked-list header
-;;; that describes nothing.  Its successor describes the current/active
-;;; dynamic heap.  Return a fixnum which "points to" that area, after
-;;; ensuring that the "active" pointers associated with the current thread's
-;;; stacks are correct.
-
-
-
-(defx86lapfunction %normalize-areas ()
-  (let ((address temp0)
-        (temp temp1))
-
-    ; update active pointer for tsp area.
-    (movq (@ (% :rcontext) x8664::tcr.ts-area) (% address))
-    (movq (@ (% :rcontext) x8664::tcr.save-tsp) (% temp))
-    (movq (% temp) (@ x8664::area.active (% address)))
-    
-    ;; Update active pointer for vsp area.
-    (movq (@ (% :rcontext) x8664::tcr.vs-area) (% address))
-    (movq (% rsp) (@ x8664::area.active (% address)))
-
-    (ref-global all-areas arg_z)
-    (movq (@ x8664::area.succ (% arg_z)) (% arg_z))
-
-    (single-value-return)))
-
-(defx86lapfunction %active-dynamic-area ()
-  (ref-global all-areas arg_z)
-  (movq (@ x8664::area.succ (% arg_z)) (% arg_z))
-  (single-value-return))
-
-  
-(defx86lapfunction %object-in-stack-area-p ((object arg_y) (area arg_z))
-  (movq (@ x8664::area.active (% area)) (% imm0))
-  (movq (@ x8664::area.high (% area)) (% imm1))
-  (rcmp (% object) (% imm0))
-  (movq ($ nil) (% arg_z))
-  (movq ($ t) (% imm0))
-  (jb @done)
-  (rcmp (% object) (% imm1))
-  (cmovbq (% imm0) (% arg_z))
-  @done
-  (single-value-return))
-
-(defx86lapfunction %object-in-heap-area-p ((object arg_y) (area arg_z))
-  (rcmp (% object) (@ x8664::area.low (% area)))
-  (setae (%b imm0))
-  (rcmp (% object) (@ x8664::area.low (% area)))
-  (setb (%b imm1))
-  (andb (% imm1.b) (% imm0.b))
-  (andl ($ x8664::t-offset) (%l imm0))
-  (lea (@ x8664::nil-value (% imm0)) (% arg_z))
-  (single-value-return))
-
-
-
-
-(defx86lapfunction walk-static-area ((a arg_y) (f arg_z))
-  (let ((fun save0)
-        (obj save1)
-        (limit save2)
-        (prev save3))
-    (save-simple-frame)
-    (push (% fun))
-    (push (% obj))
-    (push (% limit))
-    (push (% prev))
-    (xorl (%l prev) (%l prev))
-    (movq (% f) (% fun))
-    (movq (@ x8664::area.active (% a)) (% limit))
-    (movq (@ x8664::area.low (% a)) (% obj))
-    (jmp @test)
-    @loop
-    (movb (@ (% obj)) (% imm0.b))
-    (andb ($ x8664::fulltagmask) (% imm0.b))
-    (cmpb ($ x8664::fulltag-nodeheader-0) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-nodeheader-1) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-immheader-0) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-immheader-2) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-immheader-1) (% imm0.b))
-    (jne @cons)
-    @misc
-    (lea (@ x8664::fulltag-misc (% obj)) (% obj))
-    (movq (% obj) (% prev))
-    (movq (% obj) (% arg_z))
-    (set-nargs 1)
-    (:talign 4)
-    (call (% fun))
-    (recover-fn-from-rip)
-    (getvheader obj imm1)
-    (movb (% imm1.b) (% imm0.b))
-    (andb ($ x8664::fulltagmask) (% imm0.b))
-    (cmpb ($ x8664::fulltag-nodeheader-0) (% imm0.b))
-    (je @64)
-    (cmpb ($ x8664::fulltag-nodeheader-1) (% imm0.b))
-    (je @64)
-    (cmpb ($ x8664::ivector-class-64-bit) (% imm0.b))
-    (jne @not64)
-    @64
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (shlq ($ x8664::word-shift) (% imm1))
-    (jmp @uvector-next)
-    @not64
-    (cmpb ($ x8664::ivector-class-32-bit) (% imm0.b))
-    (jne @not32)
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (shlq ($ 2) (% imm1))
-    (jmp @uvector-next)
-    @not32
-    (cmpb ($ (- x8664::subtag-bit-vector 256)) (% imm1.b))
-    (jne @not-bit)
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (addq ($ 7) (% imm1))
-    (shrq ($ 3) (% imm1))
-    (jmp @uvector-next)
-    @not-bit
-    (rcmpb (% imm1.b) ($ (- x8664::min-8-bit-ivector-subtag 256)))
-    (jb @16)
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (jmp @uvector-next)
-    @16
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (shlq ($ 1) (% imm1))
-    (jmp @uvector-next)
-    @cons
-    (addq ($ x8664::fulltag-cons) (% obj))
-    (movq (% obj) (% prev))
-    (movq (% obj) (% arg_z))
-    (set-nargs 1)
-    (:talign 4)
-    (call (% fun))
-    (recover-fn-from-rip)
-    (addq ($ (- x8664::cons.size x8664::fulltag-cons)) (% obj))
-    (jmp @test)
-    ;; size of OBJ in bytes (without header or alignment padding)
-    ;; in imm1.
-    @uvector-next
-    (addq ($ (+ x8664::node-size (1- x8664::dnode-size))) (% imm1))
-    (andb ($ (lognot (1- x8664::dnode-size))) (% imm1.b))
-    (lea (@ (- x8664::fulltag-misc) (% obj) (% imm1)) (% obj))
-    @test
-    (cmpq (% limit) (% obj))
-    (jb @loop)
-    (pop (% prev))
-    (pop (% limit))
-    (pop (% obj))
-    (pop (% fun))
-    (movl ($ x8664::nil-value) (% arg_z.l))
-    (restore-simple-frame)
-    (single-value-return)))
-
-
-
-;;; This walks the active "dynamic" area.  Objects might be moving around
-;;; while we're doing this, so we have to be a lot more careful than we 
-;;; are when walking a static area.
-;;; There are a couple of approaches to termination:
-;;;  a) Allocate a "sentinel" cons, and terminate when we run into it.
-;;;  b) Check the area limit (which is changing if we're consing) and
-;;;     terminate when we hit it.
-;;; (b) loses if the function conses.  (a) conses.  I can't think of anything
-;;; better than (a).
-;;; This, of course, assumes that any GC we're doing does in-place compaction
-;;; (or at least preserves the relative order of objects in the heap.)
-
-(defx86lapfunction %walk-dynamic-area ((a arg_y) (f arg_z))
-  (let ((fun save0)
-        (obj save1)
-        (limit save2)
-        (prev save3))
-    (save-simple-frame)
-    (push (% fun))
-    (push (% obj))
-    (push (% limit))
-    (push (% prev))
-    (movq (% f) (% fun))
-    (xorl (%l prev) (%l prev))
-    (ref-global tenured-area a)
-    (movq (@ x8664::area.low (% a)) (% obj))
-    (subq ($ (- x8664::cons.size x8664::fulltag-cons))
-          (@ (% :rcontext) x8664::tcr.save-allocptr))
-    (movq (@ (% :rcontext) x8664::tcr.save-allocptr) (% allocptr))
-    (cmpq (@ (% :rcontext) x8664::tcr.save-allocbase) (% allocptr))
-    (jg @ok)
-    (uuo-alloc)
-    @ok
-    (andb ($ (lognot x8664::fulltagmask))
-          (@ (% :rcontext) x8664::tcr.save-allocptr))
-    (movq (% allocptr) (% limit))
-    (jmp @test)
-    @loop
-    (movb (@ (% obj)) (% imm0.b))
-    (andb ($ x8664::fulltagmask) (% imm0.b))
-    (cmpb ($ x8664::fulltag-nodeheader-0) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-nodeheader-1) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-immheader-0) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-immheader-2) (% imm0.b))
-    (je @misc)
-    (cmpb ($ x8664::fulltag-immheader-1) (% imm0.b))
-    (jne @cons)
-    @misc
-    (lea (@ x8664::fulltag-misc (% obj)) (% obj))
-    (movq (% obj) (% arg_z))
-    (movq (% obj) (% prev))
-    (set-nargs 1)
-    (:talign 4)
-    (call (% fun))
-    (recover-fn-from-rip)
-    (getvheader obj imm1)
-    (movb (% imm1.b) (% imm0.b))
-    (andb ($ x8664::fulltagmask) (% imm0.b))
-    (cmpb ($ x8664::fulltag-nodeheader-0) (% imm0.b))
-    (je @64)
-    (cmpb ($ x8664::fulltag-nodeheader-1) (% imm0.b))
-    (je @64)
-    (cmpb ($ x8664::ivector-class-64-bit) (% imm0.b))
-    (jne @not64)
-    @64
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (shlq ($ x8664::word-shift) (% imm1))
-    (jmp @uvector-next)
-    @not64
-    (cmpb ($ x8664::ivector-class-32-bit) (% imm0.b))
-    (jne @not32)
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (shlq ($ 2) (% imm1))
-    (jmp @uvector-next)
-    @not32
-    (cmpb ($ (- x8664::subtag-bit-vector 256)) (% imm1.b))
-    (jne @not-bit)
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (addq ($ 7) (% imm1))
-    (shrq ($ 3) (% imm1))
-    (jmp @uvector-next)
-    @not-bit
-    (rcmpb (% imm1.b) ($ (- x8664::min-8-bit-ivector-subtag 256)))
-    (jb @16)
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (jmp @uvector-next)
-    @16
-    (shrq ($ x8664::num-subtag-bits) (% imm1))
-    (shlq ($ 1) (% imm1))
-    (jmp @uvector-next)
-    @cons
-    (addq ($ x8664::fulltag-cons) (% obj))
-    (cmpq (% obj) (% limit))
-    (movq (% obj) (% arg_z))
-    (je @done)
-    (movq (% obj) (% prev))
-    (set-nargs 1)
-    (:talign 4)
-    (call (% fun))
-    (recover-fn-from-rip)
-    (addq ($ (- x8664::cons.size x8664::fulltag-cons)) (% obj))
-    (jmp @test)
-    ;; size of OBJ in bytes (without header or alignment padding)
-    ;; in imm1.
-    @uvector-next
-    (addq ($ (+ x8664::node-size (1- x8664::dnode-size))) (% imm1))
-    (andb ($ (lognot (1- x8664::dnode-size))) (% imm1.b))
-    (lea (@ (- x8664::fulltag-misc) (% obj) (% imm1)) (% obj))
-    @test
-    (cmpq (% limit) (% obj))
-    (jb @loop)
-    @done
-    (pop (% prev))
-    (pop (% limit))
-    (pop (% obj))
-    (pop (% fun))
-    (movl ($ x8664::nil-value) (% arg_z.l))
-    (restore-simple-frame)
-    (single-value-return)))
-
-(defun walk-dynamic-area (area func)
-  (with-other-threads-suspended
-      (%walk-dynamic-area area func)))
-
-
-
-(defx86lapfunction %class-of-instance ((i arg_z))
-  (svref i instance.class-wrapper arg_z)
-  (svref arg_z %wrapper-class arg_z)
-  (single-value-return))
-
-(defx86lapfunction class-of ((x arg_z))
-  (check-nargs 1)
-  (movw ($ (logior (ash 1 x8664::tag-list)
-                   (ash 1 x8664::tag-imm-1)))
-        (%w imm1))
-  (extract-lisptag x imm0)
-  (btw (% imm0.w) (% imm1.w))
-  (cmovbl (% arg_z.l) (% imm0.l))
-  (movq (@ '*class-table* (% fn)) (% temp1))
-  (cmpb ($ x8664::tag-misc) (% imm0.b))
-  (jne @have-tag)
-  (extract-subtag x imm0)
-  @have-tag
-  (movq (@ x8664::symbol.vcell (% temp1)) (% temp1))
-  (movzbl (% imm0.b) (% imm0.l))
-  (movq (@ x8664::misc-data-offset (% temp1) (% imm0) 8) (% temp0))
-  (cmpb ($ x8664::fulltag-nil) (%b temp0))
-  (je @bad)
-  (extract-fulltag temp0 imm0)
-  (cmpb ($ x8664::fulltag-function) (%b imm0))
-  (jne @ret)
-  (set-nargs 1)
-  (jmp (% temp0))
-  @bad
-  (load-constant no-class-error fname)
-  (set-nargs 1)
-  (jmp  (@ x8664::symbol.fcell (% fname)))
-  @ret
-  (movq (% temp0) (% arg_z))  ; return frob from table
-  (single-value-return))
-
-(defx86lapfunction full-gccount ()
-  (ref-global tenured-area arg_z)
-  (testq (% arg_z) (% arg_z))
-  (cmoveq (@ (+ x8664::nil-value (x8664::%kernel-global 'gc-count))) (% arg_z))
-  (cmovneq (@ x8664::area.gc-count (% arg_z)) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction gc ()
-  (check-nargs 0)
-  (movq ($ arch::gc-trap-function-gc) (% imm0))
-  (uuo-gc-trap)
-  (movq ($ nil) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction egc ((arg arg_z))
-  "Enable the EGC if arg is non-nil, disables the EGC otherwise. Return
-the previous enabled status. Although this function is thread-safe (in
-the sense that calls to it are serialized), it doesn't make a whole lot
-of sense to be turning the EGC on and off from multiple threads ..."
-  (check-nargs 1)
-  (clrq imm1)
-  (cmp-reg-to-nil arg)
-  (setne (% imm1.b))
-  (movq ($ arch::gc-trap-function-egc-control) (% imm0))
-  (uuo-gc-trap)
-  (single-value-return))
-
-
-
-
-(defx86lapfunction %configure-egc ((e0size arg_x)
-				   (e1size arg_y)
-				   (e2size arg_z))
-  (check-nargs 3)
-  (movq ($ arch::gc-trap-function-configure-egc) (% imm0))
-  (uuo-gc-trap)
-  (single-value-return))
-
-(defx86lapfunction purify ()
-  (check-nargs 0)
-  (movq ($ arch::gc-trap-function-purify) (% imm0))
-  (uuo-gc-trap)
-  (movq ($ nil) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction impurify ()
-  (check-nargs 0)
-  (movq ($ arch::gc-trap-function-impurify) (% imm0))
-  (uuo-gc-trap)
-  (movq ($ nil) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction lisp-heap-gc-threshold ()
-  "Return the value of the kernel variable that specifies the amount
-of free space to leave in the heap after full GC."
-  (check-nargs 0)
-  (movq ($ arch::gc-trap-function-get-lisp-heap-threshold) (% imm0))
-  (uuo-gc-trap)
-  #+x8632-target
-  (jmp-subprim .SPmakeu32)
-  #+x8664-target
-  (jmp-subprim .SPmakeu64))
-
-(defx86lapfunction set-lisp-heap-gc-threshold ((new arg_z))
-  "Set the value of the kernel variable that specifies the amount of free
-space to leave in the heap after full GC to new-value, which should be a
-non-negative fixnum. Returns the value of that kernel variable (which may
-be somewhat larger than what was specified)."
-  (check-nargs 1)
-  (save-simple-frame)
-  (call-subprim .SPgetu64)
-  (movq (% imm0) (% imm1))
-  (movq ($ arch::gc-trap-function-set-lisp-heap-threshold) (% imm0))
-  (uuo-gc-trap)
-  (restore-simple-frame)
-  (jmp-subprim .SPmakeu64))
-
-
-(defx86lapfunction use-lisp-heap-gc-threshold ()
-  "Try to grow or shrink lisp's heap space, so that the free space is (approximately) equal to the current heap threshold. Return NIL"
-  (check-nargs 0) 
-  (movq ($ arch::gc-trap-function-use-lisp-heap-threshold) (% imm0))
-  (uuo-gc-trap)
-  (movl ($ x8664::nil-value) (%l arg_z))
-  (single-value-return))
-
-
-
-;;; offset is a fixnum, one of the x8664::kernel-import-xxx constants.
-;;; Returns that kernel import, a fixnum.
-(defx86lapfunction %kernel-import ((offset arg_z))
-  (ref-global kernel-imports imm0)
-  (unbox-fixnum arg_z imm1)
-  (movq (@ (% imm0) (% imm1)) (% imm0))
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %get-unboxed-ptr ((macptr arg_z))
-  (macptr-ptr arg_z imm0)
-  (movq (@ (% imm0)) (% arg_z))
-  (single-value-return))
-
-
-(defx86lapfunction %revive-macptr ((p arg_z))
-  (movb ($ x8664::subtag-macptr) (@ x8664::misc-subtag-offset (% p)))
-  (single-value-return))
-
-(defx86lapfunction %macptr-type ((p arg_z))
-  (check-nargs 1)
-  (trap-unless-typecode= p x8664::subtag-macptr)
-  (svref p x8664::macptr.type-cell imm0)
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-  
-(defx86lapfunction %macptr-domain ((p arg_z))
-  (check-nargs 1)
-  (trap-unless-typecode= p x8664::subtag-macptr)
-  (svref p x8664::macptr.domain-cell imm0)
-  (box-fixnum imm0 arg_z)
-  (single-value-return))
-
-(defx86lapfunction %set-macptr-type ((p arg_y) (new arg_z))
-  (check-nargs 2)
-  (unbox-fixnum new imm1)
-  (trap-unless-typecode= p x8664::subtag-macptr)
-  (svset p x8664::macptr.type-cell imm1)
-  (single-value-return))
-
-(defx86lapfunction %set-macptr-domain ((p arg_y) (new arg_z))
-  (check-nargs 2)
-  (unbox-fixnum new imm1)
-  (trap-unless-typecode= p x8664::subtag-macptr)
-  (svset p x8664::macptr.domain-cell imm1)
-  (single-value-return))
-
-(defx86lapfunction true ()
-  (movzwl (% nargs) (%l nargs))
-  (subq ($ '3) (% nargs.q))
-  (leaq (@ '2 (% rsp) (% nargs.q)) (% imm0))
-  (cmovaq (% imm0) (% rsp))
-  (movl ($ x8664::t-value) (%l arg_z))
-  (single-value-return))
-
-(defx86lapfunction false ()
-  (movzwl (% nargs) (%l nargs))
-  (subq ($ '3) (% nargs.q))
-  (leaq (@ '2 (% rsp) (% nargs.q)) (% imm0))
-  (cmovaq (% imm0) (% rsp))
-  (movl ($ x8664::nil) (%l arg_z))
-  (single-value-return))
-
-
-
-) ; #+x8664-target
-;;; end