Fix UpEnv, some other lvars tweaks

.gitignore

@@ -34,7 +34,7 @@
 *.ind
 *.lab
 *.log
-*.out
+main.out
 *.pdf
 *.pnr
 *.six

src/gap.c

@@ -238,8 +238,10 @@ Obj Shell ( Obj context,
   STATE(ShellContext) = context;
   oldBaseShellContext = STATE(BaseShellContext);
   STATE(BaseShellContext) = context;
+  Int oldErrorLLevel = STATE(ErrorLLevel);
+  STATE(ErrorLLevel) = 0;
   oldRecursionDepth = STATE(RecursionDepth);
-  
+
   /* read-eval-print loop                                                */
   if (!OpenOutput(outFile))
       ErrorQuit("SHELL: can't open outfile %s",(Int)outFile,0);
@@ -353,6 +355,7 @@ Obj Shell ( Obj context,
   CloseOutput();
   STATE(BaseShellContext) = oldBaseShellContext;
   STATE(ShellContext) = oldShellContext;
+  STATE(ErrorLLevel) = oldErrorLLevel;
   STATE(RecursionDepth) = oldRecursionDepth;
   if (STATE(UserHasQUIT))
     {
@@ -947,7 +950,7 @@ void DownEnvInner( Int depth )
       depth = 0;
     }
     /* ... then go back to the top, and later go down to the appropriate level. */
-    STATE(ErrorLVars) = STATE(ErrorLVars0);
+    STATE(ErrorLVars) = STATE(BaseShellContext);
     STATE(ErrorLLevel) = 0;
     STATE(ShellContext) = STATE(BaseShellContext);
   }
@@ -2802,7 +2805,7 @@ GVarDescriptor GVarTHREAD_INIT;
 GVarDescriptor GVarTHREAD_EXIT;
 
 void ThreadedInterpreter(void *funcargs) {
-  Obj tmp, func;
+  Obj tmp, func, body;
   int i;
 
   /* intialize everything and begin an interpreter                       */
@@ -2815,10 +2818,10 @@ void ThreadedInterpreter(void *funcargs) {
   STATE(NrError) = 0;
   STATE(ThrownObject) = 0;
   STATE(BottomLVars) = NewBag( T_HVARS, 3*sizeof(Obj) );
-  tmp = NewFunctionC( "bottom", 0, "", 0 );
-  PTR_BAG(STATE(BottomLVars))[0] = tmp;
-  tmp = NewBag( T_BODY, sizeof(BodyHeader) );
-  SET_BODY_FUNC( PTR_BAG(STATE(BottomLVars))[0], tmp );
+  func = NewFunctionC( "bottom", 0, "", 0 );
+  FUNC_LVARS(STATE(BottomLVars)) = func;
+  body = NewBag( T_BODY, sizeof(BodyHeader) );
+  SET_BODY_FUNC( func, body );
   STATE(CurrLVars) = STATE(BottomLVars);
 
   IntrBegin( STATE(BottomLVars) );

src/gap.h

@@ -201,9 +201,6 @@ extern void ErrorReturnVoid (
             Int                 arg2,
             const Char *        msg2 );
 
-/* TL: extern Obj ErrorLVars;
-   TL: extern Obj ErrorLVars0;
- */
 
 /****************************************************************************
 **

src/gapstate.h

@@ -141,9 +141,8 @@ typedef struct GAPState {
     UInt UserHasQUIT;
     Obj  ShellContext;
     Obj  BaseShellContext;
-    Obj  ErrorLVars0;       // the initial ErrorLVars value, i.e. for the lvars were the break occurred
     Obj  ErrorLVars;        // ErrorLVars as modified by DownEnv / UpEnv
-    Int  ErrorLLevel;       // record where on the stack ErrorLVars is relative to the top, i.e. ErrorLVars0
+    Int  ErrorLLevel;       // record where on the stack ErrorLVars is relative to the top, i.e. BaseShellContext
 
     /* From objects.c */
     Obj PrintObjThis;

src/read.c

@@ -415,7 +415,7 @@ void ReadCallVarAss (
       lvars = lvars0;
       nest = 0;
       while ( type == ' ' && lvars != 0 && lvars != STATE(BottomLVars) ) {
-        nams = NAMS_FUNC(PTR_BAG(lvars)[0]);
+        nams = NAMS_FUNC(FUNC_LVARS(lvars));
         if (nams != (Obj) 0)
           {
             indx = LEN_LIST( nams );
@@ -436,7 +436,7 @@ void ReadCallVarAss (
               }
             }
         }
-        lvars = ENVI_FUNC( PTR_BAG( lvars )[0] );
+        lvars = ENVI_FUNC( FUNC_LVARS( lvars ) );
         nest++;
         if (nest >= 65536)
           {
@@ -2728,11 +2728,11 @@ void RecreateStackNams( Obj context )
 {
     Obj lvars = context;
     while (lvars != STATE(BottomLVars) && lvars != (Obj)0)  {
-        Obj nams = NAMS_FUNC(PTR_BAG(lvars)[0]);
+        Obj nams = NAMS_FUNC(FUNC_LVARS(lvars));
         if (nams != (Obj) 0) {
             PushPlist( STATE(StackNams), nams);
         }
-        lvars = ENVI_FUNC(PTR_BAG(lvars)[0]);
+        lvars = ENVI_FUNC(FUNC_LVARS(lvars));
     }
 
     // At this point we have the stack upside down, so invert it
@@ -2755,7 +2755,6 @@ ExecStatus ReadEvalCommand ( Obj context, UInt *dualSemicolon )
     volatile UInt                readTilde;
     volatile UInt                currLHSGVar;
     volatile Obj                 errorLVars;
-    volatile Obj                 errorLVars0;
     syJmp_buf           readJmpError;
 #ifdef HPCGAP
     int                 lockSP;
@@ -2792,9 +2791,7 @@ ExecStatus ReadEvalCommand ( Obj context, UInt *dualSemicolon )
     STATE(CurrLHSGVar) = 0;
     RecreateStackNams(context);
     errorLVars = STATE(ErrorLVars);
-    errorLVars0 = STATE(ErrorLVars0);
     STATE(ErrorLVars) = context;
-    STATE(ErrorLVars0) = STATE(ErrorLVars);
 #ifdef HPCGAP
     lockSP = RegionLockSP();
 #endif
@@ -2862,7 +2859,6 @@ ExecStatus ReadEvalCommand ( Obj context, UInt *dualSemicolon )
     STATE(ReadTilde)   = readTilde;
     STATE(CurrLHSGVar) = currLHSGVar;
     STATE(ErrorLVars) = errorLVars;
-    STATE(ErrorLVars0) = errorLVars0;
 
     /* copy the result (if any)                                            */
     STATE(ReadEvalResult) = STATE(IntrResult);

src/vars.c

@@ -2469,7 +2469,8 @@ Obj FuncParentLVars( Obj self, Obj lvars )
                (Int)TNAM_OBJ(lvars), 0L );
     return 0;
   }
-  return PARENT_LVARS(lvars);
+  Obj parent = PARENT_LVARS(lvars);
+  return parent ? parent : Fail;
 }
 
 Obj FuncContentsLVars (Obj self, Obj lvars )
@@ -2525,7 +2526,7 @@ void SaveLVars( Obj lvars )
   UInt len,i;
   Obj *ptr;
   SaveSubObj(FUNC_LVARS(lvars));
-  SaveUInt((UInt)ADDR_OBJ(lvars)[1]);
+  SaveUInt(STAT_LVARS(lvars));
   SaveSubObj(PARENT_LVARS(lvars));
   len = (SIZE_OBJ(lvars) - (2*sizeof(Obj)+sizeof(UInt)))/sizeof(Obj);
   ptr = ADDR_OBJ(lvars)+3;
@@ -2544,7 +2545,7 @@ void LoadLVars( Obj lvars )
   UInt len,i;
   Obj *ptr;
   FUNC_LVARS(lvars) = LoadSubObj();
-  ((UInt *)ADDR_OBJ(lvars))[1] = LoadUInt();
+  STAT_LVARS(lvars) = LoadUInt();
   PARENT_LVARS(lvars) = LoadSubObj();
   len = (SIZE_OBJ(lvars) - (2*sizeof(Obj)+sizeof(UInt)))/sizeof(Obj);
   ptr = ADDR_OBJ(lvars)+3;

src/vars.h

@@ -73,12 +73,18 @@ static inline int IS_LVARS_OR_HVARS(Obj obj)
 }
 
 
+typedef struct {
+    Obj func;
+    Expr stat;
+    Obj parent;
+} LVarsHeader;
+
 /****************************************************************************
 **
 *F  FUNC_LVARS . . . . . . . . . . . function to which the given lvars belong
 **
 */
-#define FUNC_LVARS_PTR(lvars_ptr)   (lvars_ptr[0])
+#define FUNC_LVARS_PTR(lvars_ptr)   (((LVarsHeader *)lvars_ptr)->func)
 #define FUNC_LVARS(lvars_obj)       FUNC_LVARS_PTR(ADDR_OBJ(lvars_obj))
 
 
@@ -87,7 +93,7 @@ static inline int IS_LVARS_OR_HVARS(Obj obj)
 *F  STAT_LVARS . . . . . . . current statement in function of the given lvars
 **
 */
-#define STAT_LVARS_PTR(lvars_ptr)   (lvars_ptr[1])
+#define STAT_LVARS_PTR(lvars_ptr)   (((LVarsHeader *)lvars_ptr)->stat)
 #define STAT_LVARS(lvars_obj)       STAT_LVARS_PTR(ADDR_OBJ(lvars_obj))
 
 
@@ -96,7 +102,7 @@ static inline int IS_LVARS_OR_HVARS(Obj obj)
 *F  PARENT_LVARS . . . . . . . . . . . . . .  parent lvars of the given lvars
 **
 */
-#define PARENT_LVARS_PTR(lvars_ptr) (lvars_ptr[2])
+#define PARENT_LVARS_PTR(lvars_ptr) (((LVarsHeader *)lvars_ptr)->parent)
 #define PARENT_LVARS(lvars_obj)     PARENT_LVARS_PTR(ADDR_OBJ(lvars_obj))
 
 
@@ -136,11 +142,11 @@ static inline void SetBrkCallTo( Expr expr, const char * file, int line ) {
             (int)expr, (int)STATE(CurrLVars), file, line);
   }
 #endif
-  STAT_LVARS_PTR(STATE(PtrLVars)) = (Obj)expr;
+  STAT_LVARS_PTR(STATE(PtrLVars)) = expr;
 }
 
 #ifndef NO_BRK_CALLS
-#define BRK_CALL_TO()                   ((Expr)STAT_LVARS_PTR(STATE(PtrLVars)))
+#define BRK_CALL_TO()                   STAT_LVARS_PTR(STATE(PtrLVars))
 #define SET_BRK_CALL_TO(expr)           SetBrkCallTo(expr, __FILE__, __LINE__)
 #else
 #define BRK_CALL_TO()                   /* do nothing */

tst/test-error/bad-add.g.out

@@ -1,8 +1,9 @@
+function(  ) ... end
 Error, no method found! For debugging hints type ?Recovery from NoMethodFound
 Error, no 1st choice method found for `+' on 2 arguments at GAPROOT/lib/methsel2.g:241 called from
-1 + "abc" at bad-add.g:2 called from
+1 + "abc" at *stdin*:2 called from
 <function "f">( <arguments> )
- called from read-eval loop at bad-add.g:4
+ called from read-eval loop at *stdin*:4
 you can 'quit;' to quit to outer loop, or
 you can 'return;' to continue
-brk> 
+brk> 

tst/test-error/bad-array-double-1.g.out

@@ -1,8 +1,9 @@
+function(  ) ... end
 Error, no method found! For debugging hints type ?Recovery from NoMethodFound
 Error, no 1st choice method found for `[]' on 3 arguments at GAPROOT/lib/methsel2.g:241 called from
 <compiled or corrupted statement>  called from
 <function "f">( <arguments> )
- called from read-eval loop at bad-array-double-1.g:4
+ called from read-eval loop at *stdin*:4
 you can 'quit;' to quit to outer loop, or
 you can 'return;' to continue
-brk> 
+brk> 

tst/test-error/bad-array-int-0.g.out

@@ -1,8 +1,9 @@
+function(  ) ... end
 Error, no method found! For debugging hints type ?Recovery from NoMethodFound
 Error, no 1st choice method found for `[]' on 2 arguments at GAPROOT/lib/methsel2.g:241 called from
-l[0] at bad-array-int-0.g:4 called from
+l[0] at *stdin*:4 called from
 <function "f">( <arguments> )
- called from read-eval loop at bad-array-int-0.g:6
+ called from read-eval loop at *stdin*:6
 you can 'quit;' to quit to outer loop, or
 you can 'return;' to continue
-brk> 
+brk> 

tst/test-error/bad-array-int-1.g.out

@@ -1,6 +1,7 @@
+function(  ) ... end
 Error, List Element: <list> must be a list (not a integer) in
-  return 1[1]; at bad-array-int-1.g:2 called from 
+  return 1[1]; at *stdin*:2 called from 
 <function "f">( <arguments> )
- called from read-eval loop at bad-array-int-1.g:4
+ called from read-eval loop at *stdin*:4
 you can replace <list> via 'return <list>;'
-brk> 
+brk> 

tst/test-error/bad-array-string.g.out

@@ -1,8 +1,9 @@
+function(  ) ... end
 Error, no method found! For debugging hints type ?Recovery from NoMethodFound
 Error, no 1st choice method found for `[]' on 2 arguments at GAPROOT/lib/methsel2.g:241 called from
-1["abc"] at bad-array-string.g:2 called from
+1["abc"] at *stdin*:2 called from
 <function "f">( <arguments> )
- called from read-eval loop at bad-array-string.g:4
+ called from read-eval loop at *stdin*:4
 you can 'quit;' to quit to outer loop, or
 you can 'return;' to continue
-brk> 
+brk> 

tst/test-error/bad-array-undef-0.g.out

@@ -1,6 +1,7 @@
+function(  ) ... end
 Error, Variable: 'l' must have an assigned value in
-  return l[1]; at bad-array-undef-0.g:3 called from 
+  return l[1]; at *stdin*:3 called from 
 <function "f">( <arguments> )
- called from read-eval loop at bad-array-undef-0.g:5
+ called from read-eval loop at *stdin*:5
 you can 'return;' after assigning a value
-brk> 
+brk> 

tst/test-error/bad-array-undef-1.g.out

@@ -1,6 +1,7 @@
+function(  ) ... end
 Error, Variable: 'm' must have an assigned value in
-  return l[m]; at bad-array-undef-1.g:4 called from 
+  return l[m]; at *stdin*:4 called from 
 <function "f">( <arguments> )
- called from read-eval loop at bad-array-undef-1.g:6
+ called from read-eval loop at *stdin*:6
 you can 'return;' after assigning a value
-brk> 
+brk> 

tst/test-error/bad-minus.g.out

@@ -1,10 +1,11 @@
+function(  ) ... end
 Error, no method found! For debugging hints type ?Recovery from NoMethodFound
 Error, no 1st choice method found for `AdditiveInverseMutable' on 1 arguments at GAPROOT/lib/methsel2.g:241 called from
 AINV_MUT( elm ) at GAPROOT/lib/arith.gi:200 called from
 AdditiveInverseAttr( elm ) at GAPROOT/lib/arith.gi:213 called from
-1 - "abc" at bad-minus.g:2 called from
+1 - "abc" at *stdin*:2 called from
 <function "f">( <arguments> )
- called from read-eval loop at bad-minus.g:4
+ called from read-eval loop at *stdin*:4
 you can 'quit;' to quit to outer loop, or
 you can 'return;' to continue
-brk> 
+brk> 

tst/test-error/good.g

@@ -0,0 +1 @@
+Print("All is well\n");

tst/test-error/good.g.out

@@ -0,0 +1 @@
+All is well

tst/test-error/run_gap.sh

@@ -8,4 +8,4 @@
 # 3) Rewrite the root of gap with the string GAPROOT,
 #    so the output is usable on other machines
 GAPROOT=$(cd ../..; pwd)
-echo 'Read("'$2'");\n' | $1 -r -A -q -b -x 200 2>&1 | sed "s:${GAPROOT//:/\\:}:GAPROOT:g"
+cat "$2" | "$1" -r -A -q -b -x 200 2>&1 | sed "s:${GAPROOT//:/\\:}:GAPROOT:g"

tst/test-error/top-level-error.g.out

@@ -1,5 +1,5 @@
 Error, foo called from
-not in any function at top-level-error.g:1
+not in any function at *stdin*:1
 you can 'quit;' to quit to outer loop, or
 you can 'return;' to continue
-brk> 
+brk> brk> 

tst/test-error/up-down-env.g

@@ -0,0 +1,17 @@
+f:=lvl -> 1/lvl + f(lvl-1);
+f(7);
+UpEnv(1); lvl;
+DownEnv(1); lvl;
+DownEnv(1); lvl;
+UpEnv(1); lvl;
+DownEnv(10); lvl;
+UpEnv(1); lvl;
+UpEnv(3); lvl;
+DownEnv(2); lvl;
+Read("good.g");
+lvl;
+Read("top-level-error.g");
+Where(20);
+lvl;
+quit;
+lvl;

tst/test-error/up-down-env.g.out

@@ -0,0 +1,29 @@
+function( lvl ) ... end
+Error, Rational operations: <divisor> must not be zero in
+  return 1 / lvl + f( (lvl - 1) ); at *stdin*:1 called from 
+f( lvl - 1 ) at *stdin*:1 called from
+f( lvl - 1 ) at *stdin*:1 called from
+f( lvl - 1 ) at *stdin*:1 called from
+f( lvl - 1 ) at *stdin*:1 called from
+f( lvl - 1 ) at *stdin*:1 called from
+...  at *stdin*:2
+you can replace <divisor> via 'return <divisor>;'
+brk> 0
+brk> 1
+brk> 2
+brk> 1
+brk> 7
+brk> 6
+brk> 3
+brk> 5
+brk> All is well
+brk> 5
+brk> Error, foo called from
+not in any function at top-level-error.g:1
+you can 'quit;' to quit to outer loop, or
+you can 'return;' to continue
+brk_2> not in any function at *errin*:1
+brk_2> Error, Variable: 'lvl' must have a value
+not in any function at *errin*:2
+brk_2> brk> 5
+brk>