Index: trunk/HISTORY
===================================================================
--- trunk/HISTORY	(Revision 2543)
+++ trunk/HISTORY	(Arbeitskopie)
@@ -26,6 +26,8 @@
          hash() only). hash() costs 10 ticks per iteration.
        + sha1() calculated wrong hash values with multiple interations.
        + md5() and sha1() are obsoleted by hash().
+       + lambda() now supports bound and unbound lambdas as the first element
+         in an array of a lambda expression.
 
     - Runtime
        + The --max-malloced memory limit was renamed to --hard-malloc-limit.
Index: trunk/src/closure.c
===================================================================
--- trunk/src/closure.c	(Revision 2547)
+++ trunk/src/closure.c	(Arbeitskopie)
@@ -4439,12 +4439,12 @@
             break;
           } /* CLOSURE_SIMUL_EFUN */
 
+        case CLOSURE_PRELIMINARY:
+            lambda_error("Unimplemented closure type for lambda()\n");
+
         case CLOSURE_UNBOUND_LAMBDA:
         case CLOSURE_BOUND_LAMBDA:
         case CLOSURE_LAMBDA:
-        case CLOSURE_PRELIMINARY:
-            lambda_error("Unimplemented closure type for lambda()\n");
-
         case CLOSURE_LFUN:
           {
             /* This is compiled as
@@ -4458,9 +4458,9 @@
              *
              * alien-lfun: lambda->ob != lambda->function.lfun.ob
              *
-             * For now inherited lfun closures are compiled as alien
-             * lfuns.
-             * TODO: Implement them using internal calls.
+             * Inherited lfun closures, context lfun closures and lambda
+             * closures are compiled similar to alien lfuns using
+             * F_CALL_CLOSURE.
              */
 
             mp_int i;
@@ -4469,9 +4469,8 @@
 
             block_size = (mp_int)VEC_SIZE(block);
             l = argp->u.lambda;
-            if (l->ob != current.lambda_origin
-             || l->ob != l->function.lfun.ob
-             || l->function.lfun.inhProg
+            if ((type != CLOSURE_UNBOUND_LAMBDA && l->ob != current.lambda_origin)
+             || (type == CLOSURE_LFUN && l->ob != l->function.lfun.ob)
                )
             {
                 /* Compile it like an alien lfun */
@@ -4493,10 +4492,36 @@
                 STORE_CODE(current.codep, instrs[F_FUNCALL].opcode);
                 STORE_CODE(current.codep, instrs[F_RESTORE_ARG_FRAME].opcode);
             }
+            else if (type != CLOSURE_LFUN
+             || l->function.lfun.inhProg
+#ifdef USE_NEW_INLINES
+             || l->function.lfun.context_size
+#endif
+               )
+            {
+                /* Compile it using F_CALL_CLOSURE. */
+
+                if (current.code_left < 1)
+                    realloc_code();
+                current.code_left -= 1;
+                STORE_CODE(current.codep, instrs[F_SAVE_ARG_FRAME].opcode);
+
+                insert_value_push(argp); /* Push the closure */
+                for (i = block_size; --i; )
+                {
+                    compile_value(++argp, 0);
+                }
+                if (current.code_left < 3)
+                    realloc_code();
+                current.code_left -= 3;
+                STORE_CODE(current.codep, instrs[F_CALL_CLOSURE].opcode);
+                STORE_CODE(current.codep, instrs[F_POP_SECOND].opcode);
+                STORE_CODE(current.codep, instrs[F_RESTORE_ARG_FRAME].opcode);
+            }
             else
             {
-            	/* Intra-object call: we can call by address */
-            	
+                /* Intra-object call: we can call by address */
+
                 if (current.code_left < 1)
                     realloc_code();
                 current.code_left -= 1;
Index: trunk/src/func_spec
===================================================================
--- trunk/src/func_spec	(Revision 2543)
+++ trunk/src/func_spec	(Arbeitskopie)
@@ -143,6 +143,7 @@
  */
 
         pop_value
+        pop_second
         dup
         ldup
         swap_values
@@ -163,6 +164,7 @@
         call_function
         call_inherited
         call_inherited_noargs
+        call_closure
 #ifdef USE_NEW_INLINES
         context_closure
         context_identifier
Index: trunk/src/interpret.c
===================================================================
--- trunk/src/interpret.c	(Revision 2547)
+++ trunk/src/interpret.c	(Arbeitskopie)
@@ -13168,6 +13168,14 @@
         pop_stack();
         break;
 
+    CASE(F_POP_SECOND);             /* --- pop_second          --- */
+        /* Pop the value under the topmost value and put the
+         * topmost value there.
+         */
+        free_svalue(--sp);
+        *sp = sp[1];
+        break;
+
     CASE(F_DUP);                    /* --- dup                 --- */
         /* Push a duplicate of sp[0] onto the stack.
          */
@@ -13691,6 +13699,58 @@
         break;
     }
 
+    CASE(F_CALL_CLOSURE); /* --- call_closure --- */
+        /* Call the closure on the stack with the arguments on the stack.
+         * Just like funcall(), but as an internal call.
+         * We leave the closure an the stack for a following F_POP_SECOND
+         * to clear it up. This instruction is only used by lambda closures.
+         */
+    {
+        num_arg = sp - ap;
+
+        if (ap->type == T_CLOSURE)
+        {
+            inter_sp = sp;
+
+            /* No external calls may be done when this object is
+             * destructed.
+             */
+            if (current_object->flags & O_DESTRUCTED)
+            {
+                sp = _pop_n_elems(num_arg, sp);
+                push_number(sp, 0);
+                inter_sp = sp;
+                warnf("Call from destructed object '%s' ignored.\n"
+                     , get_txt(current_object->name));
+                return sp;
+            }
+
+            /* Call the closure and push the result.
+             * Note that the closure might destruct itself.
+             */
+            inter_pc = pc;
+
+            int_call_lambda(ap, num_arg, MY_FALSE, MY_FALSE);
+
+            pc = inter_pc;
+            sp = inter_sp;
+            fp = inter_fp;
+        }
+        else
+        {
+            /* Not a closure: pop the excess args and return <cl>
+             * as result.
+             */
+
+            sp = _pop_n_elems(num_arg, sp);
+            push_number(sp, 0);
+        }
+
+        break;
+    }
+
+
+
 #ifdef USE_NEW_INLINES
     CASE(F_CONTEXT_IDENTIFIER);  /* --- context_identifier <var_ix> --- */
         /* Push value of context variable <var_ix>.
@@ -17075,7 +17135,7 @@
             }
             else /* hook->type == T_CLOSURE */
             {
-                int_call_lambda(hook, num_arg+num_extra, MY_TRUE);
+                int_call_lambda(hook, num_arg+num_extra, MY_TRUE, MY_TRUE);
                 rc = 1; /* This call obviously succeeds */
             }
 
@@ -17794,7 +17854,7 @@
 
 /*-------------------------------------------------------------------------*/
 void
-int_call_lambda (svalue_t *lsvp, int num_arg, Bool allowRefs)
+int_call_lambda (svalue_t *lsvp, int num_arg, Bool allowRefs, Bool external)
 
 /* Call the closure <lsvp> with <num_arg> arguments on the stack. On
  * success, the arguments are replaced with the result, else an errorf()
@@ -17802,6 +17862,10 @@
  * If <allowRefs> is TRUE, references may be passed as extended varargs
  * ('(varargs mixed *)'). Currently this is used only for simul efuns.
  * is generated.
+ *
+ * If <external> is TRUE, the eval_instruction is called to execute the
+ * closure. Otherwise inter_pc is just set and int_call_lambda returns
+ * (this is only valid for non-alien lfun or lambda closures).
  */
 
 {
@@ -17908,6 +17972,7 @@
             csp->prev_ob = previous_ob;
             csp->num_local_variables = num_arg;
             previous_ob = current_object;
+            external = MY_TRUE;
         }
         else
             extra_frame = MY_FALSE;
@@ -17915,7 +17980,7 @@
         /* Finish the setup of the control frame.
          * This is a real inter-object call.
          */
-        csp->extern_call = MY_TRUE;
+        csp->extern_call = external;
         current_object = l->function.lfun.ob;
         current_prog = current_object->prog;
         /* inter_sp == sp */
@@ -17924,7 +17989,10 @@
         if (l->function.lfun.context_size > 0)
             inter_context = l->context;
 #endif /* USE_NEW_INLINES */
-        eval_instruction(FUNCTION_CODE(csp->funstart), inter_sp);
+        if (external)
+            eval_instruction(FUNCTION_CODE(csp->funstart), inter_sp);
+        else
+            inter_pc = FUNCTION_CODE(csp->funstart);
 
         /* If l->ob selfdestructs during the call, l might have been
          * deallocated at this point!
@@ -17987,6 +18055,13 @@
         return;
       }
 
+    case CLOSURE_PRELIMINARY:
+        /* no valid current_object: fall out of the switch
+         * and let the error handling clean up the control
+         * stack.
+         */
+        break;
+
     case CLOSURE_BOUND_LAMBDA:  /* --- bound lambda closure --- */
       {
         lambda_t *l2;
@@ -18000,6 +18075,19 @@
       }
       /* FALLTHROUGH */
 
+    case CLOSURE_UNBOUND_LAMBDA:
+      if (lsvp->x.closure_type == CLOSURE_UNBOUND_LAMBDA)
+      {
+          if (external)
+              break;
+
+          /* Internal call of an unbound closure.
+           * Bind it on the fly.
+           */
+          l->ob = current_object;
+      }
+      /* FALLTHROUGH */
+
     case CLOSURE_LAMBDA:
       {
         fun_hdr_p funstart;
@@ -18038,22 +18126,21 @@
         function_index_offset = 0;
         funstart = l->function.code + 1;
         csp->funstart = funstart;
+        csp->extern_call = external;
         sp = setup_new_frame2(funstart, sp, allowRefs, MY_TRUE);
         current_variables = current_object->variables;
         current_strings = current_prog->strings;
-        eval_instruction(FUNCTION_CODE(funstart), sp);
+        if (external)
+            eval_instruction(FUNCTION_CODE(funstart), sp);
+        else
+        {
+            inter_pc = FUNCTION_CODE(funstart);
+            inter_sp = sp;
+        }
         /* The result is on the stack (inter_sp). */
         return;
       }
 
-    case CLOSURE_UNBOUND_LAMBDA:
-    case CLOSURE_PRELIMINARY:
-        /* no valid current_object: fall out of the switch
-         * and let the error handling clean up the control
-         * stack.
-         */
-        break;
-
     default: /* --- efun-, simul efun-, operator closure */
       {
         int i;  /* the closure type */
Index: trunk/src/interpret.h
===================================================================
--- trunk/src/interpret.h	(Revision 2543)
+++ trunk/src/interpret.h	(Arbeitskopie)
@@ -207,8 +207,8 @@
 #define secure_callback_lambda(fun, num_arg) secure_call_lambda(fun, num_arg, MY_TRUE)
 
 extern void remove_object_from_stack(object_t *ob);
-extern void int_call_lambda(svalue_t *lsvp, int num_arg, Bool allowRefs);
-#define call_lambda(lsvp, num_arg) int_call_lambda(lsvp, num_arg, MY_FALSE)
+extern void int_call_lambda(svalue_t *lsvp, int num_arg, Bool allowRefs, Bool external);
+#define call_lambda(lsvp, num_arg) int_call_lambda(lsvp, num_arg, MY_FALSE, MY_TRUE)
 extern inherit_t *adjust_variable_offsets(const inherit_t *inheritp, const program_t *prog, const object_t *obj);
 extern void free_interpreter_temporaries(void);
 extern void invalidate_apply_low_cache(void);
Index: trunk/CHANGELOG
===================================================================
--- trunk/CHANGELOG	(Revision 2548)
+++ trunk/CHANGELOG	(Arbeitskopie)
@@ -1,6 +1,11 @@
 This file lists all changes made to the game driver in all glory detail.
 See the file HISTORY for a user-oriented summary of all the changes.
 
+16-Apr-2009 (Gnomi)
+  - (closure.c, interpret.c) New opcodes F_CALL_CLOSURE and F_POP_SECOND
+    for calling more complicated closures like lambda, inherited lfun
+    and context closures from within a lambda closure. (Bug #613)
+
 15-Apr-2009 (Gnomi)
   - (pkg-gnutls.c) Support for older versions of libgnutls.