home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / wl_name.c < prev    next >
C/C++ Source or Header  |  1995-07-03  |  10KB  |  413 lines
  1. /* Copyright 1989 GROUPE BULL -- See license conditions in file COPYRIGHT
  2.  * Copyright 1989 Massachusetts Institute of Technology
  3.  */
  4. /**************************\
  5. *                *
  6. *  WOOL_OBJECT: Namespace  *
  7. *  BODY               *
  8. *                *
  9. \**************************/
  10.  
  11. #include "EXTERN.h"
  12. #include <stdio.h>
  13. #include "wool.h"
  14. #include "wl_atom.h"
  15. #include "wl_list.h"
  16. #include "wl_number.h"
  17. #include "wl_string.h"
  18. #include "INTERN.h"
  19. #include "wl_name.h"
  20.  
  21. #define WLNAMESPACE_INITIAL_SIZE 3    /* initial size (in longs) */
  22. #define DELETED (WOOL_OBJECT *)    -1    /* slot is vacant */
  23. #define NONE_DELETED        -1    /* no slot is vacant */
  24.  
  25. int WLNamespace_search_deleted();
  26.  
  27. /* High level function callable from wool. Makes a new namespace.
  28.  */
  29.  
  30. WOOL_Namespace
  31. WLNamespace_make()
  32. {
  33.     WOOL_Namespace object = (WOOL_Namespace)
  34.     Malloc(sizeof(struct _WOOL_Namespace));
  35.  
  36.     bzero(object, sizeof(struct _WOOL_Namespace));
  37.     object -> type = WLNamespace;
  38.     zrt_put(object);
  39.     object -> first_deleted = NONE_DELETED;
  40.     return object;
  41. }
  42.  
  43. /* adding a namespace domain to a namespace. returns int of created namespace
  44.  */
  45.  
  46. WOOL_OBJECT
  47. WLNamespace_add(namespace)
  48. WOOL_Namespace namespace;
  49. {
  50.     int             new_index;
  51.  
  52.     must_be_namespace(namespace, 0);
  53.     if (!namespace -> number)        /* non-empty namespaces */
  54.     increase_reference(namespace);    /* must never disapear */
  55.     if (namespace -> first_deleted == NONE_DELETED) {
  56.     new_index = namespace -> number++;
  57.     namespace -> namespaces = (WOOL_OBJECT **)
  58.         Realloc(namespace -> namespaces,
  59.             namespace -> number * sizeof(WOOL_OBJECT *));
  60.     } else {
  61.     new_index = namespace -> first_deleted;
  62.     namespace -> first_deleted =
  63.         WLNamespace_search_deleted(namespace, new_index);
  64.     }
  65.     if (namespace -> limit)
  66.     namespace -> namespaces[new_index] = (WOOL_OBJECT *)
  67.         Malloc(sizeof(WOOL_OBJECT) * namespace -> limit);
  68.     else
  69.     namespace -> namespaces[new_index] = 0;
  70.     return (WOOL_OBJECT) WLNumber_make(new_index);
  71. }
  72.  
  73. /* removing a namespace.
  74.  * just puts a DELETED in the entry
  75.  */
  76.  
  77. WOOL_OBJECT
  78. WLNamespace_remove(namespace, number)
  79. WOOL_Namespace namespace;
  80. WOOL_Number    number;
  81. {
  82.     int             index;
  83.     WOOL_OBJECT    *p;
  84.  
  85.     must_be_namespace(namespace, 0);
  86.     must_be_number(number, 1);
  87.     index = number -> number;
  88.     if (index < 0 || index >= namespace -> number)
  89.     return NIL;
  90.     for (p = namespace -> namespaces[index];
  91.      p < (namespace -> namespaces[index]) + namespace -> limit;
  92.      p++)
  93.     decrease_reference(*p);
  94.     Free(namespace -> namespaces[index]);
  95.     namespace -> namespaces[index] = DELETED;
  96.     if (namespace -> first_deleted == NONE_DELETED
  97.     || namespace -> first_deleted > index)
  98.     namespace -> first_deleted = index;
  99.     return NIL;
  100. }
  101.  
  102. /* searches for first vacant spot
  103.  */
  104.  
  105. int
  106. WLNamespace_search_deleted(namespace, index)
  107. WOOL_Namespace namespace;
  108. int           index;
  109. {
  110.     WOOL_OBJECT   **p;
  111.  
  112.     for (p = namespace -> namespaces + index;
  113.      p < namespace -> namespaces + namespace -> number;
  114.      p++) {
  115.     if (*p == DELETED)
  116.         return p - namespace -> namespaces;
  117.     }
  118.     return NONE_DELETED;
  119. }
  120.  
  121.  
  122. /* adding a new name entry in a namespace
  123.  * returns new index
  124.  */
  125.  
  126. Num
  127. WLNamespace_add_name(namespace)
  128. WOOL_Namespace namespace;
  129. {
  130.     int             i;
  131.     WOOL_OBJECT    *p;
  132.  
  133.     if (namespace -> size >= namespace -> limit) {    /* must realloc */
  134.     if (namespace -> limit)
  135.         namespace -> limit = namespace -> limit * 2 + 1;
  136.     else
  137.         namespace -> limit = WLNAMESPACE_INITIAL_SIZE;
  138.     for (i = 0; i < namespace -> number; i++) {
  139.         namespace -> namespaces[i] = (WOOL_OBJECT *) Realloc(
  140.                 namespace -> namespaces[i],
  141.                 namespace -> limit * sizeof(WOOL_OBJECT));
  142.         for (p = (namespace -> namespaces[i]) + namespace -> size;
  143.          p < (namespace -> namespaces[i]) + namespace -> limit;
  144.          p++)
  145.         increase_reference(*p = UNDEFINED_WOOL_VALUE);
  146.     }
  147.     }
  148.     return (Num) namespace -> size++;
  149. }
  150.  
  151. /* adding a name in a namespace
  152.  * (defname 'name namespace [value]) ==> sets value in each namespace state
  153.  * if no value given, and atom had a previous value, sets all name values
  154.  * this value
  155.  */
  156.  
  157. WOOL_OBJECT
  158. WLName_add(argc, argv)
  159. int        argc;
  160. WOOL_OBJECT      argv[];
  161. {
  162.     WOOL_OBJECT     value;
  163.  
  164.     switch (argc) {
  165.     case 2:
  166.     value = 0;
  167.     break;
  168.     case 3:
  169.     value = argv[2];
  170.     break;
  171.     default:
  172.     return wool_error(BAD_NUMBER_OF_ARGS, argc);
  173.     }
  174.  
  175.     must_be_namespace(argv[1], 1);
  176.     if (argv[0] -> type == WLAtom) {
  177.     if (!value && ((WOOL_Atom) argv[0]) -> c_val)
  178.         value = (WOOL_OBJECT)
  179.         WLQuotedExpr_make(((WOOL_Atom) argv[0]) -> c_val);
  180.     decrease_reference(((WOOL_Atom) argv[0]) -> c_val);
  181.     argv[0] -> type = WLName;
  182.     NameNamespace(((WOOL_Name) argv[0])) = ((WOOL_Namespace) argv[1]);
  183.     ((WOOL_Name) argv[0]) -> index =
  184.         WLNamespace_add_name((WOOL_Namespace) argv[1]);
  185.     } else if (argv[0] -> type == WLName) {
  186.     if (NameNamespace(((WOOL_Name) argv[0])) !=
  187.         ((WOOL_Namespace) argv[1])) {
  188.         WLName_release_values(argv[0]);
  189.         NameNamespace(((WOOL_Name) argv[0])) = ((WOOL_Namespace) argv[1]);
  190.         ((WOOL_Name) argv[0]) -> index =
  191.         WLNamespace_add_name((WOOL_Namespace) argv[1]);
  192.     } else {
  193.         return argv[0];
  194.     }
  195.     } else
  196.     bad_argument(argv[0], 0, "symbol");
  197.     if (value) {            /* set to arg */
  198.     WLName_set_all(argv[1], argv[0], value);
  199.     }
  200.     return argv[0];
  201. }
  202.  
  203. /* manage active namespace
  204.  * (set-current-namespace namespace current)
  205.  * with current out-of-bounds (e.g -1) returning current one
  206.  */
  207.  
  208. WOOL_OBJECT
  209. WLNamespace_set_current(namespace, index)
  210. WOOL_Namespace namespace;
  211. WOOL_Number    index;
  212. {
  213.     must_be_namespace(namespace, 0);
  214.     must_be_number(index, 1);
  215.     if (index -> number >= 0 && index -> number < namespace -> number) {
  216.     namespace -> current = index -> number;
  217.     if (namespace -> trigger)
  218.         (*(namespace -> trigger))(index -> number);
  219.     return (WOOL_OBJECT) index;
  220.     } else {
  221.     return (WOOL_OBJECT) WLNumber_make(namespace -> current);
  222.     }
  223. }
  224.  
  225. /* size of states in the namespace
  226.  */
  227.  
  228. WOOL_OBJECT
  229. WLNamespace_size(namespace)
  230. WOOL_Namespace namespace;
  231. {
  232.     must_be_namespace(namespace, 0);
  233.     return (WOOL_OBJECT) WLNumber_make(namespace -> number);
  234. }
  235.  
  236. /* namespace-of:
  237.  * on a name returns namespace or NIL if global
  238.  */
  239.  
  240. WOOL_OBJECT
  241. WLName_namespace(name)
  242. WOOL_Name      name;
  243. {
  244.     if (name -> type == WLAtom)
  245.     return NIL;
  246.     else if (name -> type == WLName)
  247.     return (WOOL_OBJECT) NameNamespace(name);
  248.     else
  249.     return bad_argument(name, 0, "symbol");
  250. }
  251.  
  252. /* free all c_val values */
  253.  
  254. WLName_release_values(name)
  255. WOOL_Name      name;
  256. {
  257.     WOOL_Namespace  namespace = NameNamespace(name);
  258.     int             i;
  259.  
  260.     for (i = 0; i < namespace -> number; i++)
  261.     decrease_reference((namespace -> namespaces[i])[name -> index]);
  262. }
  263.  
  264. WOOL_OBJECT
  265. WLName_unbind(name)
  266. WOOL_Name      name;
  267. {
  268.     WOOL_Namespace  namespace = NameNamespace(name);
  269.  
  270.     decrease_reference((namespace -> namespaces[namespace -> current])
  271.                [name -> index]);
  272.     (namespace -> namespaces[namespace -> current])
  273.     [name -> index] = UNDEFINED_WOOL_VALUE;
  274.     return NIL;
  275. }
  276.  
  277. /* namespace methods */
  278.  
  279. WOOL_OBJECT
  280. WLNamespace_print(obj)
  281. WOOL_Namespace obj;
  282. {
  283.     wool_printf("{NAMESPACE 0x%x ", obj);
  284.     wool_printf("(%d spaces", obj -> number);
  285.     wool_printf(" of %d names)}", obj -> size);
  286.     return (WOOL_OBJECT) obj;
  287. }
  288.  
  289. WOOL_OBJECT
  290. WLNamespace_free(namespace)
  291. WOOL_Namespace namespace;
  292. {
  293.     free(namespace);
  294.     return NULL;
  295. }        
  296.  
  297. /* name methods */
  298.  
  299. /*
  300.  * Evaluating an name returns the pointed slot
  301.  */
  302.  
  303. WOOL_OBJECT
  304. WLName_eval(name)
  305. WOOL_Name name;
  306. {
  307.     WOOL_Namespace  namespace = NameNamespace(name);
  308.     WOOL_OBJECT     value;
  309.  
  310.     if ((value = ((namespace -> namespaces)[namespace -> current])
  311.     [name -> index]) != UNDEFINED_WOOL_VALUE)
  312.     return value;
  313.     else
  314.     return wool_error(UNDEFINED_VARIABLE, name -> p_name);
  315. }
  316.  
  317. WOOL_OBJECT *
  318. WLName_slot(name)
  319. WOOL_Name name;
  320. {
  321.     WOOL_Namespace  namespace = NameNamespace(name);
  322.  
  323.     return &(((namespace -> namespaces)[namespace -> current])[name -> index]);
  324. }
  325.  
  326. WOOL_OBJECT
  327. WLName_silent_eval(name)
  328. WOOL_Name name;
  329. {
  330.     WOOL_Namespace  namespace = NameNamespace(name);
  331.  
  332.     return ((namespace -> namespaces)[namespace -> current]) [name -> index];
  333. }
  334.  
  335. WOOL_OBJECT
  336. WLName_set(name, value)
  337. WOOL_Name name;
  338. WOOL_OBJECT value;
  339. {
  340.     WOOL_OBJECT new = WOOL_send(WOOL_eval, value, (value));
  341.     WOOL_Namespace  namespace = NameNamespace(name);
  342.     WOOL_OBJECT *value_ptr = &(((namespace -> namespaces)
  343.                     [namespace -> current])[name -> index]);
  344.  
  345.     decrease_reference(*value_ptr);
  346.     increase_reference(*value_ptr = new);
  347.     return new;
  348. }
  349.  
  350. WOOL_OBJECT
  351. WLName_setq(name, value)
  352. WOOL_Name name;
  353. WOOL_OBJECT value;
  354. {
  355.     WOOL_Namespace  namespace = NameNamespace(name);
  356.     WOOL_OBJECT *value_ptr = &(((namespace -> namespaces)
  357.                     [namespace -> current])[name -> index]);
  358.  
  359.     decrease_reference(*value_ptr);
  360.     increase_reference(*value_ptr = value);
  361.     return value;
  362. }
  363.  
  364. /* like set but on all spaces */
  365.  
  366. WLName_set_all(namespace, name, value)
  367. WOOL_Namespace namespace;
  368. WOOL_Name name;
  369. WOOL_OBJECT value;
  370. {
  371.     WOOL_OBJECT *value_ptr;
  372.     int             i, old_current = namespace -> current;
  373.  
  374.     if (namespace -> save_state)
  375.     (*(namespace -> save_state)) ();
  376.     for (i = 0; i < namespace -> number; i++) {
  377.     value_ptr = &(((namespace -> namespaces)[i])[name -> index]);
  378.     decrease_reference(*value_ptr);
  379.     namespace -> current = i;
  380.     if (namespace -> trigger)
  381.         (*(namespace -> trigger)) (i);
  382.     increase_reference(*value_ptr = WOOL_send(WOOL_eval, value, (value)));
  383.     }
  384.     namespace -> current = old_current;
  385.     if (namespace -> trigger)
  386.     (*(namespace -> trigger)) (old_current);
  387.     if (namespace -> restore_state)
  388.     (*(namespace -> restore_state)) ();
  389. }
  390.  
  391. /*
  392.  * WLName_execute:
  393.  *     executes the object in the C_val
  394.  */
  395.  
  396. WOOL_OBJECT 
  397. WLName_execute(name, list)
  398. WOOL_Name        name;
  399. WOOL_List      list;
  400. {
  401.     WOOL_Namespace  namespace = NameNamespace(name);
  402.     WOOL_OBJECT value = ((namespace -> namespaces)
  403.                   [namespace -> current])[name -> index];
  404.  
  405.     if (value != UNDEFINED_WOOL_VALUE && (value -> type != WLAtom)) {
  406.     return WOOL_send(WOOL_execute, value, (value, list));
  407.     } else if (value && (value == NIL)) {
  408.     return NIL;
  409.     } else {
  410.     return (wool_error(UNDEFINED_FUNCTION, name));
  411.     }
  412. }
  413.