Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Tobias Decking
GHC
Commits
1dfac5c8
Commit
1dfac5c8
authored
Mar 02, 2006
by
lennart.augustsson@credit-suisse.com
Browse files
Free all memory when shutting down. XXX not implemented for Posix.
parent
c9b3d15f
Changes
3
Hide whitespace changes
Inline
Side-by-side
ghc/rts/MBlock.c
View file @
1dfac5c8
...
...
@@ -299,6 +299,12 @@ getMBlocks(nat n)
return
ret
;
}
void
freeAllMBlocks
(
void
)
{
/* XXX Do something here */
}
#else
/* defined(mingw32_HOST_OS) || defined(cygwin32_HOST_OS) */
/*
...
...
@@ -316,8 +322,10 @@ getMBlocks(nat n)
our case).
*/
char
*
base_non_committed
=
(
char
*
)
0
;
char
*
end_non_committed
=
(
char
*
)
0
;
static
char
*
base_non_committed
=
(
char
*
)
0
;
static
char
*
end_non_committed
=
(
char
*
)
0
;
static
void
*
membase
;
/* Default is to reserve 256M of VM to minimise the slop cost. */
#define SIZE_RESERVED_POOL ( 256 * 1024 * 1024 )
...
...
@@ -356,9 +364,10 @@ getMBlocks(nat n)
,
MEM_RESERVE
,
PAGE_READWRITE
);
membase
=
base_non_committed
;
if
(
base_non_committed
==
0
)
{
errorBelch
(
"getMBlocks: VirtualAlloc failed with: %ld
\n
"
,
GetLastError
());
ret
=
(
void
*
)
-
1
;
errorBelch
(
"getMBlocks: VirtualAlloc
MEM_RESERVE %lu
failed with: %ld
\n
"
,
size_reserved_pool
,
GetLastError
());
ret
=
(
void
*
)
-
1
;
}
else
{
end_non_committed
=
(
char
*
)
base_non_committed
+
(
unsigned
long
)
size_reserved_pool
;
/* The returned pointer is not aligned on a mega-block boundary. Make it. */
...
...
@@ -380,7 +389,7 @@ getMBlocks(nat n)
if
(
ret
!=
(
void
*
)
-
1
)
{
ret
=
VirtualAlloc
(
next_request
,
size
,
MEM_COMMIT
,
PAGE_READWRITE
);
if
(
ret
==
NULL
)
{
debugBelch
(
"getMBlocks: VirtualAlloc failed with: %ld
\n
"
,
GetLastError
());
debugBelch
(
"getMBlocks: VirtualAlloc
MEM_COMMIT %lu
failed with: %ld
\n
"
,
size
,
GetLastError
());
ret
=
(
void
*
)
-
1
;
}
}
...
...
@@ -406,6 +415,18 @@ getMBlocks(nat n)
return
ret
;
}
void
freeAllMBlocks
(
void
)
{
BOOL
rc
;
rc
=
VirtualFree
(
membase
,
0
,
MEM_RELEASE
);
if
(
rc
==
FALSE
)
{
debugBelch
(
"freeAllMBlocks: VirtualFree failed with: %ld
\n
"
,
GetLastError
());
}
}
/* Hand back the physical memory that is allocated to a mega-block.
ToDo: chain the released mega block onto some list so that
getMBlocks() can get at it.
...
...
ghc/rts/MBlock.h
View file @
1dfac5c8
...
...
@@ -13,6 +13,7 @@ extern lnat RTS_VAR(mblocks_allocated);
extern
void
*
getMBlock
(
void
);
extern
void
*
getMBlocks
(
nat
n
);
extern
void
freeAllMBlocks
(
void
);
#if osf3_HOST_OS
/* ToDo: Perhaps by adjusting this value we can make linking without
...
...
ghc/rts/Storage.c
View file @
1dfac5c8
...
...
@@ -266,6 +266,7 @@ void
exitStorage
(
void
)
{
stat_exit
(
calcAllocated
());
freeAllMBlocks
();
}
/* -----------------------------------------------------------------------------
...
...
Write
Preview
Supports
Markdown
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment