home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / World_Of_Computer_Software-02-387-Vol-3of3.iso / p / plbin.zip / pl / src / pl-flag.c < prev    next >
C/C++ Source or Header  |  1992-05-26  |  2KB  |  109 lines
  1. /*  pl-flag.c,v 1.1.1.1 1992/05/26 11:52:18 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: implement flag/3
  8. */
  9.  
  10. #include "pl-incl.h"
  11.  
  12. typedef struct flag *    Flag;
  13.  
  14. struct flag
  15. { Flag    next;
  16.   word    key;                /* key to the flag */
  17.   word    value;                /* value of the flag */
  18. };
  19.  
  20. static Flag flagTable[FLAGHASHSIZE];
  21.  
  22. forwards Flag lookupFlag P((word));
  23.  
  24. void
  25. initFlags()
  26. { register Flag *f;
  27.   register int n;
  28.  
  29.   for(n=0, f=flagTable; n < (FLAGHASHSIZE-1); n++, f++)
  30.     *f = (Flag) makeRef(f+1);
  31. }
  32.  
  33. static Flag
  34. lookupFlag(key)
  35. word key;
  36. { int v = pointerHashValue(key, FLAGHASHSIZE);
  37.   Flag f;
  38.  
  39.   for(f=flagTable[v]; f && !isRef((word)f); f=f->next)
  40.   { if (f->key == key)
  41.       return f;
  42.   }
  43.   f = (Flag) allocHeap(sizeof(struct flag) );
  44.   f->next = flagTable[v];
  45.   flagTable[v] = f;
  46.   f->key = key;
  47.   f->value = consNum(0);
  48.  
  49.   return f;
  50. }
  51.  
  52. word
  53. pl_flag(name, old, new)
  54. Word name, old, new;
  55. { Flag f;
  56.   word key;
  57.  
  58.   if ((key = getKey(name)) == (word) NULL)
  59.     return warning("flag/2: illegal key");
  60.  
  61.   f = lookupFlag(key);
  62.   TRY(unifyAtomic(old, f->value) );
  63.   if (isAtom(*new) || isInteger(*new))
  64.   { f->value = *new;
  65.     succeed;
  66.   } else
  67.   { word value = evaluate(new);
  68.     if ( isInteger(value) )
  69.     { f->value = value;
  70.       succeed;
  71.     }
  72.   }
  73.  
  74.   return warning("flag/2: value should be an atom, integer or expression");
  75. }
  76.  
  77. word
  78. pl_current_flag(k, h)
  79. Word k;
  80. word h;
  81. { Flag f;
  82.  
  83.   switch( ForeignControl(h) )
  84.   { case FRG_FIRST_CALL:
  85.       f = flagTable[0];
  86.       break;
  87.     case FRG_REDO:
  88.       f = (Flag) ForeignContextAddress(h);
  89.       break;
  90.     case FRG_CUTTED:
  91.     default:
  92.       succeed;
  93.   }
  94.  
  95.   for(; f; f = f->next)
  96.   { while(isRef((word)f) )
  97.     { f = *((Flag *)unRef(f));
  98.       if (f == (Flag) NULL)
  99.     fail;
  100.     }
  101.     if ( unifyKey(k, f->key) == FALSE )
  102.       continue;
  103.  
  104.     return_next_table(Flag, f);
  105.   }
  106.  
  107.   fail;
  108. }
  109.