Skip to content
GitLab
Explore
Sign in
Register
Primary navigation
Search or go to…
Project
cmucl
Manage
Activity
Members
Labels
Plan
Issues
Issue boards
Milestones
Wiki
Code
Merge requests
Repository
Branches
Commits
Tags
Repository graph
Compare revisions
Snippets
Build
Pipelines
Jobs
Pipeline schedules
Artifacts
Deploy
Releases
Package registry
Model registry
Operate
Environments
Terraform modules
Monitor
Incidents
Service Desk
Analyze
Value stream analytics
Contributor analytics
CI/CD analytics
Repository analytics
Model experiments
Help
Help
Support
GitLab documentation
Compare GitLab plans
Community forum
Contribute to GitLab
Provide feedback
Terms and privacy
Keyboard shortcuts
?
Snippets
Groups
Projects
Show more breadcrumbs
Carl Shapiro
cmucl
Commits
574bb1d2
Commit
574bb1d2
authored
34 years ago
by
wlott
Browse files
Options
Downloads
Patches
Plain Diff
Moved the signal related stuff from syscall to here.
parent
6c872bc4
No related branches found
Branches containing commit
No related tags found
Tags containing commit
No related merge requests found
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
code/signal.lisp
+202
-20
202 additions, 20 deletions
code/signal.lisp
with
202 additions
and
20 deletions
code/signal.lisp
+
202
−
20
View file @
574bb1d2
;;; -*- Log: code.log; Package:
KERNEL
-*-
;;; -*- Log: code.log; Package:
MACH
-*-
;;;
;;; **********************************************************************
;;; This code was written as part of the Spice Lisp project at
...
...
@@ -7,17 +7,177 @@
;;; Scott Fahlman (FAHLMAN@CMUC).
;;; **********************************************************************
;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.
3
1990/07/
02 04:37:3
4 wlott Exp $
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/signal.lisp,v 1.
4
1990/07/
23 18:54:1
4 wlott Exp $
;;;
;;; Code for handling UNIX signals.
;;;
;;; Written by William Lott.
;;;
(
in-package
"
KERNEL
"
)
(
in-package
"
MACH
"
)
(
export
'
(
signal-init
))
(
export
'
(
unix-signal-name
unix-signal-description
unix-signal-number
sigcontext
sigmask
unix-sigblock
unix-sigpause
unix-sigsetmask
unix-kill
unix-getpid
))
(
export
'kernel::signal-init
(
find-package
"KERNEL"
))
;;; These should probably be somewhere, but I don't know where.
;;;
(
defconstant
sig_dfl
0
)
(
defconstant
sig_ign
1
)
;;;; Utilities for dealing with signal names and numbers.
(
defstruct
(
unix-signal
(
:constructor
make-unix-signal
(
%name
%number
%description
)))
%name
; Signal keyword
(
%number
:type
integer
)
; UNIX signal number
(
%description
:type
string
))
; Documentation
(
defvar
*unix-signals*
nil
"A list of unix signal structures."
)
(
eval-when
(
compile
eval
)
(
defmacro
def-unix-signal
(
name
number
description
)
(
let
((
mach-symbol
(
intern
(
symbol-name
name
))))
`
(
progn
(
push
(
make-unix-signal
,
name
,
number
,
description
)
*unix-signals*
)
;;
;; This is to make the new signal lookup stuff compatible with
;; old code which expects the symbol with the same print name as
;; our keywords to be a constant with a value equal to the signal
;; number.
(
defconstant
,
mach-symbol
,
number
,
description
)
(
export
',mach-symbol
))))
)
;eval-when
(
defun
unix-signal-or-lose
(
arg
)
(
let
((
signal
(
find
arg
*unix-signals*
:key
(
etypecase
arg
(
symbol
#'
unix-signal-%name
)
(
number
#'
unix-signal-%number
)))))
(
unless
signal
(
error
"~S is not a valid signal name or number."
arg
))
signal
))
(
defun
unix-signal-name
(
signal
)
"Return the name of the signal as a string. Signal should be a valid
signal number or a keyword of the standard UNIX signal name."
(
symbol-name
(
unix-signal-%name
(
unix-signal-or-lose
signal
))))
(
defun
unix-signal-description
(
signal
)
"Return a string describing signal. Signal should be a valid signal
number or a keyword of the standard UNIX signal name."
(
unix-signal-%description
(
unix-signal-or-lose
signal
)))
(
defun
unix-signal-number
(
signal
)
"Return the number of the given signal. Signal should be a valid
signal number or a keyword of the standard UNIX signal name."
(
unix-signal-%number
(
unix-signal-or-lose
signal
)))
;;; Known signals
;;;
(
def-unix-signal
:CHECK
0
"Check"
)
(
def-unix-signal
:SIGHUP
1
"Hangup"
)
(
def-unix-signal
:SIGINT
2
"Interrupt"
)
(
def-unix-signal
:SIGQUIT
3
"Quit"
)
(
def-unix-signal
:SIGILL
4
"Illegal instruction"
)
(
def-unix-signal
:SIGTRAP
5
"Trace trap"
)
(
def-unix-signal
:SIGIOT
6
"Iot instruction"
)
(
def-unix-signal
:SIGEMT
7
"Emt instruction"
)
(
def-unix-signal
:SIGFPE
8
"Floating point exception"
)
(
def-unix-signal
:SIGKILL
9
"Kill"
)
(
def-unix-signal
:SIGBUS
10
"Bus error"
)
(
def-unix-signal
:SIGSEGV
11
"Segmentation violation"
)
(
def-unix-signal
:SIGSYS
12
"Bad argument to system call"
)
(
def-unix-signal
:SIGPIPE
13
"Write on a pipe with no one to read it"
)
(
def-unix-signal
:SIGALRM
14
"Alarm clock"
)
(
def-unix-signal
:SIGTERM
15
"Software termination signal"
)
(
def-unix-signal
:SIGURG
16
"Urgent condition present on socket"
)
(
def-unix-signal
:SIGSTOP
17
"Stop"
)
(
def-unix-signal
:SIGTSTP
18
"Stop signal generated from keyboard"
)
(
def-unix-signal
:SIGCONT
19
"Continue after stop"
)
(
def-unix-signal
:SIGCHLD
20
"Child status has changed"
)
(
def-unix-signal
:SIGTTIN
21
"Background read attempted from control terminal"
)
(
def-unix-signal
:SIGTTOU
22
"Background write attempted to control terminal"
)
(
def-unix-signal
:SIGIO
23
"I/O is possible on a descriptor"
)
(
def-unix-signal
:SIGXCPU
24
"Cpu time limit exceeded"
)
(
def-unix-signal
:SIGXFSZ
25
"File size limit exceeded"
)
(
def-unix-signal
:SIGVTALRM
26
"Virtual time alarm"
)
(
def-unix-signal
:SIGPROF
27
"Profiling timer alarm"
)
(
def-unix-signal
:SIGWINCH
28
"Window size change"
)
(
def-unix-signal
:SIGUSR1
30
"User defined signal 1"
)
(
def-unix-signal
:SIGUSR2
31
"User defined signal 2"
)
;;;
;;; These are Mach Specific
(
def-unix-signal
:SIGEMSG
30
"Mach Emergency message"
)
(
def-unix-signal
:SIGMSG
31
"Mach message"
)
;;; SIGMASK -- Public
;;;
(
defmacro
sigmask
(
&rest
signals
)
"Returns a mask given a set of signals."
(
apply
#'
logior
(
mapcar
#'
(
lambda
(
signal
)
(
ash
1
(
1-
(
unix-signal-number
signal
))))
signals
)))
;;;; System calls that deal with signals.
(
proclaim
'
(
inline
real-unix-kill
))
(
def-c-routine
(
"kill"
real-unix-kill
)
(
int
)
(
pid
int
)
(
signal
int
))
(
defun
unix-kill
(
pid
signal
)
"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
)))
(
proclaim
'
(
inline
real-unix-killpg
))
(
def-c-routine
(
"killpg"
real-unix-killpg
)
(
int
)
(
pgrp
int
)
(
signal
int
))
(
defun
unix-killpg
(
pgrp
signal
)
"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
)))
(
def-c-routine
(
"sigblock"
unix-sigblock
)
(
unsigned-long
)
"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
unsigned-long
))
(
def-c-routine
(
"sigpause"
unix-sigpause
)
(
void
)
"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
unsigned-long
))
(
def-c-routine
(
"sigsetmask"
unix-sigsetmask
)
(
unsigned-long
)
"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
unsigned-long
))
;;;; C routines that actually do all the work of establishing signal handlers.
(
def-c-routine
(
"install_handler"
install-handler
)
(
int
)
...
...
@@ -25,6 +185,29 @@
(
handler
unsigned-long
))
;;;; Interface to enabling and disabling signal handlers.
(
defun
enable-interrupt
(
signal
handler
)
(
without-gcing
(
install-handler
(
unix-signal-number
signal
)
(
di::get-lisp-obj-address
handler
))))
(
defun
default-interrupt
(
signal
)
(
declare
(
ignore
signal
))
(
warn
"Can't default interrupts yet."
))
(
defun
ignore-interrupt
(
signal
)
(
declare
(
ignore
signal
))
(
warn
"Can't ignore interrupts yet."
))
;;;; Default LISP signal handlers.
;;; Most of these just call ERROR to report the presence of the signal.
(
defmacro
define-signal-handler
(
name
what
&optional
(
function
'error
))
`
(
defun
,
name
(
signal
code
scp
)
(
declare
(
ignore
signal
code
))
...
...
@@ -35,7 +218,8 @@
mach:sigcontext
t
))
(
,
function
,
(
concatenate
'simple-string
what
" at #x~x."
)
(
alien-access
(
mach:sigcontext-pc
(
alien-value
sc
)))))))
(
sap-int
(
alien-access
(
mach:sigcontext-pc
(
alien-value
sc
))))))))
(
define-signal-handler
sigint-handler
"Interrupted"
break
)
(
define-signal-handler
sigill-handler
"Illegal Instruction"
)
...
...
@@ -54,19 +238,17 @@
(
defun
signal-init
()
(
macrolet
((
frob
(
signal
handler
)
`
(
install-handler
,
(
mach:unix-signal-number
signal
)
(
di::get-lisp-obj-address
,
handler
))))
#+
nil
(
frob
:sigint
#'
sigint-handler
)
(
frob
:sigquit
#'
sigquit-handler
)
(
frob
:sigill
#'
sigill-handler
)
(
frob
:sigtrap
#'
internal-error
)
(
frob
:sigiot
#'
sigiot-handler
)
(
frob
:sigemt
#'
sigemt-handler
)
#+
nil
(
frob
:sigfpe
#'
sigfpe-handler
)
(
frob
:sigbus
#'
sigbus-handler
)
(
frob
:sigsegv
#'
sigsegv-handler
)
(
frob
:sigsys
#'
sigsys-handler
)
(
frob
:sigpipe
#'
sigpipe-handler
)
(
frob
:sigalrm
#'
sigalrm-handler
))
"Enable all the default signals that Lisp knows how to deal with."
#+
nil
(
enable-interrupt
:sigint
#'
sigint-handler
)
(
enable-interrupt
:sigquit
#'
sigquit-handler
)
(
enable-interrupt
:sigill
#'
sigill-handler
)
(
enable-interrupt
:sigtrap
#'
kernel::internal-error
)
(
enable-interrupt
:sigiot
#'
sigiot-handler
)
(
enable-interrupt
:sigemt
#'
sigemt-handler
)
#+
nil
(
enable-interrupt
:sigfpe
#'
sigfpe-handler
)
(
enable-interrupt
:sigbus
#'
sigbus-handler
)
(
enable-interrupt
:sigsegv
#'
sigsegv-handler
)
(
enable-interrupt
:sigsys
#'
sigsys-handler
)
(
enable-interrupt
:sigpipe
#'
sigpipe-handler
)
(
enable-interrupt
:sigalrm
#'
sigalrm-handler
)
nil
)
This diff is collapsed.
Click to expand it.
Preview
0%
Loading
Try again
or
attach a new file
.
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Save comment
Cancel
Please
register
or
sign in
to comment