YAP 7.1.0
arrays.c
Go to the documentation of this file.
1/*************************************************************************
2* *
3* YAP Prolog *
4* *
5* Yap Prolog was developed at NCCUP - Universidade do Porto *
6* *
7* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
8* *
9**************************************************************************
10* *
11* File: arrays.c *
12* Last rev: *
13* mods: *
14* comments: Array Manipulation Routines *
15* *
16*************************************************************************/
17
109#include "Yap.h"
110#include "Yatom.h"
111#include "clause.h"
112#include "YapEval.h"
113#include "heapgc.h"
114#if HAVE_ERRNO_H
115#include <errno.h>
116#else
117extern int errno;
118#endif
119#if HAVE_STRING_H
120#include <string.h>
121#endif
122
123#if __simplescalar__
124#ifdef HAVE_MMAP
125#undef HAVE_MMAP
126#endif
127#endif
128
129static Int compile_array_refs(USES_REGS1);
130static Int array_refs_compiled(USES_REGS1);
131static Int sync_mmapped_arrays(USES_REGS1);
132
210static Int create_array(USES_REGS1);
211static Int create_mmapped_array(USES_REGS1);
212static Int array_references(USES_REGS1);
213static Int static_array(USES_REGS1);
214static Int resize_static_array(USES_REGS1);
215static Int close_static_array(USES_REGS1);
216static Int access_array(USES_REGS1);
217static Int assign_static(USES_REGS1);
218static Int assign_dynamic(USES_REGS1);
219
220#if HAVE_MMAP
221
222#if HAVE_UNISTD_H
223#include <unistd.h>
224#endif
225#if HAVE_SYS_MMAN_H
226#include <sys/mman.h>
227#endif
228#if HAVE_SYS_STAT_H
229#include <sys/stat.h>
230#endif
231#if HAVE_FCNTL_H
232#include <fcntl.h>
233#endif
234
235/* keep a list of mmaped blocks to synch on exit */
236
237typedef struct MMAP_ARRAY_BLOCK {
238 Atom name;
239 void *start;
240 size_t size;
241 Int items;
242 int fd;
243 struct MMAP_ARRAY_BLOCK *next;
244} mmap_array_block;
245
246static Int CloseMmappedArray(StaticArrayEntry *pp, void *area USES_REGS) {
247 mmap_array_block *ptr = GLOBAL_mmap_arrays, *optr = GLOBAL_mmap_arrays;
248
249 while (ptr != NULL && ptr->start != area) {
250 ptr = ptr->next;
251 optr = ptr;
252 }
253 if (ptr == NULL) {
254#if !defined(USE_SYSTEM_MALLOC)
255 Yap_FullError(SYSTEM_ERROR_INTERNAL, ARG1,
256 "close_mmapped_array (array chain incoherent)",
257 strerror(errno));
258#endif
259 return FALSE;
260 }
261 if (munmap(ptr->start, ptr->size) == -1) {
262 Yap_FullError(SYSTEM_ERROR_INTERNAL, ARG1,
263 "close_mmapped_array (munmap: %s)", strerror(errno));
264 return (FALSE);
265 }
266 optr->next = ptr->next;
267 pp->ValueOfVE.ints = NULL;
268 pp->ArrayEArity = 0;
269 if (close(ptr->fd) < 0) {
270 Yap_FullError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1,
271 "close_mmapped_array (close: %s)", strerror(errno));
272 return (FALSE);
273 }
274 Yap_FreeAtomSpace((char *)ptr);
275 return (TRUE);
276}
277
278static void ResizeMmappedArray(StaticArrayEntry *pp, Int dim,
279 void *area USES_REGS) {
280 mmap_array_block *ptr = GLOBAL_mmap_arrays;
281 size_t total_size;
282 while (ptr != NULL && ptr->start != area) {
283 ptr = ptr->next;
284 }
285 if (ptr == NULL)
286 return;
287 /* This is a very stupid algorithm to change size for an array.
288
289 First, we unmap it, then we actually change the size for the file,
290 and last we initialize again
291 */
292 if (munmap(ptr->start, ptr->size) == -1) {
293 Yap_FullError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1,
294 "resize_mmapped_array (munmap: %s)", strerror(errno));
295 return;
296 }
297 total_size = (ptr->size / ptr->items) * dim;
298 if (ftruncate(ptr->fd, total_size) < 0) {
299 Yap_FullError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1,
300 "resize_mmapped_array (ftruncate: %s)", strerror(errno));
301 return;
302 }
303 if (lseek(ptr->fd, total_size - 1, SEEK_SET) < 0) {
304 Yap_ThrowError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1,
305 "resize_mmapped_array (lseek: %s)", strerror(errno));
306 return;
307 }
308 if (write(ptr->fd, "", 1) < 0) {
309 Yap_FullError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1,
310 "resize_mmapped_array (write: %s)", strerror(errno));
311 return;
312 }
313 if ((ptr->start = (void *)mmap(0, (size_t)total_size, PROT_READ | PROT_WRITE,
314 MAP_SHARED, ptr->fd, 0)) == (void *)-1) {
315 Yap_FullError(SYSTEM_ERROR_OPERATING_SYSTEM, ARG1,
316 "resize_mmapped_array (mmap: %s)", ___LINE__, __FUNCTION__,
317 -__FILE__, strerror(errno));
318 return;
319 }
320 ptr->size = total_size;
321 ptr->items = dim;
322 pp->ValueOfVE.chars = ptr->start;
323}
324
325#endif
326
327static Term GetTermFromArray(DBTerm *ref USES_REGS) {
328 if (ref != NULL) {
329 Term TRef;
330
331 while ((TRef = Yap_FetchTermFromDB(ref)) == 0L) {
332 if (!Yap_dogc()) {
333 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
334 return 0;
335 }
336 }
337 return TRef;
338 } else {
339 Yap_ThrowError(DOMAIN_ERROR_NOT_ZERO, ARG1, "Null reference.");
340 return 0;
341 }
342}
343
344static Term GetNBTerm(live_term *ar, Int indx USES_REGS) {
345 /* The object is now in use */
346 Term livet = ar[indx].tlive;
347
348 if (!IsVarTerm(livet)) {
349 if (!IsApplTerm(livet)) {
350 return livet;
351 } else if (FunctorOfTerm(livet) == FunctorAtFoundOne) {
352 return Yap_ReadTimedVar(livet);
353 } else {
354 return livet;
355 }
356 } else {
357 Term termt = ar[indx].tstore;
358
359 if (!IsUnboundVar(&(ar[indx].tlive))) {
360 return livet;
361 }
362 if (IsVarTerm(termt)) {
363 livet = MkVarTerm();
364 } else if (IsAtomicTerm(termt)) {
365 livet = termt;
366 } else {
367 DBTerm *ref = (DBTerm *)RepAppl(termt);
368 if ((livet = GetTermFromArray(ref PASS_REGS)) == 0) {
369 return 0;
370 }
371 }
372 YapBind(&(ar[indx].tlive), livet);
373 return livet;
374 }
375}
376
377static ArrayEntry *GetArrayEntry(Atom at, int owner) {
378 CACHE_REGS
379 ArrayEntry *pp;
380 AtomEntry *ae = RepAtom(at);
381
382 READ_LOCK(ae->ARWLock);
383 pp = RepArrayProp(ae->PropsOfAE);
384 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty
385#if THREADS
386 && pp->owner_id != worker_id
387#endif
388 )
389 pp = RepArrayProp(pp->NextOfPE);
390 READ_UNLOCK(ae->ARWLock);
391 return pp;
392}
393
394static Term AccessNamedArray(Atom a, Int indx USES_REGS) {
395 ArrayEntry *pp;
396 AtomEntry *ae = RepAtom(a);
397
398 pp = GetArrayEntry(ae, worker_id);
399
400 if (!EndOfPAEntr(pp)) {
401 if (ArrayIsDynamic(pp)) {
402 Term out;
403 READ_LOCK(pp->ArRWLock);
404 if (IsVarTerm(pp->ValueOfVE)) {
405 READ_UNLOCK(pp->ArRWLock);
406 Yap_ThrowError(INSTANTIATION_ERROR, ARG1, "unbound static array", indx);
407 }
408 if (pp->ArrayEArity <= indx || indx < 0) {
409 READ_UNLOCK(pp->ArRWLock);
410 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, ARG1, "bad index %ld", indx);
411 }
412 out = RepAppl(pp->ValueOfVE)[indx + 1];
413 READ_UNLOCK(pp->ArRWLock);
414 return (out);
415 } else {
417
418 READ_LOCK(ptr->ArRWLock);
419 if (pp->ArrayEArity <= indx || indx < 0) {
420 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, ARG1, "bad index %ld", indx);
421 }
422 switch (ptr->ArrayType) {
423
424 case array_of_ints: {
425 Term out;
426 out = MkIntegerTerm(ptr->ValueOfVE.ints[indx]);
427 READ_UNLOCK(ptr->ArRWLock);
428 return out;
429 }
430 case array_of_doubles: {
431 Term out;
432 out = MkEvalFl(ptr->ValueOfVE.floats[indx]);
433 READ_UNLOCK(ptr->ArRWLock);
434 return out;
435 }
436 case array_of_ptrs: {
437 Term out;
438 out = MkIntegerTerm((Int)(ptr->ValueOfVE.ptrs[indx]));
439 READ_UNLOCK(ptr->ArRWLock);
440 return out;
441 }
442 case array_of_atoms: {
443 Term out;
444 out = ptr->ValueOfVE.atoms[indx];
445 READ_UNLOCK(ptr->ArRWLock);
446 if (out == 0L)
447 return TermNil;
448 else
449 return out;
450 }
451 /* just return the atom */
452 case array_of_chars: {
453 Term out;
454 out = MkIntegerTerm((Int)(ptr->ValueOfVE.chars[indx]));
455 READ_UNLOCK(ptr->ArRWLock);
456 return out;
457 }
458 case array_of_uchars: {
459 Term out;
460 out = MkIntegerTerm((Int)(ptr->ValueOfVE.uchars[indx]));
461 READ_UNLOCK(ptr->ArRWLock);
462 return out;
463 }
464 case array_of_dbrefs: {
465 /* The object is now in use */
466 Term TRef = ptr->ValueOfVE.dbrefs[indx];
467
468 READ_UNLOCK(ptr->ArRWLock);
469 if (TRef != 0L) {
470 DBRef ref = DBRefOfTerm(TRef);
471
472#if MULTIPLE_STACKS
473 LOCK(ref->lock);
474 INC_DBREF_COUNT(ref);
475 TRAIL_REF(ref); /* So that fail will erase it */
476 UNLOCK(ref->lock);
477#else
478 if (ref->Flags & LogUpdMask) {
479 LogUpdClause *cl = (LogUpdClause *)ref;
480
481 if (!(cl->ClFlags & InUseMask)) {
482 cl->ClFlags |= InUseMask;
483 TRAIL_CLREF(cl);
484 }
485 } else {
486 if (!(ref->Flags & InUseMask)) {
487 ref->Flags |= InUseMask;
488 TRAIL_REF(ref); /* So that fail will erase it */
489 }
490 }
491#endif
492 } else {
493 P = (yamop *)FAILCODE;
494 TRef = TermNil;
495 }
496 return TRef;
497 }
498 case array_of_nb_terms: {
499 /* The object is now in use */
500 Term out = GetNBTerm(ptr->ValueOfVE.lterms, indx PASS_REGS);
501 READ_UNLOCK(ptr->ArRWLock);
502 if (out == 0)
503 return TermNil;
504 }
505 case array_of_terms: {
506 /* The object is now in use */
507 DBTerm *ref = ptr->ValueOfVE.terms[indx];
508
509 READ_UNLOCK(ptr->ArRWLock);
510 return GetTermFromArray(ref PASS_REGS);
511 }
512 default:
513 READ_UNLOCK(ptr->ArRWLock);
514 return TermNil;
515 }
516 }
517 } else {
518 Yap_ThrowError(EXISTENCE_ERROR_ARRAY, MkAtomTerm(a), "named array");
519 return (TermNil);
520 }
521}
522
523
524
536static Int access_array(USES_REGS1) {
537 Term t = Deref(ARG1);
538 Term ti = Deref(ARG2);
539 Term tf;
540 Int indx;
541
542 if (IsNonVarTerm(ti)) {
543 Term nti;
544 if (IsIntegerTerm(nti = Yap_Eval(ti)))
545 indx = IntegerOfTerm(nti);
546 else {
547 Yap_ThrowError(TYPE_ERROR_INTEGER, ti, "access_array");
548 return (FALSE);
549 }
550 } else {
551 Yap_ThrowError(INSTANTIATION_ERROR, ti, "access_array");
552 return (TermNil);
553 }
554
555 if (IsNonVarTerm(t)) {
556 if (IsApplTerm(t)) {
557 if (indx >= ArityOfFunctor(FunctorOfTerm(t)) || indx < 0) {
558 /* Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, MkIntegerTerm(indx),
559 * "access_array");*/
560 P = (yamop *)FAILCODE;
561 return (FALSE);
562 }
563 tf = (RepAppl(t))[indx + 1];
564 } else if (IsAtomTerm(t)) {
565 tf = AccessNamedArray(AtomOfTerm(t), indx PASS_REGS);
566 if (tf == MkAtomTerm(AtomFoundVar)) {
567 return (FALSE);
568 }
569 } else {
570 Yap_ThrowError(TYPE_ERROR_ARRAY, t, "access_array");
571 return (FALSE);
572 }
573 } else {
574 Yap_ThrowError(INSTANTIATION_ERROR, t, "access_array");
575 return (FALSE);
576 }
577 return Yap_unify(tf, ARG3);
578}
579
580static Int array_arg(USES_REGS1) {
581 register Term ti = Deref(ARG3), t;
582 register Int indx;
583
584 if (IsNonVarTerm(ti)) {
585 Term nti;
586 if (IsIntegerTerm(nti = Yap_Eval(ti)))
587 indx = IntegerOfTerm(nti);
588 else {
589 Yap_ThrowError(TYPE_ERROR_INTEGER, ti, "access_array");
590 return (FALSE);
591 }
592 } else {
593 Yap_ThrowError(INSTANTIATION_ERROR, ti, "array_arg");
594 return (FALSE);
595 }
596
597 t = Deref(ARG2);
598 if (IsNonVarTerm(t)) {
599 if (IsApplTerm(t)) {
600 return (Yap_unify(((RepAppl(t))[indx + 1]), ARG1));
601 } else if (IsAtomTerm(t)) {
602 Term tf = AccessNamedArray(AtomOfTerm(t), indx PASS_REGS);
603 if (tf == MkAtomTerm(AtomFoundVar)) {
604 return (FALSE);
605 }
606 return (Yap_unify(tf, ARG1));
607 } else
608 Yap_ThrowError(TYPE_ERROR_ARRAY, t, "array_arg");
609 } else
610 Yap_ThrowError(INSTANTIATION_ERROR, t, "array_arg");
611
612 return (FALSE);
613}
614
615static void InitNamedArray(ArrayEntry *p, Int dim USES_REGS) {
616 Term *tp;
617
618 WRITE_LOCK(p->ArRWLock);
619 /* Leave a pointer so that we can reclaim array space when
620 * we backtrack or when we abort */
621 /* place terms in reverse order */
622 Bind_Global(&(p->ValueOfVE), AbsAppl(HR));
623 tp = HR;
624 tp[0] = (CELL)Yap_MkFunctor(AtomArray, dim);
625 tp++;
626 p->ArrayEArity = dim;
627 /* Initialize the array as a set of variables */
628 HR = tp + dim;
629 for (; tp < HR; tp++) {
630 RESET_VARIABLE(tp);
631 }
632 WRITE_UNLOCK(p->ArRWLock);
633}
634
635/* we assume the atom ae is already locked */
636static void CreateNamedArray(PropEntry *pp, Int dim, AtomEntry *ae USES_REGS) {
637 ArrayEntry *p;
638
639 p = (ArrayEntry *)Yap_AllocAtomSpace(sizeof(*p));
640 p->KindOfPE = ArrayProperty;
641 p->TypeOfAE = DYNAMIC_ARRAY;
642 AddPropToAtom(ae, (PropEntry *)p);
643 INIT_RWLOCK(p->ArRWLock);
644#if THREADS
645 p->owner_id = worker_id;
646#endif
647 p->NextAE = LOCAL_DynamicArrays;
648 LOCAL_DynamicArrays = p;
649 InitNamedArray(p, dim PASS_REGS);
650}
651
652static void AllocateStaticArraySpace(StaticArrayEntry *p,
653 static_array_types atype, void *old,
654 size_t array_size USES_REGS) {
655 size_t asize = 0;
656 switch (atype) {
657 case array_of_doubles:
658 asize = array_size * sizeof(Float);
659 break;
660 case array_of_ints:
661 asize = array_size * sizeof(Int);
662 break;
663 case array_of_chars:
664 asize = array_size * sizeof(char);
665 break;
666 case array_of_uchars:
667 asize = array_size * sizeof(unsigned char);
668 break;
669 case array_of_ptrs:
670 asize = array_size * sizeof(AtomEntry *);
671 break;
672 case array_of_atoms:
673 case array_of_terms:
674 case array_of_nb_terms:
675 asize = array_size * sizeof(live_term);
676 break;
677 case array_of_dbrefs:
678 asize = array_size * sizeof(DBRef);
679 break;
680 }
681 if (old == NULL) {
682 while ((p->ValueOfVE.floats = (Float *)Yap_AllocCodeSpace(asize)) == NULL) {
683 YAPLeaveCriticalSection();
684 if (!Yap_growheap(FALSE, asize, NULL)) {
685 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
686 return;
687 }
688 YAPEnterCriticalSection();
689 }
690 } else {
691 while ((p->ValueOfVE.floats = (Float *)Yap_ReallocCodeSpace(old, asize)) ==
692 NULL) {
693 YAPLeaveCriticalSection();
694 if (!Yap_growheap(FALSE, asize, NULL)) {
695 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
696 return;
697 }
698 }
699 }
700}
701
702
703void * YAP_FetchArray(Term t1, intptr_t *sz, int *type)
704{
705 AtomEntry *ae = RepAtom(AtomOfTerm(t1));
706
707 READ_LOCK(ae->ARWLock);
708 StaticArrayEntry *p = RepStaticArrayProp(ae->PropsOfAE);
709while (!EndOfPAEntr(p) && p->KindOfPE != ArrayProperty){
710 p = RepStaticArrayProp(p->NextOfPE);
711} READ_UNLOCK(ae->ARWLock);
712
713 if (EndOfPAEntr(p)) {
714 return NULL;
715 }
716 if (sz)
717*sz = p->ArrayEArity;
718if (p->ArrayType ==
719 array_of_doubles)
720 {
721 *type = 'f';
722 return p->ValueOfVE.floats;
723 }
724 if (p->ArrayType ==
725 array_of_ints)
726 {
727 *type = 'i';
728 return p->ValueOfVE.ints;
729 }
730return NULL;
731}
732
733static Int update_all( USES_REGS1) {
734 Term t1, t;
736 t = Deref(ARG2);
737 t1 = Deref(ARG1);
738 if (IsVarTerm(t1)) {
739 Yap_ThrowError(INSTANTIATION_ERROR, t1, "update_array");
740 return (FALSE);
741 }
742
743 AtomEntry *ae = RepAtom(AtomOfTerm(t1));
744
745 READ_LOCK(ae->ARWLock);
746 p = RepStaticArrayProp(ae->PropsOfAE);
747 while (!EndOfPAEntr(p) && p->KindOfPE != ArrayProperty)
748 p = RepStaticArrayProp(p->NextOfPE);
749
750 if (EndOfPAEntr(p)) {
751 READ_UNLOCK(ae->ARWLock);
752 Yap_ThrowError(EXISTENCE_ERROR_ARRAY, t1, "assign_static %s",
753 RepAtom(AtomOfTerm(t1))->StrOfAE);
754 return FALSE;
755 }
756 Int dim = p->ArrayEArity;
757 switch (p->ArrayType) {
758 case array_of_ints:
759 {
760 Int n = IntegerOfTerm(t), i;
761 for (i = 0; i < dim; i++)
762 p->ValueOfVE.ints[i] = n;
763 }
764 break;
765 case array_of_chars:
766 {
767 Int c = IntegerOfTerm(t), i;
768 for (i = 0; i < dim; i++)
769 p->ValueOfVE.chars[i] = c;
770 }
771 break;
772 case array_of_uchars:
773 { Int i;
774 UInt c = IntegerOfTerm(t);
775 for (i = 0; i < dim; i++)
776 p->ValueOfVE.uchars[i] = c;
777 }
778 break;
779 case array_of_doubles:
780 {
781 Int i;
782 Float f = FloatOfTerm(t);
783 for (i = 0; i < dim; i++)
784 p->ValueOfVE.uchars[i] = f;
785 }
786 break;
787 case array_of_ptrs:
788 {
789 Int i;
790 void *pt = AddressOfTerm(t);
791 for (i = 0; i < dim; i++)
792 p->ValueOfVE.ptrs[i] = pt;
793 }
794 break;
795 case array_of_atoms:
796 {
797 Int i;
798 for (i = 0; i < dim; i++)
799 p->ValueOfVE.atoms[i] = t;
800 }
801 break;
802 case array_of_dbrefs:
803 case array_of_terms:
804 {
805 int i;
806 for (i = 0; i < dim; i++)
807 p->ValueOfVE.terms[i] = TermToDBTerm(t);
808 }
809 break;
810 case array_of_nb_terms:
811 {
812 int i;
813 Term tn = Yap_SaveTerm(t);
814 for (i = 0; i < dim; i++) {
815 p->ValueOfVE.lterms[i].tstore = tn;
816 }
817 }
818 break;
819 }
820 return true;
821}
822
823/* ae and p are assumed to be locked, if they exist */
824static StaticArrayEntry *CreateStaticArray(AtomEntry *ae, size_t dim,
825 static_array_types type,
826 CODEADDR start_addr,
827 StaticArrayEntry *p USES_REGS) {
828 if (EndOfPAEntr(p)) {
829 while ((p = (StaticArrayEntry *)Yap_AllocCodeSpace(sizeof(*p))) == NULL) {
830 if (!Yap_growheap(FALSE, sizeof(*p), NULL)) {
831 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
832 return NULL;
833 }
834 }
835 p->KindOfPE = ArrayProperty;
836 p->ValueOfVE.ints = NULL;
837 INIT_RWLOCK(p->ArRWLock);
838 AddPropToAtom(ae, (PropEntry *)p);
839 p->NextAE = LOCAL_StaticArrays;
840 LOCAL_StaticArrays = p;
841 }
842 WRITE_LOCK(p->ArRWLock);
843 p->ArrayEArity = dim;
844 p->ArrayType = type;
845 p->TypeOfAE = STATIC_ARRAY;
846 if (start_addr == NULL) {
847 size_t i;
848 AllocateStaticArraySpace(p, type, NULL, dim PASS_REGS);
849 if (p->ValueOfVE.ints == NULL) {
850 WRITE_UNLOCK(p->ArRWLock);
851 return p;
852 }
853 switch (type) {
854 case array_of_ints:
855 for (i = 0; i < dim; i++)
856 p->ValueOfVE.ints[i] = 0;
857 break;
858 case array_of_chars:
859 for (i = 0; i < dim; i++)
860 p->ValueOfVE.chars[i] = '\0';
861 break;
862 case array_of_uchars:
863 for (i = 0; i < dim; i++)
864 p->ValueOfVE.uchars[i] = '\0';
865 break;
866 case array_of_doubles:
867 for (i = 0; i < dim; i++)
868 p->ValueOfVE.floats[i] = 0.0;
869 break;
870 case array_of_ptrs:
871 for (i = 0; i < dim; i++)
872 p->ValueOfVE.ptrs[i] = NULL;
873 break;
874 case array_of_atoms:
875 case array_of_dbrefs:
876 for (i = 0; i < dim; i++)
877 p->ValueOfVE.atoms[i] = 0L;
878 break;
879 case array_of_terms:
880 for (i = 0; i < dim; i++)
881 p->ValueOfVE.terms[i] = NULL;
882 break;
883 case array_of_nb_terms:
884 for (i = 0; i < dim; i++) {
885 RESET_VARIABLE(&(p->ValueOfVE.lterms[i].tlive));
886 p->ValueOfVE.lterms[i].tstore = TermNil;
887 }
888 break;
889 }
890 } else {
891 /* external array */
892 p->TypeOfAE |= MMAP_ARRAY;
893 p->ValueOfVE.chars = (char *)start_addr;
894 }
895 WRITE_UNLOCK(p->ArRWLock);
896 return p;
897}
898
899/* ae and p are assumed to be locked, if they exist */
900StaticArrayEntry *Yap_StaticArray(Atom na, size_t dim, static_array_types type,
901 CODEADDR start_addr, StaticArrayEntry *p) {
902 CACHE_REGS
904 ArrayEntry *e0 = GetArrayEntry(RepAtom(na), worker_id);
905 if (e0 && ArrayIsDynamic(e0)) {
906 e = NULL;
907 } else {
908 // initial version for e
909 e = RepStaticArrayProp(AbsArrayProp(e0));
910 }
911 e = CreateStaticArray(RepAtom(na), dim, type, NULL, e PASS_REGS);
912 return e;
913}
914
915static void ResizeStaticArray(StaticArrayEntry *pp, size_t dim USES_REGS) {
916 statarray_elements old_v = pp->ValueOfVE;
917 static_array_types type = pp->ArrayType;
918 size_t old_dim = pp->ArrayEArity;
919 size_t mindim = (dim < old_dim ? dim : old_dim), i;
920
921 /* change official size */
922 if (pp->ArrayEArity == 0) {
923 return;
924 }
925 WRITE_LOCK(pp->ArRWLock);
926 pp->ArrayEArity = dim;
927#if HAVE_MMAP
928 if (pp->TypeOfAE & MMAP_ARRAY) {
929 ResizeMmappedArray(pp, dim, (void *)(pp->ValueOfVE.chars)PASS_REGS);
930 WRITE_UNLOCK(pp->ArRWLock);
931 return;
932 }
933#endif
934 AllocateStaticArraySpace(pp, type, old_v.chars, dim PASS_REGS);
935 switch (type) {
936 case array_of_ints:
937 for (i = mindim; i < dim; i++)
938 pp->ValueOfVE.ints[i] = 0;
939 break;
940 case array_of_chars:
941 for (i = mindim; i < dim; i++)
942 pp->ValueOfVE.chars[i] = '\0';
943 break;
944 case array_of_uchars:
945 for (i = mindim; i < dim; i++)
946 pp->ValueOfVE.uchars[i] = '\0';
947 break;
948 case array_of_doubles:
949 for (i = mindim; i < dim; i++)
950 pp->ValueOfVE.floats[i] = 0.0;
951 break;
952 case array_of_ptrs:
953 for (i = mindim; i < dim; i++)
954 pp->ValueOfVE.ptrs[i] = NULL;
955 break;
956 case array_of_atoms:
957 for (i = mindim; i < dim; i++)
958 pp->ValueOfVE.atoms[i] = TermNil;
959 break;
960 case array_of_dbrefs:
961 for (i = mindim; i < dim; i++)
962 pp->ValueOfVE.dbrefs[i] = 0L;
963 break;
964 case array_of_terms:
965 for (i = mindim; i < dim; i++)
966 pp->ValueOfVE.terms[i] = NULL;
967 break;
968 case array_of_nb_terms:
969 for (i = mindim; i < dim; i++) {
970 RESET_VARIABLE(&(pp->ValueOfVE.lterms[i].tlive));
971 pp->ValueOfVE.lterms[i].tstore = TermNil;
972 }
973 break;
974 }
975 WRITE_UNLOCK(pp->ArRWLock);
976}
977
978static void ClearStaticArray(StaticArrayEntry *pp) {
979 statarray_elements old_v = pp->ValueOfVE;
980 static_array_types type = pp->ArrayType;
981 Int dim = pp->ArrayEArity, i;
982
983 /* change official size */
984 if (pp->ArrayEArity == 0) {
985 return;
986 }
987 WRITE_LOCK(pp->ArRWLock);
988 switch (type) {
989 case array_of_ints:
990 memset((void *)pp->ValueOfVE.ints, 0, sizeof(Int) * dim);
991 break;
992 case array_of_chars:
993 memset((void *)pp->ValueOfVE.chars, 0, sizeof(char) * dim);
994 break;
995 case array_of_uchars:
996 memset((void *)pp->ValueOfVE.uchars, 0, sizeof(unsigned char) * dim);
997 break;
998 case array_of_doubles:
999 memset((void *)pp->ValueOfVE.floats, 0, sizeof(double) * dim);
1000 break;
1001 case array_of_ptrs:
1002 memset((void *)pp->ValueOfVE.ptrs, 0, sizeof(void *) * dim);
1003 break;
1004 case array_of_atoms:
1005 for (i = 0; i < dim; i++)
1006 pp->ValueOfVE.atoms[i] = TermNil;
1007 break;
1008 case array_of_dbrefs:
1009 for (i = 0; i < dim; i++) {
1010 Term t0 = pp->ValueOfVE.dbrefs[i];
1011 if (t0 != 0L) {
1012 DBRef ptr = DBRefOfTerm(t0);
1013
1014 if (ptr->Flags & LogUpdMask) {
1015 LogUpdClause *lup = (LogUpdClause *)ptr;
1016 // LOCK(lup->ClLock);
1017 lup->ClRefCount--;
1018 if (lup->ClRefCount == 0 && (lup->ClFlags & ErasedMask) &&
1019 !(lup->ClFlags & InUseMask)) {
1020 // UNLOCK(lup->ClLock);
1021 Yap_ErLogUpdCl(lup);
1022 } else {
1023 // UNLOCK(lup->ClLock);
1024 }
1025 } else {
1026 ptr->NOfRefsTo--;
1027 if (ptr->NOfRefsTo == 0 && (ptr->Flags & ErasedMask) &&
1028 !(ptr->Flags & InUseMask)) {
1029 Yap_ErDBE(ptr);
1030 }
1031 }
1032 }
1033 pp->ValueOfVE.dbrefs[i] = 0L;
1034 }
1035 break;
1036 case array_of_terms:
1037 for (i = 0; i < dim; i++) {
1038 DBTerm *ref = pp->ValueOfVE.terms[i];
1039
1040 if (ref != NULL) {
1041 Yap_ReleaseTermFromDB(ref);
1042 }
1043 pp->ValueOfVE.terms[i] = NULL;
1044 }
1045 break;
1046 case array_of_nb_terms:
1047 for (i = 0; i < dim; i++) {
1048 Term told = pp->ValueOfVE.lterms[i].tstore;
1049 CELL *livep = &(pp->ValueOfVE.lterms[i].tlive);
1050
1051 RESET_VARIABLE(livep);
1052 /* recover space */
1053 if (IsApplTerm(told)) {
1054 Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
1055 }
1056 pp->ValueOfVE.lterms[i].tstore = old_v.lterms[i].tstore;
1057 }
1058 break;
1059 }
1060 WRITE_UNLOCK(pp->ArRWLock);
1061}
1062
1063
1069static Int create_array(USES_REGS1) {
1070 Term ti;
1071 Term t;
1072 Int size;
1073
1074restart:
1075 ti = Deref(ARG2);
1076 t = Deref(ARG1);
1077 {
1078 Term nti;
1079 if (IsVarTerm(ti)) {
1080 Yap_ThrowError(INSTANTIATION_ERROR, ti, "create_array");
1081 return (FALSE);
1082 }
1083 if (IsIntegerTerm(nti = Yap_Eval(ti)))
1084 size = IntegerOfTerm(nti);
1085 else {
1086 Yap_ThrowError(TYPE_ERROR_INTEGER, ti, "create_array");
1087 return (FALSE);
1088 }
1089 }
1090
1091 if (IsVarTerm(t)) {
1092 /* Create an anonymous array */
1093 Functor farray;
1094
1095 farray = Yap_MkFunctor(AtomArray, size);
1096 if (HR + 1 + size > ASP - 1024) {
1097 if (!Yap_dogc()) {
1098 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1099 return (FALSE);
1100 } else {
1101 if (HR + 1 + size > ASP - 1024) {
1102 if (!Yap_growstack(sizeof(CELL) * (size + 1 - (HR - ASP - 1024)))) {
1103 Yap_ThrowError(RESOURCE_ERROR_HEAP, TermNil, LOCAL_ErrorMessage);
1104 return FALSE;
1105 }
1106 }
1107 }
1108 goto restart;
1109 }
1110 t = AbsAppl(HR);
1111 *HR++ = (CELL)farray;
1112 for (; size >= 0; size--) {
1113 RESET_VARIABLE(HR);
1114 HR++;
1115 }
1116 return (Yap_unify(t, ARG1));
1117 } else if(IsAtomTerm(t)) {
1118 /* Create a named array */
1119 AtomEntry *ae = RepAtom(AtomOfTerm(t));
1120 PropEntry *pp;
1121
1122 WRITE_LOCK(ae->ARWLock);
1123 pp = RepProp(ae->PropsOfAE);
1124 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty
1125#if THREADS
1126 && ((ArrayEntry *)pp)->owner_id != worker_id
1127#endif
1128 )
1129 pp = RepProp(pp->NextOfPE);
1130 if (EndOfPAEntr(pp)) {
1131 if (HR + 1 + size > ASP - 1024) {
1132 WRITE_UNLOCK(ae->ARWLock);
1133 if (!Yap_dogc(PASS_REGS1)) {
1134 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1135 return (FALSE);
1136 } else
1137 goto restart;
1138 }
1139 CreateNamedArray(pp, size, ae PASS_REGS);
1140 WRITE_UNLOCK(ae->ARWLock);
1141 return (TRUE);
1142 } else {
1143 ArrayEntry *app = (ArrayEntry *)pp;
1144
1145 WRITE_UNLOCK(ae->ARWLock);
1146 if (!IsVarTerm(app->ValueOfVE) || !IsUnboundVar(&app->ValueOfVE)) {
1147 if (size == app->ArrayEArity)
1148 return TRUE;
1149 Yap_ThrowError(PERMISSION_ERROR_CREATE_ARRAY, t, "create_array",
1150 ae->StrOfAE);
1151 } else {
1152 if (HR + 1 + size > ASP - 1024) {
1153 if (!Yap_dogc(PASS_REGS1)) {
1154 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1155 return (FALSE);
1156 if (size == app->ArrayEArity)
1157 return TRUE;
1158 Yap_ThrowError(PERMISSION_ERROR_CREATE_ARRAY, t, "create_array",
1159 ae->StrOfAE);
1160 } else {
1161 if (HR + 1 + size > ASP - 1024) {
1162 if (!Yap_dogc(PASS_REGS1)) {
1163 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
1164 return (FALSE);
1165 } else
1166 goto restart;
1167 }
1168 InitNamedArray(app, size PASS_REGS);
1169 return (TRUE);
1170 }
1171 }
1172 }
1173 }
1174 }
1175
1176 return (FALSE);
1177 }
1178
1190static Int
1191static_array(USES_REGS1) {
1192 Term ti = Deref(ARG2);
1193 Term t = Deref(ARG1);
1194 Term tprops = Deref(ARG3);
1195 Int size;
1196 static_array_types props;
1197
1198 if (IsVarTerm(ti)) {
1199 Yap_ThrowError(INSTANTIATION_ERROR, ti, "create static array");
1200 return (FALSE);
1201 } else {
1202 Term nti;
1203
1204 if (IsIntegerTerm(nti = Yap_Eval(ti)))
1205 size = IntegerOfTerm(nti);
1206 else {
1207 Yap_ThrowError(TYPE_ERROR_INTEGER, ti, "create static array");
1208 return (FALSE);
1209 }
1210 }
1211
1212 if (IsVarTerm(tprops)) {
1213 Yap_ThrowError(INSTANTIATION_ERROR, tprops, "create static array");
1214 return (FALSE);
1215 } else if (IsAtomTerm(tprops)) {
1216 char *atname = (char *)RepAtom(AtomOfTerm(tprops))->StrOfAE;
1217 size_t sz;
1218 int l=push_text_stack();
1219 if((sz=strlen(atname))==0)
1220 Yap_ThrowError(DOMAIN_ERROR_ARRAY_TYPE, tprops, "create static array");
1221 if(atname[sz-1]=='s')
1222 {
1223 char *natname = malloc(sz);
1224 strncpy(natname,atname,sz-1);
1225 atname = natname;
1226 }
1227 if (!strcmp(atname, "int"))
1228 props = array_of_ints;
1229 else if (!strcmp(atname, "dbref"))
1230 props = array_of_dbrefs;
1231 else if (!strcmp(atname, "float"))
1232 props = array_of_doubles;
1233 else if (!strcmp(atname, "ptr"))
1234 props = array_of_ptrs;
1235 else if (!strcmp(atname, "atom"))
1236 props = array_of_atoms;
1237 else if (!strcmp(atname, "char"))
1238 props = array_of_chars;
1239 else if (!strcmp(atname, "unsigned_char"))
1240 props = array_of_uchars;
1241 else if (!strcmp(atname, "term"))
1242 props = array_of_terms;
1243 else if (!strcmp(atname, "nb_term"))
1244 props = array_of_nb_terms;
1245 else {
1246 Yap_ThrowError(DOMAIN_ERROR_ARRAY_TYPE, tprops, "create static array");
1247 return (FALSE);
1248 }
1249 pop_text_stack(l);
1250 } else {
1251 Yap_ThrowError(TYPE_ERROR_ATOM, tprops, "create static array");
1252 return (FALSE);
1253 }
1254
1255 StaticArrayEntry *pp;
1256 if (IsVarTerm(t)) {
1257 Yap_ThrowError(INSTANTIATION_ERROR, t, "create static array");
1258 return (FALSE);
1259 } else if (IsAtomTerm(t)) {
1260 /* Create a named array */
1261 AtomEntry *ae = RepAtom(AtomOfTerm(t));
1262 ArrayEntry *app;
1263
1264 WRITE_LOCK(ae->ARWLock);
1265 pp = RepStaticArrayProp(ae->PropsOfAE);
1266 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
1267 pp = RepStaticArrayProp(pp->NextOfPE);
1268
1269 app = (ArrayEntry *)pp;
1270 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
1271 pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
1272 if (pp == NULL || pp->ValueOfVE.ints == NULL) {
1273 return TRUE;
1274 }
1275 } else if (ArrayIsDynamic(app)) {
1276 if (IsVarTerm(app->ValueOfVE) && IsUnboundVar(&app->ValueOfVE)) {
1277 pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
1278 } else {
1279 Yap_ThrowError(PERMISSION_ERROR_CREATE_ARRAY, t,
1280 "cannot create static array over dynamic array");
1281 }
1282 } else {
1283 if (pp->ArrayType != props) {
1284 Yap_ThrowError(TYPE_ERROR_ATOM, t, "create static array %d/%d %d/%d", pp->ArrayEArity,size,pp->ArrayType,props);
1285 pp = NULL;
1286 } else {
1287 AllocateStaticArraySpace(pp, props, pp->ValueOfVE.ints, size PASS_REGS);
1288 }
1289 }
1290 WRITE_UNLOCK(ae->ARWLock);
1291 if (!pp) {
1292 return false;
1293 }
1294 return true;
1295 }
1296 return false;
1297}
1298
1302 static_array_types props) {
1303 CACHE_REGS
1304 AtomEntry *ae = RepAtom(Name);
1305
1306 WRITE_LOCK(ae->ARWLock);
1307 StaticArrayEntry *pp =
1308 RepStaticArrayProp(AbsArrayProp(GetArrayEntry(ae, worker_id)));
1309 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
1310 pp = CreateStaticArray(ae, size, props, NULL, pp PASS_REGS);
1311 if (pp == NULL || pp->ValueOfVE.ints == NULL) {
1312 WRITE_UNLOCK(ae->ARWLock);
1313 return FALSE;
1314 }
1315 WRITE_UNLOCK(ae->ARWLock);
1316 return pp;
1317 }
1318 return NULL;
1319}
1320
1328static Int static_array_properties(USES_REGS1) {
1329 Term t = Deref(ARG1);
1330
1331 if (IsVarTerm(t)) {
1332 return (FALSE);
1333 } else if (IsAtomTerm(t)) {
1334 /* Create a named array */
1335 AtomEntry *ae = RepAtom(AtomOfTerm(t));
1336 StaticArrayEntry *pp;
1337
1338 READ_LOCK(ae->ARWLock);
1339 pp = RepStaticArrayProp(ae->PropsOfAE);
1340 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
1341 pp = RepStaticArrayProp(pp->NextOfPE);
1342 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
1343 READ_UNLOCK(ae->ARWLock);
1344 return (FALSE);
1345 } else {
1346 static_array_types tp = pp->ArrayType;
1347 Int dim = pp->ArrayEArity;
1348
1349 READ_UNLOCK(ae->ARWLock);
1350 if (dim <= 0 || !Yap_unify(ARG2, MkIntegerTerm(dim)))
1351 return (FALSE);
1352 switch (tp) {
1353 case array_of_ints:
1354 return (Yap_unify(ARG3, MkAtomTerm(AtomInt)));
1355 case array_of_dbrefs:
1356 return (Yap_unify(ARG3, MkAtomTerm(AtomDBref)));
1357 case array_of_doubles:
1358 return (Yap_unify(ARG3, MkAtomTerm(AtomFloat)));
1359 case array_of_ptrs:
1360 return (Yap_unify(ARG3, TermPointer));
1361 case array_of_chars:
1362 return (Yap_unify(ARG3, MkAtomTerm(AtomChar)));
1363 case array_of_uchars:
1364 return (Yap_unify(ARG3, MkAtomTerm(AtomUnsignedChar)));
1365 case array_of_terms:
1366 return (Yap_unify(ARG3, TermTerm));
1367 case array_of_nb_terms:
1368 return (Yap_unify(ARG3, TermTerm));
1369 case array_of_atoms:
1370 return (Yap_unify(ARG3, MkAtomTerm(AtomAtom)));
1371 }
1372 }
1373 }
1374 return (FALSE);
1375}
1376
1377/* resize a static array (+Name, + Size, +Props) */
1378/* does not work for mmap arrays yet */
1379static Int resize_static_array(USES_REGS1) {
1380 Term ti = Deref(ARG3);
1381 Term t = Deref(ARG1);
1382 Int size;
1383
1384 if (IsVarTerm(ti)) {
1385 Yap_ThrowError(INSTANTIATION_ERROR, ti, "resize a static array");
1386 return (FALSE);
1387 } else {
1388 Term nti;
1389
1390 if (IsIntegerTerm(nti = Yap_Eval(ti)))
1391 size = IntegerOfTerm(nti);
1392 else {
1393 Yap_ThrowError(TYPE_ERROR_INTEGER, ti, "resize a static array");
1394 return (FALSE);
1395 }
1396 }
1397
1398 if (IsVarTerm(t)) {
1399 Yap_ThrowError(INSTANTIATION_ERROR, t, "resize a static array");
1400 return (FALSE);
1401 } else if (IsAtomTerm(t)) {
1402 /* resize a named array */
1403 Atom a = AtomOfTerm(t);
1404 StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropsOfAE);
1405
1406 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
1407 pp = RepStaticArrayProp(pp->NextOfPE);
1408 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
1409 Yap_ThrowError(PERMISSION_ERROR_RESIZE_ARRAY, t, "resize a static array");
1410 return (FALSE);
1411 } else {
1412 size_t osize = pp->ArrayEArity;
1413 ResizeStaticArray(pp, size PASS_REGS);
1414 return (Yap_unify(ARG2, MkIntegerTerm(osize)));
1415 }
1416 } else {
1417 Yap_ThrowError(TYPE_ERROR_ATOM, t, "resize a static array");
1418 return (FALSE);
1419 }
1420}
1421
1422/* resize a static array (+Name, + Size, +Props) */
1423/* does not work for mmap arrays yet */
1431static Int clear_static_array(USES_REGS1) {
1432 Term t = Deref(ARG1);
1433
1434 if (IsVarTerm(t)) {
1435 Yap_ThrowError(INSTANTIATION_ERROR, t, "clear a static array");
1436 return FALSE;
1437 } else if (IsAtomTerm(t)) {
1438 /* resize a named array */
1439 Atom a = AtomOfTerm(t);
1440 StaticArrayEntry *pp = RepStaticArrayProp(RepAtom(a)->PropsOfAE);
1441
1442 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
1443 pp = RepStaticArrayProp(pp->NextOfPE);
1444 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
1445 Yap_ThrowError(PERMISSION_ERROR_RESIZE_ARRAY, t, "clear a static array");
1446 return FALSE;
1447 } else {
1448 ClearStaticArray(pp);
1449 return TRUE;
1450 }
1451 } else {
1452 Yap_ThrowError(TYPE_ERROR_ATOM, t, "clear a static array");
1453 return FALSE;
1454 }
1455}
1456
1457/* Close a named array (+Name) */
1467static Int close_static_array(USES_REGS1) {
1468 /* does not work for mmap arrays yet */
1469 Term t = Deref(ARG1);
1470
1471 if (IsVarTerm(t)) {
1472 Yap_ThrowError(INSTANTIATION_ERROR, t, "close static array");
1473 return (FALSE);
1474 } else if (IsAtomTerm(t)) {
1475 /* Create a named array */
1476 AtomEntry *ae = RepAtom(AtomOfTerm(t));
1477 PropEntry *pp;
1478
1479 READ_LOCK(ae->ARWLock);
1480 pp = RepProp(ae->PropsOfAE);
1481 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
1482 pp = RepProp(pp->NextOfPE);
1483 READ_UNLOCK(ae->ARWLock);
1484 if (EndOfPAEntr(pp)) {
1485 return (FALSE);
1486 } else {
1488 if (ptr->ValueOfVE.ints != NULL) {
1489#if HAVE_MMAP
1490 Int val =
1491 CloseMmappedArray(ptr, (void *)ptr->ValueOfVE.chars PASS_REGS);
1492#if USE_SYSTEM_MALLOC
1493 if (val) {
1494#endif
1495 return (val);
1496#if USE_SYSTEM_MALLOC
1497 }
1498#endif
1499#endif
1500 Yap_FreeAtomSpace((char *)(ptr->ValueOfVE.ints));
1501 ptr->ValueOfVE.ints = NULL;
1502 ptr->ArrayEArity = 0;
1503 return (TRUE);
1504 } else {
1505 return (FALSE);
1506 }
1507 }
1508 } else {
1509 Yap_ThrowError(TYPE_ERROR_ATOM, t, "close static array");
1510 return (FALSE);
1511 }
1512}
1513
1527static Int create_mmapped_array(USES_REGS1) {
1528#ifdef HAVE_MMAP
1529 Term ti = Deref(ARG2);
1530 Term t = Deref(ARG1);
1531 Term tprops = Deref(ARG3);
1532 Term tfile = Deref(ARG4);
1533 Int size;
1534 static_array_types props;
1535 size_t total_size;
1536 CODEADDR array_addr;
1537 int fd;
1538
1539 if (IsVarTerm(ti)) {
1540 Yap_ThrowError(INSTANTIATION_ERROR, ti, "create_mmapped_array");
1541 return (FALSE);
1542 } else {
1543 Term nti;
1544
1545 if (IsIntegerTerm(nti = Yap_Eval(ti)))
1546 size = IntegerOfTerm(nti);
1547 else {
1548 Yap_ThrowError(TYPE_ERROR_INTEGER, ti, "create_mmapped_array");
1549 return (FALSE);
1550 }
1551 }
1552
1553 if (IsVarTerm(tprops)) {
1554 Yap_ThrowError(INSTANTIATION_ERROR, tprops, "create_mmapped_array");
1555 return (FALSE);
1556 } else if (IsAtomTerm(tprops)) {
1557 char *atname = RepAtom(AtomOfTerm(tprops))->StrOfAE;
1558 if (!strcmp(atname, "int")) {
1559 props = array_of_ints;
1560 total_size = size * sizeof(Int);
1561 } else if (!strcmp(atname, "dbref")) {
1562 props = array_of_dbrefs;
1563 total_size = size * sizeof(Int);
1564 } else if (!strcmp(atname, "float")) {
1565 props = array_of_doubles;
1566 total_size = size * sizeof(Float);
1567 } else if (!strcmp(atname, "ptr")) {
1568 props = array_of_ptrs;
1569 total_size = size * sizeof(AtomEntry *);
1570 } else if (!strcmp(atname, "atom")) {
1571 props = array_of_atoms;
1572 total_size = size * sizeof(Term);
1573 } else if (!strcmp(atname, "char")) {
1574 props = array_of_chars;
1575 total_size = size * sizeof(char);
1576 } else if (!strcmp(atname, "unsigned_char")) {
1577 props = array_of_uchars;
1578 total_size = size * sizeof(unsigned char);
1579 } else {
1580 Yap_ThrowError(DOMAIN_ERROR_ARRAY_TYPE, tprops, "create_mmapped_array");
1581 return (FALSE);
1582 }
1583 } else {
1584 Yap_ThrowError(TYPE_ERROR_ATOM, tprops, "create_mmapped_array");
1585 return (FALSE);
1586 }
1587
1588 if (IsVarTerm(tfile)) {
1589 Yap_ThrowError(INSTANTIATION_ERROR, tfile, "create_mmapped_array");
1590 return (FALSE);
1591 } else if (IsAtomTerm(tfile)) {
1592 char *filename = RepAtom(AtomOfTerm(tfile))->StrOfAE;
1593
1594 fd = open(filename, O_RDWR | O_CREAT, S_IRUSR | S_IWUSR);
1595 if (fd == -1) {
1596 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, ARG1, "create_mmapped_array (open: %s)",
1597 strerror(errno));
1598 return (FALSE);
1599 }
1600 if (lseek(fd, total_size - 1, SEEK_SET) < 0)
1601 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, tfile,
1602 "create_mmapped_array (lseek: %s)", strerror(errno));
1603 if (write(fd, "", 1) < 0)
1604 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, tfile,
1605 "create_mmapped_array (write: %s)", strerror(errno));
1606 /*
1607 if (ftruncate(fd, total_size) < 0)
1608 Yap_ThrowError(SYSTEM_ERROR_INTERNAL,tfile,"create_mmapped_array");
1609 */
1610 if ((array_addr =
1611 (CODEADDR)mmap(0, (size_t)total_size, PROT_READ | PROT_WRITE,
1612 MAP_SHARED, fd, 0)) == (CODEADDR)-1)
1613 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, tfile, "create_mmapped_array (mmap: %s)",
1614 strerror(errno));
1615 } else {
1616 Yap_ThrowError(TYPE_ERROR_ATOM, tfile, "create_mmapped_array");
1617 return (FALSE);
1618 }
1619
1620 if (IsVarTerm(t)) {
1621 Yap_ThrowError(INSTANTIATION_ERROR, t, "create_mmapped_array");
1622 return (FALSE);
1623 } else if (IsAtomTerm(t)) {
1624 /* Create a named array */
1625 AtomEntry *ae = RepAtom(AtomOfTerm(t));
1626 StaticArrayEntry *pp;
1627
1628 WRITE_LOCK(ae->ARWLock);
1629 pp = RepStaticArrayProp(ae->PropsOfAE);
1630 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
1631 pp = RepStaticArrayProp(pp->NextOfPE);
1632 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
1633 mmap_array_block *ptr;
1634
1635 if (EndOfPAEntr(pp)) {
1636 WRITE_UNLOCK(ae->ARWLock);
1637 return FALSE;
1638 } else {
1639 WRITE_LOCK(pp->ArRWLock);
1640 }
1641 CreateStaticArray(ae, size, props, array_addr, pp PASS_REGS);
1642 ptr = (mmap_array_block *)Yap_AllocAtomSpace(sizeof(mmap_array_block));
1643 ptr->name = AbsAtom(ae);
1644 ptr->size = total_size;
1645 ptr->items = size;
1646 ptr->start = (void *)array_addr;
1647 ptr->fd = fd;
1648 ptr->next = GLOBAL_mmap_arrays;
1649 GLOBAL_mmap_arrays = ptr;
1650 WRITE_UNLOCK(pp->ArRWLock);
1651 WRITE_UNLOCK(ae->ARWLock);
1652 return TRUE;
1653 } else {
1654 WRITE_UNLOCK(ae->ARWLock);
1655 Yap_ThrowError(DOMAIN_ERROR_ARRAY_TYPE, t, "create_mmapped_array",
1656 ae->StrOfAE);
1657 return (FALSE);
1658 }
1659 } else {
1660 Yap_ThrowError(TYPE_ERROR_ATOM, t, "create_mmapped_array");
1661 return FALSE;
1662 }
1663#else
1664 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, ARG1, "create_mmapped_array (mmap)");
1665 return (FALSE);
1666#endif
1667}
1668
1669/* This routine removes array references from complex terms? */
1670static void replace_array_references_complex(register CELL *pt0,
1671 register CELL *pt0_end,
1672 register CELL *ptn,
1673 Term Var USES_REGS) {
1674
1675 register CELL **tovisit = (CELL **)Yap_PreAllocCodeSpace();
1676 CELL **tovisit_base = tovisit;
1677
1678loop:
1679 while (pt0 < pt0_end) {
1680 register CELL d0;
1681
1682 ++pt0;
1683 d0 = Derefa(pt0);
1684 if (IsVarTerm(d0)) {
1685 *ptn++ = d0;
1686 } else if (IsPairTerm(d0)) {
1687 /* store the terms to visit */
1688 *ptn++ = AbsPair(HR);
1689#ifdef RATIONAL_TREES
1690 tovisit[0] = pt0;
1691 tovisit[1] = pt0_end;
1692 tovisit[2] = ptn;
1693 tovisit[3] = (CELL *)*pt0;
1694 tovisit += 4;
1695 *pt0 = TermNil;
1696#else
1697 if (pt0 < pt0_end) {
1698 tovisit[0] = pt0;
1699 tovisit[1] = pt0_end;
1700 tovisit[2] = ptn;
1701 tovisit += 3;
1702 }
1703#endif
1704 pt0 = RepPair(d0) - 1;
1705 pt0_end = RepPair(d0) + 1;
1706 /* write the head and tail of the list */
1707 ptn = HR;
1708 HR += 2;
1709 } else if (IsApplTerm(d0)) {
1710 register Functor f;
1711
1712 f = FunctorOfTerm(d0);
1713 /* store the terms to visit */
1714 if (IsExtensionFunctor(f)) {
1715 {
1716 *ptn++ = d0;
1717 continue;
1718 }
1719 }
1720 *ptn++ = AbsAppl(HR);
1721/* store the terms to visit */
1722#ifdef RATIONAL_TREES
1723 tovisit[0] = pt0;
1724 tovisit[1] = pt0_end;
1725 tovisit[2] = ptn;
1726 tovisit[3] = (CELL *)*pt0;
1727 tovisit += 4;
1728 *pt0 = TermNil;
1729#else
1730 if (pt0 < pt0_end) {
1731 tovisit[0] = pt0;
1732 tovisit[1] = pt0_end;
1733 tovisit[2] = ptn;
1734 tovisit += 3;
1735 }
1736#endif
1737 pt0 = RepAppl(d0);
1738 d0 = ArityOfFunctor(f);
1739 pt0_end = pt0 + d0;
1740 /* start writing the compound term */
1741 ptn = HR;
1742 *ptn++ = (CELL)f;
1743 HR += d0 + 1;
1744 } else { /* AtomOrInt */
1745 *ptn++ = d0;
1746 }
1747 /* just continue the loop */
1748 }
1749
1750 /* Do we still have compound terms to visit */
1751 if (tovisit > (CELL **)tovisit_base) {
1752#ifdef RATIONAL_TREES
1753 tovisit -= 4;
1754 pt0 = tovisit[0];
1755 pt0_end = tovisit[1];
1756 ptn = tovisit[2];
1757 *pt0 = (CELL)tovisit[3];
1758#else
1759 tovisit -= 3;
1760 pt0 = tovisit[0];
1761 pt0_end = tovisit[1];
1762 ptn = tovisit[2];
1763#endif
1764 goto loop;
1765 }
1766
1767 Bind_Global(PtrOfTerm(Var), TermNil);
1768 Yap_ReleasePreAllocCodeSpace((ADDR)tovisit);
1769}
1770
1771/*
1772 *
1773 * Given a term t0, build a new term tf of the form ta+tb, where ta is
1774 * obtained by replacing the array references in t0 by empty
1775 * variables, and tb is a list of array references and corresponding
1776 * variables.
1777 */
1778static Term replace_array_references(Term t0 USES_REGS) {
1779 Term t;
1780
1781 t = Deref(t0);
1782 if (IsVarTerm(t)) {
1783 /* we found a variable */
1784 return (MkPairTerm(t, TermNil));
1785 } else if (IsAtomOrIntTerm(t)) {
1786 return (MkPairTerm(t, TermNil));
1787 } else if (IsPairTerm(t)) {
1788 Term VList = MkVarTerm();
1789 CELL *h0 = HR;
1790
1791 HR += 2;
1792 replace_array_references_complex(RepPair(t) - 1, RepPair(t) + 1, h0,
1793 VList PASS_REGS);
1794 return MkPairTerm(AbsPair(h0), VList);
1795 } else {
1796 Term VList = MkVarTerm();
1797 CELL *h0 = HR;
1798 Functor f = FunctorOfTerm(t);
1799
1800 *HR++ = (CELL)(f);
1801 HR += ArityOfFunctor(f);
1802 replace_array_references_complex(
1803 RepAppl(t), RepAppl(t) + ArityOfFunctor(FunctorOfTerm(t)), h0 + 1,
1804 VList PASS_REGS);
1805 return (MkPairTerm(AbsAppl(h0), VList));
1806 }
1807}
1808
1809static Int array_references(USES_REGS1) {
1810 Term t = replace_array_references(ARG1 PASS_REGS);
1811 Term t1 = HeadOfTerm(t);
1812 Term t2 = TailOfTerm(t);
1813
1814 return (Yap_unify(t1, ARG2) && Yap_unify(t2, ARG3));
1815}
1816
1833static Int assign_static(USES_REGS1) {
1834 Term t1, t2, t3;
1835 StaticArrayEntry *ptr;
1836 Int indx;
1837
1838 t2 = Deref(ARG2);
1839 if (IsNonVarTerm(t2)) {
1840 Term nti;
1841
1842 if (IsIntegerTerm(nti = Yap_Eval(t2)))
1843 indx = IntegerOfTerm(nti);
1844 else {
1845 Yap_ThrowError(TYPE_ERROR_INTEGER, t2, "update_array");
1846 return (FALSE);
1847 }
1848 } else {
1849 Yap_ThrowError(INSTANTIATION_ERROR, t2, "update_array");
1850 return (FALSE);
1851 }
1852 t3 = Deref(ARG3);
1853
1854 t1 = Deref(ARG1);
1855 if (IsVarTerm(t1)) {
1856 Yap_ThrowError(INSTANTIATION_ERROR, t1, "update_array");
1857 return (FALSE);
1858 }
1859 if (!IsAtomTerm(t1)) {
1860 if (IsApplTerm(t1)) {
1861 CELL *ptr;
1862 Functor f = FunctorOfTerm(t1);
1863 /* store the terms to visit */
1864 if (IsExtensionFunctor(f)) {
1865 Yap_ThrowError(TYPE_ERROR_ARRAY, t1, "update_array");
1866 return (FALSE);
1867 }
1868 if (indx > 0 && indx > ArityOfFunctor(f)) {
1869 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "update_array");
1870 return (FALSE);
1871 }
1872 ptr = RepAppl(t1) + indx + 1;
1873#ifdef MULTI_ASSIGNMENT_VARIABLES
1874 MaBind(ptr, t3);
1875 return (TRUE);
1876#else
1877 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, t2, "update_array");
1878 return (FALSE);
1879#endif
1880 } else {
1881 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "update_array");
1882 return (FALSE);
1883 }
1884 }
1885 {
1886 AtomEntry *ae = RepAtom(AtomOfTerm(t1));
1887
1888 READ_LOCK(ae->ARWLock);
1889 ptr = RepStaticArrayProp(ae->PropsOfAE);
1890 while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
1891 ptr = RepStaticArrayProp(ptr->NextOfPE);
1892
1893 if (EndOfPAEntr(ptr)) {
1894 READ_UNLOCK(ae->ARWLock);
1895 Yap_ThrowError(EXISTENCE_ERROR_ARRAY, t1, "assign_static %s",
1896 RepAtom(AtomOfTerm(t1))->StrOfAE);
1897 return FALSE;
1898 }
1899
1900 if (ArrayIsDynamic((ArrayEntry *)ptr)) {
1901 ArrayEntry *pp = (ArrayEntry *)ptr;
1902 CELL *pt;
1903
1904 WRITE_LOCK(pp->ArRWLock);
1905 READ_UNLOCK(ae->ARWLock);
1906 if (indx < 0 || indx >= pp->ArrayEArity) {
1907 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
1908 WRITE_UNLOCK(pp->ArRWLock);
1909 return FALSE;
1910 }
1911 pt = RepAppl(pp->ValueOfVE) + indx + 1;
1912 WRITE_UNLOCK(pp->ArRWLock);
1913#ifdef MULTI_ASSIGNMENT_VARIABLES
1914 /* the evil deed is to be done now */
1915 MaBind(pt, t3);
1916 return TRUE;
1917#else
1918 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, t2, "update_array");
1919 return FALSE;
1920#endif
1921 }
1922
1923 WRITE_LOCK(ptr->ArRWLock);
1924 READ_UNLOCK(ae->ARWLock);
1925 /* a static array */
1926 if (indx < 0 || indx >= ptr->ArrayEArity) {
1927 WRITE_UNLOCK(ptr->ArRWLock);
1928 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
1929 return FALSE;
1930 }
1931 switch (ptr->ArrayType) {
1932 case array_of_ints: {
1933 Int i;
1934 Term nti;
1935
1936 if (IsVarTerm(t3)) {
1937 WRITE_UNLOCK(ptr->ArRWLock);
1938 Yap_ThrowError(INSTANTIATION_ERROR, t3, "assign_static");
1939 return FALSE;
1940 }
1941
1942 if (IsIntegerTerm(nti = Yap_Eval(t3)))
1943 i = IntegerOfTerm(nti);
1944 else {
1945 WRITE_UNLOCK(ptr->ArRWLock);
1946 Yap_ThrowError(TYPE_ERROR_INTEGER, t3, "assign_static");
1947 return (FALSE);
1948 }
1949 ptr->ValueOfVE.ints[indx] = i;
1950 } break;
1951
1952 case array_of_chars: {
1953 Int i;
1954 Term nti;
1955
1956 if (IsVarTerm(t3)) {
1957 WRITE_UNLOCK(ptr->ArRWLock);
1958 Yap_ThrowError(INSTANTIATION_ERROR, t3, "assign_static");
1959 return FALSE;
1960 }
1961 if (IsIntegerTerm(nti = Yap_Eval(t3)))
1962 i = IntegerOfTerm(nti);
1963 else {
1964 Yap_ThrowError(TYPE_ERROR_INTEGER, t3, "assign_static");
1965 return (FALSE);
1966 }
1967 if (i > 127 || i < -128) {
1968 WRITE_UNLOCK(ptr->ArRWLock);
1969 Yap_ThrowError(TYPE_ERROR_CHAR, t3, "assign_static");
1970 return FALSE;
1971 }
1972 ptr->ValueOfVE.chars[indx] = i;
1973 } break;
1974
1975 case array_of_uchars: {
1976 Int i;
1977 Term nti;
1978
1979 if (IsVarTerm(t3)) {
1980 WRITE_UNLOCK(ptr->ArRWLock);
1981 Yap_ThrowError(INSTANTIATION_ERROR, t3, "assign_static");
1982 return FALSE;
1983 }
1984 if (IsIntegerTerm(nti = Yap_Eval(t3)))
1985 i = IntegerOfTerm(nti);
1986 else {
1987 WRITE_UNLOCK(ptr->ArRWLock);
1988 Yap_ThrowError(TYPE_ERROR_INTEGER, t3, "assign_static");
1989 return FALSE;
1990 }
1991 if (i > 255 || i < 0) {
1992 WRITE_UNLOCK(ptr->ArRWLock);
1993 Yap_ThrowError(TYPE_ERROR_UCHAR, t3, "assign_static");
1994 return FALSE;
1995 }
1996 ptr->ValueOfVE.chars[indx] = i;
1997 } break;
1998
1999 case array_of_doubles: {
2000 Float f;
2001 Term nti;
2002
2003 if (IsVarTerm(t3)) {
2004 WRITE_UNLOCK(ptr->ArRWLock);
2005 Yap_ThrowError(INSTANTIATION_ERROR, t3, "assign_static");
2006 return FALSE;
2007 }
2008 if (IsFloatTerm(nti = Yap_Eval(t3)))
2009 f = FloatOfTerm(nti);
2010 else if (IsIntegerTerm(nti))
2011 f = IntegerOfTerm(nti);
2012 else {
2013 WRITE_UNLOCK(ptr->ArRWLock);
2014 Yap_ThrowError(TYPE_ERROR_FLOAT, t3, "assign_static");
2015 return FALSE;
2016 }
2017 ptr->ValueOfVE.floats[indx] = f;
2018 } break;
2019
2020 case array_of_ptrs: {
2021 Int r;
2022
2023 if (IsVarTerm(t3)) {
2024 WRITE_UNLOCK(ptr->ArRWLock);
2025 Yap_ThrowError(INSTANTIATION_ERROR, t3, "assign_static");
2026 return FALSE;
2027 }
2028 if (IsIntegerTerm(t3))
2029 r = IntegerOfTerm(t3);
2030 else {
2031 WRITE_UNLOCK(ptr->ArRWLock);
2032 Yap_ThrowError(TYPE_ERROR_PTR, t3, "assign_static");
2033 return FALSE;
2034 }
2035 ptr->ValueOfVE.ptrs[indx] = (AtomEntry *)r;
2036 } break;
2037
2038 case array_of_atoms: {
2039 if (IsVarTerm(t3)) {
2040 WRITE_UNLOCK(ptr->ArRWLock);
2041 Yap_ThrowError(INSTANTIATION_ERROR, t3, "assign_static");
2042 return FALSE;
2043 }
2044 if (!IsAtomTerm(t3)) {
2045 WRITE_UNLOCK(ptr->ArRWLock);
2046 Yap_ThrowError(TYPE_ERROR_ATOM, t3, "assign_static");
2047 return FALSE;
2048 }
2049 ptr->ValueOfVE.atoms[indx] = t3;
2050 } break;
2051
2052 case array_of_dbrefs: {
2053
2054 Term t0 = ptr->ValueOfVE.dbrefs[indx];
2055 DBRef p = DBRefOfTerm(t3);
2056
2057 if (IsVarTerm(t3)) {
2058 WRITE_UNLOCK(ptr->ArRWLock);
2059 Yap_ThrowError(INSTANTIATION_ERROR, t3, "assign_static");
2060 return FALSE;
2061 }
2062 if (!IsDBRefTerm(t3)) {
2063 WRITE_UNLOCK(ptr->ArRWLock);
2064 Yap_ThrowError(TYPE_ERROR_DBREF, t3, "assign_static");
2065 return FALSE;
2066 }
2067 ptr->ValueOfVE.dbrefs[indx] = t3;
2068 if (t0 != 0L) {
2069 DBRef ptr = DBRefOfTerm(t0);
2070
2071 if (ptr->Flags & LogUpdMask) {
2072 LogUpdClause *lup = (LogUpdClause *)ptr;
2073 // LOCK(lup->ClLock);
2074 lup->ClRefCount--;
2075 if (lup->ClRefCount == 0 && (lup->ClFlags & ErasedMask) &&
2076 !(lup->ClFlags & InUseMask)) {
2077 // UNLOCK(lup->ClLock);
2078 Yap_ErLogUpdCl(lup);
2079 } else {
2080 // UNLOCK(lup->ClLock);
2081 }
2082 } else {
2083 ptr->NOfRefsTo--;
2084 if (ptr->NOfRefsTo == 0 && (ptr->Flags & ErasedMask) &&
2085 !(ptr->Flags & InUseMask)) {
2086 Yap_ErDBE(ptr);
2087 }
2088 }
2089 }
2090
2091 if (p->Flags & LogUpdMask) {
2092 LogUpdClause *lup = (LogUpdClause *)p;
2093 // LOCK(lup->ClLock);
2094 lup->ClRefCount++;
2095 // UNLOCK(lup->ClLock);
2096 } else {
2097 p->NOfRefsTo++;
2098 }
2099 } break;
2100
2101 case array_of_nb_terms:
2102
2103 {
2104 Term told = ptr->ValueOfVE.lterms[indx].tstore;
2105
2106 CELL *livep = &(ptr->ValueOfVE.lterms[indx].tlive);
2107 RESET_VARIABLE(livep);
2108 /* recover space */
2109 if (IsApplTerm(told)) {
2110 Yap_ReleaseTermFromDB((DBTerm *)RepAppl(told));
2111 }
2112 if (IsVarTerm(t3)) {
2113 RESET_VARIABLE(&(ptr->ValueOfVE.lterms[indx].tstore));
2114 } else if (IsAtomicTerm(t3)) {
2115 ptr->ValueOfVE.lterms[indx].tstore = t3;
2116 } else {
2117 DBTerm *new = Yap_StoreTermInDB(t3, 3);
2118 if (!new) {
2119 WRITE_UNLOCK(ptr->ArRWLock);
2120 return FALSE;
2121 }
2122 ptr->ValueOfVE.lterms[indx].tstore = AbsAppl((CELL *)new);
2123 }
2124 } break;
2125
2126 case array_of_terms: {
2127
2128 DBTerm *ref = ptr->ValueOfVE.terms[indx];
2129
2130 if (ref != NULL) {
2131 Yap_ReleaseTermFromDB(ref);
2132 }
2133 ptr->ValueOfVE.terms[indx] = Yap_StoreTermInDB(t3, 3);
2134 if (ptr->ValueOfVE.terms[indx] == NULL) {
2135 WRITE_UNLOCK(ptr->ArRWLock);
2136 return FALSE;
2137 }
2138 } break;
2139 }
2140 WRITE_UNLOCK(ptr->ArRWLock);
2141 return TRUE;
2142 }
2143}
2144
2145static Int assign_dynamic(USES_REGS1) {
2146 Term t1, t2, t3;
2147 StaticArrayEntry *ptr;
2148 Int indx;
2149
2150 t2 = Deref(ARG2);
2151 if (IsNonVarTerm(t2)) {
2152 Term nti;
2153 if (IsIntegerTerm(nti = Yap_Eval(t2))) {
2154 indx = IntegerOfTerm(nti);
2155 } else {
2156 Yap_ThrowError(TYPE_ERROR_INTEGER, t2, "update_array");
2157 return (FALSE);
2158 }
2159 } else {
2160 Yap_ThrowError(INSTANTIATION_ERROR, t2, "update_array");
2161 return (FALSE);
2162 }
2163 t3 = Deref(ARG3);
2164
2165 t1 = Deref(ARG1);
2166 if (IsVarTerm(t1)) {
2167 Yap_ThrowError(INSTANTIATION_ERROR, t1, "update_array");
2168 return (FALSE);
2169 }
2170 if (!IsAtomTerm(t1)) {
2171 if (IsApplTerm(t1)) {
2172 CELL *ptr;
2173 Functor f = FunctorOfTerm(t1);
2174 /* store the terms to visit */
2175 if (IsExtensionFunctor(f)) {
2176 Yap_ThrowError(TYPE_ERROR_ARRAY, t1, "update_array");
2177 return (FALSE);
2178 }
2179 if (indx > 0 && indx > ArityOfFunctor(f)) {
2180 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "update_array");
2181 return (FALSE);
2182 }
2183 ptr = RepAppl(t1) + indx + 1;
2184#ifdef MULTI_ASSIGNMENT_VARIABLES
2185 MaBind(ptr, t3);
2186 return (TRUE);
2187#else
2188 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, t2, "update_array");
2189 return (FALSE);
2190#endif
2191 } else {
2192 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "update_array");
2193 return (FALSE);
2194 }
2195 }
2196 {
2197 AtomEntry *ae = RepAtom(AtomOfTerm(t1));
2198
2199 READ_LOCK(ae->ARWLock);
2200 ptr = RepStaticArrayProp(ae->PropsOfAE);
2201 while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
2202 ptr = RepStaticArrayProp(ptr->NextOfPE);
2203 READ_UNLOCK(ae->ARWLock);
2204 }
2205
2206 if (EndOfPAEntr(ptr)) {
2207 Yap_ThrowError(EXISTENCE_ERROR_ARRAY, t1, "assign_static %s",
2208 RepAtom(AtomOfTerm(t1))->StrOfAE);
2209 return (FALSE);
2210 }
2211
2212 if (ArrayIsDynamic((ArrayEntry *)ptr)) {
2213 ArrayEntry *pp = (ArrayEntry *)ptr;
2214 CELL *pt;
2215 WRITE_LOCK(pp->ArRWLock);
2216 if (indx < 0 || indx >= pp->ArrayEArity) {
2217 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
2218 WRITE_UNLOCK(pp->ArRWLock);
2219 return (FALSE);
2220 }
2221 pt = RepAppl(pp->ValueOfVE) + indx + 1;
2222 WRITE_UNLOCK(pp->ArRWLock);
2223#ifdef MULTI_ASSIGNMENT_VARIABLES
2224 /* the evil deed is to be done now */
2225 MaBind(pt, t3);
2226 return TRUE;
2227#else
2228 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, t2, "update_array");
2229 return FALSE;
2230#endif
2231 }
2232
2233 WRITE_LOCK(ptr->ArRWLock);
2234 /* a static array */
2235 if (indx < 0 || indx >= ptr->ArrayEArity) {
2236 WRITE_UNLOCK(ptr->ArRWLock);
2237 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "assign_static");
2238 return FALSE;
2239 }
2240 switch (ptr->ArrayType) {
2241 case array_of_ints:
2242 case array_of_chars:
2243 case array_of_uchars:
2244 case array_of_doubles:
2245 case array_of_ptrs:
2246 case array_of_atoms:
2247 case array_of_dbrefs:
2248 case array_of_terms:
2249 WRITE_UNLOCK(ptr->ArRWLock);
2250 Yap_ThrowError(DOMAIN_ERROR_ARRAY_TYPE, t3, "assign_static");
2251 return FALSE;
2252
2253 case array_of_nb_terms:
2254#ifdef MULTI_ASSIGNMENT_VARIABLES
2255 {
2256 Term t = ptr->ValueOfVE.lterms[indx].tlive;
2257 Functor f;
2258 /* we have a mutable term there */
2259
2260 if (IsVarTerm(t) || !IsApplTerm(t) ||
2261 (f = FunctorOfTerm(t)) != FunctorAtFoundOne) {
2262 Term tn = Yap_NewTimedVar(t3);
2263 CELL *sp = RepAppl(tn);
2264 *sp = (CELL)FunctorAtFoundOne;
2265 YapBind(&(ptr->ValueOfVE.lterms[indx].tlive), tn);
2266 } else {
2267 Yap_UpdateTimedVar(t, t3);
2268 }
2269 }
2270 WRITE_UNLOCK(ptr->ArRWLock);
2271 return TRUE;
2272#else
2273 WRITE_UNLOCK(ptr->ArRWLock);
2274 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, t2, "update_array");
2275 return FALSE;
2276#endif
2277 }
2278 WRITE_UNLOCK(ptr->ArRWLock);
2279 return TRUE;
2280}
2281
2305static Int add_to_array_element(USES_REGS1) {
2306 Term t1, t2, t3;
2307 StaticArrayEntry *ptr;
2308 Int indx;
2309
2310 t2 = Deref(ARG2);
2311 if (IsNonVarTerm(t2)) {
2312 Term nti;
2313 if (IsIntegerTerm(nti = Yap_Eval(t2))) {
2314 indx = IntegerOfTerm(nti);
2315 } else {
2316 Yap_ThrowError(TYPE_ERROR_INTEGER, t2, "add_to_array_element");
2317 return (FALSE);
2318 }
2319 } else {
2320 Yap_ThrowError(INSTANTIATION_ERROR, t2, "add_to_array_element");
2321 return (FALSE);
2322 }
2323
2324 t1 = Deref(ARG1);
2325 if (IsVarTerm(t1)) {
2326 Yap_ThrowError(INSTANTIATION_ERROR, t1, "add_to_array_element");
2327 return (FALSE);
2328 }
2329 t3 = Deref(ARG3);
2330 if (IsVarTerm(t3)) {
2331 Yap_ThrowError(INSTANTIATION_ERROR, t3, "add_to_array_element");
2332 return (FALSE);
2333 }
2334 if (!IsAtomTerm(t1)) {
2335 if (IsApplTerm(t1)) {
2336 CELL *ptr;
2337 Functor f = FunctorOfTerm(t1);
2338 Term ta;
2339
2340 /* store the terms to visit */
2341 if (IsExtensionFunctor(f)) {
2342 Yap_ThrowError(TYPE_ERROR_ARRAY, t1, "add_to_array_element");
2343 return (FALSE);
2344 }
2345 if (indx > 0 && indx > ArityOfFunctor(f)) {
2346 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "add_to_array_element");
2347 return (FALSE);
2348 }
2349 ptr = RepAppl(t1) + indx + 1;
2350 ta = RepAppl(t1)[indx + 1];
2351 if (IsIntegerTerm(ta)) {
2352 if (IsIntegerTerm(t3)) {
2353 ta = MkIntegerTerm(IntegerOfTerm(ta) + IntegerOfTerm(t3));
2354 } else if (IsFloatTerm(t3)) {
2355 ta = MkFloatTerm(IntegerOfTerm(ta) + FloatOfTerm(t3));
2356 } else {
2357 Yap_ThrowError(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
2358 return (FALSE);
2359 }
2360 } else if (IsFloatTerm(ta)) {
2361 if (IsFloatTerm(t3)) {
2362 ta = MkFloatTerm(FloatOfTerm(ta) + IntegerOfTerm(t3));
2363 } else if (IsFloatTerm(t3)) {
2364 ta = MkFloatTerm(FloatOfTerm(ta) + FloatOfTerm(t3));
2365 } else {
2366 Yap_ThrowError(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
2367 return (FALSE);
2368 }
2369 } else {
2370 Yap_ThrowError(TYPE_ERROR_NUMBER, ta, "add_to_array_element");
2371 return (FALSE);
2372 }
2373#ifdef MULTI_ASSIGNMENT_VARIABLES
2374 MaBind(ptr, ta);
2375 return (Yap_unify(ARG4, ta));
2376#else
2377 Yap_ThrowError(SYSTEM_ERROR_INTERNAL, t2, "add_to_array_element");
2378 return (FALSE);
2379#endif
2380 } else {
2381 Yap_ThrowError(TYPE_ERROR_ATOM, t1, "add_to_array_element");
2382 return (FALSE);
2383 }
2384 }
2385 {
2386 AtomEntry *ae = RepAtom(AtomOfTerm(t1));
2387
2388 READ_LOCK(ae->ARWLock);
2389 ptr = RepStaticArrayProp(ae->PropsOfAE);
2390 while (!EndOfPAEntr(ptr) && ptr->KindOfPE != ArrayProperty)
2391 ptr = RepStaticArrayProp(ptr->NextOfPE);
2392 READ_UNLOCK(ae->ARWLock);
2393 }
2394
2395 if (EndOfPAEntr(ptr)) {
2396 Yap_ThrowError(EXISTENCE_ERROR_ARRAY, t1, "add_to_array_element %s",
2397 RepAtom(AtomOfTerm(t1))->StrOfAE);
2398 return (FALSE);
2399 }
2400
2401 if (ArrayIsDynamic((ArrayEntry *)ptr)) {
2402 ArrayEntry *pp = (ArrayEntry *)ptr;
2403 CELL *pt;
2404 Term ta;
2405
2406 WRITE_LOCK(pp->ArRWLock);
2407 if (indx < 0 || indx >= pp->ArrayEArity) {
2408 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "add_to_array_element");
2409 READ_UNLOCK(pp->ArRWLock);
2410 return FALSE;
2411 }
2412 pt = RepAppl(pp->ValueOfVE) + indx + 1;
2413 ta = RepAppl(pp->ValueOfVE)[indx + 1];
2414 if (IsIntegerTerm(ta)) {
2415 if (IsIntegerTerm(t3)) {
2416 ta = MkIntegerTerm(IntegerOfTerm(ta) + IntegerOfTerm(t3));
2417 } else if (IsFloatTerm(t3)) {
2418 ta = MkFloatTerm(IntegerOfTerm(ta) + FloatOfTerm(t3));
2419 } else {
2420 WRITE_UNLOCK(pp->ArRWLock);
2421 Yap_ThrowError(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
2422 return FALSE;
2423 }
2424 } else if (IsFloatTerm(ta)) {
2425 if (IsFloatTerm(t3)) {
2426 ta = MkFloatTerm(FloatOfTerm(ta) + IntegerOfTerm(t3));
2427 } else if (IsFloatTerm(t3)) {
2428 ta = MkFloatTerm(FloatOfTerm(ta) + FloatOfTerm(t3));
2429 } else {
2430 WRITE_UNLOCK(pp->ArRWLock);
2431 Yap_ThrowError(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
2432 return FALSE;
2433 }
2434 } else {
2435 WRITE_UNLOCK(pp->ArRWLock);
2436 Yap_ThrowError(TYPE_ERROR_NUMBER, ta, "add_to_array_element");
2437 return FALSE;
2438 }
2439 /* the evil deed is to be done now */
2440 MaBind(pt, ta);
2441 WRITE_UNLOCK(pp->ArRWLock);
2442 return Yap_unify(ARG4, t3);
2443 }
2444
2445 WRITE_LOCK(ptr->ArRWLock);
2446 /* a static array */
2447 if (indx < 0 || indx >= ptr->ArrayEArity) {
2448 WRITE_UNLOCK(ptr->ArRWLock);
2449 Yap_ThrowError(DOMAIN_ERROR_ARRAY_OVERFLOW, t2, "add_to_array_element");
2450 return FALSE;
2451 }
2452 switch (ptr->ArrayType) {
2453 case array_of_ints: {
2454 Int i = ptr->ValueOfVE.ints[indx];
2455 if (!IsIntegerTerm(t3)) {
2456 WRITE_UNLOCK(ptr->ArRWLock);
2457 Yap_ThrowError(TYPE_ERROR_INTEGER, t3, "add_to_array_element");
2458 return FALSE;
2459 }
2460 i += IntegerOfTerm(t3);
2461 ptr->ValueOfVE.ints[indx] = i;
2462 WRITE_UNLOCK(ptr->ArRWLock);
2463 return Yap_unify(ARG4, MkIntegerTerm(i));
2464 } break;
2465 case array_of_doubles: {
2466 Float fl = ptr->ValueOfVE.floats[indx];
2467
2468 if (IsFloatTerm(t3)) {
2469 fl += FloatOfTerm(t3);
2470 } else if (IsIntegerTerm(t3)) {
2471 fl += IntegerOfTerm(t3);
2472 } else {
2473 WRITE_UNLOCK(ptr->ArRWLock);
2474 Yap_ThrowError(TYPE_ERROR_NUMBER, t3, "add_to_array_element");
2475 return FALSE;
2476 }
2477 ptr->ValueOfVE.floats[indx] = fl;
2478 WRITE_UNLOCK(ptr->ArRWLock);
2479 return Yap_unify(ARG4, MkFloatTerm(fl));
2480 } break;
2481 default:
2482 WRITE_UNLOCK(ptr->ArRWLock);
2483 Yap_ThrowError(TYPE_ERROR_NUMBER, t2, "add_to_array_element");
2484 return FALSE;
2485 }
2486}
2487
2488static Int compile_array_refs(USES_REGS1) {
2489 compile_arrays = TRUE;
2490 return (TRUE);
2491}
2492
2493static Int array_refs_compiled(USES_REGS1) { return compile_arrays; }
2494
2495static Int sync_mmapped_arrays(USES_REGS1) {
2496#ifdef HAVE_MMAP
2497 mmap_array_block *ptr = GLOBAL_mmap_arrays;
2498 while (ptr != NULL) {
2499 msync(ptr->start, ptr->size, MS_SYNC);
2500 ptr = ptr->next;
2501 }
2502#endif
2503 return (TRUE);
2504}
2505
2517static Int static_array_to_term(USES_REGS1) {
2518 Term t = Deref(ARG1);
2519
2520 if (IsVarTerm(t)) {
2521 return FALSE;
2522 } else if (IsAtomTerm(t)) {
2523 /* Create a named array */
2524 AtomEntry *ae = RepAtom(AtomOfTerm(t));
2525 StaticArrayEntry *pp;
2526
2527 READ_LOCK(ae->ARWLock);
2528 pp = RepStaticArrayProp(ae->PropsOfAE);
2529 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
2530 pp = RepStaticArrayProp(pp->NextOfPE);
2531 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
2532 READ_UNLOCK(ae->ARWLock);
2533 return (FALSE);
2534 } else {
2535 static_array_types tp = pp->ArrayType;
2536 Int dim = pp->ArrayEArity, indx;
2537 CELL *base;
2538
2539 while (HR + 1 + dim > ASP - 1024) {
2540 if (!Yap_dogc(PASS_REGS1)) {
2541 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
2542 return (FALSE);
2543 } else {
2544 if (HR + 1 + dim > ASP - 1024) {
2545 if (!Yap_growstack(sizeof(CELL) * (dim + 1 - (HR - ASP - 1024)))) {
2546 Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
2547 return FALSE;
2548 }
2549 }
2550 }
2551 }
2552 READ_LOCK(pp->ArRWLock);
2553 READ_UNLOCK(ae->ARWLock);
2554 base = HR;
2555 *HR++ = (CELL)Yap_MkFunctor(AbsAtom(ae), dim);
2556 switch (tp) {
2557 case array_of_ints: {
2558 CELL *sptr = HR;
2559 HR += dim;
2560 for (indx = 0; indx < dim; indx++) {
2561 *sptr++ = MkIntegerTerm(pp->ValueOfVE.ints[indx]);
2562 }
2563 } break;
2564 case array_of_dbrefs:
2565 for (indx = 0; indx < dim; indx++) {
2566 /* The object is now in use */
2567 Term TRef = pp->ValueOfVE.dbrefs[indx];
2568
2569 if (TRef != 0L) {
2570 DBRef ref = DBRefOfTerm(TRef);
2571 LOCK(ref->lock);
2572#if MULTIPLE_STACKS
2573 INC_DBREF_COUNT(ref);
2574 TRAIL_REF(ref); /* So that fail will erase it */
2575#else
2576 if (!(ref->Flags & InUseMask)) {
2577 ref->Flags |= InUseMask;
2578 TRAIL_REF(ref); /* So that fail will erase it */
2579 }
2580#endif
2581 UNLOCK(ref->lock);
2582 } else {
2583 TRef = TermNil;
2584 }
2585 *HR++ = TRef;
2586 }
2587 break;
2588 case array_of_doubles: {
2589 CELL *sptr = HR;
2590 HR += dim;
2591 for (indx = 0; indx < dim; indx++) {
2592 *sptr++ = MkEvalFl(pp->ValueOfVE.floats[indx]);
2593 }
2594 } break;
2595 case array_of_ptrs: {
2596 CELL *sptr = HR;
2597 HR += dim;
2598 for (indx = 0; indx < dim; indx++) {
2599 *sptr++ = MkAddressTerm(pp->ValueOfVE.ptrs[indx]);
2600 }
2601 } break;
2602 case array_of_chars: {
2603 CACHE_REGS
2604 CELL *sptr = HR;
2605 HR += dim;
2606 for (indx = 0; indx < dim; indx++) {
2607 *sptr++ = MkIntTerm(pp->ValueOfVE.chars[indx]);
2608 }
2609 } break;
2610 case array_of_uchars: {
2611 CACHE_REGS
2612 CELL *sptr = HR;
2613 HR += dim;
2614 for (indx = 0; indx < dim; indx++) {
2615 *sptr++ = MkIntTerm(pp->ValueOfVE.uchars[indx]);
2616 }
2617 } break;
2618 case array_of_terms: {
2619 CELL *sptr = HR;
2620 HR += dim;
2621 for (indx = 0; indx < dim; indx++) {
2622 /* The object is now in use */
2623 DBTerm *ref = pp->ValueOfVE.terms[indx];
2624
2625 Term TRef = GetTermFromArray(ref PASS_REGS);
2626
2627 if (P == FAILCODE) {
2628 return FALSE;
2629 }
2630
2631 *sptr++ = TRef;
2632 }
2633 } break;
2634 case array_of_nb_terms: {
2635 CELL *sptr = HR;
2636 HR += dim;
2637 for (indx = 0; indx < dim; indx++) {
2638 /* The object is now in use */
2639 Term To = GetNBTerm(pp->ValueOfVE.lterms, indx PASS_REGS);
2640
2641 if (P == FAILCODE) {
2642 return FALSE;
2643 }
2644
2645 *sptr++ = To;
2646 }
2647 } break;
2648 case array_of_atoms:
2649 for (indx = 0; indx < dim; indx++) {
2650 Term out;
2651 out = pp->ValueOfVE.atoms[indx];
2652 if (out == 0L)
2653 out = TermNil;
2654 *HR++ = out;
2655 }
2656 break;
2657 }
2658 READ_UNLOCK(pp->ArRWLock);
2659 return Yap_unify(AbsAppl(base), ARG2);
2660 }
2661 }
2662 Yap_ThrowError(TYPE_ERROR_ATOM, t, "add_to_array_element");
2663 return FALSE;
2664}
2665
2672static Int static_array_location(USES_REGS1) {
2673 Term t = Deref(ARG1);
2674
2675 if (IsVarTerm(t)) {
2676 return FALSE;
2677 } else if (IsAtomTerm(t)) {
2678 /* Create a named array */
2679 AtomEntry *ae = RepAtom(AtomOfTerm(t));
2680 StaticArrayEntry *pp;
2681 Int *ptr;
2682 READ_LOCK(ae->ARWLock);
2683 pp = RepStaticArrayProp(ae->PropsOfAE);
2684 while (!EndOfPAEntr(pp) && pp->KindOfPE != ArrayProperty)
2685 pp = RepStaticArrayProp(pp->NextOfPE);
2686 if (EndOfPAEntr(pp) || pp->ValueOfVE.ints == NULL) {
2687 READ_UNLOCK(ae->ARWLock);
2688 return FALSE;
2689 } else {
2690 ptr = pp->ValueOfVE.ints;
2691 READ_UNLOCK(ae->ARWLock);
2692 }
2693 return Yap_unify(ARG2, MkAddressTerm(ptr));
2694 }
2695 return FALSE;
2696 }
2697
2698 void Yap_InitArrayPreds(void) {
2699 Yap_InitCPred("$create_array", 2, create_array, SyncPredFlag);
2700 Yap_InitCPred("$array_references", 3, array_references, SafePredFlag);
2701 Yap_InitCPred("$array_arg", 3, array_arg, SafePredFlag);
2702 Yap_InitCPred("static_array", 3, static_array,
2703 SafePredFlag | SyncPredFlag);
2704 Yap_InitCPred("resize_static_array", 3, resize_static_array,
2705 SafePredFlag | SyncPredFlag);
2706 Yap_InitCPred("mmapped_array", 4, create_mmapped_array,
2707 SafePredFlag | SyncPredFlag);
2708 Yap_InitCPred("update_array", 3, assign_static, SafePredFlag);
2709 Yap_InitCPred("update_whole_array", 2, update_all, SafePredFlag);
2710 Yap_InitCPred("dynamic_update_array", 3, assign_dynamic, SafePredFlag); Yap_InitCPred("add_to_array_element", 4, add_to_array_element, SafePredFlag);
2711 Yap_InitCPred("array_element", 3, access_array, 0);
2712 Yap_InitCPred("reset_static_array", 1, clear_static_array, SafePredFlag);
2713 Yap_InitCPred("close_static_array", 1, close_static_array, SafePredFlag);
2714 Yap_InitCPred("$sync_mmapped_arrays", 0, sync_mmapped_arrays, SafePredFlag);
2715 Yap_InitCPred("$compile_array_refs", 0, compile_array_refs, SafePredFlag);
2716 Yap_InitCPred("$array_refs_compiled", 0, array_refs_compiled, SafePredFlag);
2717 Yap_InitCPred("$static_array_properties", 3, static_array_properties,
2718 SafePredFlag);
2719 Yap_InitCPred("static_array_to_term", 2, static_array_to_term, 0L);
2720 Yap_InitCPred("static_array_location", 2, static_array_location, 0L);
2721}
2722
Main definitions.
StaticArrayEntry * Yap_StaticVector(Atom Name, size_t size, static_array_types props)
create a new vectir in a given name Name
Definition: arrays.c:1301
Definition: Yatom.h:689
Definition: arrays.h:92
Definition: arrays.h:76
Definition: amidefs.h:264