1 /* Part of SWI-Prolog
2
3 Author: Jan Wielemaker
4 E-mail: J.Wielemaker@vu.nl
5 WWW: http://www.swi-prolog.org
6 Copyright (c) 1985-2020, University of Amsterdam
7 VU University Amsterdam
8 CWI, Amsterdam
9 All rights reserved.
10
11 Redistribution and use in source and binary forms, with or without
12 modification, are permitted provided that the following conditions
13 are met:
14
15 1. Redistributions of source code must retain the above copyright
16 notice, this list of conditions and the following disclaimer.
17
18 2. Redistributions in binary form must reproduce the above copyright
19 notice, this list of conditions and the following disclaimer in
20 the documentation and/or other materials provided with the
21 distribution.
22
23 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
24 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
25 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
26 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
27 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
28 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
29 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
30 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
31 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
32 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
33 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 POSSIBILITY OF SUCH DAMAGE.
35 */
36
37 /*#define O_DEBUG 1*/
38
39 #define GLOBAL SO_LOCAL /* allocate global variables here */
40 #include "pl-incl.h"
41 #include "pl-comp.h"
42 #include "pl-arith.h"
43 #include "os/pl-cstack.h"
44 #include "pl-dbref.h"
45 #include "pl-trie.h"
46 #include "pl-tabling.h"
47 #include <sys/stat.h>
48 #ifdef HAVE_UNISTD_H
49 #include <unistd.h>
50 #endif
51 #include <errno.h>
52
53 #undef max
54 #define max(a,b) ((a) > (b) ? (a) : (b))
55
56 #undef K
57 #undef MB
58 #define K * 1024
59 #define MB * (1024L * 1024L)
60
61 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
62 This module initialises the system and defines the global variables. It
63 also holds the code for dynamically expanding stacks based on MMU
64 access. Finally it holds the code to handle signals transparently for
65 foreign language code or packages with which Prolog was linked together.
66 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
67
68 static int allocStacks(void);
69 static void initSignals(void);
70 static void gcPolicy(Stack s, int policy);
71
72 int
setupProlog(void)73 setupProlog(void)
74 { GET_LD
75 DEBUG(1, Sdprintf("Starting Heap Initialisation\n"));
76
77 #ifdef O_LOGICAL_UPDATE
78 next_global_generation();
79 #endif
80
81 LD->critical = 0;
82 LD->magic = LD_MAGIC;
83 LD->signal.pending[0] = 0;
84 LD->signal.pending[1] = 0;
85 LD->statistics.start_time = WallTime();
86
87 startCritical;
88 DEBUG(1, Sdprintf("wam_table ...\n"));
89 initWamTable();
90 DEBUG(1, Sdprintf("character types ...\n"));
91 initCharTypes();
92 DEBUG(1, Sdprintf("foreign predicates ...\n"));
93 initForeign();
94 DEBUG(1, Sdprintf("Prolog Signal Handling ...\n"));
95 initSignals();
96 DEBUG(1, Sdprintf("Stacks ...\n"));
97 if ( !initPrologStacks(GD->options.stackLimit) )
98 outOfCore();
99 GD->combined_stack.name = "stack";
100 GD->combined_stack.gc = TRUE;
101 GD->combined_stack.overflow_id = STACK_OVERFLOW;
102
103 initPrologLocalData(PASS_LD1);
104
105 DEBUG(1, Sdprintf("Atoms ...\n"));
106 initAtoms();
107 DEBUG(1, Sdprintf("Features ...\n"));
108 initPrologFlags();
109 DEBUG(1, Sdprintf("Functors ...\n"));
110 initFunctors();
111 DEBUG(1, Sdprintf("Modules ...\n"));
112 initModules();
113 /* initModules may be called before */
114 /* LD is present in the MT version */
115 LD->modules.typein = MODULE_user;
116 LD->modules.source = MODULE_user;
117 DEBUG(1, Sdprintf("Records ...\n"));
118 initDBRef();
119 initRecords();
120 DEBUG(1, Sdprintf("Tries ...\n"));
121 initTries();
122 DEBUG(1, Sdprintf("Tabling ...\n"));
123 initTabling();
124 DEBUG(1, Sdprintf("Flags ...\n"));
125 initFlags();
126 DEBUG(1, Sdprintf("Foreign Predicates ...\n"));
127 initBuildIns();
128 DEBUG(1, Sdprintf("TCMalloc binding ...\n"));
129 initTCMalloc();
130 DEBUG(1, Sdprintf("Operators ...\n"));
131 initOperators();
132 DEBUG(1, Sdprintf("GMP ...\n"));
133 initGMP();
134 DEBUG(1, Sdprintf("Arithmetic ...\n"));
135 initArith();
136 DEBUG(1, Sdprintf("Tracer ...\n"));
137 initTracer();
138 debugstatus.styleCheck = SINGLETON_CHECK;
139 DEBUG(1, Sdprintf("IO ...\n"));
140 initIO();
141 initCharConversion();
142 #ifdef O_LOCALE
143 initLocale();
144 #endif
145 setABIVersionPrologFlag();
146 GD->io_initialised = TRUE;
147 GD->clauses.cgc_space_factor = 8;
148 GD->clauses.cgc_stack_factor = 0.03;
149 GD->clauses.cgc_clause_factor = 1.0;
150
151 if ( !endCritical )
152 return FALSE;
153
154 DEBUG(1, Sdprintf("Heap Initialised\n"));
155 return TRUE;
156 }
157
158
159 void
initPrologLocalData(ARG1_LD)160 initPrologLocalData(ARG1_LD)
161 {
162 #ifdef O_LIMIT_DEPTH
163 depth_limit = DEPTH_NO_LIMIT;
164 #endif
165 #ifdef O_INFERENCE_LIMIT
166 LD->inference_limit.limit = INFERENCE_NO_LIMIT;
167 #endif
168
169 LD->break_level = -1;
170 LD->prolog_flag.write_attributes = PL_WRT_ATTVAR_IGNORE;
171
172 #ifdef O_PLMT
173 simpleMutexInit(&LD->thread.scan_lock);
174 #endif
175
176 updateAlerted(LD);
177 }
178
179
180
181 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
182 SIGNAL HANDLING
183
184 SWI-Prolog catches a number of signals:
185
186 - SIGINT is caught to allow the user to interrupt normal execution.
187 - SIGUSR2 is caught using an empty handler to break blocking system
188 calls and allow handling of Prolog signals from them.
189 - SIGTERM, SIGABRT and SIGQUIT are caught to cleanup before killing
190 the process again using the same signal.
191 - SIGSEGV, SIGILL, SIGBUS and SIGSYS are caught by
192 os/pl-cstack.c to print a backtrace and exit.
193 - SIGHUP is caught and causes the process to exit with status 2 after
194 cleanup.
195
196 If the system is started using --nosignals, only SIGUSR2 is modified.
197
198 Note that library(time) uses SIGUSR1.
199
200 Code in SWI-Prolog should call PL_signal() rather than signal() to
201 install signal handlers. SWI-Prolog assumes the handler function is a
202 void function. On some systems this gives some compiler warnings as
203 they define signal handlers to be int functions. This should be fixed
204 some day.
205 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
206
207 #define PLSIG_PREPARED 0x00010000 /* signal is prepared */
208
209 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
210 Define the signals and their properties. This could be nicer, but
211 different systems provide different signals, and above all, MS systems
212 provide very few.
213 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
214
215 static struct signame
216 { int sig;
217 const char *name;
218 int flags;
219 } signames[] =
220 {
221 #ifdef HAVE_SIGNAL
222 #ifdef SIGHUP
223 { SIGHUP, "hup", 0},
224 #endif
225 { SIGINT, "int", 0},
226 #ifdef SIGQUIT
227 { SIGQUIT, "quit", 0},
228 #endif
229 { SIGILL, "ill", 0},
230 { SIGABRT, "abrt", 0},
231 { SIGFPE, "fpe", PLSIG_THROW},
232 #ifdef SIGKILL
233 { SIGKILL, "kill", 0},
234 #endif
235 { SIGSEGV, "segv", 0},
236 #ifdef SIGPIPE
237 { SIGPIPE, "pipe", 0},
238 #endif
239 #ifdef SIGALRM
240 { SIGALRM, "alrm", PLSIG_THROW},
241 #endif
242 { SIGTERM, "term", 0},
243 #ifdef SIGUSR1
244 { SIGUSR1, "usr1", 0},
245 #endif
246 #ifdef SIGUSR2
247 { SIGUSR2, "usr2", 0},
248 #endif
249 #ifdef SIGCHLD
250 { SIGCHLD, "chld", 0},
251 #endif
252 #ifdef SIGCONT
253 { SIGCONT, "cont", 0},
254 #endif
255 #ifdef SIGSTOP
256 { SIGSTOP, "stop", 0},
257 #endif
258 #ifdef SIGTSTP
259 { SIGTSTP, "tstp", 0},
260 #endif
261 #ifdef SIGTTIN
262 { SIGTTIN, "ttin", 0},
263 #endif
264 #ifdef SIGTTOU
265 { SIGTTOU, "ttou", 0},
266 #endif
267 #ifdef SIGTRAP
268 { SIGTRAP, "trap", 0},
269 #endif
270 #ifdef SIGBUS
271 { SIGBUS, "bus", 0},
272 #endif
273 #ifdef SIGSTKFLT
274 { SIGSTKFLT, "stkflt", 0},
275 #endif
276 #ifdef SIGURG
277 { SIGURG, "urg", 0},
278 #endif
279 #ifdef SIGIO
280 { SIGIO, "io", 0},
281 #endif
282 #ifdef SIGPOLL
283 { SIGPOLL, "poll", 0},
284 #endif
285 #ifdef SIGXCPU
286 { SIGXCPU, "xcpu", PLSIG_THROW},
287 #endif
288 #ifdef SIGXFSZ
289 { SIGXFSZ, "xfsz", PLSIG_THROW},
290 #endif
291 #ifdef SIGVTALRM
292 { SIGVTALRM, "vtalrm", PLSIG_THROW},
293 #endif
294 #ifdef SIGPROF
295 { SIGPROF, "prof", 0},
296 #endif
297 #ifdef SIGPWR
298 { SIGPWR, "pwr", 0},
299 #endif
300 #endif /*HAVE_SIGNAL*/
301
302 /* The signals below here are recorded as Prolog interrupts, but
303 not supported by OS signals. They start at offset 32.
304 */
305
306 #ifdef SIG_ATOM_GC
307 { SIG_ATOM_GC, "prolog:atom_gc", 0 },
308 #endif
309 { SIG_GC, "prolog:gc", 0 },
310 #ifdef SIG_THREAD_SIGNAL
311 { SIG_THREAD_SIGNAL, "prolog:thread_signal", 0 },
312 #endif
313 { SIG_CLAUSE_GC, "prolog:clause_gc", 0 },
314 { SIG_PLABORT, "prolog:abort", 0 },
315
316 { -1, NULL, 0}
317 };
318
319 const char *
signal_name(int sig)320 signal_name(int sig)
321 { struct signame *sn = signames;
322
323 for( ; sn->name; sn++ )
324 { if ( sn->sig == sig )
325 return sn->name;
326 }
327
328 return "unknown";
329 }
330
331
332 static int
signal_index(const char * name)333 signal_index(const char *name)
334 { struct signame *sn = signames;
335 char tmp[12];
336
337 if ( strncmp(name, "SIG", 3) == 0 && strlen(name) < 12 )
338 { strcpy(tmp, name+3);
339 strlwr(tmp);
340 name = tmp;
341 }
342
343 for( ; sn->name; sn++ )
344 { if ( streq(sn->name, name) )
345 return sn->sig;
346 }
347
348 return -1;
349 }
350
351
352 int
PL_get_signum_ex(term_t sig,int * n)353 PL_get_signum_ex(term_t sig, int *n)
354 { GET_LD
355 char *s;
356 int i = -1;
357
358 if ( PL_get_integer(sig, &i) )
359 {
360 } else if ( PL_get_chars(sig, &s, CVT_ATOM) )
361 { i = signal_index(s);
362 } else
363 { return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_signal, sig);
364 }
365
366 if ( i > 0 && i < 32 ) /* where to get these? */
367 { *n = i;
368 return TRUE;
369 }
370
371 return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_signal, sig);
372 }
373
374
375
376 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
377 SWI-Prolog main signal handler. Any signal arrives here first, after
378 which it is dispatched to the real handler. The task of the handler is
379 to ensure it is safe to start a query.
380
381 There are a few possible problems:
382
383 * The system is writing the body-arguments from the next clause.
384 In this case it is working above `lTop'. So we raise this to the
385 maximum offset.
386
387 * The system is performing a garbage collection. We should block
388 signals while in garbage-collection and non-blockable signals should
389 raise a fatal error.
390
391 * The system is in a `critical section'. These are insufficiently
392 flagged at the moment.
393
394 The sync-argument is TRUE when called from PL_handle_signals(), and
395 FALSE otherwise. It is used to delay signals marked with PLSIG_SYNC.
396
397 If we are running in the MT environment, we may get signals from threads
398 not having a Prolog engine. If there is a registered handler we call it.
399 This also deals with Control-C in Windows console apps, calling
400 interruptHandler() in pl-trace.c which in turn re-routes the interrupt
401 to the main thread.
402 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
403
404 #undef LD
405 #define LD LOCAL_LD
406
407 static int
is_fatal_signal(int sig)408 is_fatal_signal(int sig)
409 { switch(sig)
410 {
411 #ifdef SIGFPE
412 case SIGFPE:
413 #endif
414 #ifdef SIGSEGV
415 case SIGSEGV:
416 #if defined(SIGBUS) && SIGBUS != SIGSEGV
417 case SIGBUS:
418 #endif
419 #endif
420 #ifdef SIGILL
421 case SIGILL:
422 #endif
423 #ifdef SIGSYS
424 case SIGSYS:
425 #endif
426 return TRUE;
427 }
428
429 return FALSE;
430 }
431
432
433 void
dispatch_signal(int sig,int sync)434 dispatch_signal(int sig, int sync)
435 { GET_LD
436 SigHandler sh = &GD->signals.handlers[sig-1];
437 fid_t fid;
438 term_t lTopSave;
439 int saved_current_signal;
440 int saved_sync;
441
442 #ifdef O_PLMT
443 if ( !LD )
444 { if ( sh->handler )
445 (*sh->handler)(sig);
446
447 return; /* what else?? */
448 }
449
450 DEBUG(MSG_SIGNAL,
451 { const pl_wchar_t *name = L"";
452 int tid = LD->thread.info->pl_tid;
453 atom_t alias;
454
455 if ( PL_get_thread_alias(tid, &alias) )
456 name = PL_atom_wchars(alias, NULL);
457 Sdprintf("Got signal %d in thread %d (%Ws) %s\n",
458 sig, tid, name,
459 sync ? " (sync)" : " (async)");
460 });
461 #else
462 DEBUG(MSG_SIGNAL,
463 Sdprintf("Got signal %d %s\n",
464 sig, sync ? " (sync)" : " (async)"));
465 #endif
466
467 if ( true(sh, PLSIG_NOFRAME) && sh->handler )
468 { (*sh->handler)(sig);
469 return;
470 }
471
472 lTopSave = consTermRef(lTop);
473 saved_current_signal = LD->signal.current;
474 saved_sync = LD->signal.is_sync;
475
476 if ( is_fatal_signal(sig) && sig == LD->signal.current )
477 sysError("Recursively received fatal signal %d", sig);
478
479 if ( gc_status.active && sig < SIG_PROLOG_OFFSET )
480 { fatalError("Received signal %d (%s) while in %ld-th garbage collection",
481 sig, signal_name(sig), LD->gc.stats.totals.collections);
482 }
483
484 if ( (LD->critical || (true(sh, PLSIG_SYNC) && !sync)) &&
485 !is_fatal_signal(sig) )
486 { PL_raise(sig); /* wait for better times! */
487 return;
488 }
489
490 if ( !(fid = PL_open_signal_foreign_frame(sync)) )
491 { if ( is_fatal_signal(sig) )
492 sigCrashHandler(sig); /* should not return */
493 PL_raise(sig); /* no space; wait */
494 return;
495 }
496
497 if ( !sync )
498 blockGC(0 PASS_LD);
499 LD->signal.current = sig;
500 LD->signal.is_sync = sync;
501
502 DEBUG(MSG_SIGNAL,
503 Sdprintf("Handling signal %d, pred = %p, handler = %p\n",
504 sig, sh->predicate, sh->handler));
505
506 if ( sh->predicate )
507 { term_t sigterm = PL_new_term_ref();
508 qid_t qid;
509 #ifdef O_LIMIT_DEPTH
510 uintptr_t olimit = depth_limit;
511 depth_limit = DEPTH_NO_LIMIT;
512 #endif
513
514 PL_put_atom_chars(sigterm, signal_name(sig));
515 qid = PL_open_query(NULL,
516 PL_Q_PASS_EXCEPTION,
517 sh->predicate,
518 sigterm);
519 if ( PL_next_solution(qid) ) {}; /* cannot ignore return */
520 PL_cut_query(qid);
521 #ifdef O_LIMIT_DEPTH
522 depth_limit = olimit;
523 #endif
524 } else if ( true(sh, PLSIG_THROW) )
525 { char *predname;
526 int arity;
527
528 if ( environment_frame )
529 { predname = stringAtom(environment_frame->predicate->functor->name);
530 arity = environment_frame->predicate->functor->arity;
531 } else
532 { predname = NULL;
533 arity = 0;
534 }
535
536 PL_error(predname, arity, NULL, ERR_SIGNALLED, sig, signal_name(sig));
537 } else if ( sh->handler )
538 { int ex_pending = (exception_term && !sync);
539 #ifdef O_LIMIT_DEPTH
540 uintptr_t olimit = depth_limit;
541 depth_limit = DEPTH_NO_LIMIT;
542 #endif
543 (*sh->handler)(sig);
544 #ifdef O_LIMIT_DEPTH
545 depth_limit = olimit;
546 #endif
547
548 DEBUG(MSG_SIGNAL,
549 Sdprintf("Handler %p finished (pending=0x%x,0x%x)\n",
550 sh->handler, LD->signal.pending[0], LD->signal.pending[1]));
551
552 if ( !ex_pending && exception_term && !sync ) /* handler: PL_raise_exception() */
553 fatalError("Async exception handler for signal %s (%d) raised "
554 "an exception", signal_name(sig), sig);
555 }
556
557 LD->signal.current = saved_current_signal;
558 LD->signal.is_sync = saved_sync;
559 if ( sync || exception_term )
560 PL_close_foreign_frame(fid);
561 else
562 PL_discard_foreign_frame(fid);
563 lTop = (LocalFrame)valTermRef(lTopSave);
564
565 if ( !sync )
566 unblockGC(0 PASS_LD);
567
568 /* we cannot return. First try */
569 /* longjmp. If that fails, crash */
570 if ( is_fatal_signal(sig) )
571 { if ( exception_term )
572 { PL_rethrow();
573 sigCrashHandler(sig);
574 }
575 exit(4);
576 }
577 }
578
579
580 static void
pl_signal_handler(int sig)581 pl_signal_handler(int sig)
582 { dispatch_signal(sig, FALSE);
583 }
584
585 #ifndef SA_RESTART
586 #define SA_RESTART 0
587 #endif
588
589 handler_t
set_sighandler(int sig,handler_t func)590 set_sighandler(int sig, handler_t func)
591 {
592 #ifdef HAVE_SIGACTION
593 struct sigaction old;
594 struct sigaction new;
595
596 memset(&new, 0, sizeof(new)); /* deal with other fields */
597 new.sa_handler = func;
598 /*new.sa_flags = SA_RESTART; all blocking functions are restarted */
599
600 if ( sigaction(sig, &new, &old) == 0 )
601 return old.sa_handler;
602 else
603 return SIG_DFL;
604 #elif defined(HAVE_SIGNAL)
605 #ifdef __WINDOWS__
606 switch( sig ) /* Current Windows versions crash */
607 { case SIGABRT: /* when given a non-supported value */
608 case SIGFPE:
609 case SIGILL:
610 case SIGINT:
611 case SIGSEGV:
612 case SIGTERM:
613 break;
614 default:
615 return SIG_IGN;
616 }
617 #endif /*__WINDOWS__*/
618 return signal(sig, func);
619 #else
620 return NULL;
621 #endif
622 }
623
624 static SigHandler
prepareSignal(int sig)625 prepareSignal(int sig)
626 { SigHandler sh = &GD->signals.handlers[sig-1];
627
628 if ( false(sh, PLSIG_PREPARED) )
629 { set(sh, PLSIG_PREPARED);
630 if ( sig < SIG_PROLOG_OFFSET )
631 sh->saved_handler = set_sighandler(sig, pl_signal_handler);
632 }
633
634 return sh;
635 }
636
637
638 static void
unprepareSignal(int sig)639 unprepareSignal(int sig)
640 { SigHandler sh = &GD->signals.handlers[sig-1];
641
642 if ( true(sh, PLSIG_PREPARED) )
643 { if ( sig < SIG_PROLOG_OFFSET )
644 set_sighandler(sig, sh->saved_handler);
645 sh->flags = 0;
646 sh->handler = NULL;
647 sh->predicate = NULL;
648 sh->saved_handler = NULL;
649 }
650 }
651
652
653 #ifdef SIGHUP
654 static void
hupHandler(int sig)655 hupHandler(int sig)
656 { (void)sig;
657
658 PL_halt(128+sig);
659 }
660 #endif
661
662
663 #ifdef HAVE_SIGNAL
664 /* terminate_handler() is called on termination signals like SIGTERM.
665 It runs hooks registered using PL_exit_hook() and then kills itself.
666 The hooks are called with the exit status `3`.
667 */
668
669 static void
terminate_handler(int sig)670 terminate_handler(int sig)
671 { signal(sig, SIG_DFL);
672
673 run_on_halt(&GD->os.exit_hooks, 128+sig);
674
675 #if defined(HAVE_KILL) && defined(HAVE_GETPID)
676 kill(getpid(), sig);
677 #else
678 switch( sig )
679 {
680 #ifdef SIGTERM
681 case SIGTERM:
682 exit(128+SIGTERM);
683 #endif
684 #ifdef SIGQUIT
685 case SIGQUIT:
686 exit(128+SIGQUIT);
687 #endif
688 #ifdef SIGABRT
689 case SIGABRT:
690 abort();
691 #endif
692 default:
693 assert(0); /* not reached */
694 }
695 #endif
696 }
697
698 static void
initTerminationSignals(void)699 initTerminationSignals(void)
700 {
701 #ifdef SIGTERM
702 PL_signal(SIGTERM, terminate_handler);
703 #endif
704 #ifdef SIGABRT
705 PL_signal(SIGABRT, terminate_handler);
706 #endif
707 #ifdef SIGQUIT
708 PL_signal(SIGQUIT, terminate_handler);
709 #endif
710 }
711 #endif /*HAVE_SIGNAL*/
712
713 static void
agc_handler(int sig)714 agc_handler(int sig)
715 { GET_LD
716 (void)sig;
717
718 if ( GD->statistics.atoms >= GD->atoms.non_garbage + GD->atoms.margin &&
719 !gc_status.blocked )
720 pl_garbage_collect_atoms();
721 }
722
723
724 static void
gc_handler(int sig)725 gc_handler(int sig)
726 { (void)sig;
727
728 garbageCollect(0);
729 }
730
731 static void
gc_tune_handler(int sig)732 gc_tune_handler(int sig)
733 { (void)sig;
734
735 call_tune_gc_hook();
736 }
737
738 static void
cgc_handler(int sig)739 cgc_handler(int sig)
740 { (void)sig;
741
742 pl_garbage_collect_clauses();
743 }
744
745
746 static void
abort_handler(int sig)747 abort_handler(int sig)
748 { (void)sig;
749
750 abortProlog();
751 }
752
753
754 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
755 The idea behind alert_handler() is to make blocking system calls return
756 with EINTR and thus make them interruptable for thread-signals.
757 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
758
759 #ifdef SIG_ALERT
760 static void
alert_handler(int sig)761 alert_handler(int sig)
762 { SigHandler sh = &GD->signals.handlers[sig-1];
763
764 if ( sh->saved_handler &&
765 sh->saved_handler != SIG_IGN &&
766 sh->saved_handler != SIG_DFL )
767 (*sh->saved_handler)(sig);
768 }
769 #endif
770
771
772 static void
initSignals(void)773 initSignals(void)
774 { GET_LD
775
776 /* This is general signal handling that is not strictly needed */
777 if ( truePrologFlag(PLFLAG_SIGNALS) )
778 { struct signame *sn = signames;
779 #ifdef HAVE_SIGNAL
780 #ifdef SIGPIPE
781 set_sighandler(SIGPIPE, SIG_IGN);
782 #endif
783 initTerminationSignals();
784 #endif /*HAVE_SIGNAL*/
785 initBackTrace();
786 for( ; sn->name; sn++)
787 {
788 #ifdef HAVE_BOEHM_GC
789 if ( sn->sig == GC_get_suspend_signal() ||
790 sn->sig == GC_get_thr_restart_signal() )
791 sn->flags = 0;
792 #endif
793 if ( sn->flags )
794 { SigHandler sh = prepareSignal(sn->sig);
795 sh->flags |= sn->flags;
796 }
797 }
798
799 #ifdef SIGHUP
800 PL_signal(SIGHUP|PL_SIGSYNC, hupHandler);
801 #endif
802 }
803
804 /* We do need alerting to make thread signals work while the */
805 /* system is blocked in a system call. Can be controlled with --sigalert=N */
806
807 #ifdef SIG_ALERT
808 if ( GD->signals.sig_alert )
809 PL_signal(GD->signals.sig_alert|PL_SIGNOFRAME, alert_handler);
810 #endif
811
812 /* these signals are not related to Unix signals and can thus */
813 /* be enabled always */
814
815 PL_signal(SIG_GC|PL_SIGSYNC, gc_handler);
816 PL_signal(SIG_TUNE_GC|PL_SIGSYNC, gc_tune_handler);
817 PL_signal(SIG_CLAUSE_GC|PL_SIGSYNC, cgc_handler);
818 PL_signal(SIG_PLABORT|PL_SIGSYNC, abort_handler);
819 #ifdef SIG_THREAD_SIGNAL
820 PL_signal(SIG_THREAD_SIGNAL|PL_SIGSYNC, executeThreadSignals);
821 #endif
822 #ifdef SIG_ATOM_GC
823 PL_signal(SIG_ATOM_GC|PL_SIGSYNC, agc_handler);
824 #endif
825 }
826
827
828 void
cleanupSignals(void)829 cleanupSignals(void)
830 { struct signame *sn = signames;
831
832 for( ; sn->name; sn++)
833 unprepareSignal(sn->sig);
834 }
835
836
837 void
resetSignals(void)838 resetSignals(void)
839 { GET_LD
840
841 LD->signal.current = 0;
842 LD->signal.pending[0] = 0;
843 LD->signal.pending[1] = 0;
844 }
845
846 #if defined(O_PLMT) && defined(HAVE_PTHREAD_SIGMASK)
847 #ifndef HAVE_SIGPROCMASK
848 #define HAVE_SIGPROCMASK 1
849 #endif
850
851 #define sigprocmask(how, new, old) pthread_sigmask(how, new, old)
852 #endif
853
854 #ifdef HAVE_SIGPROCMASK
855
856 void
allSignalMask(sigset_t * set)857 allSignalMask(sigset_t *set)
858 { static sigset_t allmask;
859 static int done = FALSE;
860
861 if ( !done )
862 { sigset_t tmp;
863
864 sigfillset(&tmp);
865 sigdelset(&tmp, SIGSTOP);
866 sigdelset(&tmp, SIGCONT);
867 sigdelset(&tmp, SIGQUIT);
868 sigdelset(&tmp, SIGSEGV);
869 sigdelset(&tmp, SIGBUS);
870 #ifdef O_PROFILE
871 sigdelset(&tmp, SIGPROF);
872 #endif
873 allmask = tmp;
874 done = TRUE;
875 }
876
877 *set = allmask;
878 }
879
880
881 #if 0
882 static void
883 listBlocked()
884 { sigset_t current;
885 int i;
886
887 sigprocmask(SIG_BLOCK, NULL, ¤t);
888
889 Sdprintf("Blocked: ");
890 for(i=1; i<32; i++)
891 { if ( sigismember(¤t, i) )
892 Sdprintf(" %d", i);
893 }
894 Sdprintf("\n");
895 Sdprintf("UnBlocked: ");
896 for(i=1; i<32; i++)
897 { if ( !sigismember(¤t, i) )
898 Sdprintf(" %d", i);
899 }
900 Sdprintf("\n\n");
901 }
902 #endif
903
904 void
blockSignals(sigset_t * old)905 blockSignals(sigset_t *old)
906 { sigset_t set;
907
908 allSignalMask(&set);
909
910 sigprocmask(SIG_BLOCK, &set, old);
911 DEBUG(1, Sdprintf("Blocked all signals\n"));
912 }
913
914
915 void
unblockSignals(sigset_t * old)916 unblockSignals(sigset_t *old)
917 { if ( old )
918 { sigprocmask(SIG_SETMASK, old, NULL);
919 DEBUG(1, Sdprintf("Restored signal mask\n"));
920 } else
921 { sigset_t set;
922
923 allSignalMask(&set);
924
925 sigprocmask(SIG_UNBLOCK, &set, NULL);
926 DEBUG(1, Sdprintf("UnBlocked all signals\n"));
927 }
928 }
929
930
931 void
unblockSignal(int sig)932 unblockSignal(int sig)
933 { sigset_t set;
934
935 sigemptyset(&set);
936 sigaddset(&set, sig);
937
938 sigprocmask(SIG_UNBLOCK, &set, NULL);
939 DEBUG(1, Sdprintf("Unblocked signal %d\n", sig));
940 }
941
942 void
blockSignal(int sig)943 blockSignal(int sig)
944 { sigset_t set;
945
946 sigemptyset(&set);
947 sigaddset(&set, sig);
948
949 sigprocmask(SIG_BLOCK, &set, NULL);
950 DEBUG(1, Sdprintf("signal %d\n", sig));
951 }
952
953 #else /*HAVE_SIGPROCMASK*/
954
blockSignals(sigset_t * old)955 void blockSignals(sigset_t *old) {}
unblockSignals(sigset_t * old)956 void unblockSignals(sigset_t *old) {}
unblockSignal(int sig)957 void unblockSignal(int sig) {}
blockSignal(int sig)958 void blockSignal(int sig) {}
959
960 #endif
961
962 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
963 BUG: The interface of PL_signal() is broken as it does not return the
964 current flags associated with the signal and therefore we cannot restore
965 the signal safely. We should design a struct based API similar to
966 sigaction().
967 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
968
969 int
PL_sigaction(int sig,pl_sigaction_t * act,pl_sigaction_t * old)970 PL_sigaction(int sig, pl_sigaction_t *act, pl_sigaction_t *old)
971 { SigHandler sh = NULL;
972
973 if ( sig < 0 || sig > MAXSIGNAL )
974 { errno = EINVAL;
975 return -1;
976 }
977
978 if ( sig == 0 )
979 { for(sig=SIG_PROLOG_OFFSET; sig<MAXSIGNAL; sig++)
980 { sh = &GD->signals.handlers[sig-1];
981 if ( sh->flags == 0 )
982 break;
983 }
984 if ( !sh )
985 { errno = EBUSY;
986 return -2;
987 }
988 } else
989 { sh = &GD->signals.handlers[sig-1];
990 }
991
992 if ( old )
993 { memset(old, 0, sizeof(*old));
994 old->sa_cfunction = sh->handler;
995 old->sa_predicate = sh->predicate;
996 old->sa_flags = sh->flags;
997 }
998
999 if ( act && act != old )
1000 { int active = FALSE;
1001
1002 if ( (act->sa_flags&PLSIG_THROW) || act->sa_predicate )
1003 { if ( ((act->sa_flags&PLSIG_THROW) && act->sa_predicate) ||
1004 act->sa_cfunction )
1005 { errno = EINVAL;
1006 return -1;
1007 }
1008 active = TRUE;
1009 } else if ( act->sa_cfunction &&
1010 (false(sh, PLSIG_PREPARED)||act->sa_cfunction!=sh->saved_handler) )
1011 { active = TRUE;
1012 }
1013
1014 if ( active )
1015 { sh->handler = act->sa_cfunction;
1016 sh->predicate = act->sa_predicate;
1017 sh->flags = (sh->flags&~0xffff)|act->sa_flags;
1018 if ( false(sh, PLSIG_PREPARED) )
1019 prepareSignal(sig);
1020 } else
1021 { unprepareSignal(sig);
1022 sh->handler = NULL;
1023 sh->predicate = NULL;
1024 sh->flags = 0;
1025 }
1026 }
1027
1028 return sig;
1029 }
1030
1031 #ifndef SIG_DFL
1032 #define SIG_DFL (handler_t)-1
1033 #endif
1034
1035 handler_t
PL_signal(int sigandflags,handler_t func)1036 PL_signal(int sigandflags, handler_t func)
1037 { pl_sigaction_t act = {0};
1038 pl_sigaction_t old;
1039
1040 act.sa_cfunction = func;
1041 if ( (sigandflags&PL_SIGSYNC) )
1042 act.sa_flags |= PLSIG_SYNC;
1043 if ( (sigandflags&PL_SIGNOFRAME) )
1044 act.sa_flags |= PLSIG_NOFRAME;
1045
1046 if ( PL_sigaction((sigandflags & 0xffff), &act, &old) >= 0 )
1047 { if ( (old.sa_flags&PLSIG_PREPARED) && old.sa_cfunction )
1048 return old.sa_cfunction;
1049
1050 return SIG_DFL;
1051 }
1052
1053 return NULL;
1054 }
1055
1056
1057 /* return: -1: exception in handler, otherwise number of handled signals
1058 */
1059
1060 int
PL_handle_signals(void)1061 PL_handle_signals(void)
1062 { GET_LD
1063
1064 if ( !HAS_LD || LD->critical || !is_signalled(PASS_LD1) )
1065 return 0;
1066 if ( exception_term )
1067 return -1;
1068
1069 return handleSignals(PASS_LD1);
1070 }
1071
1072
1073 int
handleSignals(ARG1_LD)1074 handleSignals(ARG1_LD)
1075 { int done = 0;
1076 int i;
1077
1078 if ( !HAS_LD || LD->critical )
1079 return 0;
1080
1081 for(i=0; i<2; i++)
1082 { while( LD->signal.pending[i] )
1083 { int sig = 1+32*i;
1084 unsigned mask = 1;
1085
1086 for( ; mask ; mask <<= 1, sig++ )
1087 { if ( LD->signal.pending[i] & mask )
1088 { ATOMIC_AND(&LD->signal.pending[i], ~mask);
1089
1090 done++;
1091 dispatch_signal(sig, TRUE);
1092
1093 if ( exception_term )
1094 return -1;
1095 }
1096 }
1097 }
1098 }
1099
1100 if ( done )
1101 updateAlerted(LD);
1102
1103 return done;
1104 }
1105
1106
1107 #ifdef SIG_ALERT
1108 static
1109 PRED_IMPL("prolog_alert_signal", 2, prolog_alert_signal, 0)
1110 { PRED_LD
1111 const char *sname = signal_name(GD->signals.sig_alert);
1112 int rc;
1113
1114 if ( strcmp(sname, "unknown") == 0 )
1115 rc = PL_unify_integer(A1, GD->signals.sig_alert);
1116 else
1117 rc = PL_unify_atom_chars(A1, sname);
1118
1119 if ( rc )
1120 { if ( PL_compare(A1,A2) == CMP_EQUAL )
1121 { return TRUE;
1122 } else
1123 { int new;
1124
1125 if ( (PL_get_integer(A2, &new) && new == 0) ||
1126 PL_get_signum_ex(A2, &new) )
1127 { if ( GD->signals.sig_alert )
1128 { unprepareSignal(GD->signals.sig_alert);
1129 GD->signals.sig_alert = 0;
1130 }
1131 if ( new )
1132 { GD->signals.sig_alert = new;
1133 PL_signal(GD->signals.sig_alert|PL_SIGNOFRAME, alert_handler);
1134 }
1135
1136 return TRUE;
1137 }
1138 }
1139 }
1140
1141 return FALSE;
1142 }
1143 #endif
1144
1145
1146 int
endCritical__LD(ARG1_LD)1147 endCritical__LD(ARG1_LD)
1148 { if ( exception_term )
1149 return FALSE;
1150
1151 return TRUE;
1152 }
1153
1154
1155 #ifdef HAVE_SIGNAL
1156 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1157 on_signal(?SigNum, ?SigName, :OldHandler, :NewHandler)
1158
1159 Assign NewHandler to be called if signal arrives.
1160 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1161
1162 static int
get_meta_arg(term_t arg,term_t m,term_t t)1163 get_meta_arg(term_t arg, term_t m, term_t t)
1164 { GET_LD
1165
1166 if ( PL_is_functor(arg, FUNCTOR_colon2) )
1167 { _PL_get_arg(1, arg, m);
1168 _PL_get_arg(2, arg, t);
1169 return TRUE;
1170 }
1171
1172 return PL_error(NULL, 0, NULL, ERR_TYPE,
1173 ATOM_meta_argument, arg);
1174 }
1175
1176
1177 static int
get_module(term_t t,Module * m)1178 get_module(term_t t, Module *m)
1179 { GET_LD
1180 atom_t a;
1181
1182 if ( !PL_get_atom_ex(t, &a) )
1183 return FALSE;
1184 *m = PL_new_module(a);
1185
1186 return TRUE;
1187 }
1188
1189
1190 static
1191 PRED_IMPL("$on_signal", 4, on_signal, 0)
1192 { PRED_LD
1193 int sign = -1;
1194 SigHandler sh;
1195 char *sn;
1196 atom_t a;
1197 term_t mold = PL_new_term_ref();
1198 term_t mnew = PL_new_term_ref();
1199
1200 term_t sig = A1;
1201 term_t name = A2;
1202 term_t old = A3;
1203 term_t new = A4;
1204
1205 if ( !get_meta_arg(old, mold, old) ||
1206 !get_meta_arg(new, mnew, new) )
1207 return FALSE;
1208
1209 if ( PL_get_integer(sig, &sign) && sign >= 1 && sign <= MAXSIGNAL )
1210 { TRY(PL_unify_atom_chars(name, signal_name(sign)));
1211 } else if ( PL_get_atom_chars(name, &sn) )
1212 { if ( (sign = signal_index(sn)) != -1 )
1213 { TRY(PL_unify_integer(sig, sign));
1214 } else
1215 return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_signal, name);
1216 } else
1217 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_signal, sig);
1218
1219 sh = &GD->signals.handlers[sign-1];
1220
1221 if ( false(sh, PLSIG_PREPARED) ) /* not handled */
1222 { TRY(PL_unify_atom(old, ATOM_default));
1223 } else if ( true(sh, PLSIG_THROW) ) /* throw exception */
1224 { TRY(PL_unify_atom(old, ATOM_throw));
1225 } else if ( sh->predicate ) /* call predicate */
1226 { Definition def = sh->predicate->definition;
1227
1228 if ( PL_unify_atom(mold, def->module->name) )
1229 { if ( !PL_unify_atom(old, def->functor->name) )
1230 return FALSE;
1231 } else
1232 { if ( !PL_unify_term(old, PL_FUNCTOR, FUNCTOR_colon2,
1233 PL_ATOM, def->module->name,
1234 PL_ATOM, def->functor->name) )
1235 return FALSE;
1236 }
1237 } else if ( sh->handler )
1238 { if ( sh->handler == PL_interrupt )
1239 { TRY(PL_unify_atom(old, ATOM_debug));
1240 } else
1241 { TRY(PL_unify_term(old,
1242 PL_FUNCTOR, FUNCTOR_foreign_function1,
1243 PL_POINTER, sh->handler));
1244 }
1245 }
1246
1247 if ( PL_compare(old, new) == 0 &&
1248 PL_compare(mold, mnew) == 0 )
1249 succeed; /* no change */
1250
1251 if ( PL_get_atom(new, &a) )
1252 { if ( a == ATOM_default )
1253 { unprepareSignal(sign);
1254 } else if ( a == ATOM_throw )
1255 { sh = prepareSignal(sign);
1256 set(sh, PLSIG_THROW|PLSIG_SYNC);
1257 sh->handler = NULL;
1258 sh->predicate = NULL;
1259 } else if ( a == ATOM_debug )
1260 { sh = prepareSignal(sign);
1261
1262 clear(sh, PLSIG_THROW|PLSIG_SYNC);
1263 sh->handler = (handler_t)PL_interrupt;
1264 sh->predicate = NULL;
1265
1266 } else
1267 { Module m;
1268 predicate_t pred;
1269
1270 if ( !get_module(mnew, &m) )
1271 return FALSE;
1272 pred = lookupProcedure(PL_new_functor(a, 1), m);
1273
1274 sh = prepareSignal(sign);
1275 clear(sh, PLSIG_THROW);
1276 set(sh, PLSIG_SYNC);
1277 sh->handler = NULL;
1278 sh->predicate = pred;
1279 }
1280 } else if ( PL_is_functor(new, FUNCTOR_foreign_function1) )
1281 { term_t a = PL_new_term_ref();
1282 void *f;
1283
1284 _PL_get_arg(1, new, a);
1285
1286 if ( PL_get_pointer(a, &f) )
1287 { sh = prepareSignal(sign);
1288 clear(sh, PLSIG_THROW|PLSIG_SYNC);
1289 sh->handler = (handler_t)f;
1290 sh->predicate = NULL;
1291
1292 succeed;
1293 }
1294
1295 return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_signal_handler, sig);
1296 } else
1297 return PL_error(NULL, 0, NULL, ERR_TYPE, ATOM_signal_handler, sig);
1298
1299 succeed;
1300 }
1301
1302 #endif /*HAVE_SIGNAL*/
1303
1304
1305 /*******************************
1306 * STACKS *
1307 *******************************/
1308
1309 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1310 initPrologStacks() creates the stacks for the calling thread. It is used
1311 both at system startup to create the stack for the main thread as from
1312 pl-thread.c to create stacks for Prolog threads.
1313 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1314
1315 int
initPrologStacks(size_t limit)1316 initPrologStacks(size_t limit)
1317 { GET_LD
1318
1319 LD->stacks.limit = limit;
1320 if ( !allocStacks() )
1321 return FALSE;
1322
1323 LD->stacks.local.overflow_id = LOCAL_OVERFLOW;
1324 LD->stacks.global.overflow_id = GLOBAL_OVERFLOW;
1325 LD->stacks.trail.overflow_id = TRAIL_OVERFLOW;
1326 LD->stacks.argument.overflow_id = ARGUMENT_OVERFLOW;
1327
1328 base_addresses[STG_LOCAL] = (uintptr_t)lBase;
1329 base_addresses[STG_GLOBAL] = (uintptr_t)gBase;
1330 base_addresses[STG_TRAIL] = (uintptr_t)tBase;
1331 *gBase++ = MARK_MASK; /* see sweep_global_mark() */
1332 gMax--; /* */
1333 tMax--;
1334 emptyStacks();
1335
1336 DEBUG(1, Sdprintf("base_addresses[STG_LOCAL] = %p\n",
1337 base_addresses[STG_LOCAL]));
1338 DEBUG(1, Sdprintf("base_addresses[STG_GLOBAL] = %p\n",
1339 base_addresses[STG_GLOBAL]));
1340 DEBUG(1, Sdprintf("base_addresses[STG_TRAIL] = %p\n",
1341 base_addresses[STG_TRAIL]));
1342
1343 return TRUE;
1344 }
1345
1346
1347 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1348 Create nice empty stacks. exception_bin and exception_printed are two
1349 term-references that must be low on the stack to ensure they remain
1350 valid while the stack is unrolled after an exception.
1351 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1352
1353 static void
emptyStack(Stack s)1354 emptyStack(Stack s)
1355 { s->top = s->base;
1356 s->gced_size = 0L;
1357 }
1358
1359
1360 void
emptyStacks(void)1361 emptyStacks(void)
1362 { GET_LD
1363
1364 environment_frame = NULL;
1365 fli_context = NULL;
1366 LD->query = NULL;
1367
1368 emptyStack((Stack)&LD->stacks.local);
1369 emptyStack((Stack)&LD->stacks.global);
1370 emptyStack((Stack)&LD->stacks.trail);
1371 emptyStack((Stack)&LD->stacks.argument);
1372
1373 LD->mark_bar = gTop;
1374 if ( lTop && gTop )
1375 { int i;
1376
1377 PL_open_foreign_frame();
1378 exception_term = 0;
1379 exception_bin = PL_new_term_ref();
1380 exception_printed = PL_new_term_ref();
1381 LD->exception.tmp = PL_new_term_ref();
1382 LD->exception.pending = PL_new_term_ref();
1383 LD->trim.dummy = PL_new_term_ref();
1384 #ifdef O_ATTVAR
1385 LD->attvar.head = PL_new_term_ref();
1386 LD->attvar.tail = PL_new_term_ref();
1387 LD->attvar.gc_attvars = PL_new_term_ref();
1388 DEBUG(3, Sdprintf("attvar.tail at %p\n", valTermRef(LD->attvar.tail)));
1389 #endif
1390 LD->tabling.delay_list = init_delay_list();
1391 LD->tabling.idg_current = PL_new_term_ref();
1392 #ifdef O_GVAR
1393 destroyGlobalVars();
1394 #endif
1395 for(i=0; i<TMP_PTR_SIZE; i++)
1396 LD->tmp.h[i] = PL_new_term_ref();
1397 LD->tmp.top = 0;
1398 }
1399 }
1400
1401
1402 /********************************
1403 * STACK ALLOCATION *
1404 *********************************/
1405
1406 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1407 init_stack() initializes the stack straucture. Params:
1408
1409 - name is the name of the stack (for diagnostic purposes)
1410 - size is the allocated size
1411 - spare is the amount of spare stack we reserve
1412 - gc indicates whether gc can collect data on the stack
1413 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1414
1415 static void
init_stack(Stack s,char * name,size_t size,size_t spare,int gc)1416 init_stack(Stack s, char *name, size_t size, size_t spare, int gc)
1417 { s->name = name;
1418 s->top = s->base;
1419 s->spare = spare;
1420 s->def_spare = spare;
1421 s->min_free = 256*sizeof(word);
1422 s->max = addPointer(s->base, size - spare);
1423 s->gced_size = 0L; /* size after last gc */
1424 s->gc = gc;
1425 gcPolicy(s, GC_FAST_POLICY);
1426 }
1427
1428
1429 static int
allocStacks(void)1430 allocStacks(void)
1431 { GET_LD
1432 size_t minglobal = 8*SIZEOF_VOIDP K;
1433 size_t minlocal = 4*SIZEOF_VOIDP K;
1434 size_t mintrail = 4*SIZEOF_VOIDP K;
1435 size_t minarg = 1*SIZEOF_VOIDP K;
1436
1437 size_t itrail = nextStackSizeAbove(mintrail-1);
1438 size_t iglobal = nextStackSizeAbove(minglobal-1);
1439 size_t ilocal = nextStackSizeAbove(minlocal-1);
1440
1441 itrail = stack_nalloc(itrail);
1442 minarg = stack_nalloc(minarg);
1443 iglobal = stack_nalloc(iglobal+ilocal)-ilocal;
1444
1445 gBase = NULL;
1446 tBase = NULL;
1447 aBase = NULL;
1448
1449 gBase = (Word) stack_malloc(iglobal + ilocal);
1450 tBase = (TrailEntry) stack_malloc(itrail);
1451 aBase = (Word *) stack_malloc(minarg);
1452
1453 if ( !gBase || !tBase || !aBase )
1454 { if ( gBase )
1455 *gBase++ = MARK_MASK; /* compensate for freeStacks */
1456 freeStacks(PASS_LD1);
1457 return FALSE;
1458 }
1459
1460 lBase = (LocalFrame) addPointer(gBase, iglobal);
1461
1462 init_stack((Stack)&LD->stacks.global,
1463 "global", iglobal, 512*SIZEOF_VOIDP, TRUE);
1464 init_stack((Stack)&LD->stacks.local,
1465 "local", ilocal, 512*SIZEOF_VOIDP + LOCAL_MARGIN, FALSE);
1466 init_stack((Stack)&LD->stacks.trail,
1467 "trail", itrail, 256*SIZEOF_VOIDP, TRUE);
1468 init_stack((Stack)&LD->stacks.argument,
1469 "argument", minarg, 0, FALSE);
1470
1471 LD->stacks.local.min_free = LOCAL_MARGIN;
1472
1473 return TRUE;
1474 }
1475
1476
1477 void
freeStacks(ARG1_LD)1478 freeStacks(ARG1_LD)
1479 { if ( gBase )
1480 { gBase--;
1481 stack_free(gBase);
1482 gTop = NULL; gBase = NULL;
1483 lTop = NULL; lBase = NULL;
1484 }
1485 if ( tBase )
1486 { stack_free(tBase);
1487 tTop = NULL;
1488 tBase = NULL;
1489 }
1490 if ( aBase )
1491 { stack_free(aBase);
1492 aTop = NULL;
1493 aBase = NULL;
1494 }
1495 }
1496
1497
1498 int
trim_stack(Stack s)1499 trim_stack(Stack s)
1500 { if ( s->spare < s->def_spare )
1501 { ssize_t reduce = s->def_spare - s->spare;
1502 ssize_t room = roomStackP(s);
1503
1504 DEBUG(MSG_SPARE_STACK, Sdprintf("Reset spare for %s (%zd->%zd)\n",
1505 s->name, s->spare, s->def_spare));
1506 if ( room > 0 && room < reduce )
1507 { DEBUG(MSG_SPARE_STACK,
1508 Sdprintf("Only %d spare for %s-stack\n", room, s->name));
1509 reduce = room;
1510 }
1511
1512 s->max = addPointer(s->max, -reduce);
1513 s->spare += reduce;
1514 }
1515
1516 return FALSE;
1517 }
1518
1519
1520 /********************************
1521 * STACK TRIMMING & LIMITS *
1522 *********************************/
1523
1524 static void
gcPolicy(Stack s,int policy)1525 gcPolicy(Stack s, int policy)
1526 { GET_LD
1527
1528 s->gc = ((s == (Stack) &LD->stacks.global ||
1529 s == (Stack) &LD->stacks.trail) ? TRUE : FALSE);
1530 if ( s->gc )
1531 { s->small = SMALLSTACK;
1532 s->factor = 3;
1533 s->policy = policy;
1534 } else
1535 { s->small = 0;
1536 s->factor = 0;
1537 s->policy = 0;
1538 }
1539 }
1540
1541
1542 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1543 trimStacks() reclaims all unused space on the stack.
1544 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1545
1546 void
trimStacks(int resize ARG_LD)1547 trimStacks(int resize ARG_LD)
1548 { LD->trim_stack_requested = FALSE;
1549
1550 if ( resize )
1551 { growStacks(GROW_TRIM, GROW_TRIM, GROW_TRIM);
1552 } else
1553 { trim_stack((Stack) &LD->stacks.local);
1554 trim_stack((Stack) &LD->stacks.global);
1555 trim_stack((Stack) &LD->stacks.trail);
1556 }
1557
1558 #ifdef SECURE_GC
1559 { Word p; /* clear the stacks */
1560
1561 for(p=gTop; p<gMax; p++)
1562 *p = 0xbfbfbfbf;
1563 for(p=(Word)lTop; p<(Word)lMax; p++)
1564 *p = 0xbfbfbfbf;
1565 }
1566 #endif
1567
1568 DEBUG(CHK_SECURE,
1569 { scan_global(FALSE);
1570 checkStacks(NULL);
1571 });
1572 }
1573
1574
1575 static
1576 PRED_IMPL("trim_stacks", 0, trim_stacks, 0)
1577 { PRED_LD
1578
1579 trimStacks(TRUE PASS_LD);
1580
1581 succeed;
1582 }
1583
1584
1585 /*******************************
1586 * LOCAL DATA *
1587 *******************************/
1588
1589 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1590 In the end, this should do nice cleanup of all local data and be called
1591 both by PL_cleanup() and when destroying a thread. There is still a lot
1592 of work to do.
1593 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1594
1595 void
freePrologLocalData(PL_local_data_t * ld)1596 freePrologLocalData(PL_local_data_t *ld)
1597 { discardBuffer(&ld->fli._discardable_buffer);
1598 discardStringStack(&ld->fli.string_buffers);
1599 freeVarDefs(ld);
1600
1601 #ifdef O_GVAR
1602 if ( ld->gvar.nb_vars )
1603 destroyHTable(ld->gvar.nb_vars);
1604 #endif
1605
1606 if ( ld->bags.default_bag )
1607 { PL_free(ld->bags.default_bag);
1608 #if defined(O_ATOMGC) && defined(O_PLMT)
1609 simpleMutexDelete(&ld->bags.mutex);
1610 #endif
1611 }
1612
1613 #ifdef O_CYCLIC
1614 clearSegStack(&ld->cycle.lstack);
1615 clearSegStack(&ld->cycle.vstack);
1616 #endif
1617
1618 freeArithLocalData(ld);
1619 #ifdef O_PLMT
1620 if ( ld->prolog_flag.table )
1621 { PL_LOCK(L_PLFLAG);
1622 destroyHTable(ld->prolog_flag.table);
1623 PL_UNLOCK(L_PLFLAG);
1624 }
1625 #endif
1626
1627 if ( ld->qlf.getstr_buffer )
1628 free(ld->qlf.getstr_buffer);
1629 if ( ld->tabling.node_pool )
1630 free_alloc_pool(ld->tabling.node_pool);
1631
1632 clearThreadTablingData(ld);
1633 }
1634
1635
1636
1637 /*******************************
1638 * PREDICATES *
1639 *******************************/
1640
1641 int
set_stack_limit(size_t limit)1642 set_stack_limit(size_t limit)
1643 { GET_LD
1644
1645 if ( limit < LD->stacks.limit &&
1646 limit < sizeStack(local) +
1647 sizeStack(global) +
1648 sizeStack(trail) )
1649 { garbageCollect(GC_USER);
1650 trimStacks(TRUE PASS_LD);
1651
1652 if ( limit < sizeStack(local) +
1653 sizeStack(global) +
1654 sizeStack(trail) )
1655 { term_t ex;
1656
1657
1658 return ( (ex=PL_new_term_ref()) &&
1659 PL_put_int64(ex, limit) &&
1660 PL_error(NULL, 0, NULL, ERR_PERMISSION,
1661 ATOM_limit, ATOM_stacks, ex)
1662 );
1663 }
1664 }
1665
1666 LD->stacks.limit = limit;
1667
1668 return TRUE;
1669 }
1670
1671
1672 static
1673 PRED_IMPL("$set_prolog_stack", 4, set_prolog_stack, 0)
1674 { PRED_LD
1675 atom_t a, k;
1676 Stack stack = NULL;
1677
1678 term_t name = A1;
1679 term_t prop = A2;
1680 term_t old = A3;
1681 term_t value = A4;
1682
1683 if ( PL_get_atom(name, &a) )
1684 { if ( a == ATOM_local )
1685 stack = (Stack) &LD->stacks.local;
1686 else if ( a == ATOM_global )
1687 stack = (Stack) &LD->stacks.global;
1688 else if ( a == ATOM_trail )
1689 stack = (Stack) &LD->stacks.trail;
1690 else if ( a == ATOM_argument )
1691 stack = (Stack) &LD->stacks.argument;
1692 }
1693 if ( !stack )
1694 return PL_error(NULL, 0, NULL, ERR_EXISTENCE, ATOM_stack, name);
1695
1696 if ( PL_get_atom_ex(prop, &k) )
1697 { if ( k == ATOM_low )
1698 return (PL_unify_int64(old, stack->small) &&
1699 PL_get_size_ex(value, &stack->small));
1700 if ( k == ATOM_factor )
1701 return (PL_unify_integer(old, stack->factor) &&
1702 PL_get_integer_ex(value, &stack->factor));
1703 if ( k == ATOM_limit )
1704 { size_t newlimit;
1705
1706 if ( !printMessage(ATOM_warning,
1707 PL_FUNCTOR_CHARS, "deprecated", 1,
1708 PL_FUNCTOR_CHARS, "set_prolog_stack", 2,
1709 PL_TERM, A1,
1710 PL_ATOM, ATOM_limit) )
1711 return FALSE;
1712
1713 return ( PL_unify_int64(old, LD->stacks.limit) &&
1714 PL_get_size_ex(value, &newlimit) &&
1715 set_stack_limit(newlimit)
1716 );
1717 }
1718 if ( k == ATOM_spare )
1719 { size_t spare = stack->def_spare/sizeof(word);
1720
1721 if ( PL_unify_int64(old, spare) &&
1722 PL_get_size_ex(value, &spare) )
1723 { stack->def_spare = spare*sizeof(word);
1724 trim_stack(stack);
1725 return TRUE;
1726 }
1727 return FALSE;
1728 }
1729 if ( k == ATOM_min_free )
1730 { size_t minfree = stack->min_free/sizeof(word);
1731
1732 if ( PL_unify_int64(old, minfree) &&
1733 PL_get_size_ex(value, &minfree) )
1734 { stack->min_free = minfree*sizeof(word);
1735 trim_stack(stack);
1736 return TRUE;
1737 }
1738 return FALSE;
1739 }
1740
1741 return PL_error(NULL, 0, NULL, ERR_DOMAIN, ATOM_stack_parameter, prop);
1742 }
1743
1744 fail;
1745 }
1746
1747
1748 /*******************************
1749 * PUBLISH PREDICATES *
1750 *******************************/
1751
1752 BeginPredDefs(setup)
1753 PRED_DEF("$set_prolog_stack", 4, set_prolog_stack, 0)
1754 PRED_DEF("trim_stacks", 0, trim_stacks, 0)
1755 #ifdef HAVE_SIGNAL
1756 PRED_DEF("$on_signal", 4, on_signal, 0)
1757 #ifdef SIG_ALERT
1758 PRED_DEF("prolog_alert_signal", 2, prolog_alert_signal, 0)
1759 #endif
1760 #endif
1761 EndPredDefs
1762