Changeset 15709


Ignore:
Timestamp:
06/19/23 06:51:33 (5 months ago)
Author:
Mark Evenson
Message:

Working stepper for ABCL as a contrib!

Some characteristics:

  • For intepreted code, it won't step into compiled code
  • It is ready to use from a plain REPL and from SLIME.
  • ':?' will help a minimal help
  • Can inspect variables and symbols in the current package with 'i'
  • ':c' will resume the evaluation until the end without the stepper
  • ':s' will resume the evaluation until the next form to be analyzed
  • ':sn' will to step to the next form
  • case-insensitive when inspecting
  • ':l' will print the local bindings
  • ':q' will skip the current stepping evaluation and return NIL
  • ':b' will add a breakpoint to a symbol to use with next (n)
  • ':r' will remove an existent symbol breakpoint to use with next (n)
  • ':d' will remove all existent symbol breakpoints to use with next (n)
  • ':w' allows to watch a symbol binding
  • ':u' allows to (un)watch a symbol binding
  • ':bt' shows the current backtrace

fix

Location:
trunk/abcl
Files:
4 added
3 edited

Legend:

Unmodified
Added
Removed

  • trunk/abcl/src/org/armedbear/lisp/Environment.java

    r15361 r15709  
    127127  }
    128128
     129  public Binding getOuterMostBlock() {
     130    Binding binding = blocks;
     131    Binding result = binding;
     132    while (binding != null) {
     133      result = binding;
     134      binding = binding.next;
     135    }
     136    return result;
     137  }
     138
    129139  public Binding getBinding(LispObject symbol) {
    130140    return getBinding(symbol, vars);
    … …  
    361371            for (Binding binding = env.vars;
    362372                 binding != null; binding = binding.next)
    363               if (binding.specialp)
    364                 result = result.push(binding.symbol);
     373              if (binding.specialp) {
     374                LispObject symbolValue = ((Symbol)binding.symbol).symbolValueNoThrow();
     375                if (symbolValue != null) {
     376                  result = result.push(new Cons(binding.symbol, symbolValue));
     377                }
     378                else {
     379                  result = result.push(binding.symbol);
     380                }
     381              }
    365382              else
    366383                result = result.push(new Cons(binding.symbol, binding.value));

  • trunk/abcl/src/org/armedbear/lisp/Lisp.java

    r15707 r15709  
    485485    else
    486486      { threadToInterrupt = null; }
    487     interrupted = b; 
     487    interrupted = b;
    488488  }
    489489
    … …  
    569569                    fun.incrementCallCount();
    570570                // Don't eval args!
    571                 return fun.execute(((Cons)obj).cdr, env);
     571                LispObject stepInSymbolResult = stepInSymbolP(fun, obj);
     572                long stepNumberInternal = 0;
     573                if (stepInSymbolResult != NIL) {
     574                  stepNumber += 1;
     575                  stepNumberInternal = stepNumber;
     576                  handleStepping(fun, (obj != NIL) ? ((Cons)obj).cdr : obj, env,
     577                                 LispInteger.getInstance(stepNumberInternal));
     578                }
     579                LispObject result = fun.execute(((Cons)obj).cdr, env);
     580                if (stepInSymbolResult != NIL) {
     581                  printStepValue(stepNumberInternal, result, thread);
     582                }
     583                setStepCounterCompleted(stepNumberInternal);
     584                return result;
    572585              }
    573586            if (fun instanceof MacroObject)
    … …  
    575588                try
    576589                  {
    577                     thread.envStack.push(new Environment(null,NIL,fun)); 
     590                    thread.envStack.push(new Environment(null,NIL,fun));
    578591                    return eval(macroexpand(obj, env, thread), env, thread);}
    579592                finally
    … …  
    611624  // Also used in JProxy.java.
    612625  public static final LispObject evalCall(LispObject function,
    613                                              LispObject args,
    614                                              Environment env,
    615                                              LispThread thread)
    616 
    617   {
     626                                          LispObject args,
     627                                          Environment env,
     628                                          LispThread thread)
     629
     630  {
     631    LispObject stepInSymbolResult = stepInSymbolP(function, args);
     632    long stepNumberInternal = 0;
     633    if (stepInSymbolResult != NIL) {
     634      stepNumber += 1;
     635      stepNumberInternal = stepNumber;
     636      handleStepping(function, args != NIL ? ((Cons)args) : args, env,
     637                     LispInteger.getInstance(stepNumber));
     638    }
     639    LispObject result = NIL;
    618640    if (args == NIL) {
    619       return thread.execute(function);
     641      result = thread.execute(function);
     642      if (stepInSymbolResult != NIL) {
     643        printStepValue(stepNumberInternal, result, thread);
     644      }
     645      setStepCounterCompleted(stepNumberInternal);
     646      return result;
    620647    }
    621648    LispObject first = eval(args.car(), env, thread);
    … …  
    623650    if (args == NIL) {
    624651      thread._values = null;
    625       return thread.execute(function, first);
     652      result = thread.execute(function, first);
     653      if (stepInSymbolResult != NIL) {
     654        printStepValue(stepNumberInternal, result, thread);
     655      }
     656      setStepCounterCompleted(stepNumberInternal);
     657      return result;
    626658    }
    627659    LispObject second = eval(args.car(), env, thread);
    … …  
    629661    if (args == NIL) {
    630662      thread._values = null;
    631       return thread.execute(function, first, second);
     663      result = thread.execute(function, first, second);
     664      if (stepInSymbolResult != NIL) {
     665        printStepValue(stepNumberInternal, result, thread);
     666      }
     667      setStepCounterCompleted(stepNumberInternal);
     668      return result;
    632669    }
    633670    LispObject third = eval(args.car(), env, thread);
    … …  
    635672    if (args == NIL) {
    636673      thread._values = null;
    637       return thread.execute(function, first, second, third);
     674      result = thread.execute(function, first, second, third);
     675      if (stepInSymbolResult != NIL) {
     676        printStepValue(stepNumberInternal, result, thread);
     677      }
     678      setStepCounterCompleted(stepNumberInternal);
     679      return result;
    638680    }
    639681    LispObject fourth = eval(args.car(), env, thread);
    … …  
    641683    if (args == NIL) {
    642684      thread._values = null;
    643       return thread.execute(function, first, second, third, fourth);
     685      result = thread.execute(function, first, second, third, fourth);
     686      if (stepInSymbolResult != NIL) {
     687        printStepValue(stepNumberInternal, result, thread);
     688      }
     689      setStepCounterCompleted(stepNumberInternal);
     690      return result;
    644691    }
    645692    LispObject fifth = eval(args.car(), env, thread);
    … …  
    647694    if (args == NIL) {
    648695      thread._values = null;
    649       return thread.execute(function, first, second, third, fourth, fifth);
     696      result = thread.execute(function, first, second, third, fourth, fifth);
     697      if (stepInSymbolResult != NIL) {
     698        printStepValue(stepNumberInternal, result, thread);
     699      }
     700      setStepCounterCompleted(stepNumberInternal);
     701      return result;
    650702    }
    651703    LispObject sixth = eval(args.car(), env, thread);
    … …  
    653705    if (args == NIL) {
    654706      thread._values = null;
    655       return thread.execute(function, first, second, third, fourth, fifth,
     707      result = thread.execute(function, first, second, third, fourth, fifth,
    656708                            sixth);
     709      if (stepInSymbolResult != NIL) {
     710        printStepValue(stepNumberInternal, result, thread);
     711      }
     712      setStepCounterCompleted(stepNumberInternal);
     713      return result;
    657714    }
    658715    LispObject seventh = eval(args.car(), env, thread);
    … …  
    660717    if (args == NIL) {
    661718      thread._values = null;
    662       return thread.execute(function, first, second, third, fourth, fifth,
     719      result = thread.execute(function, first, second, third, fourth, fifth,
    663720                            sixth, seventh);
     721      if (stepInSymbolResult != NIL) {
     722        printStepValue(stepNumberInternal, result, thread);
     723      }
     724      setStepCounterCompleted(stepNumberInternal);
     725      return result;
    664726    }
    665727    LispObject eighth = eval(args.car(), env, thread);
    … …  
    667729    if (args == NIL) {
    668730      thread._values = null;
    669       return thread.execute(function, first, second, third, fourth, fifth,
     731      result = thread.execute(function, first, second, third, fourth, fifth,
    670732                            sixth, seventh, eighth);
     733      if (stepInSymbolResult != NIL) {
     734        printStepValue(stepNumberInternal, result, thread);
     735      }
     736      setStepCounterCompleted(stepNumberInternal);
     737      return result;
    671738    }
    672739    // More than CALL_REGISTERS_MAX arguments.
    … …  
    686753    }
    687754    thread._values = null;
    688     return thread.execute(function, array);
     755    result = thread.execute(function, array);
     756    if (stepInSymbolResult != NIL) {
     757      printStepValue(stepNumberInternal, result, thread);
     758    }
     759    setStepCounterCompleted(stepNumberInternal);
     760    return result;
     761
    689762  }
    690763
    … …  
    22872360    };
    22882361
     2362
    22892363  public static final Symbol internSpecial(String name, Package pkg,
    22902364                                           LispObject value)
    … …  
    29823056  // condition system before this reference is reached.
    29833057  public static java.lang.Object UNREACHED = null;
     3058
     3059  // stepping related code
     3060  public static boolean steppingTask = false;
     3061  public static boolean stepping = false;
     3062  public static boolean delimitedStepping = false;
     3063  public static Binding stepperBlock = null;
     3064  public static long stepNumber = 0;
     3065
     3066  public static LispObject stepInSymbolP (LispObject fun, LispObject obj) {
     3067    Package stepper;
     3068    Symbol symbol;
     3069    LispThread currentThread = LispThread.currentThread();
     3070    LispObject stepInSymbolPFunction;
     3071    LispObject result;
     3072    if (steppingTask) {
     3073      return NIL;
     3074    }
     3075    if (stepping) {
     3076      stepper = Packages.findPackageGlobally("ABCL-STEPPER");
     3077      symbol = stepper.findAccessibleSymbol("STEP-IN-SYMBOL-P");
     3078      stepInSymbolPFunction = coerceToFunction(symbol);
     3079      result = funcall(stepInSymbolPFunction, new LispObject[] {
     3080          fun, obj, LispObject.getInstance(delimitedStepping)
     3081        },
     3082        currentThread);
     3083      return result;
     3084    }
     3085    return NIL;
     3086  }
     3087
     3088  public static synchronized final void handleStepping (LispObject function, LispObject args,
     3089                                                        Environment env, LispInteger stepCount) {
     3090    LispThread currentThread = LispThread.currentThread();
     3091    Package stepper = Packages.findPackageGlobally("ABCL-STEPPER");
     3092    Symbol symbolPprintFormToStep = stepper.findAccessibleSymbol("PPRINT-FORM-TO-STEP");
     3093    Symbol symbolHandleUserInteraction = stepper.findAccessibleSymbol("HANDLE-USER-INTERACTION");
     3094    LispObject functionPprintFormToStep = coerceToFunction(symbolPprintFormToStep);
     3095    LispObject functionHandleUserInteraction = coerceToFunction(symbolHandleUserInteraction);
     3096    if (stepperBlock == null) {
     3097      stepperBlock = env.getOuterMostBlock();
     3098    }
     3099    if (function instanceof FuncallableStandardObject) {
     3100      function = ((FuncallableStandardObject)function).function;
     3101    }
     3102    LispObject closureName = ((Operator)function).getLambdaName();
     3103    setSteppingOff();
     3104    if (closureName != null ) {
     3105      funcall(functionPprintFormToStep, new LispObject[] {closureName, args, stepCount}, currentThread);
     3106    }
     3107    else {
     3108      funcall(functionPprintFormToStep, new LispObject[] {((Operator)function), args, stepCount}, currentThread);
     3109    }
     3110    setSteppingOn();
     3111    funcall(functionHandleUserInteraction, new LispObject[]{env}, currentThread);
     3112  }
     3113
     3114  public static final void printStepValue(long stepNumberInternal, LispObject result, LispThread thread) {
     3115    Package stepper = Packages.findPackageGlobally("ABCL-STEPPER");
     3116    Symbol symbolPrintStepperStr = stepper.findAccessibleSymbol("PRINT-STEPPER-STR");
     3117    LispObject functionPrintStepperStr = coerceToFunction(symbolPrintStepperStr);
     3118    LispObject[] values = thread._values;
     3119    if (values != null) {
     3120      for (int i = 0; i < values.length; i++) {
     3121        funcall(functionPrintStepperStr,
     3122                new LispObject[] {
     3123                  new SimpleString("step " + stepNumberInternal + " ==> value: " + values[i].printObject()),
     3124                  Symbol.T
     3125                },
     3126                thread);
     3127      }
     3128    }
     3129    else {
     3130      funcall(functionPrintStepperStr, new LispObject[] {
     3131          new SimpleString("step " + stepNumberInternal + " ==> value: " + result.printObject()),
     3132          Symbol.T
     3133        },
     3134        thread);
     3135    }
     3136    thread._values = values;
     3137  }
     3138
     3139  public static final void setStepCounterCompleted (long stepNumberInternal) {
     3140    if (stepping) {
     3141      LispThread currentThread = LispThread.currentThread();
     3142      Package stepper = Packages.findPackageGlobally("ABCL-STEPPER");
     3143      Symbol symbolSetStepCounterCompleted = stepper.findAccessibleSymbol("SET-STEP-COUNTER-COMPLETED");
     3144      LispObject functionSetStepCounterCompleted = coerceToFunction(symbolSetStepCounterCompleted);
     3145      LispObject[] values = currentThread._values;
     3146      funcall(functionSetStepCounterCompleted,
     3147              new LispObject[] {LispInteger.getInstance(stepNumberInternal)},
     3148              currentThread);
     3149      currentThread._values = values;
     3150    }
     3151  }
     3152
     3153  public static void setSteppingTaskOn () {
     3154    steppingTask = true;
     3155  }
     3156
     3157  public static void setSteppingTaskOff () {
     3158    steppingTask = false;
     3159  }
     3160
     3161  public static void setDelimitedSteppingOn () {
     3162    delimitedStepping = true;
     3163  }
     3164
     3165  public static void setDelimitedSteppingOff () {
     3166    delimitedStepping = false;
     3167  }
     3168
     3169  public static void setSteppingOn () {
     3170    stepping = true;
     3171  }
     3172
     3173  public static void initializeStepCounter () {
     3174    stepNumber = 0;
     3175  }
     3176
     3177  public static LispObject getStepCounter () {
     3178    return LispInteger.getInstance(stepNumber);
     3179  }
     3180
     3181  public static void setSteppingOff () {
     3182    stepping = false;
     3183  }
     3184
     3185  public static void initializeStepBlock () {
     3186    stepperBlock = null;
     3187  }
     3188
     3189  // ### %set-stepping-task-on
     3190  public static final Primitive SET_STEPPING_TASK_ON =
     3191    new Primitive("%set-stepping-task-on", PACKAGE_SYS, true)
     3192    {
     3193      @Override
     3194      public LispObject execute()
     3195
     3196      {
     3197        setSteppingTaskOn();
     3198        return NIL;
     3199      }
     3200    };
     3201
     3202  // ### %set-stepping-task-off
     3203  public static final Primitive SET_STEPPING_TASK_OFF =
     3204    new Primitive("%set-stepping-task-off", PACKAGE_SYS, true)
     3205    {
     3206      @Override
     3207      public LispObject execute()
     3208
     3209      {
     3210        setSteppingTaskOff();
     3211        return NIL;
     3212      }
     3213    };
     3214
     3215  // ### %set-stepper-on
     3216  public static final Primitive SET_STEPPER_ON =
     3217    new Primitive("%set-stepper-on", PACKAGE_SYS, true)
     3218    {
     3219      @Override
     3220      public LispObject execute()
     3221
     3222      {
     3223        setSteppingOn();
     3224        return NIL;
     3225      }
     3226    };
     3227
     3228  // ### %return-from-stepper
     3229  public static final Primitive RETURN_FROM_STEPPER =
     3230    new Primitive("%return-from-stepper", PACKAGE_SYS, true)
     3231    {
     3232      @Override
     3233      public LispObject execute()
     3234
     3235      {
     3236        throw new Return(stepperBlock.symbol, stepperBlock.value, NIL);
     3237      }
     3238    };
     3239
     3240  // ### %set-stepper-off
     3241  public static final Primitive SET_STEPPER_OFF =
     3242    new Primitive("%set-stepper-off", PACKAGE_SYS, true)
     3243    {
     3244      @Override
     3245      public LispObject execute()
     3246
     3247      {
     3248        setSteppingOff();
     3249        return NIL;
     3250      }
     3251    };
     3252
     3253  // ### %set-delimited-stepping-off
     3254  public static final Primitive SET_DELIMITED_STEPPING_OFF =
     3255    new Primitive("%set-delimited-stepping-off", PACKAGE_SYS, true)
     3256    {
     3257      @Override
     3258      public LispObject execute()
     3259
     3260      {
     3261        setDelimitedSteppingOff();
     3262        return NIL;
     3263      }
     3264    };
     3265
     3266  // ### %set-delimited-stepping-on
     3267  public static final Primitive SET_DELIMITED_STEPPING_ON =
     3268    new Primitive("%set-delimited-stepping-on", PACKAGE_SYS, true)
     3269    {
     3270      @Override
     3271      public LispObject execute()
     3272
     3273      {
     3274        setDelimitedSteppingOn();
     3275        return NIL;
     3276      }
     3277    };
     3278
     3279  // ### %initialize-step-counter
     3280  public static final Primitive INITIALIZE_STEP_COUNTER =
     3281    new Primitive("%initialize-step-counter", PACKAGE_SYS, true)
     3282    {
     3283      @Override
     3284      public LispObject execute()
     3285
     3286      {
     3287        initializeStepCounter();
     3288        return NIL;
     3289      }
     3290    };
     3291
     3292  // ### %get-step-counter
     3293  public static final Primitive GET_STEP_COUNTER =
     3294    new Primitive("%get-step-counter", PACKAGE_SYS, true)
     3295    {
     3296      @Override
     3297      public LispObject execute()
     3298
     3299      {
     3300        return getStepCounter();
     3301      }
     3302    };
     3303
     3304  // ### %initialize-step-block
     3305  public static final Primitive INITIALIZE_STEP_BLOCK =
     3306    new Primitive("%initialize-step-block", PACKAGE_SYS, true)
     3307    {
     3308      @Override
     3309      public LispObject execute()
     3310
     3311      {
     3312        initializeStepBlock();
     3313        return NIL;
     3314      }
     3315    };
    29843316}

  • trunk/abcl/src/org/armedbear/lisp/step.lisp

    r11391 r15709  
    3232;;; From SBCL.
    3333
     34;; For a working stepper implementation, see the contrib ABCL-STEPPER
     35
    3436(in-package "SYSTEM")
    3537
Note: See TracChangeset for help on using the changeset viewer.