Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

fix rocketnia bug http://arclanguage.org/item?id=11879

  • Loading branch information...
commit 91cfefc61fb4f4c215e787e3a5d77f73d92c8891 1 parent 513f6a3
conan dalton authored
81 src/arc/lib/tests/core-errors-continuations-test.arc
View
@@ -38,14 +38,14 @@
((fn (hefty-info)
(assign hefty-stuff (fn (other-stuff)
(assign rec-hefty (fn (n)
- (assign hefty-info (cons "hefty" (cons n hefty-info)))
+ (assign hefty-info (cons "A" (cons n hefty-info)))
(assign other-stuff (ccc other-stuff))
(if (> n 0) (rec-hefty (- n 1)))))
(rec-hefty 5)))
(assign light-stuff (fn (other-stuff)
(assign rec-light (fn (x)
- (assign hefty-info (cons "light" hefty-info))
+ (assign hefty-info (cons "B" hefty-info))
(assign other-stuff (ccc other-stuff))
(rec-light 0)))))
@@ -53,14 +53,79 @@
hefty-info
) nil)
- ("light" "hefty" 0 "light" "hefty" 1 "light" "hefty" 2 "light" "hefty" 3 "light" "hefty" 4 "light" "hefty" 4 "hefty" 5))
+ ("B" "A" 0 "B" "A" 1 "B" "A" 2 "B" "A" 3 "B" "A" 4 "B" "A" 4 "A" 5))
)
- ("protect"
- ((fn (x)
- (protect (fn () (/ 1 2)) (fn () (assign x "protected-foo")))
- x) nil)
- "protected-foo")
+ (suite "Protect"
+ ("simple protect"
+ ((fn (x)
+ (protect (fn () (/ 1 2)) (fn () (assign x "protected-foo")))
+ x) nil)
+ "protected-foo")
+
+ ("protect through continuation"
+ (tostring (catch (after (throw pr!problem) pr!-free)))
+ "problem-free")
+
+ ("protect all over the place inside a co-routine pair"
+ (let started nil
+ (accum trace
+ (assign proc-A (fn (my-b)
+ (= started t)
+ (trace 'proc-A-start)
+ (assign inner-A (fn (n)
+ (trace (sym:string 'inner-A-start- n))
+ (after (assign my-b (do (trace 'pre-ccc-my-b) (ccc my-b))) (trace (sym:string 'after-ccc-my-b- n)))
+ (trace 'end-inner-A)
+ (if (> n 0) (after (inner-A (- n 1)) (trace (sym:string 'after-inner-A-tail-call- n))))))
+ (after (inner-A 5) (trace 'after-initial-inner-A-call))))
+
+ (assign proc-B (fn (my-a)
+ (trace 'proc-B-start)
+ (assign inner-B (fn (x)
+ (trace 'inner-B-start)
+ (after (assign my-a (do (trace 'pre-ccc-my-a) (ccc my-a))) (trace 'after-ccc-my-a))
+ (trace 'end-inner-B)
+ (after (inner-B 0) (trace 'after-inner-B-tail-call))))))
+
+ (after (if (no started) (proc-A proc-B)) (trace 'final-after))
+ ))
+
+ (proc-A-start inner-A-start-5 pre-ccc-my-b proc-B-start after-ccc-my-b-5
+ end-inner-A inner-A-start-4 pre-ccc-my-b inner-B-start pre-ccc-my-a
+ after-ccc-my-a after-ccc-my-b-4 after-inner-A-tail-call-5
+ after-ccc-my-b-5 end-inner-A inner-A-start-4 pre-ccc-my-b
+ after-ccc-my-b-4 after-inner-A-tail-call-5 after-ccc-my-a end-inner-B
+ inner-B-start pre-ccc-my-a after-ccc-my-a after-inner-B-tail-call
+ after-ccc-my-b-4 after-inner-A-tail-call-5 after-ccc-my-b-4 end-inner-A
+ inner-A-start-3 pre-ccc-my-b after-ccc-my-b-3 after-inner-A-tail-call-4
+ after-inner-A-tail-call-5 after-ccc-my-a end-inner-B inner-B-start
+ pre-ccc-my-a after-ccc-my-a after-inner-B-tail-call
+ after-inner-B-tail-call after-ccc-my-b-4 after-inner-A-tail-call-5
+ after-ccc-my-b-3 end-inner-A inner-A-start-2 pre-ccc-my-b
+ after-ccc-my-b-2 after-inner-A-tail-call-3 after-inner-A-tail-call-4
+ after-inner-A-tail-call-5 after-ccc-my-a end-inner-B inner-B-start
+ pre-ccc-my-a after-ccc-my-a after-inner-B-tail-call
+ after-inner-B-tail-call after-inner-B-tail-call after-ccc-my-b-4
+ after-inner-A-tail-call-5 after-ccc-my-b-2 end-inner-A inner-A-start-1
+ pre-ccc-my-b after-ccc-my-b-1 after-inner-A-tail-call-2
+ after-inner-A-tail-call-3 after-inner-A-tail-call-4
+ after-inner-A-tail-call-5 after-ccc-my-a end-inner-B inner-B-start
+ pre-ccc-my-a after-ccc-my-a after-inner-B-tail-call
+ after-inner-B-tail-call after-inner-B-tail-call after-inner-B-tail-call
+ after-ccc-my-b-4 after-inner-A-tail-call-5 after-ccc-my-b-1 end-inner-A
+ inner-A-start-0 pre-ccc-my-b after-ccc-my-b-0 after-inner-A-tail-call-1
+ after-inner-A-tail-call-2 after-inner-A-tail-call-3
+ after-inner-A-tail-call-4 after-inner-A-tail-call-5 after-ccc-my-a
+ end-inner-B inner-B-start pre-ccc-my-a after-ccc-my-a
+ after-inner-B-tail-call after-inner-B-tail-call after-inner-B-tail-call
+ after-inner-B-tail-call after-inner-B-tail-call after-ccc-my-b-4
+ after-inner-A-tail-call-5 after-ccc-my-b-0 end-inner-A
+ after-inner-A-tail-call-1 after-inner-A-tail-call-2
+ after-inner-A-tail-call-3 after-inner-A-tail-call-4
+ after-inner-A-tail-call-5 after-initial-inner-A-call final-after)
+ )
+ )
(suite "Error handling"
("no error"
103 src/java/rainbow/functions/threads/CCC.java
View
@@ -1,24 +1,36 @@
package rainbow.functions.threads;
+import rainbow.ArcError;
import rainbow.LexicalClosure;
+import rainbow.Nil;
import rainbow.functions.Builtin;
-import rainbow.types.ArcException;
import rainbow.types.ArcObject;
import rainbow.types.Pair;
import rainbow.vm.Instruction;
import rainbow.vm.VM;
import rainbow.vm.instructions.Finally;
+import java.util.List;
+
public class CCC extends Builtin {
+
public CCC() {
super("ccc");
}
public void invokef(VM vm, ArcObject fn) {
+ if (fn instanceof Nil) {
+ throw new ArcError("Can't ccc nil!");
+ }
ContinuationWrapper e = new ContinuationWrapper(vm);
- TriggerCopyVM tcv = new TriggerCopyVM(e);
- tcv.belongsTo(this);
- vm.pushFrame(tcv);
+
+
+// TODO no longer need TCV
+// TriggerCopyVM tcv = new TriggerCopyVM(e);
+// tcv.belongsTo(this);
+// vm.pushFrame(tcv);
+
+
fn.invokef(vm, e);
}
@@ -35,56 +47,58 @@ public TriggerCopyVM(ContinuationWrapper cc) {
}
public void operate(VM vm) {
- cc.cloneVM();
+ cc.setCopyRequired();
}
- }
- static class ShallowVMState {
- public int ap = -1;
- public int ip = -1;
- private LexicalClosure currentLc;
- private ArcObject[] currentParams;
- private ArcException error;
- private boolean dead = false;
- private int ipThreshold;
-
- public ShallowVMState(VM vm) {
- this.ap = vm.ap();
- this.ip = vm.ip;
- this.currentLc = vm.lc();
- this.currentParams = vm.currentParams;
- this.error = vm.error;
- this.dead = vm.dead;
- this.ipThreshold = vm.ipThreshold;
- }
-
- public void restore(VM vm) {
- vm.ap = this.ap;
- vm.ip = this.ip;
- vm.currentLc = this.currentLc;
- vm.currentParams = this.currentParams;
- vm.error = this.error;
- vm.dead = this.dead;
- vm.ipThreshold = this.ipThreshold;
+ public String toString() {
+ return "#<require-vm-copy #" + cc.vm.threadId + ">";
}
}
public static class ContinuationWrapper extends ArcObject {
private VM vm;
- private ShallowVMState svs;
+ private boolean copyRequired = false;
public ContinuationWrapper(VM vm) {
- this.vm = vm;
- this.svs = new ShallowVMState(vm);
+ this.vm = vm.copy();
+ }
+
+ private void applyFinallies(VM vm, List[] finallies) {
+ int fc = finallies[0].size();
+ for (int i = fc - 1; i >= 0; i--) {
+ LexicalClosure lc = (LexicalClosure) finallies[1].get(i);
+ Pair instructions = (Pair) finallies[0].get(i);
+ vm.pushInvocation(lc, instructions);
+ }
}
public void invokef(VM vm, ArcObject arg) {
- if (svs != null && this.vm == vm) {
- svs.restore(vm);
- } else {
+ int oldIP = vm.lastCommonAncestor(this.vm);
+ List[] finallies = vm.gatherFinallies(oldIP);
+ this.vm.copyTo(vm);
+ vm.pushA(arg);
+ applyFinallies(vm, finallies);
+ }
+
+ public void faster_but_broken_invokef(VM vm, ArcObject arg) {
+ if (copyRequired) {
+ int oldIP = vm.lastCommonAncestor(this.vm);
+ List[] finallies = vm.gatherFinallies(oldIP);
this.vm.copyTo(vm);
+ vm.pushA(arg);
+ applyFinallies(vm, finallies);
+ } else {
+ List[] finallies = vm.gatherFinallies(this.vm.ip);
+ vm.ap = this.vm.ap;
+ vm.ip = this.vm.ip;
+ vm.currentLc = this.vm.currentLc;
+ vm.currentParams = this.vm.currentParams;
+ vm.error = this.vm.error;
+ vm.dead = this.vm.dead;
+ vm.ipThreshold = this.vm.ipThreshold;
+ vm.pushA(arg);
+ applyFinallies(vm, finallies);
}
- vm.pushA(arg);
}
public void invoke(VM vm, Pair args) {
@@ -95,9 +109,12 @@ public ArcObject type() {
return TYPE;
}
- public void cloneVM() {
- vm = vm.copy();
- svs = null;
+ public void setCopyRequired() {
+ this.copyRequired = true;
+ }
+
+ public String toString() {
+ return "#<continuation ip:" + vm.ip + ";ap:" + vm.ap + ";VM#" + vm.threadId + ">";
}
}
}
46 src/java/rainbow/vm/VM.java
View
@@ -19,7 +19,7 @@
public static final Symbol TYPE = Symbol.mkSym("thread");
private static long threadCount = 0;
- private final long threadId;
+ public final long threadId;
{
synchronized(VM.class) {
@@ -106,6 +106,31 @@ public boolean hasInstructions() {
return ip >= ipThreshold;
}
+ public int lastCommonAncestor(VM other) {
+ for (int i = 0; i < ip; i++) {
+ if (ins[i] != other.ins[i]) {
+ return i - 1;
+ }
+ }
+ return ip;
+ }
+
+ public List[] gatherFinallies(int oldIP) {
+ List instructions = new ArrayList();
+ List lexClosures = new ArrayList();
+
+ while (ip > oldIP) {
+ ArcObject nextInstruction = peekI().car();
+ if (nextInstruction instanceof Finally) {
+ instructions.add(peekI());
+ lexClosures.add(peekL());
+ }
+ popFrame();
+ }
+
+ return new List[] { instructions, lexClosures };
+ }
+
private void handleError(Throwable e) {
List stackTrace = new ArrayList(ip - ipThreshold);
List instructions = new ArrayList();
@@ -160,7 +185,11 @@ public void show() {
System.out.println("" + (ap + 1) + " args");
showArgs();
System.out.println();
- System.out.println("" + (ip + 1) + " instruction frames");
+ int fc = ip + 1;
+ if (ins[ip] instanceof Nil) {
+ fc = ip;
+ }
+ System.out.println("" + fc + " instruction frames");
showInstructions();
}
@@ -303,23 +332,30 @@ private void showArgs() {
}
private void showInstructions() {
- int end = (ip > 4) ? (ip - 4) : 0;
+ int end = (ip > 20) ? (ip - 20) : 0;
for (int i = ip; i >= end; i--) {
- showFrame(i);
+ if (!(ins[i] instanceof Nil)) {
+ showFrame(i);
+ }
}
}
private void showFrame(int frame) {
Pair instructions = ins[frame];
LexicalClosure lc = lcs[frame];
+ ArcObject[] stk = params[frame];
System.out.print("\nInstruction Frame " + frame + ":");
while (!(instructions instanceof Nil)) {
Instruction i = (Instruction) instructions.car();
instructions = (Pair) instructions.cdr();
-// System.out.print(i.toString());
System.out.print(i.toString(lc));
System.out.print(" ");
}
+ System.out.print("[");
+ for (ArcObject o : stk) {
+ System.out.print(o + " ");
+ }
+ System.out.print("]");
System.out.println();
}
2  src/java/rainbow/vm/instructions/cond/optimise/If_bound_bound_literal.java
View
@@ -44,7 +44,7 @@ public static void addInstructions(List i, ArcObject ifExpr, ArcObject thenExpr,
}
public String toString() {
- return "(if[bbl] " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
+ return "(if " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
}
public static class Or extends Instruction {
2  src/java/rainbow/vm/instructions/cond/optimise/If_bound_literal_literal.java
View
@@ -29,7 +29,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[bll] " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
+ return "(if " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
}
public static void addInstructions(List i, ArcObject ifExpr, ArcObject thenExpr, ArcObject elseExpr) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_bound_other_literal.java
View
@@ -34,7 +34,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[bol] " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
+ return "(if " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
}
public void visit(Visitor v) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_bound_other_other.java
View
@@ -35,7 +35,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[boo] " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
+ return "(if " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
}
public void visit(Visitor v) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_other_bound_other.java
View
@@ -31,7 +31,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[obo] [other] " + thenExpr + " " + elseExpr + ")";
+ return "(if ? " + thenExpr + " " + elseExpr + ")";
}
public void visit(Visitor v) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_other_other_literal.java
View
@@ -31,7 +31,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[ool] [other] " + thenExpr + " " + elseExpr + ")";
+ return "(if ? " + thenExpr + " " + elseExpr + ")";
}
public void visit(Visitor v) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_other_stack_literal.java
View
@@ -27,7 +27,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[osl] [other] " + thenExpr + " " + elseExpr + ")";
+ return "(if ? " + thenExpr + " " + elseExpr + ")";
}
public static void addInstructions(List i, ArcObject ifExpr, ArcObject thenExpr, ArcObject elseExpr) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_other_stack_other.java
View
@@ -31,7 +31,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[oso] [other] " + thenExpr + " " + elseExpr + ")";
+ return "(if ? " + thenExpr + " " + elseExpr + ")";
}
public void visit(Visitor v) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_stack_literal_free.java
View
@@ -30,7 +30,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[slf] " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
+ return "(if " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
}
public static void addInstructions(List i, ArcObject ifExpr, ArcObject thenExpr, ArcObject elseExpr) {
2  src/java/rainbow/vm/instructions/cond/optimise/If_stack_stack_literal.java
View
@@ -29,7 +29,7 @@ public void operate(VM vm) {
}
public String toString() {
- return "(if[ssl] " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
+ return "(if " + ifExpr + " " + thenExpr + " " + elseExpr + ")";
}
public static void addInstructions(List i, ArcObject ifExpr, ArcObject thenExpr, ArcObject elseExpr) {
Please sign in to comment.
Something went wrong with that request. Please try again.