[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