(define-alien-type nil
(struct fd-set
- (fds-bits (array fd-mask #.(/ fd-setsize 32)))))
+ (fds-bits (array fd-mask #.(/ fd-setsize
+ sb!vm:n-machine-word-bits)))))
(/show0 "unix.lisp 304")
\f
`(if (fixnump ,num)
(progn
(setf (deref (slot ,fdset 'fds-bits) 0) ,num)
- ,@(loop for index upfrom 1 below (/ fd-setsize 32)
+ ,@(loop for index upfrom 1 below (/ fd-setsize
+ sb!vm:n-machine-word-bits)
collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0)))
(progn
- ,@(loop for index upfrom 0 below (/ fd-setsize 32)
+ ,@(loop for index upfrom 0 below (/ fd-setsize
+ sb!vm:n-machine-word-bits)
collect `(setf (deref (slot ,fdset 'fds-bits) ,index)
- (ldb (byte 32 ,(* index 32)) ,num))))))
+ (ldb (byte sb!vm:n-machine-word-bits
+ ,(* index sb!vm:n-machine-word-bits))
+ ,num))))))
(defmacro fd-set-to-num (nfds fdset)
- `(if (<= ,nfds 32)
+ `(if (<= ,nfds sb!vm:n-machine-word-bits)
(deref (slot ,fdset 'fds-bits) 0)
- (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32)
+ (+ ,@(loop for index upfrom 0 below (/ fd-setsize
+ sb!vm:n-machine-word-bits)
collect `(ash (deref (slot ,fdset 'fds-bits) ,index)
- ,(* index 32))))))
+ ,(* index sb!vm:n-machine-word-bits))))))
;;; Examine the sets of descriptors passed as arguments to see whether
;;; they are ready for reading and writing. See the UNIX Programmer's
(defmacro fd-set (offset fd-set)
(let ((word (gensym))
(bit (gensym)))
- `(multiple-value-bind (,word ,bit) (floor ,offset 32)
+ `(multiple-value-bind (,word ,bit) (floor ,offset
+ sb!vm:n-machine-word-bits)
(setf (deref (slot ,fd-set 'fds-bits) ,word)
- (logior (truly-the (unsigned-byte 32) (ash 1 ,bit))
+ (logior (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits)
+ (ash 1 ,bit))
(deref (slot ,fd-set 'fds-bits) ,word))))))
;;; not checked for linux...
(defmacro fd-clr (offset fd-set)
(let ((word (gensym))
(bit (gensym)))
- `(multiple-value-bind (,word ,bit) (floor ,offset 32)
+ `(multiple-value-bind (,word ,bit) (floor ,offset
+ sb!vm:n-machine-word-bits)
(setf (deref (slot ,fd-set 'fds-bits) ,word)
(logand (deref (slot ,fd-set 'fds-bits) ,word)
- ;; FIXME: This may not be quite right for 64-bit
- ;; ports of SBCL. --njf, 2004-08-04
(sb!kernel:word-logical-not
- (truly-the (unsigned-byte 32) (ash 1 ,bit))))))))
+ (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits)
+ (ash 1 ,bit))))))))
;;; not checked for linux...
(defmacro fd-isset (offset fd-set)
(let ((word (gensym))
(bit (gensym)))
- `(multiple-value-bind (,word ,bit) (floor ,offset 32)
+ `(multiple-value-bind (,word ,bit) (floor ,offset
+ sb!vm:n-machine-word-bits)
(logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word)))))
;;; not checked for linux...
(defmacro fd-zero (fd-set)
`(progn
- ,@(loop for index upfrom 0 below (/ fd-setsize 32)
+ ,@(loop for index upfrom 0 below (/ fd-setsize sb!vm:n-machine-word-bits)
collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0))))
(mask ,(1- (ash 1 bits)))
(shift (* extra ,bits)))
(unless (= value mask)
- (inst mov mask-tn (lognot (ash mask shift)))
+ (inst mov mask-tn (ldb (byte 64 0)
+ (lognot (ash mask shift))))
(inst and old mask-tn))
(unless (zerop value)
(inst mov mask-tn (ash value shift))
*(sp-2)=*os_context_register_addr(context,reg_EBP);
*(sp-1)=*os_context_pc_addr(context);
+#elif defined(LISP_FEATURE_X86_64)
+ u64 *sp=(u64 *)*os_context_register_addr(context,reg_RSP);
+ *(sp-19) = post_signal_tramp; /* return address for call_into_lisp */
+
+ *(sp-18)=*os_context_register_addr(context,reg_R15);
+ *(sp-17)=*os_context_register_addr(context,reg_R14);
+ *(sp-16)=*os_context_register_addr(context,reg_R13);
+ *(sp-15)=*os_context_register_addr(context,reg_R12);
+ *(sp-14)=*os_context_register_addr(context,reg_R11);
+ *(sp-13)=*os_context_register_addr(context,reg_R10);
+ *(sp-12)=*os_context_register_addr(context,reg_R9);
+ *(sp-11)=*os_context_register_addr(context,reg_R8);
+ *(sp-10)=*os_context_register_addr(context,reg_RDI);
+ *(sp-9)=*os_context_register_addr(context,reg_RSI);
+ *(sp-8)=*os_context_register_addr(context,reg_RSP)-16;
+ *(sp-7)=0;
+ *(sp-6)=*os_context_register_addr(context,reg_RBX);
+ *(sp-5)=*os_context_register_addr(context,reg_RDX);
+ *(sp-4)=*os_context_register_addr(context,reg_RCX);
+ *(sp-3)=*os_context_register_addr(context,reg_RAX);
+ *(sp-2)=*os_context_register_addr(context,reg_RBP);
+ *(sp-1)=*os_context_pc_addr(context);
+
+ *os_context_register_addr(context,reg_RDI) = function; /* function */
+ *os_context_register_addr(context,reg_RSI) = 0; /* arg. array */
+ *os_context_register_addr(context,reg_RDX) = 0; /* no. args */
#else
struct thread *th=arch_os_get_current_thread();
build_fake_control_stack_frames(th,context);
*os_context_register_addr(context,reg_ESP) = sp-14;
#endif
#elif defined(LISP_FEATURE_X86_64)
- lose("deferred gubbins still needs to be written");
+ *os_context_pc_addr(context) = call_into_lisp;
+ *os_context_register_addr(context,reg_RCX) = 0;
+ *os_context_register_addr(context,reg_RBP) = sp-2;
+ *os_context_register_addr(context,reg_RSP) = sp-19;
#else
/* this much of the calling convention is common to all
non-x86 ports */
ret
.size GNAME(do_pending_interrupt),.-GNAME(do_pending_interrupt)
\f
-#ifdef LISP_FEATURE_GENCGC
-/* This is a fast bzero using the FPU. The first argument is the start
- * address which needs to be aligned on an 8 byte boundary, the second
- * argument is the number of bytes, which must be a nonzero multiple
- * of 8 bytes. */
-/* FIXME whether this is still faster than using the OS's bzero or
- * equivalent, we don't know */
- .text
- .globl GNAME(i586_bzero)
- .type GNAME(i586_bzero),@function
+ .globl GNAME(post_signal_tramp)
+ .type GNAME(post_signal_tramp),@function
.align align_4byte,0x90
-GNAME(i586_bzero):
- mov 4(%rsp),%rdx # Load the start address.
- mov 8(%rsp),%rax # Load the number of bytes.
- fldz
-l1: fstl 0(%rdx)
- add $8,%rdx
- sub $8,%rax
- jnz l1
- fstp %st(0)
+GNAME(post_signal_tramp):
+ /* this is notionally the second half of a function whose first half
+ * doesn't exist. This is where call_into_lisp returns when called
+ * using return_to_lisp_function */
+ addq $24,%rsp /* clear call_into_lisp args from stack */
+ popq %r15
+ popq %r14
+ popq %r13
+ popq %r12
+ popq %r11
+ popq %r10
+ popq %r9
+ popq %r8
+ popq %rdi
+ popq %rsi
+ popq %rbp
+ popq %rsp
+ popq %rdx
+ popq %rbx
+ popq %rcx
+ popq %rax
+ leave
ret
- .size GNAME(i586_bzero),.-GNAME(i586_bzero)
-#endif
+ .size GNAME(post_signal_tramp),.-GNAME(post_signal_tramp)
\f
-
-
.end
## Make a little shared object files to test with.
build_so() {
- echo building $1.so
- cc -c $1.c -o $1.o
+ echo building $1.so
+ if [ $(uname -p) = x86_64 ]; then
+ CFLAGS="$CFLAGS -fPIC"
+ fi
+ cc -c $1.c -o $1.o $CFLAGS
ld -shared -o $1.so $1.o
}
;;; checkins which aren't released. (And occasionally for internal
;;; versions, especially for internal versions off the main CVS
;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.8.18.35"
+"0.8.18.36"
projects / sbcl.git / commitdiff