Commit 489df577 authored by Vincent Laviron's avatar Vincent Laviron
Browse files

Add scripts, initial version

parent ae5ea67f
class Camlprint (gdb.Command):
"""Print info about an OCaml value"""
def __init__ (self):
super (Camlprint, self).__init__ ("camlprint", gdb.COMMAND_DATA, gdb.COMPLETE_EXPRESSION)
def invoke (self, arg, from_tty):
string_t = gdb.lookup_type("char").pointer()
value_t = gdb.lookup_type("intnat")
value_ptr = value_t.pointer()
argv = gdb.string_to_argv(arg)
arg_val = gdb.parse_and_eval(argv[0]).cast(value_t)
if arg_val & 1 == 0:
# Pointer: lookup header
ptr = arg_val.cast (value_ptr)
hptr = ptr - 1
header = hptr.dereference()
tag = header & 0xFF
size = header >> 10
if tag < 246:
# Regular block
gdb.write(f"Regular block of tag {tag} and size {size}\n")
elif tag == 246:
# Lazy block
gdb.write(f"Lazy block (size {size})\n")
elif tag == 247:
# Closure block
arity = (ptr + 1).dereference() >> 1
gdb.write(f"Closure block of size {size}, with arity {arity}\n")
elif tag == 248:
# Object or extension constructor
# Try to find if it's an extension constructor
if size < 2:
gdb.write(f"Ill-formed object (size {size})\n")
else:
field = ptr.dereference()
if field & 1 == 0:
field_header = (field - 8).cast(value_ptr).dereference()
if field_header & 0xFF == 252:
# It's very likely to be an extension constructor, let's assume as much
cstr_name = field.cast(string_t).string()
id = (ptr + 1).dereference() >> 1
gdb.write(f"Extension constructor {cstr_name}, with id {id}\n")
else:
gdb.write(f"Object block (size {size})\n")
else:
gdb.write(f"Object block (size {size})\n")
elif tag == 249:
# Infix block
arity = (ptr + 1).dereference() >> 1
gdb.write(f"Infix closure block with arity {arity}, at offset {size} from start of block\n")
elif tag == 250:
# Forward block
gdb.write(f"Forward block\n")
elif tag == 251:
# Abstract block
gdb.write(f"Abstract block of size {size}\n")
elif tag == 252:
# String block
last_byte_pos = (size << 3) - 1
last_byte = (ptr.cast(string_t) + last_byte_pos).dereference()
len = last_byte_pos - last_byte
contents = ptr.cast(string_t).string(length=len)
# TODO: escape
gdb.write(f"String \"{contents}\"\n")
elif tag == 253:
# Double tag
fl = ptr.cast(gdb.lookup_type("double").pointer()).dereference()
gdb.write(f"Float {fl}\n")
elif tag == 254:
# Double array tag
gdb.write(f"Flat float array of size {size}\n")
elif tag == 255:
# Custom tag
ops_ptr = ptr.dereference().cast(ptr.type)
identifier = ops_ptr.dereference().cast(gdb.lookup_type("char").pointer()).string()
gdb.write(f"Custom block with identifier {identifier}\n")
else:
# Should be unreachable
gdb.write(f"Error in printing logic (tag {tag})\n")
else:
# Integer
gdb.write(f"Integer {arg_val >> 1}\n")
class Camlfield (gdb.Function):
"""$camlfield(v, n) returns the n-th field of caml value v.
If n is omitted, then field 0 is returned."""
def __init__ (self):
super (Camlfield, self).__init__ ("camlfield")
def invoke (self, val, n = 0):
v = val.cast(gdb.lookup_type("intnat"))
if v & 1 == 1:
# Integer; cannot get field
raise gdb.GdbError ("camlfield: argument is not a block")
else:
vp = v.cast(v.type.pointer())
return (vp + n).dereference()
Camlprint ();
Camlfield ();
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment