Re: MPS: Loaded pdump

[Helmut Eller <eller.helmut@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 186 bytes --]

On Thu, May 16 2024, Gerd Möllmann wrote:

> As I said, nothing cames out of this. And nothing will.

The script below uses the libclang Python bindings to produce this
output:


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: x.c --]
[-- Type: text/x-csrc, Size: 1200 bytes --]

static void
mirror_Lisp_Symbol (struct igc_mirror *m, struct Lisp_Symbol *x)
{
  mirror_lisp_obj (m, &x->u.s.name);
  mirror_lisp_obj (m, &x->u.s.function);
  mirror_lisp_obj (m, &x->u.s.plist);
  mirror_ptr (m, &x->u.s.next);
}
static void
mirror_Lisp_String (struct igc_mirror *m, struct Lisp_String *x)
{
  mirror_ptr (m, &x->u.next);
  mirror_ptr (m, &x->u.s.intervals);
}
static void
mirror_interval (struct igc_mirror *m, struct interval *x)
{
  mirror_ptr (m, &x->left);
  mirror_ptr (m, &x->right);
  mirror_lisp_obj (m, &x->plist);
  mirror_ptr (m, &x->up.interval);
  mirror_lisp_obj (m, &x->up.obj);
}
static void
mirror_itree_node (struct igc_mirror *m, struct itree_node *x)
{
  mirror_ptr (m, &x->parent);
  mirror_ptr (m, &x->left);
  mirror_ptr (m, &x->right);
  mirror_lisp_obj (m, &x->data);
}
static void
mirror_image (struct igc_mirror *m, struct image *x)
{
  mirror_lisp_obj (m, &x->spec);
  mirror_lisp_obj (m, &x->dependencies);
  mirror_lisp_obj (m, &x->lisp_data);
  mirror_ptr (m, &x->next);
  mirror_ptr (m, &x->prev);
}
static void
mirror_Lisp_Cons (struct igc_mirror *m, struct Lisp_Cons *x)
{
  mirror_lisp_obj (m, &x->u.s.car);
  mirror_lisp_obj (m, &x->u.s.u.cdr);
}

[-- Attachment #3: Type: text/plain, Size: 28 bytes --]


Would this be acceptable?


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #4: igc_codegen.py --]
[-- Type: text/x-python, Size: 2123 bytes --]

import clang.cindex as cindex
import sys
import re

index = cindex.Index.create()
tu = index.parse("igc.c")

MPS_STRUCTS = ["Lisp_Symbol",
               "Lisp_String",
               "interval",
               "itree_node",
               "image",
               "Lisp_Cons"];

EXCLUDE_FIELDS = {
    "Lisp_Symbol": re.compile('u s val.*'),
    "Lisp_Cons": re.compile('.* chain'),
}

def type_for_struct_name (name) -> cindex.Type:
    for c in tu.cursor.get_children():
        if (c.kind == cindex.CursorKind.STRUCT_DECL and c.spelling == name):
            return c.type.get_canonical()
    raise Exception("struct type not found: " + name)

mps_types = [type_for_struct_name(name) for name in MPS_STRUCTS]

lisp_obj_type = next(c.type.get_canonical()
                     for c in tu.cursor.get_children()
                     if c.spelling == 'Lisp_Object'
                     if c.kind == cindex.CursorKind.TYPEDEF_DECL)

def is_mps_ref (t:cindex.Type) -> bool:
    return (t.get_canonical() == lisp_obj_type or
            (t.get_pointee().get_canonical() in mps_types))

def field_paths (t:cindex.Type):
    l1 = [([f.spelling], f.type.get_canonical()) for f in t.get_fields()]
    l2 = [(p1 + p2,t2) for (p1,t1) in l1 for (p2,t2) in field_paths(t1)]
    return l1 + l2

def ref_fields (t:cindex.Type):
    excluded = EXCLUDE_FIELDS.get(t.get_declaration().spelling, re.compile(""))
    return [(p,t) for (p,t) in field_paths(t)
            if is_mps_ref (t)
            if not excluded.fullmatch(' '.join(p))]

def emit_function_signature (t:cindex.Type):
    print("""static void
mirror_%(fname)s (struct igc_mirror *m, %(atype)s *x)
{"""% { "fname": t.get_declaration().spelling,
       "atype": t.spelling })

def emit_mirror (t:cindex.Type):
    emit_function_signature(t)
    for (path, type) in ref_fields(t):
        if type == lisp_obj_type:
            print("  mirror_lisp_obj (m, &x->%s);" % '.'.join(path))
        else:
            print("  mirror_ptr (m, &x->%s);" % '.'.join(path))
    print("}")


def main():
    for t in mps_types:
        emit_mirror(t)

if __name__ == "__main__":
   main()