Linkage tables on win32
... heuristically choose a memory range ("does not break on my two
systems, let's ship it")
... added some leftovers to cleanup.sh
... also #!+sb-doc-conditionalize docstrings in run-program.lisp
# The system doc sources are mostly texinfo, plus various odds
# and ends like docstrings embedded in .lisp sources; any HTML is
# automatically-generated output.
# The system doc sources are mostly texinfo, plus various odds
# and ends like docstrings embedded in .lisp sources; any HTML is
# automatically-generated output.
# made by "make depend" (or "gmake depend" or some such thing)
# *.lisp-obj, *.fasl, *.x86f, *.axpf, *.lbytef, *.lib
# typical extensions for fasl files (not just from SBCL, but
# made by "make depend" (or "gmake depend" or some such thing)
# *.lisp-obj, *.fasl, *.x86f, *.axpf, *.lbytef, *.lib
# typical extensions for fasl files (not just from SBCL, but
-name '?*.axpf' -o \
-name '?*.lbytef' -o \
-name '?*.fasl' -o \
-name '?*.axpf' -o \
-name '?*.lbytef' -o \
-name '?*.fasl' -o \
-name 'core' -o \
-name '?*.core' -o \
-name '*.map' -o \
-name 'core' -o \
-name '?*.core' -o \
-name '*.map' -o \
-name '*.lisp-temp' -o \
-name '*.o' -o \
-name '*.so' -o \
-name '*.lisp-temp' -o \
-name '*.o' -o \
-name '*.so' -o \
-name 'a.out' -o \
-name 'sbcl' -o \
-name 'sbcl.h' -o \
-name 'a.out' -o \
-name 'sbcl' -o \
-name 'sbcl.h' -o \
if [ "$sbcl_arch" = "x86" ]; then
printf ' :gencgc :stack-grows-downward-not-upward :c-stack-is-control-stack' >> $ltf
printf ' :stack-allocatable-closures :alien-callbacks' >> $ltf
if [ "$sbcl_arch" = "x86" ]; then
printf ' :gencgc :stack-grows-downward-not-upward :c-stack-is-control-stack' >> $ltf
printf ' :stack-allocatable-closures :alien-callbacks' >> $ltf
- if [ "$sbcl_os" = "linux" ] || [ "$sbcl_os" = "freebsd" ] || [ "$sbcl_os" = "netbsd" ] || [ "$sbcl_os" = "sunos" ] || [ "$sbcl_os" = "darwin" ]; then
+ if [ "$sbcl_os" = "linux" ] || [ "$sbcl_os" = "freebsd" ] || [ "$sbcl_os" = "netbsd" ] || [ "$sbcl_os" = "sunos" ] || [ "$sbcl_os" = "darwin" ] || [ "$sbcl_os" = "win32" ]; then
printf ' :linkage-table' >> $ltf
fi
if [ "$sbcl_os" = "win32" ]; then
printf ' :linkage-table' >> $ltf
fi
if [ "$sbcl_os" = "win32" ]; then
(rusage sb-alien:int))
(defun wait3 (&optional do-not-hang check-for-stopped)
(rusage sb-alien:int))
(defun wait3 (&optional do-not-hang check-for-stopped)
"Return any available status information on child process. "
(multiple-value-bind (pid status)
(c-wait3 (logior (if do-not-hang
"Return any available status information on child process. "
(multiple-value-bind (pid status)
(c-wait3 (logior (if do-not-hang
;;;; process control stuff
(defvar *active-processes* nil
;;;; process control stuff
(defvar *active-processes* nil
"List of process structures for all active processes.")
(defvar *active-processes-lock*
"List of process structures for all active processes.")
(defvar *active-processes-lock*
(process-status process)))
process)
(process-status process)))
process)
(setf (documentation 'process-p 'function)
"T if OBJECT is a PROCESS, NIL otherwise.")
(setf (documentation 'process-p 'function)
"T if OBJECT is a PROCESS, NIL otherwise.")
(setf (documentation 'process-pid 'function) "The pid of the child process.")
(defun process-status (process)
(setf (documentation 'process-pid 'function) "The pid of the child process.")
(defun process-status (process)
"Return the current status of PROCESS. The result is one of :RUNNING,
:STOPPED, :EXITED, or :SIGNALED."
(get-processes-status-changes)
(process-%status process))
"Return the current status of PROCESS. The result is one of :RUNNING,
:STOPPED, :EXITED, or :SIGNALED."
(get-processes-status-changes)
(process-%status process))
(setf (documentation 'process-exit-code 'function)
"The exit code or the signal of a stopped process.")
(setf (documentation 'process-exit-code 'function)
"The exit code or the signal of a stopped process.")
(setf (documentation 'process-core-dumped 'function)
"T if a core image was dumped by the process.")
(setf (documentation 'process-core-dumped 'function)
"T if a core image was dumped by the process.")
(setf (documentation 'process-pty 'function)
"The pty stream of the process or NIL.")
(setf (documentation 'process-pty 'function)
"The pty stream of the process or NIL.")
(setf (documentation 'process-input 'function)
"The input stream of the process or NIL.")
(setf (documentation 'process-input 'function)
"The input stream of the process or NIL.")
(setf (documentation 'process-output 'function)
"The output stream of the process or NIL.")
(setf (documentation 'process-output 'function)
"The output stream of the process or NIL.")
(setf (documentation 'process-error 'function)
"The error stream of the process or NIL.")
(setf (documentation 'process-error 'function)
"The error stream of the process or NIL.")
(setf (documentation 'process-status-hook 'function)
"A function that is called when PROCESS changes its status.
The function is called with PROCESS as its only argument.")
(setf (documentation 'process-status-hook 'function)
"A function that is called when PROCESS changes its status.
The function is called with PROCESS as its only argument.")
(setf (documentation 'process-plist 'function)
"A place for clients to stash things.")
(defun process-wait (process &optional check-for-stopped)
(setf (documentation 'process-plist 'function)
"A place for clients to stash things.")
(defun process-wait (process &optional check-for-stopped)
"Wait for PROCESS to quit running for some reason.
When CHECK-FOR-STOPPED is T, also returns when PROCESS is
stopped. Returns PROCESS."
"Wait for PROCESS to quit running for some reason.
When CHECK-FOR-STOPPED is T, also returns when PROCESS is
stopped. Returns PROCESS."
(process-pid proc))
(defun process-kill (process signal &optional (whom :pid))
(process-pid proc))
(defun process-kill (process signal &optional (whom :pid))
"Hand SIGNAL to PROCESS. If WHOM is :PID, use the kill Unix system call. If
WHOM is :PROCESS-GROUP, use the killpg Unix system call. If WHOM is
:PTY-PROCESS-GROUP deliver the signal to whichever process group is
"Hand SIGNAL to PROCESS. If WHOM is :PID, use the kill Unix system call. If
WHOM is :PROCESS-GROUP, use the killpg Unix system call. If WHOM is
:PTY-PROCESS-GROUP deliver the signal to whichever process group is
t)))))
(defun process-alive-p (process)
t)))))
(defun process-alive-p (process)
"Return T if PROCESS is still alive, NIL otherwise."
(let ((status (process-status process)))
(if (or (eq status :running)
"Return T if PROCESS is still alive, NIL otherwise."
(let ((status (process-status process)))
(if (or (eq status :running)
nil)))
(defun process-close (process)
nil)))
(defun process-close (process)
"Close all streams connected to PROCESS and stop maintaining the status slot."
(macrolet ((frob (stream abort)
`(when ,stream (close ,stream :abort ,abort))))
"Close all streams connected to PROCESS and stop maintaining the status slot."
(macrolet ((frob (stream abort)
`(when ,stream (close ,stream :abort ,abort))))
(defun find-executable-in-search-path (pathname
&optional
(search-path (posix-getenv "PATH")))
(defun find-executable-in-search-path (pathname
&optional
(search-path (posix-getenv "PATH")))
- "Find the first executable file matching PATHNAME in any of the colon-separated list of pathnames SEARCH-PATH"
+ #!+sb-doc
+ "Find the first executable file matching PATHNAME in any of the
+colon-separated list of pathnames SEARCH-PATH"
(loop for end = (position #\: search-path :start (if end (1+ end) 0))
and start = 0 then (and end (1+ end))
while start
(loop for end = (position #\: search-path :start (if end (1+ end) 0))
and start = 0 then (and end (1+ end))
while start
(error :output)
(if-error-exists :error)
status-hook)
(error :output)
(if-error-exists :error)
status-hook)
"RUN-PROGRAM creates a new Unix process running the Unix program found in
the file specified by the PROGRAM argument. ARGS are the standard
arguments that can be passed to a Unix program. For no arguments, use NIL
"RUN-PROGRAM creates a new Unix process running the Unix program found in
the file specified by the PROGRAM argument. ARGS are the standard
arguments that can be passed to a Unix program. For no arguments, use NIL
(def!constant static-space-end #x07fff000)
(def!constant dynamic-space-start #x09000000)
(def!constant static-space-end #x07fff000)
(def!constant dynamic-space-start #x09000000)
- (def!constant dynamic-space-end #x29000000))
+ (def!constant dynamic-space-end #x29000000)
+
+ (def!constant linkage-table-space-start #x30000000)
+ (def!constant linkage-table-space-end #x40000000))
return sigtrap_emulator(context, exception_frame);
} else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
return sigtrap_emulator(context, exception_frame);
} else if (exception_record->ExceptionCode == EXCEPTION_ACCESS_VIOLATION &&
- is_valid_lisp_addr(fault_address)) {
+ (is_valid_lisp_addr(fault_address) ||
+ /* the linkage table does not contain valid lisp
+ * objects, but is also committed on-demand here
+ */
+ in_range_p(fault_address, LINKAGE_TABLE_SPACE_START,
+ LINKAGE_TABLE_SPACE_END))) {
/* Pick off GC-related memory fault next. */
MEMORY_BASIC_INFORMATION mem_info;
/* Pick off GC-related memory fault next. */
MEMORY_BASIC_INFORMATION mem_info;
;;; 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".)
;;; 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".)