1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427
|
/*
Copyright (C) 1994 W. Schelter
This file is part of GNU Common Lisp, herein referred to as GCL
GCL is free software; you can redistribute it and/or modify it under
the terms of the GNU LIBRARY GENERAL PUBLIC LICENSE as published by
the Free Software Foundation; either version 2, or (at your option)
any later version.
GCL is distributed in the hope that it will be useful, but WITHOUT
ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public
License for more details.
You should have received a copy of the GNU Library General Public License
along with GCL; see the file COPYING. If not, write to the Free Software
Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
*/
#ifndef IN_UNIXINT
#define NEED_MP_H
#include <unistd.h>
#include <string.h>
#include <stdlib.h>
#include "include.h"
static void
invoke_handler(int,int);
#ifndef USIG2
#include <signal.h>
#include "usig.h"
/* #include "arith.h" */
#endif
#endif
#ifdef USIG2
#include USIG2
#else
/* these sstructure pointers would need their structures provided...
so we just call them void */
void * sfaslp;
#ifdef CMAC
EXTER
unsigned long s4_neg_int[4],small_neg_int[3],small_pos_int[3];
#endif
/*
We have two mechanisms for protecting against interrupts. 1] We have a
facility for delaying certain signals during critical regions of code.
This facility will involve BEGIN_NO_INTERRUPT and END_NO_INTERRUPT
*/
handler_function_type our_signal_handler[32];
struct save_for_interrupt{
object free1[32];
object free2[32];
object altfree1[32];
object altfree2[32];
union lispunion buf[32];
struct call_data fcall;
object *vs_top,vs_topVAL,*vs_base;
struct bds_bd *bds_top,bds_topVAL;
struct invocation_history *ihs_top,ihs_topVAL;
char *token_bufp;
char token_buf [4*INITIAL_TOKEN_LENGTH];
int token_st_dim;
/* for storing the XS objects in te usig2_aux.c */
void *save_objects[75];
};
/* note these are the reverse of the ones in unixint.c
... uggghhh*/
#undef SS1
#undef RS1
#define SS1(a,b) a = b ;
#define RS1(a,b) b = a ;
/* save objects in save_objects list */
char signals_handled [] = {SIGINT,SIGUSR2,SIGUSR1,SIGIO,SIGALRM,
#ifdef OTHER_SIGNALS_HANDLED
OTHER_SIGNALS_HANDLED
#endif
0};
/* * in_signal_handler: if not zero indicates we are running inside a signal
handler, which may have been invoked at a random intruction, and so
it is not safe to do a relocatable gc.
* signals_pending: if (signals_pending & signal_mask(signo)) then this
signo 's handler is waiting to be run.
* signals_allowed: indicates the state we think we were in when
checking to invoke a signal. Values:
sig_none: definitely dont run handler
sig_normal: In principle `ok', but if desiring maximum safety dont run here.
sig_safe: safe point to run a function (eg make_cons,...)
sig_at_read: interrupting the getc function in read. Should be safe.
unwind (used by throw,return etc) resets this to sig_normal just as it
does the longjmp.
If we invoke signal handling routines at a storage
allocation pt, it is completely safe: we should save
some of the globals, but the freelists etc dont need
to be saved. pass: sig_safe to raise_pending.
If we invoke it at end of a No interrupts
region, then it we must look at whether these were nested.
We should probably have two endings for END_NO_INTERRUPTS,
one for when we want to raise, and one for where we are sure
we are at safe place. pass sig_use_signals_allowed_value
If we invoke a handler when at
signals_allowed == sig_at_read, then we are safe.
*/
#define XX sig_safe
/* min safety level required for invoking a given signal handler */
char safety_required[]={XX,XX,XX,XX,XX,XX,XX,XX,
XX,XX,XX,XX,XX,XX,XX,XX,
XX,XX,XX,XX,XX,XX,XX,XX,
XX,XX,XX,XX,XX,XX,XX,XX};
void
gcl_init_safety(void)
{ safety_required[SIGINT]=sig_try_to_delay;
safety_required[SIGALRM]=sig_normal;
}
DO_INIT(gcl_init_safety();)
DEFUN_NEW("SIGNAL-SAFETY-REQUIRED",object,sSsignal_safety_required,SI,2,2,
NONE,OI,IO,OO,OO,(fixnum signo,fixnum safety),
"Set the safety level required for handling SIGNO to SAFETY, or if \
SAFETY is negative just return the current safety level for that \
signal number. Value of 1 means allow interrupt at any place not \
specifically marked in the code as bad, and value of 2 means allow it \
only in very SAFE places.")
{ if (signo > sizeof(safety_required))
{FEerror("Illegal signo:~a.",1,make_fixnum(signo));}
if (safety >=0) safety_required[signo] = safety;
return small_fixnum(safety_required[signo]) ;
}
void
#ifdef __MINGW32__
main_signal_handler(int signo)
#else
main_signal_handler(int signo, int a, int b)
#endif
{ int allowed = signals_allowed;
#ifdef NEED_TO_REINSTALL_SIGNALS
signal(signo,main_signal_handler);
#endif
if (allowed >= safety_required[signo])
{ signals_allowed = sig_none;
if (signo == SIGUSR1 ||
signo == SIGIO)
{ unblock_sigusr_sigio();}
invoke_handler(signo,allowed);
signals_allowed = allowed;
}
else {
signals_pending |= signal_mask(signo);
alarm(1);}
return;
}
static void before_interrupt(struct save_for_interrupt *p, int allowed);
static void after_interrupt(struct save_for_interrupt *p, int allowed);
/* caller saves and restores the global signals_allowed; */
static void
invoke_handler(int signo, int allowed)
{struct save_for_interrupt buf;
before_interrupt(&buf,allowed);
signals_pending &= ~(signal_mask(signo));
{int prev_in_handler = in_signal_handler;
in_signal_handler |= (allowed <= sig_normal ? 1 : 0);
signals_allowed = allowed;
our_signal_handler[signo](signo);
signals_allowed = 0;
in_signal_handler = prev_in_handler;
after_interrupt(&buf,allowed);
}}
int tok_leng;
static void
before_interrupt(struct save_for_interrupt *p, int allowed)
{int i;
/* all this must be run in no interrupts mode */
if ( allowed < sig_safe)
{ /* save tht tops of the free stacks */
for(i=0; i < t_end ; i++)
{ struct typemanager *ad = &tm_table[i];
{SS1(p->free1[i],ad->tm_free);
if (p->free1[i])
{ char *beg = (char *) (p->free1[i]);
object x = (object)beg;
int amt = ad->tm_size;
SS1(p->free2[i],OBJ_LINK(p->free1[i]));
ad->tm_nfree --;
bcopy(beg ,&(p->buf[i]), amt);
bzero(beg+sizeof(struct freelist),amt-sizeof(struct freelist));
x->d.m = 0;
if (p->free2[i])
{ x = (object) p->free2[i];
beg = (char *)x;
x->d.m = 0;
bzero(beg+sizeof(struct freelist),amt-sizeof(struct freelist));
SS1(ad->tm_free,OBJ_LINK(p->free2[i]));
ad->tm_nfree --;
}
else
{ SS1(ad->tm_free, OBJ_LINK(p->free1[i]));
}}
}}
}
SS1(p->fcall,fcall);
SS1(p->vs_top,vs_top);
SS1(p->vs_topVAL,*vs_top);
SS1(p->vs_base,vs_base);
SS1(p->bds_top,bds_top);
SS1(p->bds_topVAL,*bds_top);
SS1(p->ihs_top,ihs_top);
SS1(p->ihs_topVAL,*ihs_top);
{ void **pp = p->save_objects;
#undef XS
#undef XSI
#define XS(a) *pp++ = (void *) (a);
#define XSI(a) *pp++ = (void *)(long)(a);
/* #define XS(a) *pp++ = * (void **) (&a); */
#include "usig2_aux.c"
if ((pp - (&(p->save_objects)[0])) >= (sizeof(p->save_objects)/sizeof(void *)))
abort();
}
#define MINN(a,b) (a<b?a :b)
p->token_st_dim = MINN(token->st.st_dim,tok_leng+1);
if (p->token_st_dim < sizeof(p->token_buf))
p->token_bufp = p->token_buf;
else { p->token_bufp= (void *)OUR_ALLOCA(p->token_st_dim);}
bcopy(token->st.st_self,p->token_bufp,p->token_st_dim);
}
static void
after_interrupt(struct save_for_interrupt *p, int allowed)
{int i;
/* all this must be run in no interrupts mode */
if ( allowed < sig_safe)
{
for(i=0; i < t_end ; i++)
{ struct typemanager *ad = &tm_table[i];
object current_fl = ad->tm_free;
{RS1(p->free1[i],ad->tm_free);
if (p->free1[i])
{ char *beg = (char *) (p->free1[i]);
object x = (object)beg;
int amt = ad->tm_size;
RS1(p->free2[i],(p->free1[i]));
if (x->d.m) error("should not be free");
bcopy(&(p->buf[i]),beg, amt);
if (p->free2[i])
{ x = (object) p->free2[i];
if (x->d.m) error("should not be free");
x->d.m = FREE;
F_LINK(F_LINK(ad->tm_free)) = (long )current_fl;
ad->tm_nfree += 2;
}
else
ad->tm_nfree =1;
}
else ad->tm_nfree =0;
}}
}
RS1(p->fcall,fcall);
RS1(p->vs_top,vs_top);
RS1(p->vs_topVAL,*vs_top);
RS1(p->vs_base,vs_base);
RS1(p->bds_top,bds_top);
RS1(p->bds_topVAL,*bds_top);
RS1(p->ihs_top,ihs_top);
RS1(p->ihs_topVAL,*ihs_top);
{ void **pp = p->save_objects;
#undef XS
#undef XSI
/* #define XS(a) a = (void *)(*pp++)
We store back in the location 'a' the value we have saved.
*/
/* #define XS(a) do { void **_p = (void **)(&a); *_p = (void *)(*pp++);}while(0) */
#define XS(a) a = (void *)(*pp++)
#define XSI(a) {union {void *v;long l;}u; u.v=*pp++; a = u.l;}
#include "usig2_aux.c"
}
bcopy(p->token_bufp,token->st.st_self,p->token_st_dim);
}
/* claim the following version of make_cons can be interrupted at any line
and is suitable for inlining.
*/
/* static object */
/* MakeCons(object a, object b) */
/* { struct typemanager*ad = &tm_table[t_cons]; */
/* object new = (object) ad->tm_free; */
/* if (new == 0) */
/* { new = alloc_object(t_cons); */
/* new->c.c_car = a; */
/* goto END; */
/* } */
/* new->c.c_car=a; */
/* interrupt here and before_interrupt will copy new->c into the
C stack, so that a will be protected */
/* new->c.t=t_cons; */
/* new->c.m= 0; */
/* Make interrupt copy new out to the stack and then zero new.
That way new is certainly gc valid, and its contents are protected.
So the above three operations can occur in any order.
*/
/* { object tem = OBJ_LINK(new); */
/*
interrupt here and we see that before_interrupt must save the top of the
free list AND the second thing on the Free list. That way we will be ok
here and an interrupt here could not affect tem. It is possible that tem
== 0, yet a gc happened in between. An interrupt here when tem = 0 would
mean the free list needs to be collected again by second gc.
*/
/* ad->tm_free = tem; */
/* } */
/* Whew: we got it safely off so interrupts can't hurt us now. */
/* ad->tm_nfree --; */
/* interrupt here and the cdr field will point to a f_link which is
a 'free' and so gc valid. b is still protected since
it is in the stack or a regiseter, and a is protected since it is
in new, and new is not free
*/
/* END: */
/* new->c.c_cdr=b; */
/* return new; */
/* } */
/* COND is the condition where this is raised.
Might be sig_safe (eg at cons). */
void
raise_pending_signals(int cond)
{unsigned int allowed = signals_allowed ;
if (cond == sig_use_signals_allowed_value)
if (cond == sig_none || interrupt_enable ==0) return ;
AGAIN:
{ unsigned int pending = signals_pending;
char *p = signals_handled;
if (pending)
while(*p)
{ if (signal_mask(*p) & pending
&& cond >= safety_required[(unsigned char)*p])
{
signals_pending &= ~(signal_mask(*p));
if (*p == SIGALRM && cond >= sig_safe)
{ alarm(0);}
else
invoke_handler(*p,cond);
goto AGAIN;
}
p++;
}
signals_allowed = allowed;
return;
}}
DEFUN_NEW("ALLOW-SIGNAL",object,fSallow_signal,SI,1,1,NONE,OI,OO,OO,OO,(fixnum n),
"Install the default signal handler on signal N")
{
signals_allowed |= signal_mask(n);
unblock_signals(n,n);
/* sys v ?? just restore the signal ?? */
if (our_signal_handler[n])
{gcl_signal(n,our_signal_handler[n]);
return make_fixnum(1);
}
else
return make_fixnum(0);
}
#endif
|