summaryrefslogtreecommitdiffstats
path: root/generic/tclCkalloc.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclCkalloc.c')
-rw-r--r--generic/tclCkalloc.c132
1 files changed, 70 insertions, 62 deletions
diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c
index d60633b..8746241 100644
--- a/generic/tclCkalloc.c
+++ b/generic/tclCkalloc.c
@@ -131,10 +131,12 @@ static int ckallocInit = 0;
* Prototypes for procedures defined in this file:
*/
-static int CheckmemCmd(ClientData clientData, Tcl_Interp *interp,
- int argc, const char *argv[]);
-static int MemoryCmd(ClientData clientData, Tcl_Interp *interp,
- int argc, const char *argv[]);
+static int CheckmemCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
+static int MemoryCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static void ValidateMemory(struct mem_header *memHeaderP,
const char *file, int line, int nukeGuards);
@@ -145,7 +147,7 @@ static void ValidateMemory(struct mem_header *memHeaderP,
*
* Initialize the locks used by the allocator. This is only appropriate
* to call in a single threaded environment, such as during
- * TclInitSubsystems.
+ * Tcl_InitSubsystems.
*
*----------------------------------------------------------------------
*/
@@ -811,8 +813,8 @@ static int
MemoryCmd(
ClientData clientData,
Tcl_Interp *interp,
- int argc,
- const char *argv[])
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Obj values of arguments. */
{
const char *fileName;
FILE *fileP;
@@ -820,20 +822,17 @@ MemoryCmd(
int result;
size_t len;
- if (argc < 2) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s option [args..]\"", argv[0]));
+ if (objc < 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "option [args..]");
return TCL_ERROR;
}
- if (strcmp(argv[1], "active") == 0 || strcmp(argv[1], "display") == 0) {
- if (argc != 3) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s %s file\"",
- argv[0], argv[1]));
+ if (strcmp(TclGetString(objv[1]), "active") == 0 || strcmp(TclGetString(objv[1]), "display") == 0) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "file");
return TCL_ERROR;
}
- fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+ fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
if (fileName == NULL) {
return TCL_ERROR;
}
@@ -841,23 +840,23 @@ MemoryCmd(
Tcl_DStringFree(&buffer);
if (result != TCL_OK) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf("error accessing %s: %s",
- argv[2], Tcl_PosixError(interp)));
+ TclGetString(objv[2]), Tcl_PosixError(interp)));
return TCL_ERROR;
}
return TCL_OK;
}
- if (strcmp(argv[1],"break_on_malloc") == 0) {
+ if (strcmp(TclGetString(objv[1]),"break_on_malloc") == 0) {
int value;
- if (argc != 3) {
+ if (objc != 3) {
goto argError;
}
- if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
return TCL_ERROR;
}
break_on_malloc = (unsigned int) value;
return TCL_OK;
}
- if (strcmp(argv[1],"info") == 0) {
+ if (strcmp(TclGetString(objv[1]),"info") == 0) {
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"%-25s %10u\n%-25s %10u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER"u\n%-25s %10u\n%-25s %10" TCL_Z_MODIFIER "u\n",
"total mallocs", total_mallocs, "total frees", total_frees,
@@ -867,20 +866,19 @@ MemoryCmd(
"maximum bytes allocated", maximum_bytes_malloced));
return TCL_OK;
}
- if (strcmp(argv[1], "init") == 0) {
- if (argc != 3) {
+ if (strcmp(TclGetString(objv[1]), "init") == 0) {
+ if (objc != 3) {
goto bad_suboption;
}
- init_malloced_bodies = (strcmp(argv[2],"on") == 0);
+ init_malloced_bodies = (strcmp(TclGetString(objv[2]),"on") == 0);
return TCL_OK;
}
- if (strcmp(argv[1], "objs") == 0) {
- if (argc != 3) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s objs file\"", argv[0]));
+ if (strcmp(TclGetString(objv[1]), "objs") == 0) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "file");
return TCL_ERROR;
}
- fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+ fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
if (fileName == NULL) {
return TCL_ERROR;
}
@@ -896,13 +894,12 @@ MemoryCmd(
Tcl_DStringFree(&buffer);
return TCL_OK;
}
- if (strcmp(argv[1],"onexit") == 0) {
- if (argc != 3) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s onexit file\"", argv[0]));
+ if (strcmp(TclGetString(objv[1]),"onexit") == 0) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "file");
return TCL_ERROR;
}
- fileName = Tcl_TranslateFileName(interp, argv[2], &buffer);
+ fileName = Tcl_TranslateFileName(interp, TclGetString(objv[2]), &buffer);
if (fileName == NULL) {
return TCL_ERROR;
}
@@ -911,62 +908,59 @@ MemoryCmd(
Tcl_DStringFree(&buffer);
return TCL_OK;
}
- if (strcmp(argv[1],"tag") == 0) {
- if (argc != 3) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s tag string\"", argv[0]));
+ if (strcmp(TclGetString(objv[1]),"tag") == 0) {
+ if (objc != 3) {
+ Tcl_WrongNumArgs(interp, 2, objv, "file");
return TCL_ERROR;
}
if ((curTagPtr != NULL) && (curTagPtr->refCount == 0)) {
TclpFree((char *) curTagPtr);
}
- len = strlen(argv[2]);
+ len = strlen(TclGetString(objv[2]));
curTagPtr = (MemTag *) TclpAlloc(TAG_SIZE(len));
curTagPtr->refCount = 0;
- memcpy(curTagPtr->string, argv[2], len + 1);
+ memcpy(curTagPtr->string, TclGetString(objv[2]), len + 1);
return TCL_OK;
}
- if (strcmp(argv[1],"trace") == 0) {
- if (argc != 3) {
+ if (strcmp(TclGetString(objv[1]),"trace") == 0) {
+ if (objc != 3) {
goto bad_suboption;
}
- alloc_tracing = (strcmp(argv[2],"on") == 0);
+ alloc_tracing = (strcmp(TclGetString(objv[2]),"on") == 0);
return TCL_OK;
}
- if (strcmp(argv[1],"trace_on_at_malloc") == 0) {
+ if (strcmp(TclGetString(objv[1]),"trace_on_at_malloc") == 0) {
int value;
- if (argc != 3) {
+ if (objc != 3) {
goto argError;
}
- if (Tcl_GetInt(interp, argv[2], &value) != TCL_OK) {
+ if (Tcl_GetIntFromObj(interp, objv[2], &value) != TCL_OK) {
return TCL_ERROR;
}
trace_on_at_malloc = value;
return TCL_OK;
}
- if (strcmp(argv[1],"validate") == 0) {
- if (argc != 3) {
+ if (strcmp(TclGetString(objv[1]),"validate") == 0) {
+ if (objc != 3) {
goto bad_suboption;
}
- validate_memory = (strcmp(argv[2],"on") == 0);
+ validate_memory = (strcmp(TclGetString(objv[2]),"on") == 0);
return TCL_OK;
}
Tcl_SetObjResult(interp, Tcl_ObjPrintf(
"bad option \"%s\": should be active, break_on_malloc, info, "
"init, objs, onexit, tag, trace, trace_on_at_malloc, or validate",
- argv[1]));
+ TclGetString(objv[1])));
return TCL_ERROR;
argError:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s %s count\"", argv[0], argv[1]));
+ Tcl_WrongNumArgs(interp, 2, objv, "count");
return TCL_ERROR;
bad_suboption:
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s %s on|off\"", argv[0], argv[1]));
+ Tcl_WrongNumArgs(interp, 2, objv, "on|off");
return TCL_ERROR;
}
@@ -987,21 +981,23 @@ MemoryCmd(
*
*----------------------------------------------------------------------
*/
+static int CheckmemCmd(ClientData clientData,
+ Tcl_Interp *interp, int objc,
+ Tcl_Obj *const objv[]);
static int
CheckmemCmd(
ClientData clientData, /* Not used. */
Tcl_Interp *interp, /* Interpreter for evaluation. */
- int argc, /* Number of arguments. */
- const char *argv[]) /* String values of arguments. */
+ int objc, /* Number of arguments. */
+ Tcl_Obj *const objv[]) /* Obj values of arguments. */
{
- if (argc != 2) {
- Tcl_SetObjResult(interp, Tcl_ObjPrintf(
- "wrong # args: should be \"%s fileName\"", argv[0]));
+ if (objc != 2) {
+ Tcl_WrongNumArgs(interp, 1, objv, "fileName");
return TCL_ERROR;
}
tclMemDumpFileName = dumpFile;
- strcpy(tclMemDumpFileName, argv[1]);
+ strcpy(tclMemDumpFileName, TclGetString(objv[1]));
return TCL_OK;
}
@@ -1027,8 +1023,8 @@ Tcl_InitMemory(
* added */
{
TclInitDbCkalloc();
- Tcl_CreateCommand(interp, "memory", MemoryCmd, NULL, NULL);
- Tcl_CreateCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "memory", MemoryCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "checkmem", CheckmemCmd, NULL, NULL);
}
@@ -1121,6 +1117,8 @@ Tcl_AttemptDbCkalloc(
int line)
{
char *result;
+ (void)file;
+ (void)line;
result = (char *) TclpAlloc(size);
return result;
@@ -1200,6 +1198,8 @@ Tcl_AttemptDbCkrealloc(
int line)
{
char *result;
+ (void)file;
+ (void)line;
result = (char *) TclpRealloc(ptr, size);
return result;
@@ -1230,6 +1230,8 @@ Tcl_DbCkfree(
const char *file,
int line)
{
+ (void)file;
+ (void)line;
TclpFree(ptr);
}
@@ -1248,12 +1250,14 @@ void
Tcl_InitMemory(
Tcl_Interp *interp)
{
+ (void)interp;
}
int
Tcl_DumpActiveMemory(
const char *fileName)
{
+ (void)fileName;
return TCL_OK;
}
@@ -1262,6 +1266,8 @@ Tcl_ValidateAllMemory(
const char *file,
int line)
{
+ (void)file;
+ (void)line;
}
int
@@ -1269,6 +1275,8 @@ TclDumpMemoryInfo(
ClientData clientData,
int flags)
{
+ (void)clientData;
+ (void)flags;
return 1;
}
generated by cgit v0.12 at 2025-03-28 10:04:55 (GMT)