From mboxrd@z Thu Jan 1 00:00:00 1970 From: Mo DeJong To: insight@sources.redhat.com Subject: PATCH: Support TCL_MEM_DEBUG in libgui. Date: Fri, 03 Aug 2001 16:12:00 -0000 Message-id: X-SW-Source: 2001-q3/msg00081.html 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 * 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; }