home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / plbin.zip / pl / src / pl-rec.c < prev    next >
C/C++ Source or Header  |  1993-02-23  |  10KB  |  473 lines
  1. /*  pl-rec.c,v 1.2 1993/02/23 13:16:45 jan Exp
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6.  
  7.     Purpose: recorded database (record[az], recorded, erase)
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. forwards RecordList lookupRecordList P((word));
  13. forwards RecordList isCurrentRecordList P((word));
  14. forwards word       heapFunctor P((FunctorDef));
  15. forwards void       copyTermToHeap2 P((Word, Record, Word));
  16. forwards void       copyTermToGlobal2 P((Word, Word, Word, Word));
  17. forwards void       freeHeapTerm P((Word));
  18. forwards bool       record P((Word, Word, Word, char));
  19.  
  20. static RecordList recordTable[RECORDHASHSIZE];
  21.  
  22. void
  23. initRecords()
  24. { register RecordList *l;
  25.   register int n;
  26.  
  27.   for(n=0, l=recordTable; n < (RECORDHASHSIZE-1); n++, l++)
  28.     *l = (RecordList) makeRef(l+1);
  29. }
  30.  
  31. static RecordList
  32. lookupRecordList(key)
  33. register word key;
  34. { int v = pointerHashValue(key, RECORDHASHSIZE);
  35.   register RecordList l;
  36.  
  37.   for(l=recordTable[v]; l && !isRef((word)l); l = l->next)
  38.   { if (l->key == key)
  39.       return l;
  40.   }
  41.   l = (RecordList) allocHeap(sizeof(struct recordList) );
  42.   l->next = recordTable[v];
  43.   recordTable[v] = l;
  44.   l->key = key;
  45.   l->firstRecord = l->lastRecord = (Record) NULL;
  46.   l->type = RECORD_TYPE;
  47.  
  48.   return l;
  49. }
  50.  
  51. static RecordList
  52. isCurrentRecordList(key)
  53. register word key;
  54. { int v = pointerHashValue(key, RECORDHASHSIZE);
  55.   register RecordList l;
  56.  
  57.   for(l=recordTable[v]; l && !isRef((word)l); l = l->next)
  58.   { if (l->key == key)
  59.       return l;
  60.   }
  61.   return (RecordList) NULL;
  62. }
  63.  
  64. static word
  65. heapFunctor(def)
  66. FunctorDef def;
  67. { Functor f;
  68.   register int n;
  69.   register Word a;
  70.  
  71.   f = (Functor)allocHeap(sizeof(FunctorDef) + sizeof(word)*def->arity);
  72.   f->definition = def;
  73.   for(n=def->arity, a=argTermP(f, 0); n > 0; n--, a++)
  74.     setVar(*a);
  75.  
  76.   return (word) f;
  77. }
  78.  
  79. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  80. Copy a term from the global stack onto the heap.  Terms on the heap  are
  81. not represented as `word', but as `record'.  A `record' holds additional
  82. information  for  linking  it in the record list and to make copying the
  83. term back on the global stack faster.
  84.  
  85. All variables of a term  on  the  heap  are  together  in  an  array  of
  86. variables  of  which  the  record  knows the base address as well as the
  87. number of variables.  The term itself holds no  references,  except  for
  88. direct references into the variable array.  Using this representation we
  89. can  easily  create  a new variable array on the global stack and change
  90. the variables of the copied term to point to  this  new  variable  array
  91. when copying back to the global stack.
  92. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  93.  
  94. static void
  95. copyTermToHeap2(term, result, copy)
  96. register Word term;
  97. Word copy;
  98. Record result;
  99. { int arity;
  100.  
  101.   deRef(term);
  102.  
  103.   if (isAtom(*term) || isInteger(*term) )
  104.   { *copy = *term;
  105.     return;
  106.   }
  107.   if ( isIndirect(*term) )
  108.   {
  109. #if O_STRING
  110.     if ( isString(*term) )
  111.     { *copy = heapString(valString(*term));
  112.       return;
  113.     }
  114. #endif
  115.     *copy = heapReal(valReal(*term));
  116.     return;
  117.   }
  118.   SECURE(if (!isTerm(*term) )
  119.         sysError("Illegal type in copyTermToHeap()") );
  120.   if (functorTerm(*term) == FUNCTOR_var1)
  121.   { *copy = makeRef(result->variables + valNum(argTerm(*term, 0)));
  122.     return;
  123.   }
  124.   arity = functorTerm(*term)->arity;
  125.   *copy = heapFunctor(functorTerm(*term) );
  126.   copy = argTermP(*copy, 0);
  127.   term = argTermP(*term, 0);
  128.   for(; arity > 0; arity--, copy++, term++)
  129.     copyTermToHeap2(term, result, copy);
  130. }
  131.  
  132. Record
  133. copyTermToHeap(term)
  134. Word term;
  135. { mark m;
  136.   Record result;
  137.   register int n;
  138.   register Word v;
  139.  
  140.   result = (Record) allocHeap(sizeof(struct record) );
  141.   Mark(m);
  142.   result->n_vars = numberVars(term, FUNCTOR_var1, 0);
  143.  
  144.   if (result->n_vars > 0)
  145.     result->variables = allocHeap(sizeof(word)*result->n_vars);
  146.   for(n=result->n_vars, v=result->variables; n > 0; n--, v++)
  147.     setVar(*v);
  148.  
  149.   copyTermToHeap2(term, result, &result->term);
  150.  
  151.   Undo(m);
  152.  
  153.   return result;
  154. }
  155.  
  156. static void
  157. copyTermToGlobal2(orgvars, vars, term, copy)
  158. Word orgvars, vars;
  159. register Word term;
  160. Word copy;
  161. { int arity;
  162.  
  163.   if (isRef(*term) )
  164.   { *copy = makeRef(unRef(*term) - orgvars + vars);
  165.     return;
  166.   }
  167.   if (isAtom(*term) || isInteger(*term))
  168.   { *copy = *term;
  169.     return;
  170.   }
  171.   if (isIndirect(*term))
  172.   {
  173. #if O_STRING
  174.     if ( isString(*term) )
  175.     { *copy = globalString(valString(*term));
  176.       return;
  177.     }
  178. #endif /* O_STRING */
  179.     *copy = globalReal(valReal(*term));
  180.     return;
  181.   }
  182.   arity = functorTerm(*term)->arity;
  183.   *copy = globalFunctor(functorTerm(*term) );
  184.   term = argTermP(*term, 0);
  185.   copy = argTermP(*copy, 0);
  186.   for(; arity > 0; arity--, term++, copy++)
  187.     copyTermToGlobal2(orgvars, vars, term, copy);
  188. }
  189.  
  190. word
  191. copyTermToGlobal(term)
  192. register Record term;
  193. { Word vars;
  194.   word copy;
  195.  
  196.   if (term->n_vars > 0)
  197.   { register int n;
  198.     register Word v;
  199.  
  200.     vars = allocGlobal(sizeof(word) * term->n_vars);
  201.     for(n=term->n_vars, v=vars; n>0; n--, v++)
  202.       setVar(*v);
  203.   } else
  204.     vars = (Word) NULL;
  205.  
  206.   copyTermToGlobal2(term->variables, vars, &term->term, ©);
  207.  
  208.   return copy;
  209. }
  210.  
  211.  
  212. static void
  213. freeHeapTerm(term)
  214. register Word term;
  215. { int arity, n;
  216.   Word arg;
  217.   
  218.   deRef(term);
  219.  
  220.   if (isAtom(*term) || isInteger(*term))
  221.     return;
  222.   if (isIndirect(*term))
  223.   {
  224. #if O_STRING
  225.     if ( isString(*term) )
  226.     { freeHeap(unMask(*term), allocSizeString(sizeString(*term)));
  227.       return;
  228.     }
  229. #endif /* O_STRING */
  230.     freeHeap(unMask(*term), sizeof(real));
  231.     return;
  232.   }
  233.   if (isTerm(*term))
  234.   { arity = functorTerm(*term)->arity;
  235.     arg = argTermP(*term, 0);
  236.     for(n = arity; n > 0; n--, arg++)
  237.       freeHeapTerm(arg);
  238.     freeHeap(*term, sizeof(FunctorDef) + arity * sizeof(word));
  239.   }
  240. }
  241.  
  242. bool
  243. freeRecord(record)
  244. Record record;
  245. { freeHeapTerm(&record->term);
  246.   if (record->n_vars > 0)
  247.     freeHeap(record->variables, sizeof(word)*record->n_vars);
  248.   record->list = (RecordList) NULL;
  249.   freeHeap(record, sizeof(struct record));
  250.  
  251.   succeed;
  252. }
  253.  
  254.         /********************************
  255.         *       PROLOG CONNECTION       *
  256.         *********************************/
  257.  
  258. bool
  259. unifyKey(key, val)
  260. Word key;
  261. word val;
  262. { if ( isAtom(val) || isInteger(val) )
  263.     return unifyAtomic(key, val);
  264.  
  265.   return unifyFunctor(key, (FunctorDef) val);
  266. }
  267.  
  268. word
  269. getKey(key)
  270. register Word key;
  271. { if (isAtom(*key) || isInteger(*key))
  272.     return *key;
  273.   else if (isTerm(*key))
  274.     return (word)functorTerm(*key);
  275.   else
  276.     return (word) NULL;
  277. }
  278.  
  279. word
  280. pl_current_key(k, h)
  281. Word k;
  282. word h;
  283. { RecordList l;
  284.  
  285.   switch( ForeignControl(h) )
  286.   { case FRG_FIRST_CALL:
  287.       l = recordTable[0];
  288.       break;
  289.     case FRG_REDO:
  290.       l = (RecordList) ForeignContextAddress(h);
  291.       break;
  292.     case FRG_CUTTED:
  293.     default:
  294.       succeed;
  295.   }
  296.  
  297.   for(; l; l = l->next)
  298.   { while(isRef((word)l) )
  299.     { l = *((RecordList *)unRef(l));
  300.       if (l == (RecordList) NULL)
  301.     fail;
  302.     }
  303.     if ( l->firstRecord == NULL || unifyKey(k, l->key) == FALSE )
  304.       continue;
  305.  
  306.     return_next_table(RecordList, l);
  307.   }
  308.  
  309.   fail;
  310. }
  311.  
  312. #if PROTO
  313. static bool
  314. record(Word key, Word term, Word ref, char az)
  315. #else
  316. static bool
  317. record(key, term, ref, az)
  318. Word key, term, ref;
  319. char az;
  320. #endif
  321. { RecordList l;
  322.   Record copy;
  323.   word k;
  324.  
  325.   if ((k = getKey(key)) == (word) NULL)
  326.     return warning("record%c/3: illegal key", az);
  327.  
  328.   l = lookupRecordList(k);
  329.   copy = copyTermToHeap(term);
  330.   copy->list = l;
  331.  
  332.   TRY(unifyAtomic(ref, pointerToNum(copy)));
  333.   if (l->firstRecord == (Record) NULL)
  334.   { copy->next = (Record) NULL;
  335.     l->firstRecord = l->lastRecord = copy;
  336.     succeed;
  337.   }
  338.   if (az == 'a')
  339.   { copy->next = l->firstRecord;
  340.     l->firstRecord = copy;
  341.     succeed;
  342.   }
  343.   copy->next = (Record) NULL;
  344.   l->lastRecord->next = copy;
  345.   l->lastRecord = copy;
  346.  
  347.   succeed;
  348. }
  349.  
  350. word
  351. pl_recorda(key, term, ref)
  352. Word key, term, ref;
  353. { return record(key, term, ref, 'a');
  354. }
  355.  
  356. word
  357. pl_recordz(key, term, ref)
  358. Word key, term, ref;
  359. { return record(key, term, ref, 'z');
  360. }
  361.  
  362. word
  363. pl_recorded(key, term, ref, h)
  364. Word key, term, ref;
  365. word h;
  366. { RecordList rl;
  367.   Record record;
  368.   word k;
  369.   mark m;
  370.   word copy;
  371.  
  372.   DEBUG(5, printf("recorded: h=0x%lx, control = %d\n", h, ForeignControl(h)));
  373.   switch( ForeignControl(h) )
  374.   { case FRG_FIRST_CALL:
  375.       if ( isInteger(*ref) )
  376.       { record = (Record) numToPointer(*ref);
  377.  
  378.     if ( !inCore(record) || !isRecord(record) )
  379.       return warning("recorded/3: Invalid reference");
  380.     
  381.     Mark(m);
  382.     if ( pl_unify(term, &record->term) )
  383.     { Undo(m);
  384.       copy = copyTermToGlobal(record);
  385.       TRY( unifyKey(key, record->list->key) );
  386.       return pl_unify(term, ©);
  387.     } else
  388.       fail;
  389.       }
  390.       if ((k = getKey(key)) == (word) NULL)
  391.     return warning("recorded/3: illegal key");
  392.       if ((rl = isCurrentRecordList(k)) == (RecordList) NULL)
  393.     fail;
  394.       record = rl->firstRecord;
  395.       break;
  396.     case FRG_REDO:
  397.       record = (Record) ForeignContextAddress(h);
  398.       break;
  399.     case FRG_CUTTED:
  400.     default:
  401.       succeed;
  402.   }
  403.  
  404.   Mark(m);
  405.   for(;record; record = record->next)
  406.   { if (pl_unify(term, &record->term) )
  407.     { Undo(m);
  408.       TRY(unifyAtomic(ref, pointerToNum(record) ));
  409.       copy = copyTermToGlobal(record);
  410.       TRY(pl_unify(term, ©) );
  411.  
  412.       if (record->next == (Record) NULL)
  413.     succeed;
  414.       else
  415.     ForeignRedo(record->next);
  416.     }
  417.   }
  418.  
  419.   fail;
  420. }
  421.  
  422. word
  423. pl_erase(ref)
  424. Word ref;
  425. { Record record;
  426.   Record prev, r;
  427.   RecordList l;
  428.  
  429.   if (!isInteger(*ref))
  430.     return warning("erase/1: instantiation fault");
  431.  
  432.   record = (Record) numToPointer(*ref);
  433.   
  434.   if (!inCore(record))
  435.     return warning("erase/1: Invalid reference");
  436.  
  437.   if (isClause(record))
  438.   { Clause clause = (Clause) record;
  439.   
  440.     if ( true(clause->procedure->definition, SYSTEM) &&
  441.      false(clause->procedure->definition, DYNAMIC) )
  442.       return warning("erase/1: Attempt to erase clause from system predicate");
  443.  
  444.     return retractClauseProcedure(clause->procedure, clause);
  445.   }
  446.   
  447.   if (!isRecord(record))
  448.     return warning("erase/1: Invalid reference");
  449.  
  450.   l = record->list;
  451.   if ( record == l->firstRecord )
  452.   { if ( record->next == (Record) NULL )
  453.       l->lastRecord = (Record) NULL;
  454.     l->firstRecord = record->next;
  455.     freeRecord(record);
  456.     succeed;
  457.   }
  458.  
  459.   prev = l->firstRecord;
  460.   r = prev->next;
  461.   for(; r; prev = r, r = r->next)
  462.   { if (r == record)
  463.     { if ( r->next == (Record) NULL )
  464.         l->lastRecord = prev;
  465.       prev->next = r->next;
  466.       freeRecord(r);
  467.       succeed;
  468.     }
  469.   }
  470.  
  471.   return warning("erase/1: illegal reference");
  472. }
  473.