First pass at exception handling.

Makes basic try/CATCH work. Enough to pass 3 out of 8 tests in
44-try-catch.t.

lib/QAST/JASTCompiler.nqp

@@ -1235,7 +1235,105 @@ QAST::OperationsJAST.add_core_op('bind', -> $qastcomp, $op {
 
 # Exception handling/munging.
 QAST::OperationsJAST.map_classlib_core_op('die_s', $TYPE_OPS, 'die_s', [$RT_STR], $RT_STR, :tc);
-QAST::OperationsJAST.map_classlib_core_op('die', $TYPE_OPS, 'die', [$RT_OBJ], $RT_OBJ, :tc);
+QAST::OperationsJAST.map_classlib_core_op('die', $TYPE_OPS, 'die_s', [$RT_STR], $RT_STR, :tc);
+QAST::OperationsJAST.map_classlib_core_op('exception', $TYPE_OPS, 'exception', [], $RT_OBJ, :tc);
+QAST::OperationsJAST.map_classlib_core_op('getextype', $TYPE_OPS, 'getextype', [$RT_OBJ], $RT_INT, :tc);
+my %handler_names := nqp::hash(
+    'CATCH',   $EX_CAT_CATCH,
+    'CONTROL', $EX_CAT_CONTROL,
+    'NEXT',    $EX_CAT_NEXT,
+    'LAST',    $EX_CAT_LAST,
+    'REDO',    $EX_CAT_REDO
+);
+QAST::OperationsJAST.add_core_op('handle', sub ($qastcomp, $op) {
+    my @children := nqp::clone($op.list());
+    if @children == 0 {
+        nqp::die("The 'handle' op requires at least one child");
+    }
+
+    # If there's exactly one child, then there's nothing protecting
+    # it; just compile it and we're done.
+    my $protected := @children.shift();
+    unless @children {
+        return $qastcomp.as_jast($protected);
+    }
+
+    # Otherwise, we need to generate an install a handler block, which will
+    # decide that to do by category.
+    my $mask := 0;
+    my $hblock := QAST::Block.new(
+        QAST::Op.new(
+            :op('bind'),
+            QAST::Var.new( :name('__category__'), :scope('local'), :decl('var') ),
+            QAST::Op.new(
+                :op('getextype'),
+                QAST::Op.new( :op('exception') )
+            )));
+    my $push_target := $hblock;
+    for @children -> $type, $handler {
+        # Get the category mask.
+        unless nqp::existskey(%handler_names, $type) {
+            nqp::die("Invalid handler type '$type'");
+        }
+        my $cat_mask := %handler_names{$type};
+
+        # Chain in this handler.
+        my $check := QAST::Op.new(
+            :op('if'),
+            QAST::Op.new(
+                :op('bitand_i'),
+                QAST::Var.new( :name('__category__'), :scope('local') ),
+                QAST::IVal.new( :value($cat_mask) )
+            ),
+            $handler
+        );
+        $push_target.push($check);
+        $push_target := $check;
+
+        # Add to mask.
+        $mask := nqp::bitor_i($mask, $cat_mask);
+    }
+
+    # Compile, create a lexical to put the handler in, and add it.
+    my $name   := QAST::Node.unique('!HANDLER_');
+    my $lexidx := $*BLOCK.lexical_idx($name);
+    my $il     := JAST::InstructionList.new();
+    my $hb_res := $qastcomp.as_jast($hblock, :want($RT_OBJ));
+    $il.append($hb_res.jast);
+    $*STACK.obtain($hb_res);
+    $*BLOCK.add_lexical(QAST::Var.new( :name($name) ));
+    $il.append(JAST::Instruction.new( :op('aload'), 'cf' ));
+    $il.append(JAST::PushIndex.new( :value($lexidx) ));
+    $il.append(JAST::Instruction.new( :op('invokestatic'), $TYPE_OPS,
+        'bindlex_o', $TYPE_SMO, $TYPE_SMO, $TYPE_CF, 'Integer' ));
+    $il.append(JAST::Instruction.new( :op('pop') ));
+
+    # Register a handler.
+    my $handler := &*REGISTER_BLOCK_HANDLER($*HANDLER_IDX, $mask, $lexidx);
+
+    # Evaluate the protected code and stash it in a temporary.
+    my $result := $*TA.fresh_o();
+    my $prores := $qastcomp.as_jast_in_handler($protected, $handler, :want($RT_OBJ));
+    my $tryil  := JAST::InstructionList.new();
+    $tryil.append($prores.jast);
+    $*STACK.obtain($prores);
+    $tryil.append(JAST::Instruction.new( :op('astore'), $result ));
+
+    # The catch part just handles unwind; grab the result.
+    my $catchil := JAST::InstructionList.new();
+    $qastcomp.unwind_check($catchil, $handler);
+    $catchil.append(JAST::Instruction.new( :op('getfield'), $TYPE_EX_UNWIND, 'result', $TYPE_SMO ));
+    $catchil.append(JAST::Instruction.new( :op('astore'), $result ));
+
+    # Wrap it all up in try/catch etc.
+    $il.append($qastcomp.delimit_handler(
+        JAST::TryCatch.new( :try($tryil), :catch($catchil), :type($TYPE_EX_UNWIND) ),
+        $*HANDLER_IDX, $handler));
+
+    # Evaluate to the result.
+    $il.append(JAST::Instruction.new( :op('aload'), $result ));
+    result($il, $RT_OBJ);
+});
 
 # Control exception throwing.
 my %control_map := nqp::hash(
@@ -2383,6 +2481,13 @@ class QAST::CompilerJAST {
                     $ex_obj ?? $EX_UNWIND_OBJECT !! $EX_UNWIND_SIMPLE]);
                 $unwind
             }
+            my &*REGISTER_BLOCK_HANDLER := sub ($outer, $category, $lexidx) {
+                $*EH_IDX++;
+                my $unwind := $*EH_PREFIX + $*EH_IDX;
+                nqp::push(@handlers, [$unwind, $outer, $category,
+                    $EX_BLOCK, $lexidx]);
+                $unwind
+            }
 
             # Create JAST method and register it with the block's compilation unit
             # unique ID and name. (Note, always void return here as return values

src/org/perl6/nqp/runtime/ExceptionHandling.java

@@ -1,6 +1,7 @@
 package org.perl6.nqp.runtime;
 
 import org.perl6.nqp.sixmodel.*;
+import org.perl6.nqp.sixmodel.reprs.VMExceptionInstance;
 
 public class ExceptionHandling {
 	/* Exception handler categories. */
@@ -16,7 +17,8 @@ public class ExceptionHandling {
 	public static final int EX_BLOCK = 2;
 
 	/* Finds and executes a handler, using dynamic scope to find it. */
-	public static SixModelObject handlerDynamic(ThreadContext tc, long category) {
+	public static SixModelObject handlerDynamic(ThreadContext tc, long category,
+			VMExceptionInstance exObj) {
 		CallFrame f = tc.curFrame;
 		while (f != null) {
 			if (f.curHandler != 0) {
@@ -27,7 +29,7 @@ public static SixModelObject handlerDynamic(ThreadContext tc, long category) {
 						if (handlers[i][0] == tryHandler) {
 							// Found an active one, but is it the right category?
 							if ((handlers[i][2] & category) != 0)
-								return invokeHandler(tc, handlers[i], category);
+								return invokeHandler(tc, handlers[i], category, f, exObj);
 
 							// If not, try outer one.
 							tryHandler = handlers[i][1];
@@ -38,20 +40,36 @@ public static SixModelObject handlerDynamic(ThreadContext tc, long category) {
 			}
 			f = f.caller;
 		}
-		return panic(tc, category);
+		return panic(tc, category, exObj);
 	}
 
 	/* Invokes the handler. */
-	private static SixModelObject invokeHandler(ThreadContext tc, long[] handlerInfo, long category) {
-		// TODO: Should not always just blindly go unwinding, may need an
-		// exception object or to run it in the current dynamic context.
-		tc.unwinder.unwindTarget = handlerInfo[0];
-		tc.unwinder.category = category;
-		throw tc.unwinder;
+	private static SixModelObject invokeHandler(ThreadContext tc, long[] handlerInfo,
+			long category, CallFrame handlerFrame, VMExceptionInstance exObj) {
+		switch ((int)handlerInfo[3]) {
+		case EX_UNWIND_SIMPLE:
+			tc.unwinder.unwindTarget = handlerInfo[0];
+			tc.unwinder.category = category;
+			throw tc.unwinder;
+		case EX_BLOCK:
+			try {
+				tc.handlers.add(new HandlerInfo(exObj));
+				Ops.invokeArgless(tc, Ops.getlex_o(handlerFrame, (int)handlerInfo[4]));
+			}
+			finally {
+				tc.handlers.remove(tc.handlers.size() - 1);
+			}
+			tc.unwinder.unwindTarget = handlerInfo[0];
+			tc.unwinder.result = Ops.result_o(tc.curFrame);
+			throw tc.unwinder;
+		default:
+			throw new RuntimeException("Unknown exception kind");
+		}
 	}
 
 	/* Unahndled exception. */
-	private static SixModelObject panic(ThreadContext tc, long category) {
+	private static SixModelObject panic(ThreadContext tc, long category,
+			VMExceptionInstance exObj) {
 		throw new RuntimeException("Unhandled exception; category = " + category);
 	}
 }

src/org/perl6/nqp/runtime/GlobalContext.java

@@ -68,6 +68,11 @@ public class GlobalContext {
      */
     public SixModelObject CallCapture;
 
+    /**
+     * BOOTException type; a basic, method-less type with the VMException REPR. 
+     */
+    public SixModelObject BOOTException;
+
     /**
      * Typed VMArrays.
      */
@@ -148,5 +153,6 @@ private void setupConfig(HLLConfig config) {
         config.slurpyHashType = BOOTHash;
         config.arrayIteratorType = BOOTIter;
         config.hashIteratorType = BOOTIter;
+        config.exceptionType = BOOTException;
     }
 }

src/org/perl6/nqp/runtime/HLLConfig.java

@@ -32,4 +32,9 @@ public class HLLConfig {
      * The type to use for hash iteration (should have VMIter REPR).
      */
     public SixModelObject hashIteratorType;
+
+    /**
+     * The type to construct for exceptions (should have VMException REPR).
+     */
+    public SixModelObject exceptionType;
 }

src/org/perl6/nqp/runtime/HandlerInfo.java

@@ -0,0 +1,12 @@
+package org.perl6.nqp.runtime;
+
+import org.perl6.nqp.sixmodel.reprs.VMExceptionInstance;
+
+/* Describes an exception handler currently being processed. */
+public class HandlerInfo {
+	public VMExceptionInstance exObj;
+
+	public HandlerInfo(VMExceptionInstance exObj) {
+		this.exObj = exObj;
+	}
+}

src/org/perl6/nqp/runtime/Ops.java

@@ -963,6 +963,9 @@ public static void invoke(ThreadContext tc, SixModelObject invokee, int callsite
         else
         	invokeInternal(tc, invokee, emptyCallSite);
     }
+    public static void invokeArgless(ThreadContext tc, SixModelObject invokee) {
+    	invokeInternal(tc, invokee, emptyCallSite);
+    }
     private static void invokeInternal(ThreadContext tc, SixModelObject invokee, CallSiteDescriptor csd) {
     	// Otherwise, get the code ref.
     	CodeRef cr;
@@ -2199,15 +2202,30 @@ public static double sleep(final double seconds) {
 
     /* Exception related. */
     public static String die_s(String msg, ThreadContext tc) {
-    	// TODO Implement exceptions properly.
-    	throw new RuntimeException(msg);
-    }
-    public static SixModelObject die(SixModelObject msg, ThreadContext tc) {
-    	// TODO Implement exceptions properly.
-    	throw new RuntimeException(msg.get_str(tc));
+    	// Construct exception object.
+    	SixModelObject exType = tc.curFrame.codeRef.staticInfo.compUnit.hllConfig.exceptionType;
+    	VMExceptionInstance exObj = (VMExceptionInstance)exType.st.REPR.allocate(tc, exType.st);
+    	exObj.initialize(tc);
+    	exObj.message = msg;
+    	exObj.category = ExceptionHandling.EX_CAT_CATCH;
+    	ExceptionHandling.handlerDynamic(tc, ExceptionHandling.EX_CAT_CATCH, exObj);
+    	return msg;
     }
     public static SixModelObject throwcatdyn(long category, ThreadContext tc) {
-    	return ExceptionHandling.handlerDynamic(tc, category);
+    	return ExceptionHandling.handlerDynamic(tc, category, null);
+    }
+    public static SixModelObject exception(ThreadContext tc) {
+    	int numHandlers = tc.handlers.size();
+    	if (numHandlers > 0)
+    		return tc.handlers.get(numHandlers - 1).exObj;
+    	else
+    		throw new RuntimeException("Cannot get exception object ouside of exception handler");
+    }
+    public static long getextype(SixModelObject obj, ThreadContext tc) {
+    	if (obj instanceof VMExceptionInstance)
+    		return ((VMExceptionInstance)obj).category;
+    	else
+    		throw new RuntimeException("getextype needs an object with VMException representation");
     }
 
     /* HLL configuration and compiler related options. */

src/org/perl6/nqp/runtime/ThreadContext.java

@@ -1,5 +1,7 @@
 package org.perl6.nqp.runtime;
 
+import java.util.ArrayList;
+
 import org.perl6.nqp.sixmodel.reprs.CallCaptureInstance;
 
 /**
@@ -47,6 +49,11 @@ public class ThreadContext {
      */
     public UnwindException unwinder;
 
+    /**
+     * Stack of handlers we're currently in.
+     */
+    public ArrayList<HandlerInfo> handlers;
+
     /**
      * The current lexotic we're throwing.
      */
@@ -61,6 +68,7 @@ public ThreadContext(GlobalContext gc) {
         this.gc = gc;
         this.theLexotic = new LexoticException();
         this.unwinder = new UnwindException();
+        this.handlers = new ArrayList<HandlerInfo>();
         if (gc.CallCapture != null) {
         	savedCC = (CallCaptureInstance)gc.CallCapture.st.REPR.allocate(this, gc.CallCapture.st);
         	savedCC.initialize(this);

src/org/perl6/nqp/runtime/UnwindException.java

@@ -1,7 +1,18 @@
 package org.perl6.nqp.runtime;
 
+import org.perl6.nqp.sixmodel.SixModelObject;
+
 public class UnwindException extends RuntimeException {
 	private static final long serialVersionUID = -2452898396745530180L;
+
+	/* What we're unwinding to. */
 	public long unwindTarget;
+
+	/* The category, if we're a simple handler. */
 	public long category;
+
+	/* If there was a block handler, this is the result the block
+	 * produced.
+	 */
+	public SixModelObject result;
 }

src/org/perl6/nqp/sixmodel/KnowHOWBootstrapper.java

@@ -21,6 +21,7 @@ public static void bootstrap(ThreadContext tc)
         tc.gc.SCRef = bootType(tc, "SCRef", "SCRef");
         tc.gc.ContextRef = bootType(tc, "ContextRef", "ContextRef");
         tc.gc.CallCapture = bootType(tc, "CallCapture", "CallCapture");
+        tc.gc.BOOTException = bootType(tc, "BOOTException", "VMException");
 
         tc.gc.BOOTIntArray = bootTypedArray(tc, "BOOTIntArray", tc.gc.BOOTInt);
         tc.gc.BOOTNumArray = bootTypedArray(tc, "BOOTNumArray", tc.gc.BOOTNum);

src/org/perl6/nqp/sixmodel/REPRRegistry.java

@@ -44,5 +44,6 @@ public static void setup() {
         addREPR("CodeRef", new CodeRefREPR());
         addREPR("CallCapture", new CallCapture());
         addREPR("NFA", new NFA());
+        addREPR("VMException", new VMException());
     }
 }

src/org/perl6/nqp/sixmodel/reprs/VMException.java

@@ -0,0 +1,33 @@
+package org.perl6.nqp.sixmodel.reprs;
+
+import org.perl6.nqp.runtime.ThreadContext;
+import org.perl6.nqp.sixmodel.REPR;
+import org.perl6.nqp.sixmodel.STable;
+import org.perl6.nqp.sixmodel.SerializationReader;
+import org.perl6.nqp.sixmodel.SixModelObject;
+import org.perl6.nqp.sixmodel.TypeObject;
+
+public class VMException extends REPR {
+	public SixModelObject type_object_for(ThreadContext tc, SixModelObject HOW) {
+		STable st = new STable(this, HOW);
+        SixModelObject obj = new TypeObject();
+        obj.st = st;
+        st.WHAT = obj;
+        return st.WHAT;
+	}
+
+	public SixModelObject allocate(ThreadContext tc, STable st) {
+		VMExceptionInstance obj = new VMExceptionInstance();
+        obj.st = st;
+        return obj;
+	}
+
+	public SixModelObject deserialize_stub(ThreadContext tc, STable st) {
+		throw new RuntimeException("VMException does not participate in serialization");
+	}
+
+	public void deserialize_finish(ThreadContext tc, STable st,
+			SerializationReader reader, SixModelObject obj) {
+		throw new RuntimeException("VMException does not participate in serialization");
+	}
+}

src/org/perl6/nqp/sixmodel/reprs/VMExceptionInstance.java

@@ -0,0 +1,12 @@
+package org.perl6.nqp.sixmodel.reprs;
+
+import org.perl6.nqp.runtime.CallFrame;
+import org.perl6.nqp.sixmodel.SixModelObject;
+
+public class VMExceptionInstance extends SixModelObject {
+	public String message;
+	public SixModelObject payload;
+	public long category;
+	public boolean resumable;
+	public CallFrame origin;
+}