Handle run-program with :directory nil.

[sbcl.git] / src / code / cross-modular.lisp

diff --git a/src/code/cross-modular.lisp b/src/code/cross-modular.lisp
index b89d151..3f8d1d1 100644 (file)
--- a/src/code/cross-modular.lisp
+++ b/src/code/cross-modular.lisp
@@ -22,42 +22,36 @@
 
 #.
 (collect ((forms))
-  (flet ((definition (name lambda-list prototype width)
+  (flet ((unsigned-definition (name lambda-list prototype width)
            `(defun ,name ,lambda-list
-              (ldb (byte ,width 0) (,prototype ,@lambda-list)))))
-    (loop for infos being each hash-value of (modular-class-funs *unsigned-modular-class*) using (hash-key prototype)
-          when (listp infos)
-          do (loop for info in infos
-                   for name = (modular-fun-info-name info)
-                   and width = (modular-fun-info-width info)
-                   and lambda-list = (modular-fun-info-lambda-list info)
-                   do (forms (definition name lambda-list prototype width)))))
-  `(progn ,@(forms)))
-
-#.
-(collect ((forms))
-  (flet ((definition (name lambda-list prototype width)
+              (ldb (byte ,width 0) (,prototype ,@lambda-list))))
+         (signed-definition (name lambda-list prototype width)
            `(defun ,name ,lambda-list
               (mask-signed-field ,width (,prototype ,@lambda-list)))))
-    (loop for infos being each hash-value of (modular-class-funs *signed-modular-class*) using (hash-key prototype)
-          when (listp infos)
-          do (loop for info in infos
-                   for name = (modular-fun-info-name info)
-                   and width = (modular-fun-info-width info)
-                   and lambda-list = (modular-fun-info-lambda-list info)
-                   do (forms (definition name lambda-list prototype width)))))
+    (flet ((do-mfuns (class)
+             (loop for infos being each hash-value of (modular-class-funs class) using (hash-key prototype)
+                   when (listp infos)
+                   do (loop for info in infos
+                            for name = (modular-fun-info-name info)
+                            and width = (modular-fun-info-width info)
+                            and signedp = (modular-fun-info-signedp info)
+                            and lambda-list = (modular-fun-info-lambda-list info)
+                            if signedp
+                            do (forms (signed-definition name lambda-list prototype width))
+                            else
+                            do (forms (unsigned-definition name lambda-list prototype width))))))
+      (do-mfuns *untagged-unsigned-modular-class*)
+      (do-mfuns *untagged-signed-modular-class*)
+      (do-mfuns *tagged-modular-class*)))
   `(progn ,@(forms)))
 
-#!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 32) '(and) '(or))
-(defun sb!vm::ash-left-mod32 (integer amount)
-  (ldb (byte 32 0) (ash integer amount)))
-#!+#.(cl:if (cl:= sb!vm:n-machine-word-bits 64) '(and) '(or))
-(defun sb!vm::ash-left-mod64 (integer amount)
-  (ldb (byte 64 0) (ash integer amount)))
-#!+x86
-(defun sb!vm::ash-left-smod30 (integer amount)
-  (mask-signed-field 30 (ash integer amount)))
-#!+x86-64
-(defun sb!vm::ash-left-smod61 (integer amount)
-  (mask-signed-field 61 (ash integer amount)))
+#.`
+(defun ,(intern (format nil "ASH-LEFT-MOD~D" sb!vm:n-machine-word-bits)
+                "SB!VM")
+    (integer amount)
+  (ldb (byte ,sb!vm:n-machine-word-bits 0) (ash integer amount)))
 
+#!+(or x86 x86-64)
+(defun sb!vm::ash-left-modfx (integer amount)
+  (mask-signed-field (- sb!vm:n-word-bits sb!vm:n-fixnum-tag-bits)
+                     (ash integer amount)))