cvsuser 04/09/07 17:34:03
Modified: build_tools build_nativecall.pl
classes sarray.pmc
imcc pbc.c
include/parrot memory.h string_funcs.h
io io_buf.c
lib/Parrot Pmc2c.pm
ops string.ops
src datatypes.c debug.c dynext.c headers.c inter_misc.c
library.c memory.c mmd.c objects.c packfile.c pmc.c
resources.c smallobject.c string.c utils.c
Log:
Patch a bunch of small leaks
Do some code refactoring to make debugging memory issues easier
Give an alternative for constant strings
Fix a few really big string header leaks
Revision Changes Path
1.54 +0 -0 parrot/build_tools/build_nativecall.pl
Index: build_nativecall.pl
===================================================================
RCS file: /cvs/public/parrot/build_tools/build_nativecall.pl,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -w -r1.53 -r1.54
--- build_nativecall.pl 7 Sep 2004 14:33:55 -0000 1.53
+++ build_nativecall.pl 8 Sep 2004 00:33:49 -0000 1.54
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: build_nativecall.pl,v 1.53 2004/09/07 14:33:55 dan Exp $
+# $Id: build_nativecall.pl,v 1.54 2004/09/08 00:33:49 dan Exp $
=head1 NAME
@@ -165,7 +165,7 @@
/* nci.c
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: build_nativecall.pl,v 1.53 2004/09/07 14:33:55 dan Exp $
+ * $Id: build_nativecall.pl,v 1.54 2004/09/08 00:33:49 dan Exp $
* Overview:
* Native Call Interface routines. The code needed to build a
* parrot to C call frame is in here
1.30 +5 -1 parrot/classes/sarray.pmc
Index: sarray.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/sarray.pmc,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- sarray.pmc 19 Aug 2004 13:46:12 -0000 1.29
+++ sarray.pmc 8 Sep 2004 00:33:51 -0000 1.30
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: sarray.pmc,v 1.29 2004/08/19 13:46:12 leo Exp $
+$Id: sarray.pmc,v 1.30 2004/09/08 00:33:51 dan Exp $
=head1 NAME
@@ -618,6 +618,10 @@
if (PMC_int_val(SELF))
internal_exception(OUT_OF_BOUNDS, "SArray: Can't resize!\n");
PMC_int_val(SELF) = size;
+ /* Probably ought to actually copy this... */
+ if (PMC_data(SELF)) {
+ mem_sys_free(PMC_data(SELF));
+ }
PMC_data(SELF) = mem_sys_allocate_zeroed((2 + size) *
sizeof(HashEntry));
PObj_custom_mark_destroy_SETALL(SELF);
1.89 +7 -2 parrot/imcc/pbc.c
Index: pbc.c
===================================================================
RCS file: /cvs/public/parrot/imcc/pbc.c,v
retrieving revision 1.88
retrieving revision 1.89
diff -u -w -r1.88 -r1.89
--- pbc.c 21 Aug 2004 09:05:47 -0000 1.88
+++ pbc.c 8 Sep 2004 00:33:52 -0000 1.89
@@ -860,8 +860,13 @@
constant_folding(interpreter, unit);
store_sub_size(code_size, ins_size);
bytes = (oldsize + code_size) * sizeof(opcode_t);
+ if (interpreter->code->byte_code) {
interpreter->code->byte_code =
mem_sys_realloc(interpreter->code->byte_code, bytes);
+ } else {
+ interpreter->code->byte_code =
+ mem_sys_allocate(bytes);
+ }
interpreter->code->cur_cs->base.size = oldsize + code_size;
interpreter->code->cur_cs->base.data = interpreter->code->byte_code;
pc = (opcode_t*) interpreter->code->byte_code + oldsize;
1.16 +17 -4 parrot/include/parrot/memory.h
Index: memory.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/memory.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -w -r1.15 -r1.16
--- memory.h 22 Apr 2004 08:55:05 -0000 1.15
+++ memory.h 8 Sep 2004 00:33:54 -0000 1.16
@@ -1,7 +1,7 @@
/* memory.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: memory.h,v 1.15 2004/04/22 08:55:05 leo Exp $
+ * $Id: memory.h,v 1.16 2004/09/08 00:33:54 dan Exp $
* Overview:
* This is the api header for the memory subsystem
* Data Structure and Algorithms:
@@ -12,15 +12,28 @@
#if !defined(PARROT_MEMORY_H_GUARD)
#define PARROT_MEMORY_H_GUARD
-
+#include <assert.h>
void *mem_sys_allocate(size_t);
void *mem_sys_allocate_zeroed(size_t);
-void *mem_sys_realloc(void *, size_t);
-
+void *mem__sys_realloc(void *, size_t);
+#define mem_sys_realloc(x,y) (assert(x!=NULL), mem__sys_realloc(x,y))
void mem_sys_free(void *);
+void *mem__internal_allocate(size_t, char *, int);
+#define mem_internal_allocate(x) mem__internal_allocate(x, __FILE__, __LINE__)
+
+void *mem__internal_allocate_zeroed(size_t, char *, int);
+#define mem_internal_allocate_zeroed(x) mem__internal_allocate_zeroed(x, __FILE__,
__LINE__)
+
+void *mem__internal_realloc(void *, size_t, char *, int);
+#define mem_internal_realloc(x, y) mem__internal_realloc(x, y, __FILE__, __LINE__)
+
+void mem__internal_free(void *, char *, int);
+#define mem_internal_free(x) mem__internal_free(x, __FILE__, __LINE__)
+
+
void mem_setup_allocator(struct Parrot_Interp *);
#define mem_allocate_new_stash() NULL
1.43 +2 -1 parrot/include/parrot/string_funcs.h
Index: string_funcs.h
===================================================================
RCS file: /cvs/public/parrot/include/parrot/string_funcs.h,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- string_funcs.h 9 Jul 2004 08:42:57 -0000 1.42
+++ string_funcs.h 8 Sep 2004 00:33:54 -0000 1.43
@@ -1,7 +1,7 @@
/* string_funcs.h
* Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
* CVS Info
- * $Id: string_funcs.h,v 1.42 2004/07/09 08:42:57 leo Exp $
+ * $Id: string_funcs.h,v 1.43 2004/09/08 00:33:54 dan Exp $
* Overview:
* This is the api header for the string subsystem
* Data Structure and Algorithms:
@@ -69,6 +69,7 @@
INTVAL string_str_index(struct Parrot_Interp *interpreter, const STRING *s,
const STRING *s2, UINTVAL start);
STRING *string_from_cstring(struct Parrot_Interp *, const void *, UINTVAL);
+STRING *string_from_const_cstring(struct Parrot_Interp *, const void *, UINTVAL);
STRING *const_string(struct Parrot_Interp *, const char *);
char *string_to_cstring(struct Parrot_Interp *, STRING *);
void string_cstring_free(void *);
1.29 +13 -4 parrot/io/io_buf.c
Index: io_buf.c
===================================================================
RCS file: /cvs/public/parrot/io/io_buf.c,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -w -r1.28 -r1.29
--- io_buf.c 29 Jul 2004 06:56:29 -0000 1.28
+++ io_buf.c 8 Sep 2004 00:33:55 -0000 1.29
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: io_buf.c,v 1.28 2004/07/29 06:56:29 leo Exp $
+$Id: io_buf.c,v 1.29 2004/09/08 00:33:55 dan Exp $
=head1 NAME
@@ -578,8 +578,13 @@
if (s->bufused < l) {
if (may_realloc) {
s->representation = enum_stringrep_one;
- PObj_bufstart(s) = s->strstart =
+ if (s->strstart) {
+ PObj_bufstart(s) =
+ s->strstart =
mem_sys_realloc(s->strstart, l);
+ } else {
+ PObj_bufstart(s) = s->strstart = mem_sys_allocate(l);
+ }
PObj_buflen(s) = l;
}
else
@@ -596,7 +601,11 @@
if (s->bufused < l) {
if (may_realloc) {
s->representation = enum_stringrep_one;
+ if (s->strstart) {
PObj_bufstart(s) = s->strstart = mem_sys_realloc(s->strstart, l);
+ } else {
+ PObj_bufstart(s) = s->strstart = mem_sys_allocate(l);
+ }
PObj_buflen(s) = l;
}
else
1.39 +3 -3 parrot/lib/Parrot/Pmc2c.pm
Index: Pmc2c.pm
===================================================================
RCS file: /cvs/public/parrot/lib/Parrot/Pmc2c.pm,v
retrieving revision 1.38
retrieving revision 1.39
diff -u -w -r1.38 -r1.39
--- Pmc2c.pm 22 Aug 2004 09:00:17 -0000 1.38
+++ Pmc2c.pm 8 Sep 2004 00:33:55 -0000 1.39
@@ -1,5 +1,5 @@
# Copyright: 2004 The Perl Foundation. All Rights Reserved.
-# $Id: Pmc2c.pm,v 1.38 2004/08/22 09:00:17 leo Exp $
+# $Id: Pmc2c.pm,v 1.39 2004/09/08 00:33:55 dan Exp $
=head1 NAME
@@ -167,7 +167,7 @@
EOC
foreach my $class (@classes) {
$cout .= <<"EOC";
- whoami = string_from_cstring(interpreter, "$class", 0);
+ whoami = string_from_const_cstring(interpreter, "$class", 0);
type${class} = pmc_register(interpreter, whoami);
EOC
}
@@ -1328,7 +1328,7 @@
$l
${decl} {
$ret_def
- STRING *meth = const_string(interpreter, $delegate_meth);
+ STRING *meth = string_from_cstring(interpreter, $delegate_meth, 0);
PMC *sub = find_or_die(interpreter, pmc, meth);
${func_ret}Parrot_run_meth_fromc_args_save$ret_type(interpreter, sub,
pmc, meth, "$sig"$arg);
1.27 +2 -1 parrot/ops/string.ops
Index: string.ops
===================================================================
RCS file: /cvs/public/parrot/ops/string.ops,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -w -r1.26 -r1.27
--- string.ops 12 Jul 2004 17:26:15 -0000 1.26
+++ string.ops 8 Sep 2004 00:33:56 -0000 1.27
@@ -354,7 +354,7 @@
char *c = (char *)&$3, *n;
STRING *s;
INTVAL ln;
- const char *t;
+ char *t;
int i;
s = string_make(interpreter, c, (UINTVAL)$2, "iso-8859-1", 0);
@@ -371,6 +371,7 @@
t = string_to_cstring(interpreter, s);
for (i = $4; i < $4 + $2; i++)
n[i] = t[i - $4];
+ string_cstring_free(t);
goto NEXT();
1.11 +4 -2 parrot/src/datatypes.c
Index: datatypes.c
===================================================================
RCS file: /cvs/public/parrot/src/datatypes.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -w -r1.10 -r1.11
--- datatypes.c 9 Apr 2004 20:32:42 -0000 1.10
+++ datatypes.c 8 Sep 2004 00:33:58 -0000 1.11
@@ -1,7 +1,7 @@
/*
Copyright: (c) 2002 Leopold Toetsch <[EMAIL PROTECTED]>
License: Artistic/GPL, see README and LICENSES for details
-$Id: datatypes.c,v 1.10 2004/04/09 20:32:42 dan Exp $
+$Id: datatypes.c,v 1.11 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -41,9 +41,11 @@
int i;
for (i = enum_first_type; i < enum_last_type; i++) {
- if (!strcmp(data_types[i - enum_first_type].name, type))
+ if (!strcmp(data_types[i - enum_first_type].name, type)) {
+ string_cstring_free(type);
return i;
}
+ }
string_cstring_free(type);
1.131 +9 -4 parrot/src/debug.c
Index: debug.c
===================================================================
RCS file: /cvs/public/parrot/src/debug.c,v
retrieving revision 1.130
retrieving revision 1.131
diff -u -w -r1.130 -r1.131
--- debug.c 20 Aug 2004 10:15:53 -0000 1.130
+++ debug.c 8 Sep 2004 00:33:58 -0000 1.131
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: debug.c,v 1.130 2004/08/20 10:15:53 leo Exp $
+$Id: debug.c,v 1.131 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -2070,9 +2070,14 @@
/* Update the constant count and reallocate */
k = ++interpreter->code->const_table->const_count;
+ if (interpreter->code->const_table->constants) {
interpreter->code->const_table->constants =
mem_sys_realloc(interpreter->code->const_table->constants,
k * sizeof(struct PackFile_Constant *));
+ } else {
+ interpreter->code->const_table->constants =
+ mem_sys_allocate(k * sizeof(struct PackFile_Constant *));
+ }
/* Allocate a new constant */
interpreter->code->const_table->constants[--k] = PackFile_Constant_new();
1.30 +3 -2 parrot/src/dynext.c
Index: dynext.c
===================================================================
RCS file: /cvs/public/parrot/src/dynext.c,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- dynext.c 31 Aug 2004 09:14:30 -0000 1.29
+++ dynext.c 8 Sep 2004 00:33:58 -0000 1.30
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: dynext.c,v 1.29 2004/08/31 09:14:30 leo Exp $
+$Id: dynext.c,v 1.30 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -269,6 +269,7 @@
if (path) {
char* cpath = string_to_cstring(interpreter, path);
handle = Parrot_dlopen(cpath);
+ string_cstring_free(cpath);
}
#else
UNUSED(initializer);
1.59 +12 -13 parrot/src/headers.c
Index: headers.c
===================================================================
RCS file: /cvs/public/parrot/src/headers.c,v
retrieving revision 1.58
retrieving revision 1.59
diff -u -w -r1.58 -r1.59
--- headers.c 20 Aug 2004 08:41:38 -0000 1.58
+++ headers.c 8 Sep 2004 00:33:58 -0000 1.59
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: headers.c,v 1.58 2004/08/20 08:41:38 leo Exp $
+$Id: headers.c,v 1.59 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -192,7 +192,7 @@
/* Expand the array of sized resource pools, if necessary */
if (num_old <= idx) {
UINTVAL num_new = idx + 1;
- sized_pools = mem_sys_realloc(sized_pools, num_new * sizeof(void *));
+ sized_pools = mem_internal_realloc(sized_pools, num_new * sizeof(void *));
memset(sized_pools + num_old, 0, sizeof(void *) * (num_new - num_old));
interpreter->arena_base->sized_header_pools = sized_pools;
@@ -263,7 +263,7 @@
#endif
pmc->pmc_ext = new_pmc_ext(interpreter);
if (flags & PObj_is_PMC_shared_FLAG) {
- PMC_sync(pmc) = mem_sys_allocate(sizeof(*PMC_sync(pmc)));
+ PMC_sync(pmc) = mem_internal_allocate(sizeof(*PMC_sync(pmc)));
PMC_sync(pmc)->owner = interpreter;
MUTEX_INIT(PMC_sync(pmc)->pmc_lock);
}
@@ -348,7 +348,6 @@
new_string_header(Interp *interpreter, UINTVAL flags)
{
STRING *string;
-
string = get_free_buffer(interpreter, (flags & PObj_constant_FLAG)
? interpreter->
arena_base->constant_string_header_pool :
@@ -714,14 +713,14 @@
for (cur_arena = pool->last_Arena; cur_arena;) {
next = cur_arena->prev;
#if ARENA_DOD_FLAGS
- mem_sys_free(cur_arena->dod_flags);
+ mem_internal_free(cur_arena->dod_flags);
#else
- mem_sys_free(cur_arena->start_objects);
+ mem_internal_free(cur_arena->start_objects);
#endif
- mem_sys_free(cur_arena);
+ mem_internal_free(cur_arena);
cur_arena = next;
}
- free(pool);
+ mem_internal_free(pool);
}
}
@@ -730,15 +729,15 @@
for (cur_arena = pool->last_Arena; cur_arena;) {
next = cur_arena->prev;
#if ARENA_DOD_FLAGS
- mem_sys_free(cur_arena->dod_flags);
+ mem_internal_free(cur_arena->dod_flags);
#else
- mem_sys_free(cur_arena->start_objects);
+ mem_internal_free(cur_arena->start_objects);
#endif
- mem_sys_free(cur_arena);
+ mem_internal_free(cur_arena);
cur_arena = next;
}
- mem_sys_free(interpreter->arena_base->pmc_ext_pool);
- mem_sys_free(interpreter->arena_base->sized_header_pools);
+ mem_internal_free(interpreter->arena_base->pmc_ext_pool);
+ mem_internal_free(interpreter->arena_base->sized_header_pools);
}
#if 0
1.8 +2 -2 parrot/src/inter_misc.c
Index: inter_misc.c
===================================================================
RCS file: /cvs/public/parrot/src/inter_misc.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -w -r1.7 -r1.8
--- inter_misc.c 20 Aug 2004 10:15:53 -0000 1.7
+++ inter_misc.c 8 Sep 2004 00:33:58 -0000 1.8
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: inter_misc.c,v 1.7 2004/08/20 10:15:53 leo Exp $
+$Id: inter_misc.c,v 1.8 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -121,7 +121,7 @@
VTABLE_set_pmc_keyed_str(interpreter, hash, type, nci);
/* build native call interface fir the C sub in "func" */
VTABLE_set_pointer_keyed_str(interpreter, nci,
- const_string(interpreter, "pIt"), func);
+ string_from_const_cstring(interpreter, "pIt", 0),
func);
}
1.6 +3 -1 parrot/src/library.c
Index: library.c
===================================================================
RCS file: /cvs/public/parrot/src/library.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- library.c 26 May 2004 19:14:34 -0000 1.5
+++ library.c 8 Sep 2004 00:33:58 -0000 1.6
@@ -1,6 +1,6 @@
/*
Copyright: 2004 The Perl Foundation. All Rights Reserved.
-$Id: library.c,v 1.5 2004/05/26 19:14:34 jrieks Exp $
+$Id: library.c,v 1.6 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -96,6 +96,8 @@
ret = Parrot_runops_fromc_arglist_save(interpreter, sub, csig, args);
va_end(args);
+ string_cstring_free(csig);
+
/* done */
interpreter->resume_flag = resume;
return ret;
1.46 +64 -2 parrot/src/memory.c
Index: memory.c
===================================================================
RCS file: /cvs/public/parrot/src/memory.c,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -w -r1.45 -r1.46
--- memory.c 15 Aug 2004 15:24:17 -0000 1.45
+++ memory.c 8 Sep 2004 00:33:58 -0000 1.46
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: memory.c,v 1.45 2004/08/15 15:24:17 leo Exp $
+$Id: memory.c,v 1.46 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -43,6 +43,21 @@
void *ptr = malloc((size_t)size);
if (!ptr)
PANIC("Out of mem");
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Allocated %i at %p\n", size, ptr);
+#endif
+ return ptr;
+}
+
+void *
+mem__internal_allocate(size_t size, char *file, int line)
+{
+ void *ptr = malloc((size_t)size);
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Internal malloc %i at %p (%s/%d)\n", size, ptr, file, line);
+#endif
+ if (!ptr)
+ PANIC("Out of mem");
return ptr;
}
@@ -63,6 +78,21 @@
void *ptr = calloc(1, (size_t)size);
if (!ptr)
PANIC("Out of mem");
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Allocated %i at %p\n", size, ptr);
+#endif
+ return ptr;
+}
+
+void *
+mem__internal_allocate_zeroed(size_t size, char *file, int line)
+{
+ void *ptr = calloc(1, (size_t)size);
+ if (!ptr)
+ PANIC("Out of mem");
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Internal malloc %i at %p (%s/%d)\n", size, ptr, file, line);
+#endif
return ptr;
}
@@ -78,11 +108,31 @@
*/
void *
-mem_sys_realloc(void *from, size_t size)
+mem__sys_realloc(void *from, size_t size)
+{
+ void *ptr;
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Freed %p (realloc -- %i bytes)\n", from, size);
+#endif
+ ptr = realloc(from, size);
+ if (!ptr)
+ PANIC("Out of mem");
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Allocated %i at %p\n", size, ptr);
+#endif
+ return ptr;
+}
+
+void *
+mem__internal_realloc(void *from, size_t size, char *file, int line)
{
void *ptr = realloc(from, size);
if (!ptr)
PANIC("Out of mem");
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("internal free of %p (realloc -- %i bytes) (%s/%d)\n", from, size, file,
line);
+ printf("Internal malloc %i at %p (%s/%d)\n", size, ptr, file, line);
+#endif
return ptr;
}
#undef interpreter
@@ -101,6 +151,18 @@
void
mem_sys_free(void *from)
{
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Freed %p\n", from);
+#endif
+ free(from);
+}
+
+void
+mem__internal_free(void *from, char *file, int line)
+{
+#ifdef DETAIL_MEMORY_DEBUG
+ printf("Internal free of %p (%s/%d)\n", from, file, line);
+#endif
free(from);
}
1.43 +9 -4 parrot/src/mmd.c
Index: mmd.c
===================================================================
RCS file: /cvs/public/parrot/src/mmd.c,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -w -r1.42 -r1.43
--- mmd.c 23 Jul 2004 16:25:50 -0000 1.42
+++ mmd.c 8 Sep 2004 00:33:58 -0000 1.43
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: mmd.c,v 1.42 2004/07/23 16:25:50 leo Exp $
+$Id: mmd.c,v 1.43 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -353,9 +353,14 @@
{
INTVAL i;
if (func_nr >= (INTVAL)interpreter->n_binop_mmd_funcs) {
- interpreter->binop_mmd_funcs = mem_sys_realloc(
- interpreter->binop_mmd_funcs,
+ if (interpreter->binop_mmd_funcs) {
+ interpreter->binop_mmd_funcs =
+ mem_sys_realloc(interpreter->binop_mmd_funcs,
(func_nr + 1) * sizeof(MMD_table));
+ } else {
+ interpreter->binop_mmd_funcs =
+ mem_sys_allocate((func_nr + 1) * sizeof(MMD_table));
+ }
for (i = interpreter->n_binop_mmd_funcs; i <= func_nr; ++i) {
MMD_table *table = interpreter->binop_mmd_funcs + i;
1.116 +7 -3 parrot/src/objects.c
Index: objects.c
===================================================================
RCS file: /cvs/public/parrot/src/objects.c,v
retrieving revision 1.115
retrieving revision 1.116
diff -u -w -r1.115 -r1.116
--- objects.c 19 Aug 2004 13:46:14 -0000 1.115
+++ objects.c 8 Sep 2004 00:33:58 -0000 1.116
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: objects.c,v 1.115 2004/08/19 13:46:14 leo Exp $
+$Id: objects.c,v 1.116 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -1136,8 +1136,12 @@
if (store_it) {
UINTVAL i;
if (type >= mc->mc_size) {
+ if (mc->idx) {
mc->idx = mem_sys_realloc(mc->idx,
sizeof(UINTVAL*) * (type + 1));
+ } else {
+ mc->idx = mem_sys_allocate(sizeof(UINTVAL*) * (type + 1));
+ }
for (i = mc->mc_size; i <= type; ++i)
mc->idx[i] = NULL;
mc->mc_size = type + 1;
1.172 +24 -8 parrot/src/packfile.c
Index: packfile.c
===================================================================
RCS file: /cvs/public/parrot/src/packfile.c,v
retrieving revision 1.171
retrieving revision 1.172
diff -u -w -r1.171 -r1.172
--- packfile.c 22 Aug 2004 09:00:18 -0000 1.171
+++ packfile.c 8 Sep 2004 00:33:58 -0000 1.172
@@ -2,7 +2,7 @@
Copyright (C) 2001-2002 Gregor N. Purdy. All rights reserved.
This program is free software. It is subject to the same license as
Parrot itself.
-$Id: packfile.c,v 1.171 2004/08/22 09:00:18 leo Exp $
+$Id: packfile.c,v 1.172 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -719,8 +719,13 @@
struct PackFile_Segment *seg)
{
- dir->segments = mem_sys_realloc (dir->segments,
+ if (dir->segments) {
+ dir->segments =
+ mem_sys_realloc(dir->segments,
sizeof (struct PackFile_Segment *) * (dir->num_segments+1));
+ } else {
+ dir->segments = mem_sys_allocate(sizeof (struct PackFile_Segment *) *
(dir->num_segments+1));
+ }
dir->segments[dir->num_segments] = seg;
dir->num_segments++;
seg->dir = dir;
@@ -1361,8 +1366,14 @@
opcode_t *pos;
dir->num_segments = PF_fetch_opcode (pf, &cursor);
- dir->segments = mem_sys_realloc (dir->segments,
+ if (dir->segments) {
+ dir->segments =
+ mem_sys_realloc (dir->segments,
sizeof(struct PackFile_Segment *) * dir->num_segments);
+ } else {
+ dir->segments =
+ mem_sys_allocate(sizeof(struct PackFile_Segment *) * dir->num_segments);
+ }
for (i=0; i < dir->num_segments; i++) {
struct PackFile_Segment *seg;
@@ -2320,9 +2331,14 @@
}
i = self->fixup_count;
self->fixup_count++;
+ if (self->fixups) {
self->fixups =
mem_sys_realloc(self->fixups, self->fixup_count *
sizeof(struct PackFile_FixupEntry *));
+ } else {
+ self->fixups =
+ mem_sys_allocate(sizeof(struct PackFile_FixupEntry *));
+ }
self->fixups[i] = mem_sys_allocate(sizeof(struct PackFile_FixupEntry));
self->fixups[i]->type = type;
self->fixups[i]->name = mem_sys_allocate(strlen(label) + 1);
1.88 +2 -2 parrot/src/pmc.c
Index: pmc.c
===================================================================
RCS file: /cvs/public/parrot/src/pmc.c,v
retrieving revision 1.87
retrieving revision 1.88
diff -u -w -r1.87 -r1.88
--- pmc.c 15 Aug 2004 04:39:23 -0000 1.87
+++ pmc.c 8 Sep 2004 00:33:58 -0000 1.88
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: pmc.c,v 1.87 2004/08/15 04:39:23 chromatic Exp $
+$Id: pmc.c,v 1.88 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -460,7 +460,7 @@
if (pos >= (INTVAL)string_length(interpreter, vtable->isa_str))
break;
len = string_str_index(interpreter, vtable->isa_str,
- const_string(interpreter, " "), pos);
+ string_from_const_cstring(interpreter, " ", 1), pos);
if (len == -1)
break;
class_name = string_substr(interpreter, vtable->isa_str, pos,
1.130 +6 -6 parrot/src/resources.c
Index: resources.c
===================================================================
RCS file: /cvs/public/parrot/src/resources.c,v
retrieving revision 1.129
retrieving revision 1.130
diff -u -w -r1.129 -r1.130
--- resources.c 21 Aug 2004 11:08:25 -0000 1.129
+++ resources.c 8 Sep 2004 00:33:58 -0000 1.130
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: resources.c,v 1.129 2004/08/21 11:08:25 leo Exp $
+$Id: resources.c,v 1.130 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -55,7 +55,7 @@
/* Allocate a new block. Header info's on the front, plus a fudge factor
* for good measure */
- new_block = mem_sys_allocate_zeroed(sizeof(struct Memory_Block) +
+ new_block = mem_internal_allocate_zeroed(sizeof(struct Memory_Block) +
alloc_size + 32);
if (!new_block) {
fprintf(stderr, "out of mem allocsize = %d\n", (int)alloc_size+32);
@@ -393,7 +393,7 @@
arena_base->memory_allocated -= cur_block->size;
/* We know the pool body and pool header are a single chunk, so
* this is enough to get rid of 'em both */
- mem_sys_free(cur_block);
+ mem_internal_free(cur_block);
cur_block = next_block;
}
@@ -679,7 +679,7 @@
{
struct Memory_Pool *pool;
- pool = mem_sys_allocate(sizeof(struct Memory_Pool));
+ pool = mem_internal_allocate(sizeof(struct Memory_Pool));
if (pool) {
pool->top_block = NULL;
pool->compact = compact;
@@ -748,11 +748,11 @@
cur_block = pool->top_block;
while (cur_block) {
next_block = cur_block->prev;
- mem_sys_free(cur_block);
+ mem_internal_free(cur_block);
cur_block = next_block;
}
- mem_sys_free(pool);
+ mem_internal_free(pool);
}
}
1.52 +6 -6 parrot/src/smallobject.c
Index: smallobject.c
===================================================================
RCS file: /cvs/public/parrot/src/smallobject.c,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -w -r1.51 -r1.52
--- smallobject.c 7 Sep 2004 12:18:26 -0000 1.51
+++ smallobject.c 8 Sep 2004 00:33:58 -0000 1.52
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: smallobject.c,v 1.51 2004/09/07 12:18:26 leo Exp $
+$Id: smallobject.c,v 1.52 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -386,7 +386,7 @@
*/
memset(new_arena->start_objects, 0xff, size); /* simulate dirty */
#endif
- new_arena->dod_flags = mem_sys_allocate(ARENA_FLAG_SIZE(pool));
+ new_arena->dod_flags = mem_internal_allocate(ARENA_FLAG_SIZE(pool));
new_arena->pool = pool;
/* not the first one - put all on free list */
@@ -418,12 +418,12 @@
UINTVAL start, end;
/* Setup memory for the new objects */
- new_arena = mem_sys_allocate(sizeof(struct Small_Object_Arena));
+ new_arena = mem_internal_allocate(sizeof(struct Small_Object_Arena));
if (!new_arena)
PANIC("Out of arena memory");
size = pool->object_size * pool->objects_per_alloc;
- /* could be mem_sys_allocate too, but calloc is fast */
- new_arena->start_objects = mem_sys_allocate_zeroed(size);
+ /* could be mem_internal_allocate too, but calloc is fast */
+ new_arena->start_objects = mem_internal_allocate_zeroed(size);
Parrot_append_arena_in_pool(interpreter, pool, new_arena, size);
@@ -471,7 +471,7 @@
{
struct Small_Object_Pool *pool;
- pool = mem_sys_allocate_zeroed(sizeof(struct Small_Object_Pool));
+ pool = mem_internal_allocate_zeroed(sizeof(struct Small_Object_Pool));
SET_NULL(pool->last_Arena);
SET_NULL(pool->free_list);
SET_NULL(pool->mem_pool);
1.219 +24 -2 parrot/src/string.c
Index: string.c
===================================================================
RCS file: /cvs/public/parrot/src/string.c,v
retrieving revision 1.218
retrieving revision 1.219
diff -u -w -r1.218 -r1.219
--- string.c 16 Aug 2004 09:13:01 -0000 1.218
+++ string.c 8 Sep 2004 00:33:58 -0000 1.219
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: string.c,v 1.218 2004/08/16 09:13:01 jhi Exp $
+$Id: string.c,v 1.219 2004/09/08 00:33:58 dan Exp $
=head1 NAME
@@ -631,6 +631,28 @@
/*
+=item C<
+STRING *
+string_from_const_cstring(Interp *interpreter,
+ const void *buffer, UINTVAL len)>
+
+Make a Parrot string from a specified C string.
+
+=cut
+
+*/
+
+STRING *
+string_from_const_cstring(Interp *interpreter,
+ const void *buffer, UINTVAL len)
+{
+ return string_make(interpreter, buffer, len ? len :
+ buffer ? strlen(buffer) : 0,
+ "iso-8859-1", PObj_external_FLAG); /* make this utf-8
eventually? */
+}
+
+/*
+
=item C<const char*
string_primary_encoding_for_representation(Interp *interpreter,
parrot_string_representation_t representation)>
@@ -2765,7 +2787,7 @@
void
string_cstring_free(void *ptr) {
- free(ptr);
+ mem_sys_free(ptr);
}
/*
1.15 +4 -2 parrot/src/utils.c
Index: utils.c
===================================================================
RCS file: /cvs/public/parrot/src/utils.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -w -r1.14 -r1.15
--- utils.c 22 Aug 2004 09:00:47 -0000 1.14
+++ utils.c 8 Sep 2004 00:34:00 -0000 1.15
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: utils.c,v 1.14 2004/08/22 09:00:47 leo Exp $
+$Id: utils.c,v 1.15 2004/09/08 00:34:00 dan Exp $
=head1 NAME
@@ -518,7 +518,7 @@
*/
out_array = mem_sys_allocate((sizeof(long)) * (arraylen + 1));
out_array[arraylen] = 0;
-
+ // printf("Long array has %i elements\n", arraylen);
for (cur = 0; cur < arraylen; cur++) {
out_array[cur] = VTABLE_get_integer_keyed_int(interpreter, array, cur);
}
@@ -571,8 +571,10 @@
out_array = mem_sys_allocate((sizeof(char *)) * (arraylen + 1));
out_array[arraylen] = 0;
+ // printf("String array has %i elements\n", arraylen);
for (cur = 0; cur < arraylen; cur++) {
out_array[cur] = string_to_cstring(interpreter,
VTABLE_get_string_keyed_int(interpreter, array, cur));
+ // printf("Offset %i is %s\n", cur, out_array[cur]);
}
return out_array;
