OXYGENHUB
◆ main openmsx / share / scripts / _save_debuggable.tcl
6.4 KiB · Tcl · last changed chore(): initial commit 1 month ago source blame history raw
e8555c89 Andy McCall 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::*