(This version can bootstrap itself without :SB-INTERPRETER.
However, it can't pass all the original regression
tests, and I even had to disable some code in
debug-int.lisp in order to get it to build, so more
work is needed before it becomes unflaky.)
I wasn't making much progress on figuring out why the system
can't cross-compile FIND-ESCAPED-FRAME when
bootstrapping itself without :SB-INTERPRETER, so I
I just stubbed out FIND-ESCAPED-FRAME.
deleted unused 'find . | xargs egrep tty-process-group' stuff
deleted unused SIGMASK macro
deleted unused UNIX-SIGBLOCK and UNIX-SIGPAUSE functions
moved F(sigsetmask) out of __*BSD__ conditionalization in
undefineds.h so that GENESIS could find it (I dunno
how it found it before. Perhaps old references
to sigblock or sigpause caused sigsetmask to be
slurped in too?)
"WS-YPIXEL" "W_OK" "X_OK" "SIGSYS" "TCSETPGRP" "FD-ZERO"
"SIGQUIT" "SIGCHLD" "SIGSEGV" "FD-CLR" "SIGUSR2"
"EALREADY" "SIGPIPE" "CHECK" "SIGXCPU" "EOPNOTSUPP"
- "SIGFPE" "SIGHUP" "ENOTSOCK" "SIGMASK" "EINTR"
+ "SIGFPE" "SIGHUP" "ENOTSOCK" "EINTR"
"SIGCONT" "UNIX-RESOLVE-LINKS" "SIGKILL" "EMSGSIZE" "ERANGE"
"EPROTOTYPE" "UNIX-SIGNAL-NUMBER" "EPFNOSUPPORT" "SIGILL"
- "EDOM" "UNIX-SIGPAUSE" "EDQUOT" "FD-SETSIZE" "SIGTSTP"
+ "EDOM" "EDQUOT" "FD-SETSIZE" "SIGTSTP"
"EAFNOSUPPORT" "TCGETPGRP" "EMFILE" "ECONNRESET"
"EADDRNOTAVAIL" "SIGALRM" "ENETDOWN" "EVICEOP"
"UNIX-FAST-GETRUSAGE" "EPERM" "SIGINT" "EXDEV" "EDEADLK"
"EUSERS" "SIGVTALRM" "ENOTCONN" "ESUCCESS" "EPIPE"
"UNIX-SIMPLIFY-PATHNAME" "EISCONN" "FD-ISSET"
"ESHUTDOWN" "EBUSY" "SIGTERM" "ENAMETOOLONG" "EMLINK"
- "EADDRINUSE" "SIGBUS" "ERESTART" "TTY-PROCESS-GROUP"
+ "EADDRINUSE" "SIGBUS" "ERESTART"
"UNIX-SIGNAL-NAME" "ETIMEDOUT" "ECHILD" "EFBIG" "SIGTRAP"
"UNIX-KILLPG" "ENOTBLK" "SIGIOT" "SIGUSR1" "ECONNABORTED"
"EHOSTUNREACH" "EBADF" "EINVAL" "FD-SET" "EISDIR"
"SIGTTIN" "UNIX-KILL" "EHOSTDOWN" "E2BIG" "ESPIPE"
"UNIX-FAST-SELECT" "ENXIO" "ENOTTY" "ELOOP" "LTCHARS"
"SIGXFSZ" "EINPROGRESS" "ENOENT"
- "EPROTONOSUPPORT" "UNIX-SIGBLOCK" "SIGIO" "ENOMEM" "SIGEMT"
+ "EPROTONOSUPPORT" "SIGIO" "ENOMEM" "SIGEMT"
"EFAULT" "ENODEV" "EIO" "EVICEERR" "ETXTBSY" "EWOULDBLOCK"
"EAGAIN" "EDESTADDRREQ" "ENOEXEC" "ENETUNREACH" "ENOTEMPTY"
"ENFILE"
#!+x86
(defun compute-calling-frame (caller ra up-frame)
(declare (type system-area-pointer caller ra))
-; (format t "ccf: ~A ~A ~A~%" caller ra up-frame)
(when (cstack-pointer-valid-p caller)
-; (format t "ccf2~%")
;; First check for an escaped frame.
(multiple-value-bind (code pc-offset escaped) (find-escaped-frame caller)
(cond (code
;; If it's escaped it may be a function end breakpoint trap.
-; (format t "ccf2: escaped ~S ~S~%" code pc-offset)
(when (and (code-component-p code)
(eq (%code-debug-info code) :bogus-lra))
;; If :bogus-lra grab the real lra.
(setq pc-offset (code-header-ref
code (1+ real-lra-slot)))
(setq code (code-header-ref code real-lra-slot))
-; (format t "ccf3 :bogus-lra ~S ~S~%" code pc-offset)
(aver code)))
(t
- ;; Not escaped
+ ;; not escaped
(multiple-value-setq (pc-offset code)
(compute-lra-data-from-pc ra))
-; (format t "ccf4 ~S ~S~%" code pc-offset)
(unless code
(setf code :foreign-function
pc-offset 0
#!+x86
(defun find-escaped-frame (frame-pointer)
(declare (type system-area-pointer frame-pointer))
+
+ ;; FIXME: These conditionals are a hack to get the system to
+ ;; bootstrap itself despite a byte interpreter/compiler bug. Without
+ ;; it, the byte interpreter blows up when trying to cross-compile
+ ;; this function, hitting #:UNINITIALIZED-EVAL-STACK-ELEMENT while
+ ;; executing (SB-XC:MACRO-FUNCTION 'SB!EXT:WITH-ALIEN).
+ #+sb-xc (values nil 0 nil) #-sb-xc ; REMOVEME
(dotimes (index *free-interrupt-context-index* (values nil 0 nil))
(sb!alien:with-alien
((lisp-interrupt-contexts (array (* os-context-t) nil)
#!+sb-doc
"Set the handler function for an object set operation.")
-;;; from unix.lisp
-(in-package "SB!UNIX")
-(defsetf tty-process-group (&optional fd) (pgrp)
- #!+sb-doc
- "Set the tty-process-group for the unix file-descriptor FD to PGRP. If not
- supplied, FD defaults to /dev/tty."
- `(%set-tty-process-group ,pgrp ,fd))
-
;;; from x86-vm.lisp
(in-package "SB!VM")
(defsetf context-register %set-context-register)
;;; Call FUNCTION on matches.
(defun %enumerate-matches (pathname verify-existence follow-links function)
- (/show0 "entering %ENUMERATE-MATCHES")
+ (/noshow0 "entering %ENUMERATE-MATCHES")
(when (pathname-type pathname)
(unless (pathname-name pathname)
(error "cannot supply a type without a name:~% ~S" pathname)))
(member (pathname-type pathname) '(nil :unspecific)))
(error "cannot supply a version without a type:~% ~S" pathname))
(let ((directory (pathname-directory pathname)))
- (/show0 "computed DIRECTORY")
+ (/noshow0 "computed DIRECTORY")
(if directory
(ecase (car directory)
(:absolute
- (/show0 "absolute directory")
+ (/noshow0 "absolute directory")
(%enumerate-directories "/" (cdr directory) pathname
verify-existence follow-links
nil function))
(:relative
- (/show0 "relative directory")
+ (/noshow0 "relative directory")
(%enumerate-directories "" (cdr directory) pathname
verify-existence follow-links
nil function)))
;;; Call FUNCTION on files.
(defun %enumerate-files (directory pathname verify-existence function)
(declare (simple-string directory))
- (/show0 "entering %ENUMERATE-FILES")
+ (/noshow0 "entering %ENUMERATE-FILES")
(let ((name (%pathname-name pathname))
(type (%pathname-type pathname))
(version (%pathname-version pathname)))
- (/show0 "computed NAME, TYPE, and VERSION")
+ (/noshow0 "computed NAME, TYPE, and VERSION")
(cond ((member name '(nil :unspecific))
- (/show0 "UNSPECIFIC, more or less")
+ (/noshow0 "UNSPECIFIC, more or less")
(when (or (not verify-existence)
(sb!unix:unix-file-kind directory))
(funcall function directory)))
(pattern-p type)
(eq name :wild)
(eq type :wild))
- (/show0 "WILD, more or less")
+ (/noshow0 "WILD, more or less")
;; I IGNORE-ERRORS here just because the original CMU CL
;; code did. I think the intent is that it's not an error
;; to request matches to a wild pattern when no matches
directory
complete-filename))))))
(t
- (/show0 "default case")
+ (/noshow0 "default case")
(let ((file (concatenate 'string directory name)))
- (/show0 "computed basic FILE=..")
+ (/noshow0 "computed basic FILE=..")
(/primitive-print file)
(unless (or (null type) (eq type :unspecific))
- (/show0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
+ (/noshow0 "tweaking FILE for more-or-less-:UNSPECIFIC case")
(setf file (concatenate 'string file "." type)))
(unless (member version '(nil :newest :wild))
- (/show0 "tweaking FILE for more-or-less-:WILD case")
+ (/noshow0 "tweaking FILE for more-or-less-:WILD case")
(setf file (concatenate 'string file "."
(quick-integer-to-string version))))
- (/show0 "finished possibly tweaking FILE=..")
+ (/noshow0 "finished possibly tweaking FILE=..")
(/primitive-print file)
(when (or (not verify-existence)
(sb!unix:unix-file-kind file t))
- (/show0 "calling FUNCTION on FILE")
+ (/noshow0 "calling FUNCTION on FILE")
(funcall function file)))))))
-(/show0 "filesys.lisp 603")
+(/noshow0 "filesys.lisp 603")
;;; FIXME: Why do we need this?
(defun quick-integer-to-string (n)
\f
(defun default-gc-notify-before (notify-stream bytes-in-use)
(declare (type stream notify-stream))
- (format notify-stream
- "~&; GC is beginning with ~:D bytes in use at internal runtime ~:D.~%"
- bytes-in-use
- (get-internal-run-time))
+ (format
+ notify-stream
+ "~&; GC is beginning with ~:D bytes in use at internal runtime ~:D.~%"
+ bytes-in-use
+ (get-internal-run-time))
(finish-output notify-stream))
(defparameter *gc-notify-before* #'default-gc-notify-before
#!+sb-doc
(finish-output notify-stream))
(defparameter *gc-notify-after* #'default-gc-notify-after
#!+sb-doc
- "The function bound to this variable is invoked after GC'ing with
-the value of *GC-NOTIFY-STREAM*, the amount of dynamic usage (in
-bytes) now free, the number of bytes freed by the GC, and the new GC
-trigger threshold. The function should notify the user that the system
-has finished GC'ing.")
+ "The function bound to this variable is invoked after GC'ing with the
+value of *GC-NOTIFY-STREAM*, the amount of dynamic usage (in bytes) now
+free, the number of bytes freed by the GC, and the new GC trigger
+threshold; or if *GC-NOTIFY-STREAM* is NIL, it's not invoked. The
+function should notify the user that the system has finished GC'ing.")
\f
;;;; internal GC
\f
;;;; SUB-GC
-;;; Used to carefully invoke hooks.
+;;; This is used to carefully invoke hooks.
(eval-when (:compile-toplevel :execute)
(sb!xc:defmacro carefully-funcall (function &rest args)
`(handler-case (funcall ,function ,@args)
#!+svr4
(!def-unix-signal :SIGWAITING 32) ; Process's LWPs are blocked.
-(sb!xc:defmacro sigmask (&rest signals)
- #!+sb-doc
- "Returns a mask given a set of signals."
- (apply #'logior
- (mapcar (lambda (signal)
- (ash 1 (1- (unix-signal-number signal))))
- signals)))
-
(/show0 "done with signal.lisp")
(pid sb!c-call:int)
(signal sb!c-call:int))
+;;; Send the signal SIGNAL to the process with process id PID. SIGNAL
+;;; should be a valid signal number or a keyword of the standard UNIX
+;;; signal name.
(defun unix-kill (pid signal)
- #!+sb-doc
- "Unix-kill sends the signal signal to the process with process
- id pid. Signal should be a valid signal number or a keyword of the
- standard UNIX signal name."
(real-unix-kill pid (unix-signal-number signal)))
#!-sb-fluid (declaim (inline real-unix-killpg))
(pgrp sb!c-call:int)
(signal sb!c-call:int))
+;;; Send the signal SIGNAL to the all the process in process group
+;;; PGRP. SIGNAL should be a valid signal number or a keyword of the
+;;; standard UNIX signal name.
(defun unix-killpg (pgrp signal)
- #!+sb-doc
- "Unix-killpg sends the signal signal to the all the process in process
- group PGRP. Signal should be a valid signal number or a keyword of
- the standard UNIX signal name."
(real-unix-killpg pgrp (unix-signal-number signal)))
-(sb!alien:def-alien-routine ("sigblock" unix-sigblock) sb!c-call:unsigned-long
- #!+sb-doc
- "Unix-sigblock cause the signals specified in mask to be
- added to the set of signals currently being blocked from
- delivery. The macro sigmask is provided to create masks."
- (mask sb!c-call:unsigned-long))
-
-(sb!alien:def-alien-routine ("sigpause" unix-sigpause) sb!c-call:void
- #!+sb-doc
- "Unix-sigpause sets the set of masked signals to its argument
- and then waits for a signal to arrive, restoring the previous
- mask upon its return."
- (mask sb!c-call:unsigned-long))
-
+;;; Set the current set of masked signals (those being blocked from
+;;; delivery).
+;;;
+;;; (Note: CMU CL had a SIGMASK operator to create masks, but since
+;;; SBCL only uses 0, we no longer support it. If you need it, you
+;;; can pull it out of the CMU CL sources, or the old SBCL sources;
+;;; but you might also consider doing things the SBCL way and moving
+;;; this kind of C-level work down to C wrapper functions.)
(sb!alien:def-alien-routine ("sigsetmask" unix-sigsetmask)
sb!c-call:unsigned-long
- #!+sb-doc
- "Unix-sigsetmask sets the current set of masked signals (those
- begin blocked from delivery) to the argument. The macro sigmask
- can be used to create the mask. The previous value of the signal
- mask is returned."
(mask sb!c-call:unsigned-long))
\f
;;;; C routines that actually do all the work of establishing signal handlers
(declare (type unix-pathname name))
(void-syscall ("unlink" c-string) name))
-;;; Set the tty-process-group for the unix file-descriptor FD to PGRP.
-;;; If not supplied, FD defaults to "/dev/tty".
-(defun %set-tty-process-group (pgrp &optional fd)
- (let ((old-sigs (unix-sigblock (sigmask :sigttou
- :sigttin
- :sigtstp
- :sigchld))))
- (declare (type (unsigned-byte 32) old-sigs))
- (unwind-protect
- (if fd
- (tcsetpgrp fd pgrp)
- (multiple-value-bind (tty-fd errno) (unix-open "/dev/tty" o_rdwr 0)
- (cond (tty-fd
- (multiple-value-prog1
- (tcsetpgrp tty-fd pgrp)
- (unix-close tty-fd)))
- (t
- (values nil errno)))))
- (unix-sigsetmask old-sigs))))
-
;;; Return the name of the host machine as a string.
(defun unix-gethostname ()
(with-alien ((buf (array char 256)))
LDSO_STUBIFY(send)
LDSO_STUBIFY(setitimer)
LDSO_STUBIFY(setpgrp)
- LDSO_STUBIFY(sigblock)
- LDSO_STUBIFY(sigpause)
LDSO_STUBIFY(sigsetmask)
LDSO_STUBIFY(sinh)
LDSO_STUBIFY(socket)
F(setsockopt)
F(settimeofday)
F(shutdown)
-#ifndef SVR4
-F(sigblock)
-#endif
-F(sigpause)
#if !defined(hpux) && !defined(SVR4) && !defined(__i386__)
F(sigreturn)
#endif
-#if !defined(SVR4) && !defined(__FreeBSD__) && !defined(__OpenBSD__)
F(sigsetmask)
+#if !defined(SVR4) && !defined(__FreeBSD__) && !defined(__OpenBSD__)
F(sigstack)
F(sigvec)
#endif
;;; four numeric fields, is used for versions which aren't released
;;; but correspond only to CVS tags or snapshots.
-"0.pre7.14.flaky4.3"
+"0.pre7.14.flaky4.6"
projects / sbcl.git / commitdiff