Start decoupling sub metadata from protopads

Soon the protopad will be just like any other pad, and elidable in many cases. +10K SAFE.dll due to duplicated functionality.
sorear · Aug 17, 2010 · eba4446 · eba4446
1 parent aae0b1f
commit eba4446
Show file tree

Hide file tree

Showing 7 changed files with 110 additions and 86 deletions.
diff --git a/CgOp.pm b/CgOp.pm
@@ -578,10 +578,13 @@ use warnings;
 
     # must only be called during to_cgop phase!
     sub protosub {
-        my ($body, @extra) = @_;
+        my ($body, $ltm) = @_;
         prog(
             CgOp::Primitive->new(op => [ 'open_protopad', $body ]),
             $body->to_cgop,
+            (!$ltm ? () : (
+                CgOp::Primitive->new(op => [ 'set_ltm', $body->csname ],
+                    zyg => [ $ltm ]))),
             CgOp::Primitive->new(op => [ 'close_sub', $body ]));
     }
 

diff --git a/CodeGen.pm b/CodeGen.pm
@@ -417,7 +417,7 @@ use 5.010;
 
     sub protolget {
         my ($self, $name) = @_;
-        $self->_push('object', "th.proto.lex[" . qm($name) . "]");
+        $self->_push('object', "th.info.proto.lex[" . qm($name) . "]");
         $self->cast('Variable');
     }
 
@@ -609,20 +609,18 @@ use 5.010;
     sub close_sub {
         my ($self, $body) = @_;
 
-        $self->_push('object', $body->csname . "_lines");
-        $self->proto_var('?lines');
-
-        if ($body->type eq 'mainline') {
-            $self->clr_string($body->file);
-            $self->proto_var('?file');
+        $self->_emit($body->csname . "_info.PutHint(\"?file\", " . qm($body->file) . ")") if $body->type eq 'mainline';
+        my $ob = $self->bodies->[-2];
+        if ($ob) {
+            $self->_emit($body->csname . "_info.outer = " . $ob->csname . "_info");
         }
 
         $self->pop_let('protopad');
         pop @{ $self->bodies };
         $self->peek_let('protopad');
         my ($pp, $op) = $self->_popn(2);
-        $self->_push('IP6', "Kernel.MakeSub(new DynBlockDelegate(" .
-            $body->csname . "), $pp, $op)");
+        $self->_emit($body->csname . "_info.proto = $pp");
+        $self->_push('IP6', "Kernel.MakeSub(" . $body->csname . "_info, $op)");
     }
 
     sub proto_var {
@@ -672,10 +670,19 @@ use 5.010;
         }
     }
 
+    # XXX a bit too much integration here
+    sub set_ltm {
+        my ($self, $bodyn) = @_;
+        my ($ltm) = $self->_popn(1);
+        $self->_emit("${bodyn}_info.ltm = $ltm");
+    }
+
     sub open_protopad {
         my ($self, $body) = @_;
+        $self->push_null('Frame');
         $self->peek_let('protopad');
-        $self->clr_new('Frame', 1);
+        $self->_push('SubInfo', $body->csname . "_info");
+        $self->clr_new('Frame', 3);
         $self->push_let('protopad');
         push @{ $self->bodies }, $body;
     }
@@ -712,10 +719,10 @@ use 5.010;
         print ::NIECZA_OUT " " x 16, "throw new Exception(\"Invalid IP\");\n";
         print ::NIECZA_OUT " " x 8, "}\n";
         print ::NIECZA_OUT " " x 4, "}\n";
-        if ($name ne 'BOOT') {
-            print ::NIECZA_OUT " " x 4, "private static int[] ${name}_lines = {",
-                join (", ", map { ($_ // 0) } @{ $self->lineinfo }), "};\n";
-        }
+        print ::NIECZA_OUT " " x 4, "private static int[] ${name}_lines = {",
+            join (", ", map { ($_ // 0) } @{ $self->lineinfo }), "};\n";
+        print ::NIECZA_OUT " " x 4, "private static SubInfo ${name}_info = ",
+            "new SubInfo(${name}_lines, ${name}, null, null, null);\n";
     }
 
     sub BUILD {

diff --git a/Cursor.cs b/Cursor.cs
@@ -189,13 +189,7 @@ public sealed class Edge {
         if (Lexer.LtmTrace && method != null)
             Console.WriteLine("+ Found method");
 
-        DynObject dom = method as DynObject;
-        if (dom != null) {
-            object o;
-            if (dom.slots.TryGetValue("ltm-prefix", out o)) {
-                sub = o as LAD;
-            }
-        }
+        sub = ((SubInfo)(((DynObject)method).slots["info"])).ltm;
 
         if (Lexer.LtmTrace)
             Console.WriteLine("+ {0} to sub-automaton",
@@ -455,7 +449,7 @@ public class LADProtoRegex : LAD {
 
     public override void ToNFA(NFA pad, int from, int to) {
         foreach (DynObject cand in Lexer.ResolveProtoregex(pad.cursor_class, name)) {
-            ((LAD)cand.slots["ltm-prefix"]).ToNFA(pad, from, to);
+            ((SubInfo)cand.slots["info"]).ltm.ToNFA(pad, from, to);
         }
     }
 
@@ -633,7 +627,7 @@ public class Lexer {
         DynObject[] candidates = ResolveProtoregex(dc.klass, name);
         LAD[] branches = new LAD[candidates.Length];
         for (int i = 0; i < candidates.Length; i++)
-            branches[i] = (LAD) candidates[i].slots["ltm-prefix"];
+            branches[i] = ((SubInfo) candidates[i].slots["info"]).ltm;
         Lexer l = new Lexer(dc, name, branches);
         Cursor c = (Cursor)Kernel.UnboxAny(cursor);
         int[] brnum = l.Run(c.backing, c.pos);

diff --git a/Decl.pm b/Decl.pm
@@ -69,22 +69,10 @@ use CgOp;
             CgOp::proto_var($self->var, CgOp::newscalar(
                     CgOp::protosub($self->code)));
         } else {
-            # TODO: More direct support
-            my $cg = CgOp::proto_var($self->var,
+            CgOp::proto_var($self->var,
                 CgOp::methodcall(
                     CgOp::scopedlex($self->class), 'bless',
-                    CgOp::newscalar(CgOp::protosub($self->code))));
-
-            if ($self->ltm) {
-                # ick
-                $cg = CgOp::prog($cg,
-                    CgOp::setindex("ltm-prefix",
-                        CgOp::getfield("slots", CgOp::cast('DynObject',
-                                CgOp::fetch(CgOp::scopedlex($self->var)))),
-                        $self->ltm));
-            }
-
-            $cg;
+                    CgOp::newscalar(CgOp::protosub($self->code, $self->ltm))));
         }
     }