share/scripts/_save_debuggable.tcl at main · doomsdayone/openmsx

◆ main openmsx / share / scripts / _save_debuggable.tcl

6.4 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw

namespace eval save_debuggable {

set_help_text save_debuggable \
{Save (part of) a debuggable to file. Examples of debuggables are memory, VRAM, ...
Use 'debug list' to get a complete list of all debuggables.

Usage:
  save_debuggable VRAM vram.raw    Save the content of the MSX VRAM to a file
                                   called 'vram.raw'
  save_debuggable memory mem.sav 0x4000 0x8000
                                   Save the 32 kB content of the memory debuggable
                                   starting from 0x4000 to a file called 'mem.sav'
}
proc save_debuggable {debuggable filename {start 0} {size 0}} {
	if {$size == 0} { set size [expr {[debug size $debuggable] - $start}] }
	set data [debug read_block $debuggable $start $size]
	set file [open $filename "WRONLY CREAT TRUNC"]
	fconfigure $file -translation binary -buffersize $size
	puts -nonewline $file $data
	close $file
}

set_help_text load_debuggable \
{Load a raw data file (somewhere) into a certain debuggable (see also save_debuggable).
Note that saving and reloading the same data again does not always bring the
MSX in the same state (e.g. the subslotregister). Use 'savestate' and 'loadstate'
if you want that.
}
proc load_debuggable {debuggable filename {start 0}} {
	set size [file size $filename]
	set file [open $filename "RDONLY"]
	fconfigure $file -translation binary -buffersize $size
	set data [read $file]
	close $file
	debug write_block $debuggable $start $data
}

set_tabcompletion_proc save_debuggable [namespace code tab_loadsave_debuggable]
set_tabcompletion_proc load_debuggable [namespace code tab_loadsave_debuggable]
proc tab_loadsave_debuggable {args} {
	if {[llength $args] == 2} {
		return [debug list]
	}
	if {[llength $args] == 3} {
		return [utils::file_completion {*}$args]
	}
}

# TODO remove these two procs?
#  They were meant as a very quick-and-dirty savestate mechanism, but it
#  doesn't work (e.g. because of subslot register)
proc save_all {directory} {
	puts stderr "This command ('save_all') has been deprecated (and may be removed in a future release). In contrast to what you might think, it cannot be used to save the machine state. You probably just want to use 'save_state' instead!"
	foreach debuggable [debug list] {
		save_debuggable $debuggable ${directory}/${debuggable}.sav
	}
}
proc load_all {directory} {
	puts stderr "This command ('load_all') has been deprecated (and may be removed in a future release). In contrast to what you might think, it cannot be used to load the machine state. You probably just want to use 'load_state' instead!"
	foreach debuggable [debug list] {
		load_debuggable $debuggable ${directory}/${debuggable}.sav
	}
}

# for backwards compatibility
proc vramdump {{filename "vramdump"}} {
	#puts stderr "This command ('vramdump') has been deprecated (and may be removed in a future release), please use 'save_debuggable VRAM' instead!"
	# I prefer to keep this command as a convenience shortcut
	save_debuggable "VRAM" $filename
}

set_help_text vram2bmp \
{Dump a selected region of the video memory into a bitmap file.

vram filename filename [start address] [width] [length]

usage example: vram2bmp RawDataDump.bmp 0 256 1024
}

proc vram2bmp {filename start dx dy} {
	set file [open $filename "WRONLY CREAT TRUNC"]
	set data_len [expr {$dx * $dy / 2}]
	set file_len [expr {$data_len + 0x76}]
	set file_len_HI [expr {$file_len / 0x100}]
	set dx_HI [expr {$dx / 0x100}]
	set dy_HI [expr {$dy / 0x100}]
	set data_len_HI [expr {$data_len / 0x100}]
	fconfigure $file -translation binary -buffersize $file_len

	puts -nonewline $file "\x42\x4d"                ;# BMP FILE identificator
	puts -nonewline $file [format %c $file_len]     ;# <-File length
	puts -nonewline $file [format %c $file_len_HI]  ;# <-File length
	puts -nonewline $file "\x00\x00"                ;# last always always zero because maximim file length is 128KB + header length
	puts -nonewline $file "\x00\x00\x00\x00"        ;# unused
	puts -nonewline $file "\x76\x00\x00\x00"        ;# offset to bitmap data - always same for 16 colors bmp
	puts -nonewline $file "\x28\x00\x00\x00"        ;# number of bytes in the header
	puts -nonewline $file [format %c $dx]           ;# bitmap width
	puts -nonewline $file [format %c $dx_HI]        ;# bitmap width
	puts -nonewline $file "\x00\x00"                ;# bitmap width - unused because maximum width is 256
	puts -nonewline $file [format %c $dy]           ;# bitmap height
	puts -nonewline $file [format %c $dy_HI]        ;# bitmap height
	puts -nonewline $file "\x00\x00"                ;# bitmap height, if negative image will look normal in mspaint
	puts -nonewline $file "\x01\x00"                ;# 1 plane used
	puts -nonewline $file "\x04\x00"                ;# 4 bits per pixel
	puts -nonewline $file "\x00\x00\x00\x00"        ;# no compression used
	puts -nonewline $file [format %c $data_len]     ;# RAW image data length
	puts -nonewline $file [format %c $data_len_HI]  ;# RAW image data length
	puts -nonewline $file "\x00\x00"                ;# RAW image data length - always zero, because maximum length is 128KB
	puts -nonewline $file "\x00\x00\x00\x00"
	puts -nonewline $file "\x00\x00\x00\x00"
	puts -nonewline $file "\x00\x00\x00\x00"        ;#how many colors used
	puts -nonewline $file "\x00\x00\x00\x00"        ;#important colors

	#set colors (16 colors [0..15])
	for {set col 0} {$col < 16} {incr col} {
		set color [getcolor $col]
		puts -nonewline $file [format %c [expr {[string index $color 2] * 255 / 7}]]
		puts -nonewline $file [format %c [expr {[string index $color 1] * 255 / 7}]]
		puts -nonewline $file [format %c [expr {[string index $color 0] * 255 / 7}]]
		puts -nonewline $file "\x00"
	}

	set cur_addr $start
	for {set i 0} {$i < $dy} {incr i} {
		for {set addr $cur_addr} {$addr < ($cur_addr + $dx / 2)} {incr addr} {
			puts -nonewline $file [format %c [vpeek $addr]]
		}
		set cur_addr [expr {$cur_addr + 0x80}]
	}
	close $file
}

set_help_text save_to_file \
{Helper proc to easily write something to a file.
Typically used in combination with another proc. For example:
  save_to_file my_data.hex [showmem 0x8000 20]
}
proc save_to_file {filename data} {
	set file [open $filename "WRONLY CREAT TRUNC"]
	fconfigure $file -translation binary
	puts -nonewline $file $data
	close $file
}

namespace export save_debuggable
namespace export load_debuggable
namespace export save_all
namespace export load_all
namespace export vramdump
namespace export vram2bmp
namespace export save_to_file

} ;# namespace save_debuggable

namespace import save_debuggable::*

`/`	Search
`g` `c`	Code
`g` `h`	History
`g` `b`	Bookmarks
`g` `t`	Trust
`y`	Permalink to this state (files and trees)
`?`	This sheet

1	namespace eval save_debuggable {
2
3	set_help_text save_debuggable \
4	{Save (part of) a debuggable to file. Examples of debuggables are memory, VRAM, ...
5	Use 'debug list' to get a complete list of all debuggables.
6
7	Usage:
8	save_debuggable VRAM vram.raw Save the content of the MSX VRAM to a file
9	called 'vram.raw'
10	save_debuggable memory mem.sav 0x4000 0x8000
11	Save the 32 kB content of the memory debuggable
12	starting from 0x4000 to a file called 'mem.sav'
13	}
14	proc save_debuggable {debuggable filename {start 0} {size 0}} {
15	if {$size == 0} { set size [expr {[debug size $debuggable] - $start}] }
16	set data [debug read_block $debuggable $start $size]
17	set file [open $filename "WRONLY CREAT TRUNC"]
18	fconfigure $file -translation binary -buffersize $size
19	puts -nonewline $file $data
20	close $file
21	}
22
23	set_help_text load_debuggable \
24	{Load a raw data file (somewhere) into a certain debuggable (see also save_debuggable).
25	Note that saving and reloading the same data again does not always bring the
26	MSX in the same state (e.g. the subslotregister). Use 'savestate' and 'loadstate'
27	if you want that.
28	}
29	proc load_debuggable {debuggable filename {start 0}} {
30	set size [file size $filename]
31	set file [open $filename "RDONLY"]
32	fconfigure $file -translation binary -buffersize $size
33	set data [read $file]
34	close $file
35	debug write_block $debuggable $start $data
36	}
37
38	set_tabcompletion_proc save_debuggable [namespace code tab_loadsave_debuggable]
39	set_tabcompletion_proc load_debuggable [namespace code tab_loadsave_debuggable]
40	proc tab_loadsave_debuggable {args} {
41	if {[llength $args] == 2} {
42	return [debug list]
43	}
44	if {[llength $args] == 3} {
45	return [utils::file_completion {*}$args]
46	}
47	}
48
49	# TODO remove these two procs?
50	# They were meant as a very quick-and-dirty savestate mechanism, but it
51	# doesn't work (e.g. because of subslot register)
52	proc save_all {directory} {
53	puts stderr "This command ('save_all') has been deprecated (and may be removed in a future release). In contrast to what you might think, it cannot be used to save the machine state. You probably just want to use 'save_state' instead!"
54	foreach debuggable [debug list] {
55	save_debuggable $debuggable ${directory}/${debuggable}.sav
56	}
57	}
58	proc load_all {directory} {
59	puts stderr "This command ('load_all') has been deprecated (and may be removed in a future release). In contrast to what you might think, it cannot be used to load the machine state. You probably just want to use 'load_state' instead!"
60	foreach debuggable [debug list] {
61	load_debuggable $debuggable ${directory}/${debuggable}.sav
62	}
63	}
64
65	# for backwards compatibility
66	proc vramdump {{filename "vramdump"}} {
67	#puts stderr "This command ('vramdump') has been deprecated (and may be removed in a future release), please use 'save_debuggable VRAM' instead!"
68	# I prefer to keep this command as a convenience shortcut
69	save_debuggable "VRAM" $filename
70	}
71
72	set_help_text vram2bmp \
73	{Dump a selected region of the video memory into a bitmap file.
74
75	vram filename filename [start address] [width] [length]
76
77	usage example: vram2bmp RawDataDump.bmp 0 256 1024
78	}
79
80	proc vram2bmp {filename start dx dy} {
81	set file [open $filename "WRONLY CREAT TRUNC"]
82	set data_len [expr {$dx * $dy / 2}]
83	set file_len [expr {$data_len + 0x76}]
84	set file_len_HI [expr {$file_len / 0x100}]
85	set dx_HI [expr {$dx / 0x100}]
86	set dy_HI [expr {$dy / 0x100}]
87	set data_len_HI [expr {$data_len / 0x100}]
88	fconfigure $file -translation binary -buffersize $file_len
89
90	puts -nonewline $file "\x42\x4d" ;# BMP FILE identificator
91	puts -nonewline $file [format %c $file_len] ;# <-File length
92	puts -nonewline $file [format %c $file_len_HI] ;# <-File length
93	puts -nonewline $file "\x00\x00" ;# last always always zero because maximim file length is 128KB + header length
94	puts -nonewline $file "\x00\x00\x00\x00" ;# unused
95	puts -nonewline $file "\x76\x00\x00\x00" ;# offset to bitmap data - always same for 16 colors bmp
96	puts -nonewline $file "\x28\x00\x00\x00" ;# number of bytes in the header
97	puts -nonewline $file [format %c $dx] ;# bitmap width
98	puts -nonewline $file [format %c $dx_HI] ;# bitmap width
99	puts -nonewline $file "\x00\x00" ;# bitmap width - unused because maximum width is 256
100	puts -nonewline $file [format %c $dy] ;# bitmap height
101	puts -nonewline $file [format %c $dy_HI] ;# bitmap height
102	puts -nonewline $file "\x00\x00" ;# bitmap height, if negative image will look normal in mspaint
103	puts -nonewline $file "\x01\x00" ;# 1 plane used
104	puts -nonewline $file "\x04\x00" ;# 4 bits per pixel
105	puts -nonewline $file "\x00\x00\x00\x00" ;# no compression used
106	puts -nonewline $file [format %c $data_len] ;# RAW image data length
107	puts -nonewline $file [format %c $data_len_HI] ;# RAW image data length
108	puts -nonewline $file "\x00\x00" ;# RAW image data length - always zero, because maximum length is 128KB
109	puts -nonewline $file "\x00\x00\x00\x00"
110	puts -nonewline $file "\x00\x00\x00\x00"
111	puts -nonewline $file "\x00\x00\x00\x00" ;#how many colors used
112	puts -nonewline $file "\x00\x00\x00\x00" ;#important colors
113
114	#set colors (16 colors [0..15])
115	for {set col 0} {$col < 16} {incr col} {
116	set color [getcolor $col]
117	puts -nonewline $file [format %c [expr {[string index $color 2] * 255 / 7}]]
118	puts -nonewline $file [format %c [expr {[string index $color 1] * 255 / 7}]]
119	puts -nonewline $file [format %c [expr {[string index $color 0] * 255 / 7}]]
120	puts -nonewline $file "\x00"
121	}
122
123	set cur_addr $start
124	for {set i 0} {$i < $dy} {incr i} {
125	for {set addr $cur_addr} {$addr < ($cur_addr + $dx / 2)} {incr addr} {
126	puts -nonewline $file [format %c [vpeek $addr]]
127	}
128	set cur_addr [expr {$cur_addr + 0x80}]
129	}
130	close $file
131	}
132
133	set_help_text save_to_file \
134	{Helper proc to easily write something to a file.
135	Typically used in combination with another proc. For example:
136	save_to_file my_data.hex [showmem 0x8000 20]
137	}
138	proc save_to_file {filename data} {
139	set file [open $filename "WRONLY CREAT TRUNC"]
140	fconfigure $file -translation binary
141	puts -nonewline $file $data
142	close $file
143	}
144
145	namespace export save_debuggable
146	namespace export load_debuggable
147	namespace export save_all
148	namespace export load_all
149	namespace export vramdump
150	namespace export vram2bmp
151	namespace export save_to_file
152
153	} ;# namespace save_debuggable
154
155	namespace import save_debuggable::*

Keyboard