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) 2014-2020, VU University Amsterdam
7 CWI, Amsterdam
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions
12 are met:
13
14 1. Redistributions of source code must retain the above copyright
15 notice, this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in
19 the documentation and/or other materials provided with the
20 distribution.
21
22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 POSSIBILITY OF SUCH DAMAGE.
34 */
35
36 /*#define O_DEBUG 1*/
37 #include "pl-incl.h"
38 #include "pl-comp.h"
39 #include "pl-dbref.h"
40 #include "pl-event.h"
41 #include "pl-tabling.h"
42
43 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
44 Source administration. The core object is SourceFile, which keeps track
45 of procedures that are defined by it. Source files are identified by an
46 unsigned int, which is registered with clauses and procedures.
47 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
48
49 #undef LD
50 #define LD LOCAL_LD
51
52 static inline void
LOCKSRCFILE(SourceFile sf)53 LOCKSRCFILE(SourceFile sf)
54 { acquireSourceFile(sf);
55 #ifdef O_PLMT
56 countingMutexLock((sf)->mutex);
57 #endif
58 }
59
60 static inline void
UNLOCKSRCFILE(SourceFile sf)61 UNLOCKSRCFILE(SourceFile sf)
62 {
63 #ifdef O_PLMT
64 countingMutexUnlock((sf)->mutex);
65 #endif
66 releaseSourceFile(sf);
67 }
68
69 static void
putSourceFileArray(size_t where,SourceFile sf)70 putSourceFileArray(size_t where, SourceFile sf)
71 { int idx = MSB(where);
72
73 if ( !GD->files.array.blocks[idx] )
74 { PL_LOCK(L_MISC);
75 if ( !GD->files.array.blocks[idx] )
76 { size_t bs = (size_t)1<<idx;
77 SourceFile *newblock;
78
79 if ( !(newblock=PL_malloc_uncollectable(bs*sizeof(SourceFile))) )
80 outOfCore();
81
82 memset(newblock, 0, bs*sizeof(SourceFile));
83 GD->files.array.blocks[idx] = newblock-bs;
84 }
85 PL_UNLOCK(L_MISC);
86 }
87
88 GD->files.array.blocks[idx][where] = sf;
89 }
90
91
92 static void
registerSourceFile(SourceFile sf)93 registerSourceFile(SourceFile sf) /* locked by lookupSourceFile() */
94 { size_t index;
95 int i;
96 int last = FALSE;
97
98 if ( GD->files.no_hole_before == 0 )
99 GD->files.no_hole_before = 1;
100
101 for(index=GD->files.no_hole_before, i=MSB(index); !last; i++)
102 { size_t upto = (size_t)2<<i;
103 SourceFile *b = GD->files.array.blocks[i];
104
105 if ( upto >= GD->files.highest )
106 { upto = GD->files.highest;
107 last = TRUE;
108 }
109
110 for(; index<upto; index++)
111 { if ( b[index] == NULL )
112 { sf->index = index;
113 b[index] = sf;
114 GD->files.no_hole_before = index+1;
115
116 return;
117 }
118 }
119 }
120
121 GD->files.no_hole_before = index+1;
122 sf->index = index;
123 if ( (size_t)sf->index != index )
124 fatalError("Too many (%d) source files", index);
125 putSourceFileArray(index, sf);
126 GD->files.highest = index+1;
127 }
128
129
130 size_t
highSourceFileIndex(void)131 highSourceFileIndex(void)
132 { return GD->files.highest;
133 }
134
135
136 SourceFile
indexToSourceFile(int index)137 indexToSourceFile(int index)
138 { if ( index > 0 && index < GD->files.highest )
139 { int idx = MSB(index);
140
141 return GD->files.array.blocks[idx][index];
142 }
143
144 return NULL;
145 }
146
147
148 static void
freeList(ListCell * lp)149 freeList(ListCell *lp)
150 { ListCell c;
151
152 if ( (c=*lp) )
153 { ListCell n;
154
155 *lp = NULL;
156 for( ; c; c=n )
157 { n = c->next;
158
159 freeHeap(c, sizeof(*c));
160 }
161 }
162 }
163
164
165 static void
unallocSourceFile(SourceFile sf)166 unallocSourceFile(SourceFile sf)
167 { if ( sf->magic == SF_MAGIC_DESTROYING )
168 { sf->magic = 0;
169 freeList(&sf->procedures);
170 freeList(&sf->modules);
171 #ifdef O_PLMT
172 if ( sf->mutex )
173 freeSimpleMutex(sf->mutex);
174 #endif
175 freeHeap(sf, sizeof(*sf));
176 }
177 }
178
179
180 static void
freeSymbolSourceFile(void * name,void * value)181 freeSymbolSourceFile(void *name, void *value)
182 { SourceFile sf = value;
183
184 if ( sf->magic == SF_MAGIC )
185 sf->magic = SF_MAGIC_DESTROYING;
186 unallocSourceFile(sf);
187 }
188
189
190 static void
cleanupSourceFileArray(void)191 cleanupSourceFileArray(void)
192 { int i;
193 SourceFile *ap0;
194
195 GD->files.highest = 0;
196 for(i=0; (ap0=GD->files.array.blocks[i]); i++)
197 { size_t bs = (size_t)1<<i;
198
199 ap0 += bs;
200 GD->files.array.blocks[i] = NULL;
201 PL_free(ap0);
202 }
203 }
204
205
206 void
cleanupSourceFiles(void)207 cleanupSourceFiles(void)
208 { Table t;
209
210 if ( (t=GD->files.table) )
211 { GD->files.table = NULL;
212
213 destroyHTable(t);
214 }
215
216 cleanupSourceFileArray();
217 }
218
219
220 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
221 This updates the dynamic predicates that maintain the source admin. The
222 callback is rather dubious as it is completely unclear what we must do
223 with exceptions in various conditions.
224 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
225
226 static bool
clearSourceAdmin(atom_t sf_name)227 clearSourceAdmin(atom_t sf_name)
228 { GET_LD
229 int rc = FALSE;
230 fid_t fid;
231 static predicate_t pred = NULL;
232
233 if ( !pred )
234 pred = PL_predicate("$clear_source_admin", 1, "system");
235
236 if ( (fid=PL_open_foreign_frame()) )
237 { term_t name = PL_new_term_ref();
238
239 PL_put_atom(name, sf_name);
240 startCritical; /* block signals */
241 rc = PL_call_predicate(MODULE_system, PL_Q_NODEBUG, pred, name);
242 endCritical;
243
244 PL_discard_foreign_frame(fid);
245 }
246
247 return rc;
248 }
249
250
251 static atom_t
destroySourceFile(SourceFile sf)252 destroySourceFile(SourceFile sf)
253 { if ( sf->magic == SF_MAGIC )
254 { SourceFile f;
255 atom_t name;
256
257 sf->magic = SF_MAGIC_DESTROYING;
258 f = deleteHTable(GD->files.table, (void*)sf->name);
259 assert(f);
260 name = sf->name;
261 putSourceFileArray(sf->index, NULL);
262 if ( GD->files.no_hole_before > sf->index )
263 GD->files.no_hole_before = sf->index;
264 unallocSourceFile(sf);
265
266 return name;
267 }
268
269 return 0;
270 }
271
272
273 static SourceFile
lookupSourceFile_unlocked(atom_t name,int create)274 lookupSourceFile_unlocked(atom_t name, int create)
275 { GET_LD
276 SourceFile file;
277
278 if ( !GD->files.table )
279 { GD->files.table = newHTable(32);
280 GD->files.table->free_symbol = freeSymbolSourceFile;
281 GD->files.no_hole_before = 1;
282 }
283
284 if ( !(file=lookupHTable(GD->files.table, (void*)name)) &&
285 create )
286 { file = allocHeapOrHalt(sizeof(*file));
287 memset(file, 0, sizeof(*file));
288
289 file->name = name;
290 file->system = GD->bootsession;
291 file->from_state = GD->bootsession;
292 file->resource = GD->bootsession;
293 #ifdef O_PLMT
294 file->mutex = allocSimpleMutex(PL_atom_chars(name));
295 #endif
296 file->magic = SF_MAGIC;
297 PL_register_atom(file->name);
298 registerSourceFile(file);
299
300 addNewHTable(GD->files.table, (void*)name, file);
301 }
302
303 return file;
304 }
305
306
307 SourceFile
lookupSourceFile(atom_t name,int create)308 lookupSourceFile(atom_t name, int create)
309 { SourceFile sf;
310
311 PL_LOCK(L_SRCFILE);
312 sf = lookupSourceFile_unlocked(name, create);
313 if ( sf )
314 acquireSourceFile(sf);
315 PL_UNLOCK(L_SRCFILE);
316
317 return sf;
318 }
319
320
321 void
322 #ifdef O_DEBUG
acquireSourceFile_d(SourceFile sf,const char * file,unsigned int line)323 acquireSourceFile_d(SourceFile sf, const char *file, unsigned int line)
324 #else
325 acquireSourceFile(SourceFile sf)
326 #endif
327 { ATOMIC_INC(&sf->references);
328 DEBUG(MSG_SRCFILE_REF,
329 { Sdprintf("%d: acquireSourceFile(%s) at %s:%d --> %d\n",
330 PL_thread_self(), PL_atom_chars(sf->name), file, line, sf->references);
331 });
332 }
333
334
335 static void
acquireSourceFileNo(int index)336 acquireSourceFileNo(int index)
337 { SourceFile sf;
338
339 if ( (sf = indexToSourceFile(index)) )
340 return acquireSourceFile(sf);
341 }
342
343
344 int
345 #ifdef O_DEBUG
releaseSourceFile_d(SourceFile sf,const char * file,unsigned int line)346 releaseSourceFile_d(SourceFile sf, const char *file, unsigned int line)
347 #else
348 releaseSourceFile(SourceFile sf)
349 #endif
350 { DEBUG(MSG_SRCFILE_REF,
351 Sdprintf("%d: releaseSourceFile(%s) at %s:%d --> %d\n",
352 PL_thread_self(),
353 PL_atom_chars(sf->name),
354 file, line,
355 sf->references-1));
356
357 if ( sf->references <= 0 )
358 { Sdprintf("Oops: %d references for sourc file %s\n", PL_atom_chars(sf->name));
359 sf->references = 0x4000000;
360 }
361 if ( ATOMIC_DEC(&sf->references) == 0 )
362 { atom_t name = 0;
363
364 PL_LOCK(L_SRCFILE);
365 if ( sf->references == 0 &&
366 !sf->system &&
367 !sf->current_procedure &&
368 !sf->procedures &&
369 !sf->modules )
370 { DEBUG(MSG_DESTROY_MODULE,
371 Sdprintf("Destroying empty source file %s\n",
372 PL_atom_chars(sf->name)));
373 name = destroySourceFile(sf);
374 }
375 PL_UNLOCK(L_SRCFILE);
376
377 if ( name )
378 { int rc = clearSourceAdmin(name);
379 PL_unregister_atom(name);
380
381 return rc;
382 }
383 }
384
385 return TRUE;
386 }
387
388 int
releaseSourceFileNo(int index)389 releaseSourceFileNo(int index)
390 { SourceFile sf;
391
392 if ( (sf = indexToSourceFile(index)) )
393 return releaseSourceFile(sf);
394
395 return TRUE;
396 }
397
398 int
hasProcedureSourceFile(SourceFile sf,Procedure proc)399 hasProcedureSourceFile(SourceFile sf, Procedure proc)
400 { ListCell cell;
401
402 if ( true(proc->definition, FILE_ASSIGNED) )
403 { for(cell=sf->procedures; cell; cell = cell->next)
404 { if ( cell->value == proc )
405 return TRUE;
406 }
407 }
408
409 return FALSE;
410 }
411
412 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
413 addProcedureSourceFile(SourceFile, Procedure) associates a procedure to
414 a source file. Note that a procedure may be associated to multiple
415 source files.
416 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
417
418 void
addProcedureSourceFile(SourceFile sf,Procedure proc)419 addProcedureSourceFile(SourceFile sf, Procedure proc)
420 { if ( !(sf->index == proc->source_no && !sf->reload) )
421 { LOCKSRCFILE(sf);
422 if ( !hasProcedureSourceFile(sf, proc) )
423 { ListCell cell;
424
425 cell = allocHeapOrHalt(sizeof(struct list_cell));
426 cell->value = proc;
427 cell->next = sf->procedures;
428 sf->procedures = cell;
429 set(proc->definition, FILE_ASSIGNED);
430 if ( COMPARE_AND_SWAP_UINT(&proc->source_no, 0, sf->index) )
431 acquireSourceFile(sf);
432 else
433 set(proc, PROC_MULTISOURCE);
434 }
435 UNLOCKSRCFILE(sf);
436 }
437 }
438
439
440 /* Add a module to the source file. Note that we must add additional
441 modules at the end because '$already_loaded'/4 assumes that the first
442 module is the primary module of the file.
443 */
444
445 int
addModuleSourceFile(SourceFile sf,Module m)446 addModuleSourceFile(SourceFile sf, Module m)
447 { ListCell *cp, c2;
448 int rc = TRUE;
449
450 LOCKSRCFILE(sf);
451 for(cp=&sf->modules; *cp; cp = &(*cp)->next)
452 { ListCell cell = *cp;
453
454 if ( cell->value == m )
455 goto out;
456 }
457
458 if ( !(c2 = allocHeap(sizeof(struct list_cell))) )
459 { rc = FALSE; /* no memory */
460 goto out;
461 }
462 c2->value = m;
463 c2->next = NULL;
464 *cp = c2;
465
466 out:
467 UNLOCKSRCFILE(sf);
468 return rc;
469 }
470
471
472 static int
delModuleSourceFile(SourceFile sf,Module m)473 delModuleSourceFile(SourceFile sf, Module m)
474 { ListCell *cp, c;
475 int rc = FALSE;
476
477 LOCKSRCFILE(sf);
478 for(cp=&sf->modules; (c=*cp); cp=&c->next)
479 { if ( c->value == m )
480 { *cp = c->next;
481 freeHeap(c, sizeof(*c));
482
483 rc = TRUE;
484 break;
485 }
486 }
487 UNLOCKSRCFILE(sf);
488
489 return rc;
490 }
491
492
493 static void /* requires LOCKSRCFILE(sf) */
delAllModulesSourceFile__unlocked(SourceFile sf)494 delAllModulesSourceFile__unlocked(SourceFile sf)
495 { ListCell c = sf->modules, n;
496
497 sf->modules = NULL;
498
499 for(; c; c = n)
500 { Module m = c->value;
501
502 n = c->next;
503 if ( m->file == sf )
504 { PL_LOCK(L_MODULE);
505 m->file = NULL;
506 m->line_no = 0;
507 clearHTable(m->public);
508 PL_UNLOCK(L_MODULE);
509 }
510
511 freeHeap(c, sizeof(*c));
512 }
513 }
514
515
516 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
517 Remove all links from sf to m module. If sf becomes empty, we also
518 delete the source file.
519
520 (*) Although the system:$init_goal/3 clauses belong to the file, we'll
521 consider a file holding only initialization goals empty.
522 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
523
524 void
unlinkSourceFileModule(SourceFile sf,Module m)525 unlinkSourceFileModule(SourceFile sf, Module m)
526 { GET_LD
527 ListCell cell, next, prev = NULL;
528
529 LOCKSRCFILE(sf);
530
531 DEBUG(MSG_DESTROY_MODULE,
532 Sdprintf("Cleaning %s\n", PL_atom_chars(sf->name)));
533
534 for(cell=sf->procedures; cell; cell=next)
535 { Procedure proc;
536 Definition def;
537
538 next = cell->next;
539 proc = cell->value;
540 def = proc->definition;
541
542 if ( lookupHTable(m->procedures, (void*)def->functor->functor) ||
543 PROCEDURE_dinit_goal->definition == def ) /* see (*) */
544 { if ( sf->current_procedure == proc )
545 sf->current_procedure = NULL;
546
547 if ( prev )
548 prev->next = cell->next;
549 else
550 sf->procedures = cell->next;
551 freeHeap(cell, sizeof(*cell));
552 } else
553 { DEBUG(MSG_DESTROY_MODULE,
554 Sdprintf(" Keeping %s\n", procedureName(proc)));
555 prev = cell;
556 }
557 }
558
559 UNLOCKSRCFILE(sf);
560 }
561
562
563 /** '$source_file'(:Head, -File) is semidet.
564 */
565
566 static
567 PRED_IMPL("$source_file", 2, source_file, PL_FA_TRANSPARENT)
568 { PRED_LD
569 Procedure proc;
570 SourceFile sf;
571
572 term_t descr = A1;
573 term_t file = A2;
574
575 if ( get_procedure(descr, &proc, 0, GP_FINDHERE) )
576 { if ( isDefinedProcedure(proc) &&
577 (sf = indexToSourceFile(proc->source_no)) &&
578 sf->count > 0 )
579 return PL_unify_atom(file, sf->name);
580 }
581
582 return FALSE;
583 }
584
585 /** '$source_file_predicates'(+File, -Heads:list(callable)) is semidet.
586 */
587
588 static
589 PRED_IMPL("$source_file_predicates", 2, source_file_predicates, 0)
590 { PRED_LD
591 atom_t name;
592 int rc = TRUE;
593 SourceFile sf;
594
595 term_t file = A1;
596
597 PL_LOCK(L_SRCFILE);
598 if ( PL_get_atom_ex(file, &name) &&
599 (sf = lookupSourceFile_unlocked(name, FALSE)) &&
600 sf->count > 0 )
601 { term_t tail = PL_copy_term_ref(A2);
602 term_t head = PL_new_term_ref();
603 ListCell cell;
604
605 LOCKSRCFILE(sf);
606 for(cell=sf->procedures; rc && cell; cell = cell->next )
607 { Procedure proc = cell->value;
608 Definition def = proc->definition;
609
610 rc = ( PL_unify_list(tail, head, tail) &&
611 unify_definition(MODULE_user, head, def, 0, GP_QUALIFY)
612 );
613 }
614 rc = (rc && PL_unify_nil(tail));
615 UNLOCKSRCFILE(sf);
616 } else
617 rc = FALSE;
618 PL_UNLOCK(L_SRCFILE);
619
620 return rc;
621 }
622
623
624 static
625 PRED_IMPL("$time_source_file", 3, time_source_file, PL_FA_NONDETERMINISTIC)
626 { PRED_LD
627 int index;
628 int mx = highSourceFileIndex();
629 term_t file = A1;
630 term_t time = A2;
631 term_t type = A3; /* user or system */
632 fid_t fid;
633
634 switch( CTX_CNTRL )
635 { case FRG_FIRST_CALL:
636 index = 0;
637 break;
638 case FRG_REDO:
639 index = (int)CTX_INT;
640 break;
641 case FRG_CUTTED:
642 default:
643 succeed;
644 }
645
646 fid = PL_open_foreign_frame();
647 for(; index < mx; index++)
648 { SourceFile f = indexToSourceFile(index);
649
650 if ( f == NULL || f->count == 0 )
651 continue;
652
653 if ( PL_unify_atom(file, f->name) &&
654 PL_unify_float(time, f->mtime) &&
655 PL_unify_atom(type, f->system ? ATOM_system : ATOM_user) )
656 { PL_close_foreign_frame(fid);
657 ForeignRedoInt(index+1);
658 }
659
660 PL_rewind_foreign_frame(fid);
661 }
662
663 PL_close_foreign_frame(fid);
664 fail;
665 }
666
667
668 /** '$source_file_property'(+SrcFile, +Property, -Value) is semidet.
669 */
670
671 static
672 PRED_IMPL("$source_file_property", 3, source_file_property, 0)
673 { PRED_LD
674 atom_t filename, property;
675
676 if ( PL_get_atom_ex(A1, &filename) &&
677 PL_get_atom_ex(A2, &property) )
678 { SourceFile sf = lookupSourceFile(filename, FALSE);
679 int rc;
680
681 if ( property == ATOM_load_count )
682 rc = PL_unify_integer(A3, sf ? sf->count : 0);
683 else if ( property == ATOM_reloading )
684 rc = PL_unify_bool(A3, sf ? sf->reload != NULL : 0);
685 else if ( property == ATOM_number_of_clauses )
686 rc = PL_unify_integer(A3, sf ? sf->number_of_clauses : 0);
687 else if ( property == ATOM_resource )
688 rc = PL_unify_bool(A3, sf ? sf->resource : FALSE);
689 else if ( property == ATOM_from_state )
690 rc = PL_unify_bool(A3, sf ? sf->from_state : FALSE);
691 else
692 rc = PL_domain_error("source_file_property", A2);
693
694 if ( sf )
695 releaseSourceFile(sf);
696
697 return rc;
698 }
699
700 return FALSE;
701 }
702
703 static
704 PRED_IMPL("$set_source_file", 3, set_source_file, 0)
705 { PRED_LD
706 atom_t filename, property;
707 SourceFile sf;
708
709 if ( !PL_get_atom_ex(A1, &filename) ||
710 !PL_get_atom_ex(A2, &property) )
711 return FALSE;
712
713 if ( (sf = lookupSourceFile(filename, FALSE)) )
714 { int rc;
715
716 if ( property == ATOM_resource )
717 { int v;
718
719 if ( PL_get_bool_ex(A3, &v) )
720 { sf->resource = v;
721 rc = TRUE;
722 } else
723 rc = FALSE;
724 } else
725 rc = PL_domain_error("source_file_property", A2);
726
727 releaseSourceFile(sf);
728 return rc;
729 } else
730 return PL_existence_error("source_file", A1);
731
732 }
733
734 static
735 PRED_IMPL("$set_source_files", 1, set_source_files, 0)
736 { PRED_LD
737 atom_t prop;
738
739 if ( !PL_get_atom_ex(A1, &prop) )
740 return FALSE;
741 if ( prop == ATOM_system || prop == ATOM_from_state )
742 { int i, n;
743
744 PL_LOCK(L_SRCFILE);
745 n = highSourceFileIndex();
746 for(i=1; i<n; i++)
747 { SourceFile f = indexToSourceFile(i);
748
749 if ( f )
750 { if ( prop == ATOM_system )
751 f->system = TRUE;
752 f->from_state = TRUE;
753 }
754 }
755 PL_UNLOCK(L_SRCFILE);
756
757 return TRUE;
758 } else
759 return PL_domain_error("source_property", A1);
760 }
761
762
763 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
764 unloadFile(SourceFile sf)
765 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
766
767 static int
unloadFile(SourceFile sf)768 unloadFile(SourceFile sf)
769 { ListCell cell, next;
770 size_t deleted = 0;
771 int rc;
772
773 delayEvents();
774 LOCKSRCFILE(sf);
775 /* remove the clauses */
776 for(cell = sf->procedures; cell; cell = cell->next)
777 { Procedure proc = cell->value;
778 Definition def = proc->definition;
779
780 if ( false(def, P_FOREIGN|P_THREAD_LOCAL) )
781 { deleted += removeClausesPredicate(
782 def, true(def, P_MULTIFILE) ? sf->index : 0, TRUE);
783 }
784
785 DEBUG(MSG_UNLOAD,
786 if ( false(def, P_MULTIFILE) && def->impl.clauses.number_of_clauses )
787 Sdprintf("%s: %d clauses after unload\n",
788 predicateName(def), def->impl.clauses.number_of_clauses));
789
790 if ( false(def, P_MULTIFILE) )
791 { clear(def, FILE_ASSIGNED);
792 clear_meta_declaration(def);
793 }
794 }
795 DEBUG(MSG_UNLOAD, Sdprintf("Removed %ld clauses\n", (long)deleted));
796
797 /* cleanup the procedure list */
798 for(cell = sf->procedures; cell; cell = next)
799 { next = cell->next;
800 freeHeap(cell, sizeof(struct list_cell));
801 }
802 sf->procedures = NULL;
803
804 delAllModulesSourceFile__unlocked(sf);
805 UNLOCKSRCFILE(sf);
806
807 rc = sendDelayedEvents(TRUE) >= 0;
808 pl_garbage_collect_clauses();
809
810 return rc;
811 }
812
813
814 /** '$unload_file'(+Name) is det.
815
816 Remove all traces of a loaded file.
817 */
818
819 static
820 PRED_IMPL("$unload_file", 1, unload_file, 0)
821 { PRED_LD
822 SourceFile sf;
823 atom_t name;
824
825 if ( !PL_get_atom_ex(A1, &name) )
826 return FALSE;
827
828 if ( (sf = lookupSourceFile(name, FALSE)) )
829 { ListCell mc, mcn;
830 int rc;
831
832 if ( sf->system )
833 { rc = PL_error(NULL, 0, NULL, ERR_PERMISSION,
834 ATOM_unload, ATOM_file, A1);
835 } else
836 { if ( unloadFile(sf) )
837 { for(mc=sf->modules; mc; mc=mcn)
838 { Module m = mc->value;
839
840 mcn = mc->next;
841 LOCKMODULE(m);
842 m->file = NULL;
843 m->line_no = 0;
844 delModuleSourceFile(sf, m);
845 clearHTable(m->public);
846 setSuperModule(m, MODULE_user);
847 UNLOCKMODULE(m);
848 }
849 rc = TRUE;
850 } else
851 rc = FALSE;
852 }
853
854 releaseSourceFile(sf);
855 return rc;
856 }
857
858 return TRUE;
859 }
860
861
862 /*******************************
863 * RECONSULT *
864 *******************************/
865
866 static void fix_discontiguous(p_reload *r);
867 static void fix_metapredicate(p_reload *r);
868
869 #ifdef O_PLMT
870 #define GEN_RELOAD (GEN_MAX-PL_thread_self())
871 #else
872 #define GEN_RELOAD (GEN_MAX-1)
873 #endif
874
875 static int
startReconsultFile(SourceFile sf)876 startReconsultFile(SourceFile sf)
877 { GET_LD
878 sf_reload *r;
879
880 DEBUG(MSG_RECONSULT, Sdprintf("Reconsult %s ...\n", sourceFileName(sf)));
881
882 if ( (r = allocHeap(sizeof(*sf->reload))) )
883 { ListCell cell;
884
885 memset(r, 0, sizeof(*r));
886 r->procedures = newHTable(16);
887 r->reload_gen = GEN_RELOAD;
888 r->pred_access_count = popNPredicateAccess(0);
889 sf->reload = r;
890
891 LD->gen_reload = r->reload_gen;
892
893 for(cell = sf->procedures; cell; cell = cell->next)
894 { Procedure proc = cell->value;
895 Definition def = proc->definition;
896 ClauseRef c;
897
898 if ( false(def, P_FOREIGN|P_THREAD_LOCAL) )
899 { acquire_def(def);
900 for(c = def->impl.clauses.first_clause; c; c = c->next)
901 { Clause cl = c->value.clause;
902
903 if ( !GLOBALLY_VISIBLE_CLAUSE(cl, global_generation()) ||
904 true(cl, CL_ERASED) )
905 continue;
906 if ( true(def, P_MULTIFILE) && cl->owner_no != sf->index )
907 continue;
908 if ( true(def, P_DYNAMIC) && cl->owner_no == 0 )
909 continue;
910
911 cl->generation.erased = r->reload_gen;
912 }
913 release_def(def);
914 }
915 if ( true(def, P_AUTOLOAD) )
916 { clear(def, P_AUTOLOAD); /* should be be more selective? */
917 }
918 }
919
920 return TRUE;
921 }
922
923 return PL_no_memory();
924 }
925
926
927 static ClauseRef
find_clause(ClauseRef cref,gen_t generation)928 find_clause(ClauseRef cref, gen_t generation)
929 { for(; cref; cref = cref->next)
930 { if ( GLOBALLY_VISIBLE_CLAUSE(cref->value.clause, generation) )
931 break;
932 }
933
934 return cref;
935 }
936
937
938 static void
advance_clause(p_reload * r ARG_LD)939 advance_clause(p_reload *r ARG_LD)
940 { ClauseRef cref;
941
942 if ( (cref = r->current_clause) )
943 { acquire_def(r->predicate);
944 for(cref = cref->next; cref; cref = cref->next)
945 { if ( GLOBALLY_VISIBLE_CLAUSE(cref->value.clause, r->generation) )
946 break;
947 }
948 release_def(r->predicate);
949 r->current_clause = cref;
950 }
951 }
952
953
954 static void
copy_clause_source(Clause dest,Clause src)955 copy_clause_source(Clause dest, Clause src)
956 { dest->line_no = src->line_no;
957 if ( dest->source_no != src->source_no ||
958 dest->owner_no != src->owner_no )
959 { acquireSourceFileNo(src->owner_no);
960 if ( src->source_no != src->owner_no )
961 acquireSourceFileNo(src->source_no);
962 releaseSourceFileNo(dest->owner_no);
963 if ( dest->source_no != dest->owner_no )
964 releaseSourceFileNo(dest->source_no);
965 dest->source_no = src->source_no;
966 dest->owner_no = src->owner_no;
967 }
968 }
969
970
971 static ClauseRef
keep_clause(p_reload * r,Clause clause ARG_LD)972 keep_clause(p_reload *r, Clause clause ARG_LD)
973 { ClauseRef cref = r->current_clause;
974 Clause keep = cref->value.clause;
975
976 keep->generation.erased = GEN_MAX;
977 copy_clause_source(keep, clause);
978 freeClause(clause);
979 advance_clause(r PASS_LD);
980
981 return cref;
982 }
983
984
985 static int
equal_clause(Clause cl1,Clause cl2)986 equal_clause(Clause cl1, Clause cl2)
987 { if ( cl1->code_size == cl2->code_size )
988 { size_t bytes = (size_t)cl1->code_size * sizeof(code);
989
990 return memcmp(cl1->codes, cl2->codes, bytes) == 0;
991 }
992
993 return FALSE;
994 }
995
996
997 int
reloadHasClauses(SourceFile sf,Procedure proc ARG_LD)998 reloadHasClauses(SourceFile sf, Procedure proc ARG_LD)
999 { p_reload *reload;
1000
1001 if ( sf->reload && (reload=lookupHTable(sf->reload->procedures, proc)) )
1002 { return reload->number_of_clauses > 0;
1003 }
1004
1005 return FALSE;
1006 }
1007
1008
1009 int
isRedefinedProcedure(Procedure proc,gen_t gen)1010 isRedefinedProcedure(Procedure proc, gen_t gen)
1011 { GET_LD
1012 Definition def = proc->definition;
1013 ClauseRef c;
1014 int ret = FALSE;
1015
1016 acquire_def(def);
1017 for(c = def->impl.clauses.first_clause; c; c = c->next)
1018 { Clause cl = c->value.clause;
1019 if ( GLOBALLY_VISIBLE_CLAUSE(cl, gen) )
1020 { ret = TRUE;
1021 break;
1022 }
1023 }
1024 release_def(def);
1025
1026 return ret;
1027 }
1028
1029
1030 static p_reload *
reloadContext(SourceFile sf,Procedure proc ARG_LD)1031 reloadContext(SourceFile sf, Procedure proc ARG_LD)
1032 { p_reload *reload;
1033
1034 if ( !(reload = lookupHTable(sf->reload->procedures, proc)) )
1035 { Definition def = proc->definition;
1036
1037 if ( !(reload = allocHeap(sizeof(*reload))) )
1038 { PL_no_memory();
1039 return NULL;
1040 }
1041 memset(reload, 0, sizeof(*reload));
1042 reload->predicate = def;
1043 if ( true(def, P_THREAD_LOCAL|P_FOREIGN) )
1044 { set(reload, P_NO_CLAUSES);
1045 } else if ( isRedefinedProcedure(proc, global_generation()) )
1046 { reload->generation = pushPredicateAccess(def);
1047 acquire_def(def);
1048 reload->current_clause = find_clause(def->impl.clauses.first_clause,
1049 reload->generation);
1050 release_def(def);
1051 } else
1052 { set(reload, P_NEW);
1053 }
1054 addNewHTable(sf->reload->procedures, proc, reload);
1055 DEBUG(MSG_RECONSULT_PRED,
1056 Sdprintf("%s %s ...\n",
1057 true(reload, P_NEW) ? "New" :
1058 true(reload, P_NO_CLAUSES) ? "Alien" :
1059 "Reload",
1060 predicateName(def)));
1061 }
1062
1063 return reload;
1064 }
1065
1066
1067 ClauseRef
assertProcedureSource(SourceFile sf,Procedure proc,Clause clause ARG_LD)1068 assertProcedureSource(SourceFile sf, Procedure proc, Clause clause ARG_LD)
1069 { if ( sf && sf->reload )
1070 { p_reload *reload;
1071 Definition def = proc->definition;
1072 ClauseRef cref;
1073
1074 assert(proc == sf->current_procedure);
1075
1076 sf->reload->number_of_clauses++;
1077
1078 if ( !(reload = reloadContext(sf, proc PASS_LD)) )
1079 { freeClause(clause);
1080 return NULL;
1081 }
1082
1083 if ( reload->number_of_clauses++ == 0 )
1084 fix_discontiguous(reload);
1085
1086 if ( true(reload, P_NEW|P_NO_CLAUSES) )
1087 return assertProcedure(proc, clause, CL_END PASS_LD);
1088
1089 if ( (cref = reload->current_clause) )
1090 { ClauseRef cref2;
1091
1092 if ( equal_clause(cref->value.clause, clause) )
1093 { DEBUG(MSG_RECONSULT_CLAUSE,
1094 Sdprintf(" Keeping clause %d\n",
1095 clauseNo(cref->value.clause, reload->generation)));
1096 return keep_clause(reload, clause PASS_LD);
1097 }
1098
1099 set(reload, P_MODIFIED);
1100
1101 acquire_def(def);
1102 for(cref2 = cref->next; cref2; cref2 = cref2->next)
1103 { Clause c2 = cref2->value.clause;
1104
1105 if ( !GLOBALLY_VISIBLE_CLAUSE(c2, reload->generation) )
1106 continue;
1107 if ( true(def, P_MULTIFILE) && c2->owner_no != sf->index )
1108 continue;
1109
1110 if ( equal_clause(c2, clause) )
1111 { ClauseRef del;
1112
1113 for(del = cref; del != cref2; del = del->next)
1114 { Clause c = del->value.clause;
1115
1116 if ( !GLOBALLY_VISIBLE_CLAUSE(c, reload->generation) ||
1117 true(c, CL_ERASED) )
1118 continue;
1119 if ( true(def, P_MULTIFILE) && c->owner_no != sf->index )
1120 continue;
1121
1122 DEBUG(MSG_RECONSULT_CLAUSE,
1123 Sdprintf(" Deleted clause %d\n",
1124 clauseNo(c, reload->generation)));
1125 }
1126 release_def(def);
1127
1128 reload->current_clause = cref2;
1129 DEBUG(MSG_RECONSULT_CLAUSE,
1130 Sdprintf(" Keeping clause %d\n",
1131 clauseNo(cref2->value.clause, reload->generation)));
1132 return keep_clause(reload, clause PASS_LD);
1133 }
1134 }
1135 release_def(def);
1136
1137 DEBUG(MSG_RECONSULT_CLAUSE,
1138 Sdprintf(" Inserted before clause %d\n",
1139 clauseNo(cref->value.clause, reload->generation)));
1140 if ( (cref2 = assertProcedure(proc, clause, cref PASS_LD)) )
1141 cref2->value.clause->generation.created = sf->reload->reload_gen;
1142
1143 return cref2;
1144 } else
1145 { if ( (cref = assertProcedure(proc, clause, CL_END PASS_LD)) )
1146 cref->value.clause->generation.created = sf->reload->reload_gen;
1147 DEBUG(MSG_RECONSULT_CLAUSE, Sdprintf(" Added at the end\n"));
1148
1149 set(reload, P_MODIFIED);
1150
1151 return cref;
1152 }
1153 } else if ( sf )
1154 { sf->number_of_clauses++;
1155 }
1156
1157 return assertProcedure(proc, clause, CL_END PASS_LD);
1158 }
1159
1160
1161 static void
associateSource(SourceFile sf,Procedure proc)1162 associateSource(SourceFile sf, Procedure proc)
1163 { Definition def = proc->definition;
1164
1165 if ( false(def, FILE_ASSIGNED) )
1166 { GET_LD
1167
1168 DEBUG(2, Sdprintf("Associating %s to %s (%p)\n",
1169 predicateName(def), PL_atom_chars(source_file_name),
1170 def));
1171 addProcedureSourceFile(sf, proc);
1172
1173 if ( SYSTEM_MODE )
1174 { set(def, P_LOCKED|HIDE_CHILDS);
1175 } else
1176 { if ( truePrologFlag(PLFLAG_DEBUGINFO) )
1177 clear(def, HIDE_CHILDS);
1178 else
1179 set(def, HIDE_CHILDS);
1180 }
1181 }
1182 }
1183
1184
1185 #define P_ATEND (P_VOLATILE|P_PUBLIC|P_ISO|P_NOPROFILE|P_NON_TERMINAL)
1186
1187 int
setAttrProcedureSource(SourceFile sf,Procedure proc,unsigned attr,int val ARG_LD)1188 setAttrProcedureSource(SourceFile sf, Procedure proc,
1189 unsigned attr, int val ARG_LD)
1190 { if ( val && (attr&PROC_DEFINED) )
1191 associateSource(sf, proc);
1192
1193 if ( sf->reload )
1194 { p_reload *reload;
1195
1196 if ( !(reload = reloadContext(sf, proc PASS_LD)) )
1197 return FALSE;
1198
1199 if ( val )
1200 set(reload, attr);
1201 else
1202 clear(reload, attr);
1203
1204 if ( (attr&(P_ATEND|P_TRANSPARENT)) )
1205 return TRUE;
1206 }
1207
1208 return setAttrDefinition(proc->definition, attr, val);
1209 }
1210
1211
1212 static void
fix_attributes(SourceFile sf,Definition def,p_reload * r ARG_LD)1213 fix_attributes(SourceFile sf, Definition def, p_reload *r ARG_LD)
1214 { if ( false(def, P_MULTIFILE) )
1215 def->flags = (def->flags & ~P_ATEND) | (r->flags & P_ATEND);
1216 else
1217 def->flags |= (r->flags&P_ATEND);
1218
1219 fix_metapredicate(r);
1220 }
1221
1222
1223 static void
fix_discontiguous(p_reload * r)1224 fix_discontiguous(p_reload *r)
1225 { Definition def = r->predicate;
1226
1227 if ( true(def, P_DISCONTIGUOUS) && false(r, P_DISCONTIGUOUS) )
1228 clear(def, P_DISCONTIGUOUS);
1229 }
1230
1231
1232 int
setMetapredicateSource(SourceFile sf,Procedure proc,arg_info * args ARG_LD)1233 setMetapredicateSource(SourceFile sf, Procedure proc,
1234 arg_info *args ARG_LD)
1235 { associateSource(sf, proc);
1236
1237 if ( sf->reload )
1238 { p_reload *reload;
1239 size_t i, arity = proc->definition->functor->arity;
1240
1241 if ( !(reload = reloadContext(sf, proc PASS_LD)) )
1242 return FALSE;
1243
1244 if ( !reload->args )
1245 reload->args = allocHeapOrHalt(sizeof(*reload->args)*arity);
1246 for(i=0; i<arity; i++)
1247 reload->args[i].meta = args[i].meta;
1248
1249 if ( isTransparentMetamask(proc->definition, args) )
1250 set(reload, P_TRANSPARENT);
1251 else
1252 clear(reload, P_TRANSPARENT);
1253 set(reload, P_META);
1254 } else
1255 { setMetapredicateMask(proc->definition, args);
1256 }
1257
1258 return TRUE;
1259 }
1260
1261
1262 static int
equal_meta(Definition def,const arg_info * args)1263 equal_meta(Definition def, const arg_info *args)
1264 { if ( def->impl.any.args && args )
1265 { size_t i, arity = def->functor->arity;
1266
1267 for(i=0; i<arity; i++)
1268 { if ( def->impl.any.args[i].meta != args[i].meta )
1269 return FALSE;
1270 }
1271
1272 return TRUE;
1273 }
1274
1275 return FALSE;
1276 }
1277
1278 static void
fix_metapredicate(p_reload * r)1279 fix_metapredicate(p_reload *r)
1280 { Definition def = r->predicate;
1281
1282 if ( false(def, P_MULTIFILE) )
1283 { int mfmask = (P_META|P_TRANSPARENT);
1284
1285 if ( (def->flags&mfmask) != (r->flags&mfmask) ||
1286 !equal_meta(def, r->args) )
1287 { if ( true(def, P_META) && false(r, P_META) )
1288 clear_meta_declaration(def);
1289 else if ( true(r, P_META) )
1290 setMetapredicateMask(def, r->args);
1291 clear(def, P_TRANSPARENT);
1292 set(def, r->flags&P_TRANSPARENT);
1293
1294 freeCodesDefinition(def, FALSE);
1295 }
1296 } else if ( true(r, P_META) )
1297 { setMetapredicateMask(def, r->args);
1298 freeCodesDefinition(def, FALSE);
1299 } else if ( true(r, P_TRANSPARENT) )
1300 { set(def, P_TRANSPARENT);
1301 }
1302 }
1303
1304
1305 void
registerReloadModule(SourceFile sf,Module module)1306 registerReloadModule(SourceFile sf, Module module)
1307 { GET_LD
1308 m_reload *r;
1309
1310 if ( sf->reload )
1311 { Table mt;
1312
1313 if ( !(mt=sf->reload->modules) )
1314 mt = sf->reload->modules = newHTable(8);
1315
1316 if ( !(r=lookupHTable(mt, module)) )
1317 { r = allocHeapOrHalt(sizeof(*r));
1318 memset(r, 0, sizeof(*r));
1319 addNewHTable(mt, module, r);
1320 }
1321 }
1322 }
1323
1324
1325 int
exportProcedureSource(SourceFile sf,Module module,Procedure proc)1326 exportProcedureSource(SourceFile sf, Module module, Procedure proc)
1327 { GET_LD
1328 m_reload *r;
1329
1330 if ( sf->reload && sf->reload->modules &&
1331 (r = lookupHTable(sf->reload->modules, module)) )
1332 { if ( !r->public )
1333 r->public = newHTable(8);
1334 updateHTable(r->public,
1335 (void *)proc->definition->functor->functor,
1336 proc);
1337 }
1338
1339 return exportProcedure(module, proc);
1340 }
1341
1342
1343 static void
fix_module(Module m,m_reload * r)1344 fix_module(Module m, m_reload *r)
1345 { GET_LD
1346
1347 LOCKMODULE(m);
1348 for_table(m->public, n, v,
1349 { if ( !r->public ||
1350 !lookupHTable(r->public, n) )
1351 { DEBUG(MSG_RECONSULT_MODULE,
1352 Sdprintf("Delete export %s\n",
1353 procedureName(v)));
1354 deleteHTable(m->public, n);
1355 }
1356 });
1357 UNLOCKMODULE(m);
1358 }
1359
1360
1361 static void
delete_old_predicate(SourceFile sf,Procedure proc)1362 delete_old_predicate(SourceFile sf, Procedure proc)
1363 { Definition def = proc->definition;
1364 size_t deleted;
1365
1366 if ( def->functor->functor == FUNCTOR_dtabled2 )
1367 { GET_LD
1368 ClauseRef c;
1369
1370 acquire_def(def);
1371 for(c = def->impl.clauses.first_clause; c; c = c->next)
1372 { Clause cl = c->value.clause;
1373
1374 if ( false(cl, CL_ERASED) &&
1375 GLOBALLY_VISIBLE_CLAUSE(cl, global_generation()) )
1376 untable_from_clause(cl);
1377 }
1378 release_def(def);
1379 }
1380
1381 deleted = removeClausesPredicate(
1382 def,
1383 true(def, P_MULTIFILE) ? sf->index : 0,
1384 TRUE);
1385
1386 if ( false(def, P_MULTIFILE) )
1387 { clear(def, FILE_ASSIGNED);
1388 clear_meta_declaration(def);
1389 freeCodesDefinition(def, TRUE);
1390 }
1391
1392 DEBUG(MSG_RECONSULT_PRED,
1393 Sdprintf("Deleted %ld clauses from predicate %s\n",
1394 (long)deleted, predicateName(def)));
1395
1396 (void)deleted;
1397 }
1398
1399
1400 static void
delete_old_predicates(SourceFile sf)1401 delete_old_predicates(SourceFile sf)
1402 { GET_LD
1403 ListCell cell, prev = NULL, next;
1404
1405 for(cell = sf->procedures; cell; cell = next)
1406 { Procedure proc = cell->value;
1407
1408 next = cell->next;
1409
1410 if ( false(proc->definition, P_FOREIGN) &&
1411 !lookupHTable(sf->reload->procedures, proc) )
1412 { delete_old_predicate(sf, proc);
1413
1414 if ( prev )
1415 prev->next = cell->next;
1416 else
1417 sf->procedures = cell->next;
1418 } else
1419 { prev = cell;
1420 }
1421 }
1422 }
1423
1424
1425 static void
delete_pending_clauses(SourceFile sf,Definition def,p_reload * r ARG_LD)1426 delete_pending_clauses(SourceFile sf, Definition def, p_reload *r ARG_LD)
1427 { ClauseRef cref;
1428 sf_reload *rl = sf->reload;
1429
1430 acquire_def(def);
1431 for(cref = r->current_clause; cref; cref = cref->next)
1432 { Clause c = cref->value.clause;
1433
1434 if ( !GLOBALLY_VISIBLE_CLAUSE(c, r->generation) ||
1435 true(c, CL_ERASED) )
1436 continue;
1437 if ( true(r->predicate, P_MULTIFILE|P_DYNAMIC) && c->owner_no != sf->index )
1438 continue;
1439
1440 if ( def->functor->functor == FUNCTOR_dtabled2 )
1441 untable_from_clause(c);
1442
1443 c->generation.erased = rl->reload_gen;
1444 set(r, P_MODIFIED);
1445 DEBUG(MSG_RECONSULT_CLAUSE,
1446 Sdprintf(" %s: deleted clause %d\n",
1447 predicateName(def),
1448 clauseNo(c, r->generation)));
1449 }
1450 release_def(def);
1451 }
1452
1453
1454 static size_t
end_reconsult_proc(SourceFile sf,Procedure proc,p_reload * r ARG_LD)1455 end_reconsult_proc(SourceFile sf, Procedure proc, p_reload *r ARG_LD)
1456 { size_t dropped_access = 0;
1457
1458 DEBUG(MSG_RECONSULT_CLAUSE,
1459 Sdprintf("Fixup %s\n", predicateName(proc->definition)));
1460
1461 if ( false(r, P_NEW|P_NO_CLAUSES) )
1462 { Definition def = proc->definition;
1463
1464 delete_pending_clauses(sf, def, r PASS_LD);
1465 fix_attributes(sf, def, r PASS_LD);
1466 reconsultFinalizePredicate(sf->reload, def, r PASS_LD);
1467 } else
1468 { dropped_access++;
1469 if ( true(r, P_NO_CLAUSES) )
1470 { Definition def = proc->definition;
1471 fix_attributes(sf, def, r PASS_LD);
1472 }
1473 }
1474 if ( r->args )
1475 freeHeap(r->args, 0);
1476 freeHeap(r, sizeof(*r));
1477
1478 return dropped_access;
1479 }
1480
1481
1482 static int
endReconsult(SourceFile sf)1483 endReconsult(SourceFile sf)
1484 { GET_LD
1485 sf_reload *reload;
1486
1487 if ( (reload=sf->reload) )
1488 { size_t accessed_preds = reload->procedures->size;
1489
1490 delayEvents();
1491 delete_old_predicates(sf);
1492
1493 for_table(reload->procedures, n, v,
1494 { Procedure proc = n;
1495 p_reload *r = v;
1496
1497 accessed_preds -= end_reconsult_proc(sf, proc, r PASS_LD);
1498 });
1499
1500 popNPredicateAccess(accessed_preds);
1501 assert(reload->pred_access_count == popNPredicateAccess(0));
1502 destroyHTable(reload->procedures);
1503
1504 if ( reload->modules )
1505 { for_table(reload->modules, n, v,
1506 { Module m = n;
1507 m_reload *r = v;
1508
1509 fix_module(m, r);
1510 if ( r->public )
1511 destroyHTable(r->public);
1512 freeHeap(r, sizeof(*r));
1513 });
1514 destroyHTable(reload->modules);
1515 }
1516
1517 sf->number_of_clauses = sf->reload->number_of_clauses;
1518 sf->reload = NULL;
1519 freeHeap(reload, sizeof(*reload));
1520
1521 LD->gen_reload = GEN_INVALID;
1522
1523 pl_garbage_collect_clauses();
1524 if ( sendDelayedEvents(TRUE) < 0 )
1525 return FALSE;
1526 }
1527
1528 return TRUE;
1529 }
1530
1531
1532 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1533 Flush the definition of proc in the context of (reloading) the source
1534 file sf. This performs the following steps:
1535
1536 - If we have not seen the predicate, remove all clauses we may have
1537 for it and add as P_NEW.
1538 - If we have seen the predicate, perform the generation sync we would
1539 normally do at the end of the file and mark the predicate reload
1540 context as P_NEW.
1541
1542 `proc` is a predicate indicator. If it is not qualified, it is resolved
1543 against M in prolog_load_context(module, M).
1544 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1545
1546 static int
flush_procedure(SourceFile sf,Procedure proc)1547 flush_procedure(SourceFile sf, Procedure proc)
1548 { GET_LD
1549 sf_reload *reload;
1550
1551 if ( (reload=sf->reload) )
1552 { p_reload *r;
1553
1554 if ( (r=lookupHTable(sf->reload->procedures, proc)) )
1555 { if ( false(r, P_NEW|P_NO_CLAUSES) )
1556 { Definition def = proc->definition;
1557
1558 delete_pending_clauses(sf, def, r PASS_LD);
1559 fix_attributes(sf, def, r PASS_LD);
1560 reconsultFinalizePredicate(reload, def, r PASS_LD);
1561 }
1562 } else
1563 { delete_old_predicate(sf, proc);
1564 (void)reloadContext(sf, proc PASS_LD);
1565 }
1566 }
1567
1568 return TRUE;
1569 }
1570
1571
1572 /*******************************
1573 * CONSULT *
1574 *******************************/
1575
1576 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
1577 startConsult(SourceFile sf)
1578
1579 This function is called when starting the consult a file. Its task is to
1580 remove all clauses that come from this file if this is a *reconsult*.
1581 There are two options.
1582
1583 * Immediately remove the clauses from any non-referenced predicate.
1584 This saves space, but if there are multiple threads it may cause
1585 other threads to trap an undefined predicate.
1586
1587 * Delay until garbage_collect_clauses/0
1588 This way other threads can happily keep running.
1589 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
1590
1591 int
startConsult(SourceFile sf)1592 startConsult(SourceFile sf)
1593 { acquireSourceFile(sf);
1594 if ( sf->count++ > 0 ) /* This is a re-consult */
1595 { if ( !startReconsultFile(sf) )
1596 { releaseSourceFile(sf);
1597 return FALSE;
1598 }
1599 }
1600
1601 sf->current_procedure = NULL;
1602 return TRUE;
1603 }
1604
1605
1606 /** '$start_consult'(+Id, +Modified) is det.
1607 */
1608
1609 static
1610 PRED_IMPL("$start_consult", 2, start_consult, 0)
1611 { PRED_LD
1612 atom_t name;
1613 double time;
1614
1615 term_t file = A1;
1616 term_t modified = A2;
1617
1618 if ( PL_get_atom_ex(file, &name) &&
1619 PL_get_float_ex(modified, &time) )
1620 { SourceFile sf = lookupSourceFile(name, TRUE);
1621
1622 sf->mtime = time;
1623 startConsult(sf);
1624 releaseSourceFile(sf);
1625
1626 return TRUE;
1627 }
1628
1629 return FALSE;
1630 }
1631
1632
1633 int
endConsult(SourceFile sf)1634 endConsult(SourceFile sf)
1635 { int rc;
1636
1637 sf->current_procedure = NULL;
1638 rc = endReconsult(sf);
1639 releaseSourceFile(sf);
1640
1641 return rc;
1642 }
1643
1644
1645 static
1646 PRED_IMPL("$fixup_reconsult", 1, fixup_reconsult, 0)
1647 { PRED_LD
1648 atom_t name;
1649 int rc = FALSE;
1650
1651 if ( PL_get_atom_ex(A1, &name) )
1652 { SourceFile sf;
1653
1654 if ( (sf=lookupSourceFile(name, FALSE)) )
1655 { rc = endReconsult(sf);
1656 releaseSourceFile(sf);
1657 sf->current_procedure = NULL;
1658 }
1659 }
1660
1661 return rc;
1662 }
1663
1664
1665 static
1666 PRED_IMPL("$end_consult", 1, end_consult, 0)
1667 { PRED_LD
1668 atom_t name;
1669 int rc = FALSE;
1670
1671 if ( PL_get_atom_ex(A1, &name) )
1672 { SourceFile sf;
1673
1674 if ( (sf=lookupSourceFile(name, FALSE)) )
1675 { rc = endConsult(sf);
1676 releaseSourceFile(sf);
1677 }
1678 }
1679
1680 return rc;
1681 }
1682
1683
1684
1685 /** '$clause_from_source'(+Owner, +File, +Line, -Clause) is semidet.
1686
1687 True when Clause is the clause that contains Line in File. Owner is the
1688 source file owning Clause. For normal files, Owner and File are the
1689 same. This predicate can find a clause in an included file by specifying
1690 the main file as Owner and the included file as File.
1691 */
1692
1693 static
1694 PRED_IMPL("$clause_from_source", 4, clause_from_source, 0)
1695 { PRED_LD
1696 atom_t owner_name;
1697 atom_t file_name;
1698 SourceFile of=NULL, sf=NULL; /* owner file, source file */
1699 unsigned int source_no;
1700 int ln;
1701 ListCell cell;
1702 Clause c = NULL;
1703 int rc = FALSE;
1704
1705 term_t owner = A1;
1706 term_t file = A2;
1707 term_t line = A3;
1708 term_t clause = A4;
1709
1710 if ( !PL_get_atom_ex(owner, &owner_name) ||
1711 !PL_get_atom_ex(file, &file_name) ||
1712 !PL_get_integer_ex(line, &ln) ||
1713 !(of = lookupSourceFile(owner_name, FALSE)) )
1714 return FALSE;
1715
1716 if ( file_name == owner_name ) {
1717 source_no = of->index;
1718 } else {
1719 if ( !(sf=lookupSourceFile(file_name, FALSE)) )
1720 goto out;
1721 source_no = sf->index;
1722 }
1723
1724 LOCKSRCFILE(of);
1725 for(cell = of->procedures; cell; cell = cell->next)
1726 { Procedure proc = cell->value;
1727 Definition def = proc->definition;
1728
1729 if ( def && false(def, P_FOREIGN) )
1730 { ClauseRef cref;
1731
1732 acquire_def(def);
1733 for(cref = def->impl.clauses.first_clause; cref; cref = cref->next )
1734 { Clause cl = cref->value.clause;
1735
1736 if ( cl->source_no == source_no )
1737 { if ( ln >= (int)cl->line_no )
1738 { if ( !c || c->line_no < cl->line_no )
1739 c = cl;
1740 }
1741 }
1742 }
1743 release_def(def);
1744 }
1745 }
1746 UNLOCKSRCFILE(of);
1747
1748 if ( c )
1749 rc = PL_unify_clref(clause, c);
1750
1751 out:
1752 if ( of ) releaseSourceFile(of);
1753 if ( sf ) releaseSourceFile(sf);
1754
1755 return rc;
1756 }
1757
1758 /** '$flush_predicate'(+Predicate, +File) is det.
1759 *
1760 * Finalize the definition of Predicate wrt. File. After this,
1761 * subsequent changes to the predicate are _immediate_.
1762 */
1763
1764 static int
flush_predicate(term_t pred ARG_LD)1765 flush_predicate(term_t pred ARG_LD)
1766 { SourceFile sf;
1767 Procedure proc;
1768 Module m = LD->modules.source;
1769 functor_t fdef;
1770 int rc = FALSE;
1771
1772 if ( ReadingSource )
1773 sf = lookupSourceFile(source_file_name, TRUE);
1774 else
1775 return TRUE; /* not reading source; nothing to flush */
1776
1777 if ( get_functor(pred, &fdef, &m, 0, GF_PROCEDURE) )
1778 { if ( (proc=isCurrentProcedure(fdef,m)) )
1779 rc = flush_procedure(sf, proc);
1780 }
1781 releaseSourceFile(sf);
1782
1783 return rc;
1784 }
1785
1786
1787 static
1788 PRED_IMPL("$flush_predicate", 1, flush_predicate, 0)
1789 { PRED_LD
1790
1791 return flush_predicate(A1 PASS_LD);
1792 }
1793
1794
1795 /** '$flushed_predicate'(:Head) is semidet.
1796 *
1797 * True when the finalized definition of Goal is defined.
1798 */
1799
1800 static
1801 PRED_IMPL("$flushed_predicate", 1, flushed_predicate, 0)
1802 { PRED_LD
1803 SourceFile sf;
1804 term_t head = PL_new_term_ref();
1805 Module m = LD->modules.source;
1806 functor_t fdef;
1807 Procedure proc;
1808 int rc;
1809
1810 if ( !PL_strip_module(A1, &m, head) )
1811 return FALSE;
1812 if ( !PL_get_functor(head, &fdef) )
1813 return PL_type_error("callable", A1);
1814 if ( !(proc=isCurrentProcedure(fdef, m)) )
1815 return FALSE;
1816
1817 if ( ReadingSource )
1818 sf = lookupSourceFile(source_file_name, TRUE);
1819 else
1820 return isDefinedProcedure(proc);
1821
1822 flush_procedure(sf, proc);
1823 rc = isDefinedProcedure(proc);
1824 releaseSourceFile(sf);
1825
1826 return rc;
1827 }
1828
1829
1830 /*******************************
1831 * PUBLISH PREDICATES *
1832 *******************************/
1833
1834 #define PL_FA_NONDET PL_FA_NONDETERMINISTIC
1835
1836 BeginPredDefs(srcfile)
1837 PRED_DEF("$source_file", 2, source_file, 0)
1838 PRED_DEF("$source_file_predicates", 2, source_file_predicates, 0)
1839 PRED_DEF("$time_source_file", 3, time_source_file, PL_FA_NONDET)
1840 PRED_DEF("$source_file_property", 3, source_file_property, 0)
1841 PRED_DEF("$set_source_file", 3, set_source_file, 0)
1842 PRED_DEF("$clause_from_source", 4, clause_from_source, 0)
1843 PRED_DEF("$unload_file", 1, unload_file, 0)
1844 PRED_DEF("$start_consult", 2, start_consult, 0)
1845 PRED_DEF("$end_consult", 1, end_consult, 0)
1846 PRED_DEF("$fixup_reconsult", 1, fixup_reconsult, 0)
1847 PRED_DEF("$set_source_files", 1, set_source_files, 0)
1848 PRED_DEF("$flush_predicate", 1, flush_predicate, 0)
1849 PRED_DEF("$flushed_predicate", 1, flushed_predicate, 0)
1850 EndPredDefs
1851