[Cmucl-cvs] [git] CMU Common Lisp branch rtoy-clm-oids created. 20f-52-g999def9

Raymond Toy rtoy at common-lisp.net
Sat Oct 25 16:56:24 UTC 2014


This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "CMU Common Lisp".

The branch, rtoy-clm-oids has been created
        at  999def9f312bf1fec74d5cc37eb9bf655c7003a1 (commit)

- Log -----------------------------------------------------------------
commit 999def9f312bf1fec74d5cc37eb9bf655c7003a1
Merge: 1daac74 c18c16c
Author: Raymond Toy <toy.raymond at gmail.com>
Date:   Wed Oct 22 19:09:38 2014 -0700

    Merge branch 'clm-oids' of /Volumes/share2/src/clnet/rkreuter/cmucl into clm-oids


commit c18c16cd61de3f931c954cd735d68b95fde715b5
Author: Richard M Kreuter <kreuter at progn.net>
Date:   Mon Oct 13 19:37:53 2014 -0400

    Rename "oblist.*" to "oid.*" (since the data structure is incidental).

diff --git a/src/motif/server/GNUmakefile b/src/motif/server/GNUmakefile
index 32915de..7acc58b 100644
--- a/src/motif/server/GNUmakefile
+++ b/src/motif/server/GNUmakefile
@@ -5,7 +5,7 @@ LDFLAGS =
 TARGET = motifd
 OBJS = main.o server.o translations.o packet.o message.o datatrans.o \
        requests.o callbacks.o widgets.o resources.o tables.o motif.o \
-       text.o xmstring.o list.o events.o oblist.o
+       text.o xmstring.o list.o events.o oid.o
 
 include Config
 
diff --git a/src/motif/server/datatrans.c b/src/motif/server/datatrans.c
index 197a71c..e9f960e 100644
--- a/src/motif/server/datatrans.c
+++ b/src/motif/server/datatrans.c
@@ -21,7 +21,7 @@
 #include "types.h"
 #include "datatrans.h"
 #include "tables.h"
-#include "oblist.h"
+#include "oid.h"
 
 void message_write_oid(message_t,void *,int);
 void message_read_oid(message_t,caddr_t*,int,int);
diff --git a/src/motif/server/oblist.c b/src/motif/server/oid.c
similarity index 99%
rename from src/motif/server/oblist.c
rename to src/motif/server/oid.c
index ddd1f3e..97d1a5b 100644
--- a/src/motif/server/oblist.c
+++ b/src/motif/server/oid.c
@@ -2,7 +2,7 @@
 #include <X11/Intrinsic.h>
 
 #include "global.h"
-#include "oblist.h"
+#include "oid.h"
 
 /* OID generation. */
 static unsigned int current_oid;
diff --git a/src/motif/server/oblist.h b/src/motif/server/oid.h
similarity index 100%
rename from src/motif/server/oblist.h
rename to src/motif/server/oid.h
diff --git a/src/motif/server/requests.c b/src/motif/server/requests.c
index 2694f02..b6ddd36 100644
--- a/src/motif/server/requests.c
+++ b/src/motif/server/requests.c
@@ -21,7 +21,7 @@
 #include "types.h"
 #include "functions.h"
 #include "tables.h"
-#include "oblist.h"
+#include "oid.h"
 
 typedef void (*request_f)(message_t);
 Boolean must_confirm = False;
diff --git a/src/motif/server/tables.c b/src/motif/server/tables.c
index 1fa5dc7..2168989 100644
--- a/src/motif/server/tables.c
+++ b/src/motif/server/tables.c
@@ -20,7 +20,7 @@
 #include "global.h"
 #include "datatrans.h"
 #include "tables.h"
-#include "oblist.h"
+#include "oid.h"
 
 extern WidgetClass overrideShellWidgetClass,transientShellWidgetClass,
   topLevelShellWidgetClass,applicationShellWidgetClass;
diff --git a/src/motif/server/xmstring.c b/src/motif/server/xmstring.c
index 93133fe..8202826 100644
--- a/src/motif/server/xmstring.c
+++ b/src/motif/server/xmstring.c
@@ -18,7 +18,7 @@
 #include "types.h"
 #include "tables.h"
 #include "requests.h"
-#include "oblist.h"
+#include "oid.h"
 
 /* Functions for building XmFontLists */
 

commit 27a7c149e77fb549bd59c87024d01df65cf37806
Author: Richard M Kreuter <kreuter at progn.net>
Date:   Wed Sep 17 20:15:01 2014 -0400

    XEvents need to be trafficked as oids, too.
    
    * There might only be one place where Lisp needs to indicate an XEvent
      back to motifd, in XmMenuPosition, but raw pointers won't cut it.

diff --git a/src/motif/lisp/conversion.lisp b/src/motif/lisp/conversion.lisp
index 144391f..8bfbe49 100644
--- a/src/motif/lisp/conversion.lisp
+++ b/src/motif/lisp/conversion.lisp
@@ -66,10 +66,16 @@
 	 (message-write-string message value)))
     (xlib:font (message-write-xid message (xlib:font-id value) :font))
     (xlib:cursor (message-write-xid message (xlib:cursor-id value) :cursor))
+    ;; Wart: events are written back to motifd through here as integers.
     ((unsigned-byte 24)
-     (message-put-dblword message (combine-type-and-data :short value)))
+     (if (eql type :event)
+         (progn
+           (message-put-dblword message (combine-type-and-data :event 0))
+           (message-put-dblword message value))
+         (message-put-dblword message (combine-type-and-data :short value))))
     ((or (signed-byte 32) (unsigned-byte 32))
-     (message-put-dblword message (combine-type-and-data :int 0))
+     (message-put-dblword
+      message (combine-type-and-data (if (eql type :event) :event :int) 0))
      (message-put-dblword message value))
     ((member t nil)
      (if (eq type t)
diff --git a/src/motif/server/callbacks.c b/src/motif/server/callbacks.c
index d0852c4..671acf4 100644
--- a/src/motif/server/callbacks.c
+++ b/src/motif/server/callbacks.c
@@ -51,6 +51,7 @@
 #include "datatrans.h"
 #include "types.h"
 #include "tables.h"
+#include "oid.h"
 
 int end_callback_loop = 0;
 extern message_t prepare_reply(message_t m);
@@ -273,7 +274,7 @@ void CallbackHandler(Widget *w, int name_token, XmAnyCallbackStruct *info)
   
   /* Now, we write the Reason structure into the message */
   message_write_enum(reply,info?info->reason:0,callback_reason_tag);
-  message_write_int(reply,info?info->event:0,int_tag);
+  message_write_int(reply,info?intern_object(info->event):0,int_tag);
 
   if( class==xmArrowButtonWidgetClass || class==xmArrowButtonGadgetClass ||
      class==xmPushButtonWidgetClass || class==xmPushButtonGadgetClass )
diff --git a/src/motif/server/datatrans.c b/src/motif/server/datatrans.c
index 5445aaf..197a71c 100644
--- a/src/motif/server/datatrans.c
+++ b/src/motif/server/datatrans.c
@@ -253,6 +253,11 @@ void message_write_xm_string_table(message_t m,StringTable *items,int tag)
     message_write_xm_string(m,(XmString)items->data[i],xm_string_tag);
 }
 
+void message_write_event(message_t m,XEvent *event,int tag)
+{
+  message_write_oid(m,event,tag);
+}
+
 void message_write_color(message_t m,XColor *color,int tag)
 {
   message_put_dblword(m,combine_type_and_data(tag,color->red));
@@ -504,6 +509,12 @@ void message_read_xm_string_table(message_t m,StringTable *items,
     toolkit_read_value(m,&(items->data[i]),XmRXmString);
 }
 
+void message_read_event(message_t message,XEvent *event,int tag,int data)
+{
+  message_read_oid(message,(void*)event,tag,data);
+}
+
+
 void message_read_color(message_t m,XColor *color,int tag, int red)
 {
   color->red = red;
diff --git a/src/motif/server/datatrans.h b/src/motif/server/datatrans.h
index 5894621..7411a17 100644
--- a/src/motif/server/datatrans.h
+++ b/src/motif/server/datatrans.h
@@ -35,7 +35,7 @@ extern void message_write_font_list();
 extern void message_write_string_table();
 extern void message_write_xm_string_table();
 extern void message_write_int_list();
-#define message_write_event message_write_int
+extern void message_write_event();
 extern void message_write_color();
 /* GCC complains without the full prototype */
 extern void message_write_float(message_t,float,int);
@@ -63,7 +63,7 @@ extern void message_read_font_list();
 extern void message_read_string_table();
 extern void message_read_xm_string_table();
 extern void message_read_int_list();
-#define message_read_event message_read_int
+extern void message_read_event();
 extern void message_read_color();
 extern void message_read_float();
 
diff --git a/src/motif/server/events.c b/src/motif/server/events.c
index ea5307a..4e2c459 100644
--- a/src/motif/server/events.c
+++ b/src/motif/server/events.c
@@ -23,8 +23,7 @@ extern int end_callback_loop;
 
 void write_any_event(message_t reply,XEvent *event)
 {
-  message_put_dblword(reply,combine_type_and_data(event_tag,0));
-  message_put_dblword(reply,(unsigned long)event);
+  message_write_event(reply,event,event_tag);
   message_put_dblword(reply,event->xany.type);
   message_put_dblword(reply,event->xany.serial);
   message_put_dblword(reply,event->xany.send_event);

commit 93d7f94f9004fbb054a291211391c538a8439c6e
Author: Richard M Kreuter <kreuter at progn.net>
Date:   Wed Sep 17 19:04:41 2014 -0400

    Add an "oid" layer to motifd.
    
    * The wire protocol between motifd and Lisp employs 32-bit handles for
      various types; on 32-bit systems, the pointer address has been used,
      but that's lossy on 64-bit systems. This changeset introduces a
      32-bit handle called an "oid", and keeps a process-global
      doubly-linked list associating oids with pointers.

diff --git a/src/motif/server/Config.Darwin b/src/motif/server/Config.Darwin
index e24be15..dcc463c 100644
--- a/src/motif/server/Config.Darwin
+++ b/src/motif/server/Config.Darwin
@@ -1,6 +1,6 @@
 CFLAGS = -g -O2 -I/opt/local/include -I/sw/include -I/usr/local/include -I/usr/X11R6/include -I. -I$(VPATH)
 LDFLAGS = -L/opt/local/lib -L/usr/X11R6/lib -L/sw/lib -L/usr/local/lib
-LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE
+LIBS = -lXft -lXm -lXt -lXext -lX11 -lSM -lICE
 #LIBS = -lXm -lXt -lXext -lX11 -lSM -lICE -llanginfo
 # This def assumes you are building in the same or parallel
 # tree to the CVS souce layout. Sites may need to customize
diff --git a/src/motif/server/GNUmakefile b/src/motif/server/GNUmakefile
index 62eccb1..32915de 100644
--- a/src/motif/server/GNUmakefile
+++ b/src/motif/server/GNUmakefile
@@ -5,7 +5,7 @@ LDFLAGS =
 TARGET = motifd
 OBJS = main.o server.o translations.o packet.o message.o datatrans.o \
        requests.o callbacks.o widgets.o resources.o tables.o motif.o \
-       text.o xmstring.o list.o events.o
+       text.o xmstring.o list.o events.o oblist.o
 
 include Config
 
diff --git a/src/motif/server/datatrans.c b/src/motif/server/datatrans.c
index e36711a..5445aaf 100644
--- a/src/motif/server/datatrans.c
+++ b/src/motif/server/datatrans.c
@@ -21,6 +21,10 @@
 #include "types.h"
 #include "datatrans.h"
 #include "tables.h"
+#include "oblist.h"
+
+void message_write_oid(message_t,void *,int);
+void message_read_oid(message_t,caddr_t*,int,int);
 
 void packet_write_string(packet_t packet,String string,int count)
 {
@@ -93,8 +97,7 @@ void message_write_function(message_t message, int value,int type_tag)
 
 void message_write_widget(message_t message,Widget widget,int type_tag)
 {
-  message_put_dblword(message,combine_type_and_data(type_tag,0));
-  message_put_dblword(message,(long)widget);
+  message_write_oid(message,widget,type_tag);
 }
 
 void message_write_widget_class(message_t message,WidgetClass class,int tag)
@@ -117,10 +120,16 @@ void message_write_xid(message_t message,XID value,int tag)
   message_put_dblword(message,value);
 }
 
-void message_write_atom(message_t message,Atom value,int tag)
+void message_write_oid(message_t message,void *value,int tag)
 {
+  int oid = intern_object(value);
   message_put_dblword(message,combine_type_and_data(tag,0));
-  message_put_dblword(message,value);
+  message_put_dblword(message,oid);
+}
+
+void message_write_atom(message_t message,Atom value,int tag)
+{
+  message_write_oid(message,(void*)value,tag);
 }
 
 void message_write_enum(message_t message,int enumval,int tag)
@@ -208,26 +217,22 @@ void message_write_resource_names(message_t message,ResourceList *list,int tag)
 
 void message_write_xm_string(message_t message,XmString xs,int tag)
 {
-  message_put_dblword(message,combine_type_and_data(tag,0));
-  message_put_dblword(message,(long)xs);
+  message_write_oid(message,xs,tag);
 }
 
 void message_write_translation_table(message_t m,XtTranslations t,int tag)
 {
-  message_put_dblword(m,combine_type_and_data(tag,0));
-  message_put_dblword(m,(unsigned long)t);
+  message_write_oid(m,t,tag);
 }
 
 void message_write_accelerator_table(message_t m,XtAccelerators a,int tag)
 {
-  message_put_dblword(m,combine_type_and_data(tag,0));
-  message_put_dblword(m,(unsigned long)a);
+  message_write_oid(m,a,tag);
 }
 
 void message_write_font_list(message_t m,XmFontList flist,int tag)
 {
-  message_put_dblword(m,combine_type_and_data(tag,0));
-  message_put_dblword(m,(unsigned long)flist);
+  message_write_oid(m,flist,tag);
 }
 
 void message_write_string_table(message_t m,StringTable *items,int tag)
@@ -265,7 +270,7 @@ void message_write_float(message_t m,float f,int tag)
 
 void message_read_widget(message_t message,Widget *w,int tag,int data)
 {
-  *w = (Widget)message_get_dblword(message);
+  message_read_oid(message,(void*)w,tag,data);
 }
 
 void message_read_widget_class(message_t message,WidgetClass *c,
@@ -340,7 +345,7 @@ void message_read_xm_string(message_t message,XmString *xs,int tag,int data)
     register_garbage(xmstring,GarbageXmString);
   }
   else
-    *xs = (XmString)message_get_dblword(message);
+    message_read_oid(message,(void*)xs,tag,data);
 }
 
 /* used to be int *val here, but many places pass address of Boolean into
@@ -371,9 +376,15 @@ void message_read_xid(message_t message,XID *id,int tag,int data)
   *id = message_get_dblword(message);
 }
 
+void message_read_oid(message_t message,caddr_t *obj,int tag,int data)
+{
+  int oid = message_get_dblword(message);
+  *obj = find_object(oid);
+}
+
 void message_read_atom(message_t message,Atom *a,int tag,int data)
 {
-  *a = message_get_dblword(message);
+  message_read_oid(message,(void*)a,tag,data);
 }
 
 void message_read_enum(message_t message,int *enumval,int tag,int data)
@@ -456,18 +467,18 @@ void message_read_int_list(message_t message,IntList *list,int tag,int length)
 void message_read_translation_table(message_t m,XtTranslations *t,
 				    int tag,int data)
 {
-  *t = (XtTranslations)message_get_dblword(m);
+  message_read_oid(m,(void*)t,tag,data);
 }
 
 void message_read_accelerator_table(message_t m,XtAccelerators *a,
 				    int tag,int data)
 {
-  *a = (XtAccelerators)message_get_dblword(m);
+  message_read_oid(m,(void*)a,tag,data);
 }
 
 void message_read_font_list(message_t m,XmFontList *flist,int tag,int data)
 {
-  *flist = (XmFontList)message_get_dblword(m);
+  message_read_oid(m,(void*)flist,tag,data);
 }
 
 void message_read_string_table(message_t m,StringTable *items,int tag,int len)
diff --git a/src/motif/server/oblist.c b/src/motif/server/oblist.c
new file mode 100644
index 0000000..ddd1f3e
--- /dev/null
+++ b/src/motif/server/oblist.c
@@ -0,0 +1,117 @@
+#include <stdio.h>
+#include <X11/Intrinsic.h>
+
+#include "global.h"
+#include "oblist.h"
+
+/* OID generation. */
+static unsigned int current_oid;
+
+static void init_oids()
+{
+  current_oid = (unsigned int)0;
+}
+
+static unsigned int next_oid()
+{
+  if (current_oid == 0xffffffff) 
+    fatal_error("next_oid: ran out of oids"); /* This should be smarter.*/
+  return (++current_oid);
+}
+
+/* For expediency of implementation, the table of pointer-to-OID
+   associations will be a doubly-linked list. */
+typedef struct oblist oblist_t;
+
+struct oblist {
+  oblist_t *next;
+  oblist_t *prev;
+  void *obj;
+  int oid;
+};
+
+static oblist_t *oblist = NULL;
+
+static oblist_t *find_node_if(int(*fn)(oblist_t*,void*), void *datum)
+{
+  oblist_t *ret = NULL;
+  oblist_t *node = oblist;
+  while (node != NULL) {
+    if (fn(node, datum)==1) {
+      ret = node;
+      break;
+    }
+    node = node->next;
+  }
+  return ret;
+}
+
+static int obj_eql(oblist_t *node, void *obj) {
+  return (node->obj == obj);
+}
+
+static int id_eql(oblist_t *node, void *oidp) {
+  return (node->oid == *(int*)oidp);
+}
+
+void *find_object(unsigned int oid)
+{
+  oblist_t *node = find_node_if(&id_eql, &oid);
+  if (node != NULL)
+    return node->obj;
+  else
+    return NULL;
+}
+
+unsigned int intern_object(void *obj)
+{
+  oblist_t *node = find_node_if(&obj_eql, obj);
+
+  if (node != NULL)
+    return node->oid;
+
+  if (oblist == NULL)
+    init_oids();
+
+  if ((node = (void*)XtCalloc(1, sizeof(oblist_t))) == NULL)
+    fatal_error("intern_object: out of memory");
+
+  node->next = oblist;
+  node->prev = NULL;
+  if (node->next) node->next->prev = node;
+  node->obj = obj;
+  node->oid = next_oid();
+  oblist = node;
+  return node->oid;
+}
+
+static int unintern_if(int(*fn)(oblist_t*,void*), void *datum) 
+{
+  oblist_t *node;
+
+  node = find_node_if(fn,datum);
+  if (node == NULL)
+    return 0;
+  
+  if (node == oblist) oblist = node->next;
+  if (node->prev) (node->prev)->next = node->next;
+  if (node->next) (node->next)->prev = node->prev;
+
+  XtFree((char*)node);
+  return 1;
+}
+
+
+void unintern_object(void * obj)
+{
+  if (unintern_if(&obj_eql, obj)==0) {
+    if( global_will_trace ) {
+      printf("unintern_object: couldn't unintern %p\n",obj);
+      fflush(stdout);}
+  }
+}
+
+void maybe_unintern_object(void * obj)
+{
+  unintern_if(&obj_eql, obj);
+}
diff --git a/src/motif/server/oblist.h b/src/motif/server/oblist.h
new file mode 100644
index 0000000..7c6b16e
--- /dev/null
+++ b/src/motif/server/oblist.h
@@ -0,0 +1,6 @@
+extern unsigned int intern_object(void *);
+extern void *find_object(unsigned int);
+extern void unintern_object(void *);
+extern void unintern_object(void *);
+extern void maybe_unintern_object(void *);
+
diff --git a/src/motif/server/requests.c b/src/motif/server/requests.c
index f8aa1fa..2694f02 100644
--- a/src/motif/server/requests.c
+++ b/src/motif/server/requests.c
@@ -21,6 +21,7 @@
 #include "types.h"
 #include "functions.h"
 #include "tables.h"
+#include "oblist.h"
 
 typedef void (*request_f)(message_t);
 Boolean must_confirm = False;
@@ -60,11 +61,13 @@ void cleanup_garbage()
   
   garbage_list = NULL;
   while( current ) {
-    if( current->kind == GarbageXmString )
+    if( current->kind == GarbageXmString ) {
+      maybe_unintern_object(current->junk);
       XmStringFree( (XmString)current->junk );
-    else
+    } else {
+      maybe_unintern_object(current->junk);
       XtFree( current->junk );
-
+    }
     doomed = current;
     current = current->next;
     XtFree( (char *)doomed );
diff --git a/src/motif/server/tables.c b/src/motif/server/tables.c
index 8220ef5..1fa5dc7 100644
--- a/src/motif/server/tables.c
+++ b/src/motif/server/tables.c
@@ -20,6 +20,7 @@
 #include "global.h"
 #include "datatrans.h"
 #include "tables.h"
+#include "oblist.h"
 
 extern WidgetClass overrideShellWidgetClass,transientShellWidgetClass,
   topLevelShellWidgetClass,applicationShellWidgetClass;
@@ -190,7 +191,9 @@ void record_class_resources(WidgetClass class,class_resources *r)
   r->resource_count = resource_count;
   r->constraint_count = constraint_count;
 
+  maybe_unintern_object(resource_list);
   XtFree( (char *)resource_list );
+  maybe_unintern_object(resource_list);
   XtFree( (char *)constraint_list );
 }
 
diff --git a/src/motif/server/xmstring.c b/src/motif/server/xmstring.c
index a0eb697..93133fe 100644
--- a/src/motif/server/xmstring.c
+++ b/src/motif/server/xmstring.c
@@ -18,7 +18,7 @@
 #include "types.h"
 #include "tables.h"
 #include "requests.h"
-
+#include "oblist.h"
 
 /* Functions for building XmFontLists */
 
@@ -61,6 +61,7 @@ void RXmFontListFree(message_t message)
   XmFontList flist;
 
   toolkit_read_value(message,&flist,XmRFontList);
+  unintern_object(flist);
   XmFontListFree(flist);
 }
 
@@ -189,6 +190,7 @@ void RXmStringFree(message_t message)
   XmString s;
 
   toolkit_read_value(message,&s,XmRXmString);
+  unintern_object(s);
   XmStringFree(s);
 }
 

-----------------------------------------------------------------------


hooks/post-receive
-- 
CMU Common Lisp




More information about the cmucl-cvs mailing list