implements class/instance link

diff --git a/link/link.ml b/link/link.ml
index 95764dd..55737fd 100644 (file)
--- a/link/link.ml
+++ b/link/link.ml
@@ -1,6 +1,12 @@
 open Base
 open Swflib.AbcType
 
+let reloc ctx f xs =
+  List.map (f ctx) xs
+
+let link f ctx x y =
+  x @ reloc ctx f y
+
 (* cpool *)
 let reloc_ns ctx ns =
   let n =
@@ -44,9 +50,6 @@ let reloc_multi ctx = function
   | MultinameLA name ->
       MultinameLA (name + ctx#str)
 
-let reloc ctx f xs =
-  List.map (f ctx) xs
-
 let link_cpool c1 c2 =
   let ctx = {|
       str = List.length c1.string;
@@ -58,11 +61,17 @@ let link_cpool c1 c2 =
       uint          = c1.uint          @ c2.uint;
       double        = c1.double        @ c2.double;
       string        = c1.string        @ c2.string;
-      namespace     = c1.namespace     @ reloc ctx reloc_ns    c2.namespace;
-      namespace_set = c1.namespace_set @ reloc ctx reloc_nss   c2.namespace_set;
-      multiname     = c1.multiname     @ reloc ctx reloc_multi c2.multiname;
+      namespace     = link reloc_ns    ctx c1.namespace     c2.namespace;
+      namespace_set = link reloc_nss   ctx c1.namespace_set c2.namespace_set;
+      multiname     = link reloc_multi ctx c1.multiname     c2.multiname;
     }
 
+let reloc_name ctx name =
+  if name = 0 then
+    0
+  else
+    name + ctx#cpool#multiname
+
 (* method *)
 let reloc_code ctx : Swflib.LowInst.t -> Swflib.LowInst.t = function
     `PushString i ->
@@ -78,25 +87,39 @@ let reloc_code ctx : Swflib.LowInst.t -> Swflib.LowInst.t = function
 
 let reloc_method_info ctx m =
   { m with
-      method_name =  m.method_name + ctx#cpool#string }
-
+      method_name = reloc_name ctx m.method_name }
 
 let reloc_method ctx m =
   { m with
-      method_sig = m.method_sig + ctx#info;
+      method_sig = m.method_sig + ctx#methods;
       code       = reloc ctx reloc_code m.code }
 
+(* class *)
+let reloc_class ctx c =
+  { c with
+      cinit = c.cinit + ctx#methods }
+
+let reloc_instance ctx i =
+  {i with
+     instance_name = reloc_name ctx i.instance_name;
+     super_name    = reloc_name ctx i.super_name;
+     iinit = i.iinit + ctx#methods }
+
 let link a1 a2 =
   let ctx = {|
       cpool = {|
          int    = List.length a1.cpool.int;
          uint   = List.length a1.cpool.uint;
          double = List.length a1.cpool.double;
-         string = List.length a1.cpool.string
+         string = List.length a1.cpool.string;
+         multiname =  List.length a1.cpool.multiname
       |};
-      info = List.length a1.method_info
+      methods = List.length a1.method_info
   |} in
     { a1 with
        cpool         = link_cpool a1.cpool a2.cpool;
-       method_info   = a1.method_info   @ reloc ctx reloc_method_info a2.method_info;
-       method_bodies = a1.method_bodies @ reloc ctx reloc_method a2.method_bodies}
+       method_info   = link reloc_method_info ctx a1.method_info   a2.method_info;
+       method_bodies = link reloc_method      ctx a1.method_bodies a2.method_bodies;
+       classes       = link reloc_class       ctx a1.classes       a2.classes;
+       instances     = link reloc_instance    ctx a1.instances     a2.instances
+    }

diff --git a/link/linkTest.ml b/link/linkTest.ml
index 43a8e8f..358e8f6 100644 (file)
--- a/link/linkTest.ml
+++ b/link/linkTest.ml
@@ -163,7 +163,7 @@ let _ = begin "link.ml" >::: [
         method_bodies = [body;
                          {body with method_sig=1}];
         instances     = [{ instance with instance_name=1; super_name=2; };
-                         { instance with instance_name=1; super_name=2; iinit=1; }]}
+                         { instance with instance_name=3; super_name=4; iinit=1; }]}
       {abc with
         cpool={ cpool with
                   string    = ["foo"];