Implement correct semantics for return statements inside a Smalltalk

block, which is to return from the method containing the block's
definition.


git-svn-id: svn+ssh://svn.gna.org/svn/gnustep/libs/steptalk/trunk@36419 72102866-910b-0410-8b05-ffd578937521

Languages/Smalltalk/ChangeLog

@@ -1,6 +1,22 @@
+2013-03-24  Wolfgang Lux  <wolfgang.lux@gmail.com>
+
+    * Externs.h (STInterpreterReturnException):
+    * Externs.m (STInterpreterReturnException):
+    * STCompiler.m (-compileStatements:blockFlag:):
+    * STBytecodeInterpreter.m (-interpretMethod:forReceiver:arguments:
+    	-returnValue:, -returnBlockValue:, -dispatchBytecode:):
+    An explicit return statement in a block returns from the method
+    context containing the block's definition. This is achieved by
+    throwing a STInterpreterReturnException.
+
+    * STBlock.m (-handler:): Don't let user code handle
+    STInterpreterReturnException.
+
+    * STBytecodeInterpreter.m (-interpret): Fix incorrect logging levels.
+
 2013-03-23  Wolfgang Lux  <wolfgang.lux@gmail.com>
 
-    * STCompiler.m (compileStatements:blockFlag:): Fix compiler bug: The
+    * STCompiler.m (-compileStatements:blockFlag:): Fix compiler bug: The
     value of a Smalltalk statement sequence is the value of its last
     statement and not that of the first.
 

Languages/Smalltalk/Externs.h

@@ -14,3 +14,4 @@ extern NSString *STCompilerGenericException;
 extern NSString *STCompilerInconsistencyException;
 
 extern NSString *STInterpreterGenericException;
+extern NSString *STInterpreterReturnException;

Languages/Smalltalk/Externs.m

@@ -14,3 +14,4 @@ NSString *STCompilerGenericException = @"STCompilerGenericException";
 NSString *STCompilerInconsistencyException =@"STCompilerInconsistencyException";
 
 NSString *STInterpreterGenericException = @"STInterpreterGenericException";
+NSString *STInterpreterReturnException = @"STInterpreterReturnException";

Languages/Smalltalk/STBlock.m

@@ -23,6 +23,7 @@
  */
 
 
+#import "Externs.h"
 #import "STBlock.h"
 #import "STLiterals.h"
 #import "STBlockContext.h"
@@ -207,6 +208,9 @@ Class STBlockContextClass = nil;
     NS_DURING
         retval = [self value];
     NS_HANDLER
+	/* don't handle the internal STInterpreterReturnException exception */
+	if ([[localException name] isEqualToString:STInterpreterReturnException])
+	    [localException raise];
         retval = [handlerBlock value:localException];
         /* restore the execution context */
         [interpreter setContext:context];

Languages/Smalltalk/STBytecodeInterpreter.m

@@ -116,30 +116,30 @@ static Class NSInvocation_class = nil;
     STMethodContext    *newContext;
     id                  retval;
     
-    if(!environment)
+    if (!environment)
     {
-        [NSException  raise:STInterpreterGenericException
-                     format:@"No execution environment set"];
+        [NSException raise:STInterpreterGenericException
+                    format:@"No execution environment set"];
         return nil;
     }
     
     NSDebugLLog(@"STBytecodeInterpreter",@"Executing method %@ with %i args", 
                 [method selector],[args count]);
 
-    if(!method)
+    if (!method)
     {
         return nil;
     }
     
-    if([args count] != [method argumentCount])
+    if ([args count] != [method argumentCount])
     {
-        [NSException  raise:STInterpreterGenericException
-                     format:@"Invalid argument count %i (should be %i)"
-                            @" for method %@ ",
-                            [args count],[method argumentCount], 
-                            [method selector]];
+        [NSException raise:STInterpreterGenericException
+                    format:@"Invalid argument count %i (should be %i)"
+                           @" for method %@ ",
+                           [args count],[method argumentCount], 
+                           [method selector]];
     }
-    
+
     newContext = [[STMethodContext alloc] initWithMethod:method
                                              environment:environment];
 
@@ -149,14 +149,33 @@ static Class NSInvocation_class = nil;
     oldContext = activeContext;
     [self setContext:newContext];
 
-    retval = [self interpret];
+    NS_DURING
+	retval = [self interpret];
+    NS_HANDLER
+	if ([[localException name] isEqualToString:STInterpreterReturnException])
+	{
+	    NSDictionary *userInfo = [localException userInfo];
+	    if ([userInfo objectForKey: @"Context"] == newContext)
+	    {
+		retval = [userInfo objectForKey:@"Value"];
+	    }
+	    else
+	    {
+		[localException raise];
+	    }
+	}
+	else
+	{
+	    [localException raise];
+	}
+    NS_ENDHANDLER
 
     [self setContext:oldContext];
 
     RELEASE(newContext);
     // RETAIN(retval);
     // [pool release];
-    // AUTORELEASE(retval)
+    // AUTORELEASE(retval);
 
     return retval;
 }
@@ -247,7 +266,7 @@ static Class NSInvocation_class = nil;
     }
     else
     {
-        NSDebugLLog(@"STBytecode interpreter",@"Stop requested");
+        NSDebugLLog(@"STBytecodeInterpreter",@"Stop requested");
         
         retval = nil;
     }
@@ -261,7 +280,7 @@ static Class NSInvocation_class = nil;
 
 - (void)halt
 {
-    NSDebugLLog(@"STBytecode interpreter",@"Halt!");
+    NSDebugLLog(@"STBytecodeInterpreter",@"Halt!");
     stopRequested = YES;
 }
 
@@ -277,6 +296,35 @@ static Class NSInvocation_class = nil;
                 @"%@ return value '%@' from method",
                 activeContext,value);
 
+    if (activeContext != [activeContext homeContext])
+    {
+	NSDictionary *userInfo;
+
+	/* Don't try to optimize this code by invalidating the context before
+	   the conditional. The method -invalidate resets the home context of
+	   a block and hence the test above would always fail. */
+	/* FIXME Invalidate all contexts between the active context and the
+	   home context as well.  Note that the semantics presented in the
+	   Blue Book doesn't get this right either. */
+        userInfo =
+            [NSDictionary dictionaryWithObjectsAndKeys:
+                value, @"Value", [activeContext homeContext], @"Context", nil];
+        [activeContext invalidate];
+        [[NSException exceptionWithName:STInterpreterReturnException
+                                 reason:@"Block cannot return"
+                               userInfo:userInfo] raise];
+    }
+    [activeContext invalidate];
+    [stack push:value];
+}
+ 
+- (void)returnBlockValue:(id)value
+{
+
+    NSDebugLLog(@"STExecutionContext",
+                @"%@ return value '%@' from block",
+                activeContext,value);
+
     [activeContext invalidate];
     [stack push:value];
 }
@@ -538,11 +586,15 @@ static Class NSInvocation_class = nil;
                 break;
 
     case STReturnBytecode:
-    case STReturnBlockBytecode:
                 STDebugBytecode(bytecode);
                 [self returnValue:[stack pop]];
                 return NO;
 
+    case STReturnBlockBytecode:
+                STDebugBytecode(bytecode);
+                [self returnBlockValue:[stack pop]];
+                return NO;
+
     case STBlockCopyBytecode: 
                 STDebugBytecode(bytecode);
                 {

Languages/Smalltalk/STCompiler.m

@@ -643,10 +643,6 @@ extern int STCparse(void *context);
         {
             [self emitPopStack];
         }
-        else 
-        {
-            first = NO;
-        }
         [self compileExpression:expr];
     }
 
@@ -658,7 +654,14 @@ extern int STCparse(void *context);
         stackSize = stackSizeSave;
         stackPos = stackPosSave;
 
-        [self emitReturnFromBlock];
+        if (expr)
+        {
+            [self emitReturn];
+        }
+        else
+        {
+            [self emitReturnFromBlock];
+        }
     }
     else
     {