home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 22 gnu / 22-gnu.zip / gwm18a.zip / wl_pointer.c < prev    next >
C/C++ Source or Header  |  1995-07-03  |  5KB  |  219 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: Pointer     *
  7. *  BODY             *
  8. *              *
  9. \************************/
  10.  
  11. /* Pointers are like atoms, but instead of pointing toward a WOOL_OBJECT,
  12.  * they refer via their "ptr" field to just ANY memory location able to hold
  13.  * a long.
  14.  * 
  15.  * Thus setting a pointer to a value COPIES this value at the location pointed
  16.  * to.
  17.  * 
  18.  * If a pointer is NULL, then it is an offset in the Context structure,
  19.  * whose offset is taken in the pre-field (set field of active values)
  20.  */
  21.  
  22. #include "EXTERN.h"
  23. #include <stdio.h>
  24. #include "wool.h"
  25. #include "wl_atom.h"
  26. #include "wl_list.h"
  27. #include "wl_number.h"
  28. #include "wl_string.h"
  29. #include "wl_active.h"
  30. #include "INTERN.h"
  31. #include "wl_pointer.h"
  32.  
  33. /*
  34.  * Constructor: WLPointer_make
  35.  *     arg 1: The atom (or pointer) to be used 
  36.  *     arg 2: The pointer to the location which will be updated by
  37.  *            setting this pointer
  38.  *     returns the pointer, which is our arg1 but modified in place
  39.  * 
  40.  * C programmers should rather use wool_pointer_make below.
  41.  */
  42.  
  43. WOOL_Pointer
  44. WLPointer_make(atom, ptr)
  45. WOOL_Atom atom;            /* previously allocated atom */
  46. long      *ptr;            /* location pointed to */
  47. {
  48.     must_be_atom(atom, 0);
  49.     if (atom -> type == WLAtom) {    /* free what was pointed */
  50.     decrease_reference(atom -> c_val);
  51.     }
  52.     atom -> type = WLPointer;    /* just change type of object */
  53.     ((WOOL_Pointer) atom) -> ptr = ptr;
  54.     WLPointerBase(atom) = NULL;
  55.     return (WOOL_Pointer) atom;
  56. }
  57.  
  58. /*
  59.  * wool_pointer_make:
  60.  * High level function callable from C. Makes a pointer with a string and a
  61.  * C pointer
  62.  */
  63.  
  64. WOOL_Pointer
  65. wool_pointer_make(name, ptr)
  66. char *name;
  67. char *ptr;
  68. {
  69.     return WLPointer_make(wool_atom(name), ptr);
  70. }
  71.  
  72. /* wool_base_pointer_make:
  73.  * High level function callable from C. Makes a pointer with a string, a base
  74.  * and a C pointer
  75.  */
  76.  
  77. WOOL_Pointer
  78. wool_base_pointer_make(name, base, ptr)
  79. char *name;
  80. char **base, *ptr;
  81. {
  82.     WOOL_Pointer wl_ptr = WLPointer_make(wool_atom(name), ptr - *base);
  83.     WOOL_Pointer_internal int_ptr =  WL_Pointer_internal(wl_ptr);
  84.  
  85.     int_ptr -> base = base;
  86.     return wl_ptr;
  87. }
  88.  
  89. /*
  90.  * wool_self_pointer_make:
  91.  * to make a pointer to a given value (stored in the Quark field)
  92.  * 
  93.  * the prefix is a control char prefixed to the name to act as a domain name
  94.  * for names. Currently chars are used for:
  95.  * 
  96.  *     ^F    for X fonts id
  97.  *     ^X    for X intern atoms
  98.  *     ^M    for mallocated blocs (MLEAK tracing)
  99.  *    ^T    for tags
  100.  */
  101.  
  102. WOOL_Pointer
  103. wool_self_pointer_make(name, prefix, ppointer)
  104. char *name;
  105. char prefix;
  106. WOOL_Pointer *ppointer;
  107. {
  108.     char    prefixed_name[MAX_TEMP_STRING_SIZE + 1];
  109.  
  110.     prefixed_name[0] = prefix;
  111.     prefixed_name[1] = '\0';
  112.     strcat(prefixed_name, name);
  113.     *ppointer = (WOOL_Pointer) wool_atom(prefixed_name);
  114.     if((*ppointer) -> type == WLAtom) {
  115.     (*ppointer) -> ptr = (long *) (((char *) *ppointer) - 
  116.         (sizeof(struct _WOOL_Active_internal)
  117.         - sizeof(struct _WOOL_Active)));
  118.     (*ppointer) -> type = WLPointer;
  119.     *((*ppointer) -> ptr) = 0;
  120.     return NULL;
  121.     }
  122.     return *ppointer;
  123. }
  124.  
  125. /*
  126.  * Evaluating a pointer yields the WOOL number containing the value pointed
  127.  * to by the Pointer
  128.  */
  129.  
  130. WOOL_OBJECT
  131. WLPointer_eval(obj)
  132. WOOL_Pointer obj;
  133. {
  134.     if (WLPointerBase(obj)) {
  135.     WOOL_Pointer_internal int_ptr = WL_Pointer_internal(obj);
  136.  
  137.     return (WOOL_OBJECT) WLNumber_make(
  138.                *((long *)( *(int_ptr -> base) + int_ptr -> ptr)));
  139.     } else
  140.     return (WOOL_OBJECT) WLNumber_make(*(obj -> ptr));
  141. }
  142.  
  143. /*
  144.  * returns the raw value
  145.  */
  146.  
  147. long
  148. WLPointer_get_C_value(obj)
  149. WOOL_Pointer obj;
  150. {
  151.     if (WLPointerBase(obj)) {
  152.     WOOL_Pointer_internal int_ptr = WL_Pointer_internal(obj);
  153.  
  154.     return *((long *) (*(int_ptr -> base) + int_ptr -> ptr));
  155.     } else
  156.     return *(obj -> ptr);
  157. }
  158.  
  159. /*
  160.  * WLPointer_execute:
  161.  * like active-values: without args gets, with 1 arg, sets
  162.  */
  163.  
  164. WOOL_OBJECT 
  165. WLPointer_execute(obj, list)
  166. WOOL_Pointer     obj;
  167. WOOL_List      list;
  168. {
  169.     if (list -> size == 1) {
  170.     return (WOOL_OBJECT) WLPointer_eval(obj);
  171.     } else if (list -> size == 2) {
  172.     return (WOOL_OBJECT) WLPointer_set(obj, list -> list[1]);
  173.     } else {
  174.     return wool_error(BAD_NUMBER_OF_ARGS, list -> size - 1);
  175.     }
  176. }
  177.  
  178. /*
  179.  * used to set value pointed to
  180.  */
  181.  
  182. WOOL_OBJECT
  183. WLPointer_set(obj, value)
  184. WOOL_Pointer obj;
  185. WOOL_OBJECT value;
  186. {
  187.     WOOL_OBJECT evaluated_value = WOOL_send(
  188.                          WOOL_eval, value, (value));
  189.     long            C_value = (long) WOOL_send(
  190.               WOOL_get_C_value, evaluated_value, (evaluated_value));
  191.     WOOL_OBJECT     result = (WOOL_OBJECT) WLNumber_make(C_value);
  192.  
  193.     if (WLPointerBase(obj)) {
  194.     WOOL_Pointer_internal int_ptr = WL_Pointer_internal(obj);
  195.  
  196.     *((long *) (*(int_ptr -> base) + int_ptr -> ptr)) = C_value;
  197.     } else
  198.     *(obj -> ptr) = C_value;
  199.     return result;
  200. }
  201.  
  202. WOOL_OBJECT
  203. WLPointer_setq(obj, value)
  204. WOOL_Pointer obj;
  205. WOOL_OBJECT value;
  206. {
  207.     WOOL_OBJECT     result = (WOOL_OBJECT) WLNumber_make(value);
  208.     long            C_value = (long) WOOL_send(
  209.               WOOL_get_C_value, value, (value));
  210.  
  211.     if (WLPointerBase(obj)) {
  212.         WOOL_Pointer_internal int_ptr = WL_Pointer_internal(obj);
  213.  
  214.         *((long *) (*(int_ptr -> base) + int_ptr -> ptr)) = C_value;
  215.     } else
  216.         *(obj -> ptr) = C_value;
  217.     return result;
  218. }
  219.