~ubuntu-branches/ubuntu/vivid/gcl/vivid

« back to all changes in this revision

Viewing changes to o/usig2.c

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2002-03-04 14:29:59 UTC
  • Revision ID: james.westby@ubuntu.com-20020304142959-dey14w08kr7lldu3
Tags: upstream-2.5.0.cvs20020219
ImportĀ upstreamĀ versionĀ 2.5.0.cvs20020219

Show diffs side-by-side

added added

removed removed

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