This is the mail archive of the
insight@sources.redhat.com
mailing list for the Insight project.
PATCH: Support TCL_MEM_DEBUG in libgui.
- To: insight at sources dot redhat dot com
- Subject: PATCH: Support TCL_MEM_DEBUG in libgui.
- From: Mo DeJong <mdejong at cygnus dot com>
- Date: Fri, 3 Aug 2001 16:12:42 -0700 (PDT)
Here is a patch to add support for Tcl memory debugging
in libgui. We simply need to use ckalloc/ckfree
instead of malloc/free or Tcl_Alloc/Tcl_Free.
This code from tcl.h shows why this is a good idea.
#ifdef TCL_MEM_DEBUG
# define ckalloc(x) Tcl_DbCkalloc(x, __FILE__, __LINE__)
# define ckfree(x) Tcl_DbCkfree(x, __FILE__, __LINE__)
# define ckrealloc(x,y) Tcl_DbCkrealloc((x), (y),__FILE__, __LINE__)
#else /* !TCL_MEM_DEBUG */
/*
* If we are not using the debugging allocator, we should call the
* Tcl_Alloc, et al. routines in order to guarantee that every module
* is using the same memory allocator both inside and outside of the
* Tcl library.
*/
# define ckalloc(x) Tcl_Alloc(x)
# define ckfree(x) Tcl_Free(x)
# define ckrealloc(x,y) Tcl_Realloc(x,y)
When TCL_MEM_DEBUG is compiled into Tcl, one can track down
all sorts of nasty memory conditions with ease.
The patch is appended to this file.
cheers
Mo
2001-08-03 Mo DeJong <mdejong@redhat.com>
* src/subcommand.c:
* src/tclgetdir.c:
* src/tclhelp.c:
* src/tclmain.c:
* src/tclmsgbox.c:
* src/tclsizebox.c:
* src/tclwinmode.c:
* src/tclwinpath.c:
* src/tclwinprint.c:
* src/tkWinPrintCanvas.c:
* src/tkWinPrintText.c:
Use ckalloc/ckfree instead of Tcl_Alloc/Tcl_Free
or malloc/free so that allocations will
be marked with file positions when Tcl mem
debug is activated.
Index: src/subcommand.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/subcommand.c,v
retrieving revision 1.1
diff -u -r1.1 subcommand.c
--- subcommand.c 1997/12/16 14:05:03 1.1
+++ subcommand.c 2001/08/03 22:06:11
@@ -26,7 +26,7 @@
if (data->delete)
(*data->delete) (data->subdata);
- Tcl_Free ((char *) data);
+ ckfree ((char *) data);
}
/* This function implements any Tcl command registered as having
@@ -113,7 +113,7 @@
}
}
- data = (struct subcommand_clientdata *) Tcl_Alloc (sizeof *data);
+ data = (struct subcommand_clientdata *) ckalloc (sizeof *data);
data->commands = table;
data->subdata = subdata;
data->delete = delete;
Index: src/tclgetdir.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclgetdir.c,v
retrieving revision 1.11
diff -u -r1.11 tclgetdir.c
--- tclgetdir.c 1999/03/11 03:45:54 1.11
+++ tclgetdir.c 2001/08/03 22:06:11
@@ -237,7 +237,7 @@
re-eval. This is a lot less efficient, but it doesn't really
matter. */
- new_args = (char **) Tcl_Alloc ((argc + 2) * sizeof (char *));
+ new_args = (char **) ckalloc ((argc + 2) * sizeof (char *));
new_args[0] = "tk_getOpenFile";
new_args[1] = "-choosedir";
@@ -249,8 +249,8 @@
merge = Tcl_Merge (argc + 2, new_args);
result = Tcl_GlobalEval (interp, merge);
- Tcl_Free (merge);
- Tcl_Free ((char *) new_args);
+ ckfree (merge);
+ ckfree ((char *) new_args);
return result;
}
Index: src/tclhelp.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclhelp.c,v
retrieving revision 1.6.212.2
diff -u -r1.6.212.2 tclhelp.c
--- tclhelp.c 2001/08/02 21:45:03 1.6.212.2
+++ tclhelp.c 2001/08/03 22:06:13
@@ -109,12 +109,12 @@
Tcl_DeleteExitHandler (help_command_atexit, cd);
if (hdata->filename != NULL)
- free (hdata->filename);
+ ckfree (hdata->filename);
if (hdata->header_filename != NULL)
- free (hdata->header_filename);
+ ckfree (hdata->header_filename);
if (hdata->hash_initialized)
Tcl_DeleteHashTable (&hdata->topic_hash);
- Tcl_Free ((char *) hdata);
+ ckfree ((char *) hdata);
}
/* Initialize the help system: choose a window, and set up the topic
@@ -223,9 +223,9 @@
{
struct help_command_data *hdata = (struct help_command_data *) cd;
- hdata->filename = malloc (strlen (argv[2]) + 1);
+ hdata->filename = ckalloc (strlen (argv[2]) + 1);
strcpy (hdata->filename, argv[2]);
- hdata->header_filename = malloc (strlen (argv[3]) + 1);
+ hdata->header_filename = ckalloc (strlen (argv[3]) + 1);
strcpy (hdata->header_filename, argv[3]);
return TCL_OK;
}
@@ -348,7 +348,7 @@
{
struct help_command_data *hdata;
- hdata = (struct help_command_data *) Tcl_Alloc (sizeof *hdata);
+ hdata = (struct help_command_data *) ckalloc (sizeof *hdata);
hdata->filename = NULL;
hdata->header_filename = NULL;
@@ -389,16 +389,16 @@
struct help_command_data *hdata = (struct help_command_data *) cd;
if (hdata->filename != NULL)
- free (hdata->filename);
+ ckfree (hdata->filename);
if (hdata->header_filename != NULL)
- free (hdata->header_filename);
+ ckfree (hdata->header_filename);
if (hdata->help_dir != NULL)
- free (hdata->help_dir);
+ ckfree (hdata->help_dir);
if (hdata->hash_initialized)
Tcl_DeleteHashTable (&hdata->topic_hash);
if (hdata->memory_block != NULL)
- free (hdata->memory_block);
- Tcl_Free ((char *) hdata);
+ ckfree (hdata->memory_block);
+ ckfree ((char *) hdata);
}
/* Implement the ide_help initialize command. */
@@ -409,11 +409,11 @@
{
struct help_command_data *hdata = (struct help_command_data *) cd;
- hdata->filename = malloc (strlen (argv[2]) + 1);
+ hdata->filename = ckalloc (strlen (argv[2]) + 1);
strcpy (hdata->filename, argv[2]);
- hdata->header_filename = malloc (strlen (argv[3]) + 1);
+ hdata->header_filename = ckalloc (strlen (argv[3]) + 1);
strcpy (hdata->header_filename, argv[3]);
- hdata->help_dir = malloc (strlen (argv[4]) + 1);
+ hdata->help_dir = ckalloc (strlen (argv[4]) + 1);
strcpy (hdata->help_dir, argv[4]);
return TCL_OK;
}
@@ -434,7 +434,7 @@
FILE *e;
char buf[200], *block_start;
- block_start = hdata->memory_block = malloc(6000);
+ block_start = hdata->memory_block = ckalloc(6000);
e = fopen (hdata->header_filename, "r");
if (e == NULL)
@@ -567,7 +567,7 @@
{
struct help_command_data *hdata;
- hdata = (struct help_command_data *) Tcl_Alloc (sizeof *hdata);
+ hdata = (struct help_command_data *) ckalloc (sizeof *hdata);
hdata->filename = NULL;
hdata->help_dir = NULL;
Index: src/tclmain.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclmain.c,v
retrieving revision 1.5
diff -u -r1.5 tclmain.c
--- tclmain.c 1998/08/14 01:16:57 1.5
+++ tclmain.c 2001/08/03 22:06:13
@@ -47,7 +47,7 @@
args = Tcl_Merge (argc - 1, argv + 1);
Tcl_SetVar (interp, "argv", args, TCL_GLOBAL_ONLY);
- Tcl_Free (args);
+ ckfree (args);
sprintf (buf, "%d", argc-1);
Tcl_SetVar (interp, "argc", buf, TCL_GLOBAL_ONLY);
Index: src/tclmsgbox.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclmsgbox.c,v
retrieving revision 1.2
diff -u -r1.2 tclmsgbox.c
--- tclmsgbox.c 1998/08/14 01:16:57 1.2
+++ tclmsgbox.c 2001/08/03 22:06:13
@@ -155,7 +155,7 @@
return DefWindowProc (hwnd, message, wparam, lparam);
/* Queue up a Tcl event. */
- me = (struct msgbox_event *) Tcl_Alloc (sizeof *me);
+ me = (struct msgbox_event *) ckalloc (sizeof *me);
me->header.proc = msgbox_eventproc;
me->md = (struct msgbox_data *) lparam;
Tcl_QueueEvent ((Tcl_Event *) me, TCL_QUEUE_TAIL);
@@ -202,10 +202,10 @@
/* We are now done with the msgbox_data structure, so we can free
the fields and the structure itself. */
- Tcl_Free (me->md->code);
- Tcl_Free (me->md->message);
- Tcl_Free (me->md->title);
- Tcl_Free ((char *) me->md);
+ ckfree (me->md->code);
+ ckfree (me->md->message);
+ ckfree (me->md->title);
+ ckfree ((char *) me->md);
if (ret != TCL_OK)
Tcl_BackgroundError (me->md->interp);
@@ -401,15 +401,15 @@
msgbox_init ();
- md = (struct msgbox_data *) Tcl_Alloc (sizeof *md);
+ md = (struct msgbox_data *) ckalloc (sizeof *md);
md->interp = interp;
- md->code = Tcl_Alloc (strlen (code) + 1);
+ md->code = ckalloc (strlen (code) + 1);
strcpy (md->code, code);
md->hidden_hwnd = hidden_hwnd;
md->hwnd = hWnd;
- md->message = Tcl_Alloc (strlen (message) + 1);
+ md->message = ckalloc (strlen (message) + 1);
strcpy (md->message, message);
- md->title = Tcl_Alloc (strlen (title) + 1);
+ md->title = ckalloc (strlen (title) + 1);
strcpy (md->title, title);
md->flags = flags | modal;
Index: src/tclsizebox.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclsizebox.c,v
retrieving revision 1.2
diff -u -r1.2 tclsizebox.c
--- tclsizebox.c 1998/03/22 22:48:40 1.2
+++ tclsizebox.c 2001/08/03 22:06:13
@@ -112,7 +112,7 @@
su = (struct sizebox_userdata *) GetWindowLong (hwnd, GWL_USERDATA);
SetWindowLong (hwnd, GWL_USERDATA, 0);
SetWindowLong (hwnd, GWL_WNDPROC, (LONG) su->wndproc);
- Tcl_Free ((char *) su);
+ ckfree ((char *) su);
DestroyWindow (hwnd);
}
}
@@ -149,7 +149,7 @@
pt.x, pt.y, Tk_Width (tkwin), Tk_Height (tkwin),
parhwnd, NULL, Tk_GetHINSTANCE (), NULL);
- su = (struct sizebox_userdata *) Tcl_Alloc (sizeof *su);
+ su = (struct sizebox_userdata *) ckalloc (sizeof *su);
su->tkwin = tkwin;
su->wndproc = (WNDPROC) GetWindowLong (hwnd, GWL_WNDPROC);
SetWindowLong (hwnd, GWL_USERDATA, (LONG) su);
Index: src/tclwinmode.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclwinmode.c,v
retrieving revision 1.1
diff -u -r1.1 tclwinmode.c
--- tclwinmode.c 1998/03/30 20:07:30 1.1
+++ tclwinmode.c 2001/08/03 22:06:13
@@ -61,11 +61,11 @@
{
Tcl_AppendResult (interp, "unrecognized key \"", list[i],
"\"", (char *) NULL);
- Tcl_Free ((char *) list);
+ ckfree ((char *) list);
return TCL_ERROR;
}
}
- Tcl_Free ((char *) list);
+ ckfree ((char *) list);
val = SetErrorMode (val);
Index: src/tclwinpath.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclwinpath.c,v
retrieving revision 1.1
diff -u -r1.1 tclwinpath.c
--- tclwinpath.c 1997/12/16 14:05:40 1.1
+++ tclwinpath.c 2001/08/03 22:06:13
@@ -133,7 +133,7 @@
char *buf;
size = cygwin32_posix_to_win32_path_list_buf_size (argv[2]);
- buf = Tcl_Alloc (size);
+ buf = ckalloc (size);
cygwin32_posix_to_win32_path_list (argv[2], buf);
Tcl_SetResult (interp, buf, TCL_DYNAMIC);
return TCL_OK;
@@ -149,7 +149,7 @@
char *buf;
size = cygwin32_win32_to_posix_path_list_buf_size (argv[2]);
- buf = Tcl_Alloc (size);
+ buf = ckalloc (size);
cygwin32_win32_to_posix_path_list (argv[2], buf);
Tcl_SetResult (interp, buf, TCL_DYNAMIC);
return TCL_OK;
Index: src/tclwinprint.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tclwinprint.c,v
retrieving revision 1.3
diff -u -r1.3 tclwinprint.c
--- tclwinprint.c 1998/08/21 02:08:31 1.3
+++ tclwinprint.c 2001/08/03 22:06:14
@@ -126,10 +126,10 @@
{
/* FIXME: I don't know if we are supposed to free the hDevMode
and hDevNames fields. */
- Tcl_Free ((char *) wd->page_setup);
+ ckfree ((char *) wd->page_setup);
}
- Tcl_Free ((char *) wd);
+ ckfree ((char *) wd);
}
/* Implement ide_winprint page_setup. */
@@ -216,7 +216,7 @@
}
if (wd->page_setup == NULL)
- wd->page_setup = (PAGESETUPDLG *) Tcl_Alloc (sizeof (PAGESETUPDLG));
+ wd->page_setup = (PAGESETUPDLG *) ckalloc (sizeof (PAGESETUPDLG));
*wd->page_setup = psd;
@@ -916,7 +916,7 @@
{
struct winprint_data *wd;
- wd = (struct winprint_data *) Tcl_Alloc (sizeof *wd);
+ wd = (struct winprint_data *) ckalloc (sizeof *wd);
wd->page_setup = NULL;
wd->aborted = 0;
Index: src/tkWinPrintCanvas.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tkWinPrintCanvas.c,v
retrieving revision 1.4.180.1
diff -u -r1.4.180.1 tkWinPrintCanvas.c
--- tkWinPrintCanvas.c 2001/08/03 00:22:30 1.4.180.1
+++ tkWinPrintCanvas.c 2001/08/03 22:06:14
@@ -52,7 +52,7 @@
int tiles_wide,tiles_high;
int tile_y, tile_x;
int screenX1, screenX2, screenY1, screenY2, width, height;
- DOCINFO *lpdi = malloc(sizeof(DOCINFO));
+ DOCINFO *lpdi = (DOCINFO *) ckalloc(sizeof(DOCINFO));
if (argc < 2) {
Tcl_AppendResult(interp, "wrong # args: should be \"",
@@ -74,7 +74,7 @@
memset(lpdi,0,sizeof(DOCINFO));
lpdi->cbSize=sizeof(DOCINFO);
- lpdi->lpszDocName=malloc(255);
+ lpdi->lpszDocName= (LPCSTR) ckalloc(255);
sprintf((char*)lpdi->lpszDocName,"SN - Printing\0");
lpdi->lpszOutput=NULL;
@@ -164,12 +164,12 @@
EndDoc(pd.hDC);
done:
- free ((char*) lpdi->lpszDocName);
- free (lpdi);
+ ckfree ((char*) lpdi->lpszDocName);
+ ckfree ((char*) lpdi);
return TCL_OK;
error:
- free ((char*) lpdi->lpszDocName);
- free (lpdi);
+ ckfree ((char*) lpdi->lpszDocName);
+ ckfree ((char*) lpdi);
return TCL_ERROR;
}
Index: src/tkWinPrintText.c
===================================================================
RCS file: /cvs/cvsfiles/devo/libgui/src/tkWinPrintText.c,v
retrieving revision 1.6.180.2
diff -u -r1.6.180.2 tkWinPrintText.c
--- tkWinPrintText.c 2001/08/03 00:22:30 1.6.180.2
+++ tkWinPrintText.c 2001/08/03 22:06:14
@@ -249,7 +249,7 @@
Pixmap pixmap;
int bottomY = 0; /* Initialization needed only to stop
* compiler warnings. */
- DOCINFO *lpdi = malloc(sizeof(DOCINFO));
+ DOCINFO *lpdi = (DOCINFO *) ckalloc(sizeof(DOCINFO));
TkTextIndex first, last;
int numLines;
HDC hDCpixmap;
@@ -291,7 +291,7 @@
memset(lpdi,0,sizeof(DOCINFO));
lpdi->cbSize=sizeof(DOCINFO);
- lpdi->lpszDocName=malloc(255);
+ lpdi->lpszDocName = (LPCSTR) ckalloc(255);
sprintf((char*)lpdi->lpszDocName,"SN - Printing\0");
lpdi->lpszOutput=NULL;
@@ -446,12 +446,12 @@
textPtr->dInfoPtr->flags|=DINFO_OUT_OF_DATE;
done:
- free ((char*) lpdi->lpszDocName);
- free (lpdi);
+ ckfree ((char*) lpdi->lpszDocName);
+ ckfree ((char*) lpdi);
return TCL_OK;
error:
- free ((char*) lpdi->lpszDocName);
- free (lpdi);
+ ckfree ((char*) lpdi->lpszDocName);
+ ckfree ((char*) lpdi);
return TCL_ERROR;
}