Date: Fri, 23 Nov 2001 20:16:27 -0500 From: The Anarcat <anarcat@anarcat.dyndns.org> To: Libh <freebsd-libh@freebsd.org> Subject: memory management in libh Message-ID: <20011124011627.GC27297@shall.anarcat.dyndns.org>
next in thread | raw e-mail | index | archive | help
--xo44VMWPx7vlQ2+2
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable
Ok. I just discovered that you could and probably must free structures
created throught the libh language interface.
The problem is that I ran some tests here, and it doesn't seem to be
making any effect whatsoever. :)
The included patch frees some global structures at appropriate times,
that is, when they are initialized and when the editor is closed.
However, it doesn't seem to have an effect, on the contrary:
# original version
anarcat@shall[~/libh]% ps l | egrep 'UID|tcl[h]'
UID PID PPID CPU PRI NI VSZ RSS WCHAN STAT TT TIME COMMAND
1000 27625 27273 3 2 0 8780 5012 select S+ p2 0:00.39 tclh.sta=
tic disk.tcl
anarcat@shall[~/libh]% ps l | egrep 'UID|tcl[h]'
UID PID PPID CPU PRI NI VSZ RSS WCHAN STAT TT TIME COMMAND
1000 27625 27273 6 2 0 9040 5288 select S+ p2 0:00.73 tclh.sta=
tic disk.tcl
anarcat@shall[~/libh]% ps l | egrep 'UID|tcl[h]'
UID PID PPID CPU PRI NI VSZ RSS WCHAN STAT TT TIME COMMAND
1000 27625 27273 2 2 0 9108 5340 select S+ p2 0:00.77 tclh.sta=
tic disk.tcl
anarcat@shall[~/libh]% # ok now let's see the new version
anarcat@shall[~/libh]% ps l | egrep 'UID|tcl[h]'
UID PID PPID CPU PRI NI VSZ RSS WCHAN STAT TT TIME COMMAND
1000 27636 27273 0 2 0 8776 5008 select S+ p2 0:00.36 tclh.sta=
tic disk.tcl
anarcat@shall[~/libh]% ps l | egrep 'UID|tcl[h]'
UID PID PPID CPU PRI NI VSZ RSS WCHAN STAT TT TIME COMMAND
1000 27636 27273 13 2 0 9036 5284 select S+ p2 0:00.69 tclh.sta=
tic disk.tcl
anarcat@shall[~/libh]% ps l | egrep 'UID|tcl[h]'
UID PID PPID CPU PRI NI VSZ RSS WCHAN STAT TT TIME COMMAND
1000 27636 27273 2 2 0 9104 5336 select S+ p2 0:00.73 tclh.sta=
tic disk.tcl
the 3 runs for each are before, while and after the window is open. We
see that on the second run, we have 4 bytes less in memory. However, the
lovely thing is that it *starts* with 4 bytes less! So I guess it
doesn't change anything.
I don't understand. I don't even know if it's worth working on that at
all.
And what's more, what to do about things that are *not* dialogs and that
allow memory? For example, windows are displayed without keeping the
control flow, so there is no clear way of cleaning the memory allowed
in there apart from the "close callback" which is usually a generic=20
proc button_click_result {$hui button result} {
return $result
}
I am now even more puzzle as of how to deal with libh objects in TCL.
Please help.
A.
Index: disklabel.tcl
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
RCS file: /home/libh/cvs/libh/release/diskedit/disklabel.tcl,v
retrieving revision 1.29
diff -u -r1.29 disklabel.tcl
--- disklabel.tcl 2001/11/09 19:47:49 1.29
+++ disklabel.tcl 2001/11/24 01:02:33
@@ -17,6 +17,20 @@
source dialogs.tcl
source formats.tcl
=20
+proc free_list {list} {
+
+ lmap $list "H::delete"
+
+}
+
+proc lmap {list procname} {
+
+ set max [llength $list]
+ for {set i 1} {$i <=3D $max} {incr i} {
+ $procname [lindex list $i]
+ }
+}
+
# walk a chunk architecture, exectuting proc on each chunk
# XXX: this does not belong here, but more to lib/disk/
# the procedure is called with the chunk arg and a "level"
@@ -78,7 +92,14 @@
global parts_list
global part_to_disk_list
=20
+ if [info exists parts_list] {
+ free_list $parts_list
+ }
set parts_list [list]
+ =20
+ if [info exists parts_to_disk_list] {
+ free_list $part_to_disk_list
+ }
set part_to_disk_list [list]
foreach disk $disk_list {
set current_disk $disk
@@ -141,7 +162,9 @@
global disk_list
=20
# clear the list
- # XXX: do we have to free each node????
+ if [info exists disk_list] {
+ free_list $disk_list
+ }
set disk_list [list]
=20
# refill everything
@@ -180,23 +203,23 @@
set but_cont [$disk_window container "but_cont" "0 0" "horizontal"]
=20
set m_buts [$but_cont container "m_buts" "0 0" "vertical"]
- $m_buts button "newfs_t_but" "&Newfs Toggle" {parts_callback NEWFS}
- $m_buts button "boot_but" "Toggle &Bootable" {parts_callback BOOT}
+ set b1 [$m_buts button "newfs_t_but" "&Newfs Toggle"
{parts_callback NEWFS}]
+ set b2 [$m_buts button "boot_but" "Toggle &Bootable"
{parts_callback BOOT}]
# change type? that's a weird idea
# let's just assume the user will delete + add instead
# in order to have a "change type" button, we'll have to have a=20
# "replace" button and/or function and use it to implement this
# $m_buts button "type_but" "Change &Type" {parts_callback TYPE}
- $m_buts button "units_but" "Cycle Si&ze Units ($size_units)"
{cycle_units_callback ""}
- $m_buts button "undo_but" "&Undo changes" {parts_callback UNDO}
+ set b3 [$m_buts button "units_but" "Cycle Si&ze Units
($size_units)" {cycle_units_callback ""}]
+ set b4 [$m_buts button "undo_but" "&Undo changes" {parts_callback
UNDO}]
=20
set r_buts [$but_cont container "r_buts" "0 0" "vertical"]
- $r_buts button "add_but" "&Add" {parts_callback ADD}
+ set b5 [$r_buts button "add_but" "&Add" {parts_callback ADD}]
# we postpone this implementation until after primary impl
# (add/del)
# $r_buts button "res_but" "&Resize" {parts_callback RESIZE}
- $r_buts button "del_but" "&Delete" {parts_callback DELETE}
- $r_buts button "edit_but" "&Edit" {parts_callback EDIT}
- $r_buts button "write_but" "Write Changes" {parts_callback WRITE}
+ set b6 [$r_buts button "del_but" "&Delete" {parts_callback DELETE}]
+ set b7 [$r_buts button "edit_but" "&Edit" {parts_callback EDIT}]
+ set b8 [$r_buts button "write_but" "Write Changes" {parts_callback
WRITE}]
=20
set b [$disk_window button "qbutton" "&Close" {parts_callback QUIT}
"default"]
$b resize "3 -1"
@@ -207,6 +230,14 @@
=20
$disk_window exec
=20
+ # free memory
+ global disk_list parts_list part_to_disk_list
+ free_list $disk_list
+ free_list $parts_list
+ free_list $part_to_disk_list
+ free_list {$parts $disk_window $but_cont $m_buts $r_buts $b}
+ free_list {$b1 $b2 $b3 $b4 $b5 $b6 $b7 $b8}
+ =20
}
=20
#
--xo44VMWPx7vlQ2+2
Content-Type: application/pgp-signature
Content-Disposition: inline
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.0.6 (FreeBSD)
Comment: For info see http://www.gnupg.org
iEYEARECAAYFAjv+9OoACgkQttcWHAnWiGc4JQCcDXOxUU4uaGLQOoxvHJ4eqIrm
0VUAnj4T6ZXf+k+XGRRlprdMOSayM9mt
=8OBy
-----END PGP SIGNATURE-----
--xo44VMWPx7vlQ2+2--
To Unsubscribe: send mail to majordomo@FreeBSD.org
with "unsubscribe freebsd-libh" in the body of the message
Want to link to this message? Use this URL: <https://mail-archive.FreeBSD.org/cgi/mid.cgi?20011124011627.GC27297>