help-smalltalk
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Help-smalltalk] [RFT] scripting improvements, part 2


From: Paolo Bonzini
Subject: [Help-smalltalk] [RFT] scripting improvements, part 2
Date: Thu, 29 Mar 2007 10:01:42 +0200
User-agent: Thunderbird 1.5.0.10 (Macintosh/20070221)

This, as suggested by Janis, eliminates the need
for temporaries and bangs in user interactions.

The changes are two-fold: first, each statement
is evaluated separately.  Second, temporaries are
automatically declared outside methods, and bangs
reset the the set of auto temporaries.

I'm not going to commit this because it's not
complete (it causes regressions for tests that
have a "foo. !" in them) and because it would
give Daniele some serious merging headaches. :-)

Still, I believe it is a *huge* improvement to
be able to write something like

  st> a := #( 1 2 3 nil ).
  Array new: 4 "<0x300f2e0>"
  st> (a collect: [ :each | each class ]) asBag printNl.
  Bag(UndefinedObject:1 SmallInteger:3 )
  Bag new: 4 "<0x300f568>"

The next step could be to automatically send #printNl
instead of using the built-in printing.  That's
actually a one-line change, but if you guys can
report on this (bugs, usability, etc.) that would
be great.

One known bug is that it is possible to use "#{a}"
on the automatically defined temporaries (because
they are actually globals in this implementation).
Please let me know if you thing this bug/feature
should be kept.

Paolo
--- orig/libgst/comp.c
+++ mod/libgst/comp.c
@@ -607,8 +607,9 @@ _gst_display_compilation_trace (const ch
 
 
 OOP
-_gst_execute_statements (tree_node temporaries,
+_gst_execute_statements (tree_node temps,
                         tree_node statements,
+                        enum undeclared_strategy undeclared,
                         mst_Boolean quiet)
 {
   tree_node messagePattern;
@@ -619,13 +620,13 @@ _gst_execute_statements (tree_node tempo
 #endif
   OOP methodOOP;
   OOP oldClass, oldCategory;
+  enum undeclared_strategy oldUndeclared;
   inc_ptr incPtr;
   YYLTYPE loc;
 
-  quiet = quiet || _gst_verbosity <= 1 || _gst_emacs_process
-         || !_gst_get_cur_stream_prompt ();
-
-  quiet = quiet && !_gst_regression_testing;
+  if (!_gst_regression_testing)
+    quiet = quiet || _gst_verbosity <= 1 || _gst_emacs_process
+           || !_gst_get_cur_stream_prompt ();
 
   oldClass = _gst_this_class;
   oldCategory = _gst_this_category;
@@ -643,16 +644,22 @@ _gst_execute_statements (tree_node tempo
 
   /* This is a big hack to let doits access the variables and classes
      in the current namespace.  */
+  oldUndeclared = _gst_undeclared_set (undeclared);
   SET_CLASS_ENVIRONMENT (_gst_undefined_object_class,
                         _gst_current_namespace);
+
+  if (statements->nodeType != TREE_STATEMENT_LIST)
+    statements = _gst_make_statement_list (&statements->location, statements);
+
   methodOOP =
-    _gst_compile_method (_gst_make_method
-                        (&statements->location, &loc, messagePattern,
-                         temporaries, NULL, statements),
+    _gst_compile_method (_gst_make_method (&statements->location, &loc,
+                                          messagePattern, temps, NULL,
+                                          statements),
                         true, false);
 
   SET_CLASS_ENVIRONMENT (_gst_undefined_object_class,
                         _gst_smalltalk_dictionary);
+  _gst_undeclared_set (oldUndeclared);
 
   _gst_set_compilation_class (oldClass);
   _gst_set_compilation_category (oldCategory);
@@ -665,9 +672,6 @@ _gst_execute_statements (tree_node tempo
   incPtr = INC_SAVE_POINTER ();
   INC_ADD_OOP (methodOOP);
 
-  if (!quiet && (_gst_regression_testing || _gst_verbosity >= 3))
-    printf ("\nExecution begins...\n");
-
   _gst_bytecode_counter = _gst_primitives_executed =
     _gst_self_returns = _gst_inst_var_returns = _gst_literal_returns =
     0;
@@ -695,22 +699,22 @@ _gst_execute_statements (tree_node tempo
 
   INC_RESTORE_POINTER (incPtr);
 
-  if (quiet)
-    return (_gst_last_returned_value);
-
-  /* Do more frequent flushing to ensure the result are well placed */
-  if (_gst_regression_testing)
-    fflush(stdout);
-
-  if (_gst_regression_testing || _gst_verbosity >= 3)
-    printf ("returned value is ");
+  if (!quiet)
+    {
+      /* Do more frequent flushing to ensure the result are well placed */
+      if (_gst_regression_testing || _gst_verbosity >= 3)
+       {
+          fflush(stdout);
+          printf ("returned value is ");
+       }
 
-  printf ("%O\n", _gst_last_returned_value);
+      printf ("%O\n", _gst_last_returned_value);
 
-  if (_gst_regression_testing)
-    fflush(stdout);
+      if (_gst_regression_testing || _gst_verbosity >= 3)
+        fflush(stdout);
+    }
 
-  if (_gst_verbosity < 3)
+  if (quiet || _gst_regression_testing || _gst_verbosity < 3)
     return (_gst_last_returned_value);
 
   deltaTime = endTime - startTime;
@@ -718,17 +722,12 @@ _gst_execute_statements (tree_node tempo
                                           core dump */
 
 #ifdef ENABLE_JIT_TRANSLATION
-#define GIVING_X_BYTECODES_PER_SEC
-#define BYTECODES_PER_SEC
-  printf ("Execution");
+  printf ("Execution took %.3f seconds\n", deltaTime / 1000.0);
 #else
-#define GIVING_X_BYTECODES_PER_SEC ", giving %lu bytecodes/sec"
-#define BYTECODES_PER_SEC , (unsigned long) (_gst_bytecode_counter/ (deltaTime 
/ 1000.0))
-  printf ("%lu byte codes executed\nwhich", _gst_bytecode_counter);
+  printf ("%lu byte codes executed\nwhich took %.3f seconds",
+         _gst_bytecode_counter, deltaTime / 1000.0);
 #endif
 
-  printf (" took %.3f seconds" GIVING_X_BYTECODES_PER_SEC "\n",
-         deltaTime / 1000.0 BYTECODES_PER_SEC);
 #if 0 && defined(HAVE_GETRUSAGE)
   deltaTime = ((endRusage.ru_utime.tv_sec * 1000) +
               (endRusage.ru_utime.tv_usec / 1000)) -
@@ -736,19 +735,13 @@ _gst_execute_statements (tree_node tempo
      (startRusage.ru_utime.tv_usec / 1000));
   deltaTime += (deltaTime == 0);       /* it could be zero which would 
                                           core dump */
-  printf ("(%.3f seconds user time" GIVING_X_BYTECODES_PER_SEC ", ",
-         deltaTime / 1000.0 BYTECODES_PER_SEC);
+  printf ("(user %.3fsec");
 
   deltaTime = ((endRusage.ru_stime.tv_sec * 1000) +
               (endRusage.ru_stime.tv_usec / 1000)) -
     ((startRusage.ru_stime.tv_sec * 1000) +
      (startRusage.ru_stime.tv_usec / 1000));
-  printf ("%.3f seconds system time)\n", deltaTime / 1000.0);
-
-  printf ("(%ld swaps, %ld minor page faults, %ld major page faults)\n",
-         endRusage.ru_nswap - startRusage.ru_nswap,
-         endRusage.ru_minflt - startRusage.ru_minflt,
-         endRusage.ru_majflt - startRusage.ru_majflt);
+  printf (", sys %.3fsec)\n");
 #endif
 
 #ifdef ENABLE_JIT_TRANSLATION
@@ -764,9 +757,8 @@ _gst_execute_statements (tree_node tempo
 
   printf ("%lu primitives, percent %.2f\n", _gst_primitives_executed,
          100.0 * _gst_primitives_executed / _gst_bytecode_counter);
-  printf
-    ("self returns %lu, inst var returns %lu, literal returns %lu\n",
-     _gst_self_returns, _gst_inst_var_returns, _gst_literal_returns);
+  printf ("self returns %lu, inst var returns %lu, literal returns %lu\n",
+          _gst_self_returns, _gst_inst_var_returns, _gst_literal_returns);
   printf ("%lu method cache lookups since last cleanup, percent %.2f\n",
          _gst_sample_counter,
          100.0 * _gst_sample_counter / _gst_bytecode_counter);
@@ -776,15 +768,12 @@ _gst_execute_statements (tree_node tempo
   printf ("%lu method cache hits, %lu misses", cacheHits,
          _gst_cache_misses);
   if (cacheHits || _gst_cache_misses)
-    printf (", %.2f percent hits\n",
-           (100.0 * cacheHits) / _gst_sample_counter);
+    printf (", %.2f percent hits\n", (100.0 * cacheHits) / 
_gst_sample_counter);
   else
     printf ("\n");
 
   return (_gst_last_returned_value);
 }
-#undef GIVING_X_BYTECODES_PER_SEC
-#undef BYTECODES_PER_SEC
 
 
 
@@ -2301,9 +2290,9 @@ _gst_make_attribute (tree_node attribute
       tree_node value = keyword->v_list.value;
       if (value->nodeType != TREE_CONST_EXPR)
        {
-          tree_node stmt = _gst_make_statement_list (&value->location, value);
-          OOP result = _gst_execute_statements (NULL, stmt, true);
-          value = _gst_make_oop_constant (&stmt->location, result);
+          OOP result = _gst_execute_statements (NULL, value, UNDECLARED_NONE,
+                                               true);
+          value = _gst_make_oop_constant (&value->location, result);
           if (!result)
            {
              _gst_had_error = true;


--- orig/libgst/comp.h
+++ mod/libgst/comp.h
@@ -263,13 +263,14 @@ extern mst_Boolean _gst_had_error 
 extern mst_Boolean _gst_untrusted_methods 
   ATTRIBUTE_HIDDEN;
 
-/* Called to compile and execute an "immediate expression"; i.e. a set
-   of Smalltalk statements that are not part of a method definition.
-   The parse trees are in TEMPORARIES and STATEMENTS.  Return the object
-   that was returned by the expression.  */
-extern OOP _gst_execute_statements (tree_node temporaries,
-                                   tree_node statements,
-                                   mst_Boolean quiet) 
+/* Called to compile and execute an "immediate expression"; i.e. a Smalltalk
+   statement that is not part of a method definition and where temporaries are
+   declared automatically.  The parse trees are in TEMPS and STATEMENTS.
+   Return the object that was returned by the expression.  */
+extern OOP _gst_execute_statements (tree_node temps,
+                                   tree_node statement,
+                                   enum undeclared_strategy undeclared,
+                                   mst_Boolean quiet)
   ATTRIBUTE_HIDDEN;
 
 /* This function will print a message describing the method category


--- orig/libgst/gst-parse.c
+++ mod/libgst/gst-parse.c
@@ -322,21 +322,46 @@ recover_error (gst_parser *p)
 static void
 parse_doit (gst_parser *p)
 {
-  tree_node temps = parse_temporaries (p, false);
-  tree_node statements = parse_statements (p, true);
+  mst_Boolean first = true;
+  OOP oldTemporaries = _gst_push_temporaries_dictionary ();
+  tree_node temps, statement;
 
-  if (p->token != EOF && p->token != '!')
-    expected (p, '!', -1);
+  do
+    {
+      temps = parse_temporaries (p, false);
+      lex_skip_if (p, '^', false);
+      statement = parse_expression (p, EXPR_ANY);
 
-  if (statements && !_gst_had_error)
-    _gst_execute_statements (temps, statements, false);
+      if (p->token != '.' && p->token != EOF && p->token != '!')
+        expected (p, '.', '!', -1);
 
-  _gst_free_tree ();
-  _gst_had_error = false;
+      /* When regression testing, don't print intermediate values.  */
+      if (statement && !_gst_had_error)
+        {
+          if (first
+             && _gst_kernel_initialized
+             && (_gst_regression_testing || _gst_verbosity >= 3))
+            {
+              printf ("\nExecution begins...\n");
+              first = false;
+            }
 
-  /* Do not lex until after _gst_free_tree, or we lose a token!  */
-  if (p->token != EOF)
+          _gst_execute_statements (NULL, statement, UNDECLARED_TEMPORARIES,
+                                  _gst_regression_testing && p->token != '!');
+       }
+
+      _gst_free_tree ();
+      _gst_had_error = false;
+
+       /* Do not lex until after _gst_free_tree, or we lose a token!  */
+       lex_skip_if (p, '.', false);
+    }
+  while (p->token != '!' && p->token != EOF);
+
+  while (p->token == '!')
     lex (p);
+
+  _gst_pop_temporaries_dictionary (oldTemporaries);
 }
 
 
@@ -889,7 +914,12 @@ parse_compile_time_constant (gst_parser 
   lex_skip_mandatory (p, ')');
 
   if (statements && !_gst_had_error)
-    result = _gst_execute_statements (temps, statements, true);
+    {
+      OOP oldDictionary = _gst_push_temporaries_dictionary ();
+      result = _gst_execute_statements (temps, statements, UNDECLARED_CURRENT,
+                                       true);
+      _gst_pop_temporaries_dictionary (oldDictionary);
+    }
 
   return _gst_make_oop_constant (&loc, result ? result : _gst_nil_oop); 
 }


--- orig/libgst/gstpriv.h
+++ mod/libgst/gstpriv.h
@@ -655,13 +655,13 @@ extern OOP _gst_nil_oop 
 #include "lib.h"
 #include "oop.h"
 #include "byte.h"
+#include "sym.h"
 #include "comp.h"
 #include "interp.h"
 #include "opt.h"
 #include "save.h"
 #include "str.h"
 #include "sysdep.h"
-#include "sym.h"
 #include "xlat.h"
 #include "mpz.h"
 #include "print.h"


--- orig/libgst/interp.c
+++ mod/libgst/interp.c
@@ -1961,8 +1961,6 @@ semaphore_new (int signals)
   return (semaphoreOOP);
 }
 
-/* runs before every evaluation (_gst_execute_statements) and before GC turned 
on.
-   Note that we don't use the incubator because _gst_processor_oop is a 
global.  */
 void
 _gst_init_process_system (void)
 {


--- orig/libgst/interp.h
+++ mod/libgst/interp.h
@@ -426,9 +426,9 @@ extern void _gst_fixup_object_pointers (
 extern void _gst_restore_object_pointers (void) 
   ATTRIBUTE_HIDDEN;
 
-/* This runs before every evaluation (_gst_execute_statements) and
-   before GC turned on.  It creates an initial process if no process
-   is ready to run or if no process has been created yet.  */
+/* This runs before every evaluation and before GC turned on.  It creates an
+   initial process if no process is ready to run or if no process has been
+   created yet.  */
 extern void _gst_init_process_system (void) 
   ATTRIBUTE_HIDDEN;
 


--- orig/libgst/lib.c
+++ mod/libgst/lib.c
@@ -838,6 +838,7 @@ process_stdin ()
 mst_Boolean
 process_file (const char *fileName)
 {
+  enum undeclared_strategy old;
   int fd;
 
   fd = _gst_open_file (fileName, "r");
@@ -847,11 +848,11 @@ process_file (const char *fileName)
   if (_gst_verbosity > 2)
     printf ("Processing %s\n", fileName);
 
-  _gst_use_undeclared++;
+  old = _gst_undeclared_set (UNDECLARED_GLOBALS);
   _gst_push_unix_file (fd, fileName);
   _gst_parse_stream (false);
   _gst_pop_stream (true);
-  _gst_use_undeclared--;
+  _gst_undeclared_set (old);
   return (true);
 }
 


--- orig/libgst/prims.def
+++ mod/libgst/prims.def
@@ -5099,6 +5099,7 @@ primitive VMpr_Object_makeWeak [succeed,
 
 primitive VMpr_Stream_fileIn [succeed,fail]
 {
+  enum undeclared_strategy old;
   OOP streamOOP = STACKTOP ();
   _gst_primitives_executed++;
 
@@ -5119,9 +5120,9 @@ primitive VMpr_Stream_fileIn [succeed,fa
     }
 
   _gst_push_stream_oop (streamOOP);
-  _gst_use_undeclared++;
+  old = _gst_undeclared_set (UNDECLARED_GLOBALS);
   parse_stream_with_protection (false);
-  _gst_use_undeclared--;
+  _gst_undeclared_set (old);
   _gst_pop_stream (false);     /* we didn't open it, so we don't close it */
   PRIM_SUCCEEDED;
 }


--- orig/libgst/sym.c
+++ mod/libgst/sym.c
@@ -160,11 +160,13 @@ OOP _gst_while_true_colon_symbol = NULL;
 OOP _gst_while_true_symbol = NULL;
 OOP _gst_current_namespace = NULL;
 
+OOP temporaries_dictionary = NULL;
+
 /* The list of selectors for the send immediate bytecode.  */
 struct builtin_selector _gst_builtin_selectors[256] = {};
 
 /* True if undeclared globals can be considered forward references.  */
-int _gst_use_undeclared = 0;
+enum undeclared_strategy _gst_use_undeclared = UNDECLARED_TEMPORARIES;
 
 /* Answer whether OOP is a Smalltalk String LEN characters long and
    these characters match the first LEN characters of STR (which must
@@ -538,6 +540,32 @@ find_class_variable (OOP varName)
 }
 
 
+int
+_gst_undeclared_set (enum undeclared_strategy new)
+{
+  enum undeclared_strategy old = _gst_use_undeclared;
+  if (new != UNDECLARED_CURRENT)
+    _gst_use_undeclared = new;
+  return old;
+}
+
+OOP
+_gst_push_temporaries_dictionary (void)
+{
+  OOP old = temporaries_dictionary;
+  temporaries_dictionary = _gst_dictionary_new (8);
+  _gst_register_oop (temporaries_dictionary);
+  return old;
+}
+
+void
+_gst_pop_temporaries_dictionary (OOP dictionaryOOP)
+{
+  _gst_unregister_oop (temporaries_dictionary);
+  temporaries_dictionary = dictionaryOOP;
+}
+
+
 OOP
 _gst_find_variable_binding (tree_node list)
 {
@@ -558,22 +586,21 @@ _gst_find_variable_binding (tree_node li
       char *varName;
 
       varName = STRING_OOP_CHARS (symbol);
-      if (!isupper (*varName) || !_gst_use_undeclared)
+      if (_gst_use_undeclared == UNDECLARED_NONE
+         || (!isupper (*varName) && _gst_use_undeclared == UNDECLARED_GLOBALS))
        return (assocOOP);
 
-      undeclaredDictionary =
-       dictionary_at (_gst_smalltalk_dictionary,
-                      _gst_undeclared_symbol);
-
-      assocOOP =
-       dictionary_association_at (undeclaredDictionary, symbol);
+      if (_gst_use_undeclared == UNDECLARED_GLOBALS)
+        undeclaredDictionary = dictionary_at (_gst_smalltalk_dictionary,
+                                             _gst_undeclared_symbol);
+      else
+        undeclaredDictionary = temporaries_dictionary;
 
+      assocOOP = dictionary_association_at (undeclaredDictionary, symbol);
       if (IS_NIL (assocOOP))
        {
          assocOOP =
-           NAMESPACE_AT_PUT (undeclaredDictionary, symbol,
-                             _gst_nil_oop);
-
+           NAMESPACE_AT_PUT (undeclaredDictionary, symbol, _gst_nil_oop);
          MAKE_OOP_UNTRUSTED (assocOOP, _gst_untrusted_methods);
        }
     }


--- orig/libgst/sym.h
+++ mod/libgst/sym.h
@@ -84,8 +84,26 @@ typedef struct symbol_entry
 }
 symbol_entry;
 
-/* True if undeclared globals can be considered forward references.  */
-extern int _gst_use_undeclared
+enum undeclared_strategy {
+  UNDECLARED_NONE,
+  UNDECLARED_GLOBALS,
+  UNDECLARED_TEMPORARIES,
+  UNDECLARED_CURRENT
+};
+
+/* Set whether undeclared globals can be considered forward references,
+   or whether they should be considered like temporary variables.  */
+extern int _gst_set_undeclared (enum undeclared_strategy value)
+  ATTRIBUTE_HIDDEN;
+
+/* Establish a new dictionary that will host local variables of the
+   evaluations; return the old one.  */
+extern OOP _gst_push_temporaries_dictionary (void)
+  ATTRIBUTE_HIDDEN;
+
+/* Switch back to a previously used dictionary to host local variables of the
+   evaluations.  */
+extern void _gst_pop_temporaries_dictionary (OOP dictionaryOOP)
   ATTRIBUTE_HIDDEN;
 
 extern OOP _gst_and_symbol ATTRIBUTE_HIDDEN;


--- orig/tests/compiler.ok
+++ mod/tests/compiler.ok
@@ -24,7 +24,7 @@ compiler.st:110: parse error, expected k
 
 Execution begins...
 returned value is 'No crashes'
-compiler.st:117: parse error, expected '!'
+compiler.st:117: parse error, expected '.' or '!'
 
 Execution begins...
 returned value is 2


--- orig/tests/exceptions.st
+++ mod/tests/exceptions.st
@@ -74,10 +74,13 @@ Smalltalk at: #TestException put: ExAll 
 
 Smalltalk at: #Ok put: 0!
 
+"TODO: turn this into an eval!!"
+[
     [   self error: ' Ignore this error']
         ifCurtailed: [ Ok := Ok + 1 ].
     
-    Ok := Ok + 2!
+    Ok := Ok + 2
+] value!
 
     Transcript cr; show: 'testIfCurtailed...'.
     Ok = 1 ifFalse: [


--- orig/tests/untrusted.ok
+++ mod/tests/untrusted.ok
@@ -60,8 +60,8 @@ returned value is nil
 
 Execution begins...
 returned value is Set
-untrusted.st:118: invalid assignment to instance variable tally
-untrusted.st:124: invalid assignment to global variable Array
+untrusted.st:124: invalid assignment to instance variable tally
+untrusted.st:130: invalid assignment to global variable Array
 
 Execution begins...
 returned value is Set
@@ -74,8 +74,8 @@ returned value is UntrustedSet
 
 Execution begins...
 returned value is UntrustedSet
-untrusted.st:154: invalid assignment to instance variable tally
-untrusted.st:160: invalid assignment to global variable Array
+untrusted.st:160: invalid assignment to instance variable tally
+untrusted.st:166: invalid assignment to global variable Array
 
 Execution begins...
 returned value is nil


--- orig/tests/untrusted.st
+++ mod/tests/untrusted.st
@@ -84,8 +84,10 @@ cleanBlock
 ^A new dirtyBlock value!
 
 "Make the current process untrusted... -----------------------------------"
-Processor activeProcess makeUntrusted: true.
-^thisContext isUntrusted!
+[
+    Processor activeProcess makeUntrusted: true.
+    thisContext isUntrusted
+] value!
 
 "...and check that subsequently created process are trusted."
 ^thisContext isUntrusted!
@@ -102,14 +104,18 @@ s wait.
 
 "Check that access restrictions are enforced -----------------------------"
 
-Processor activeProcess makeUntrusted: true.
-Set compile: 'lovelyMethod ^tally'.
-Set compile: 'dangerousMethod tally := 0'.
-Set compile: 'lovelyMethod ^Array'.
-Set compile: 'dangerousMethod Array := 0'!
-
-!Processor activeProcess makeUntrusted: true.
-Set methodsFor: 'security checking'!
+[
+    Processor activeProcess makeUntrusted: true.
+    Set compile: 'lovelyMethod ^tally'.
+    Set compile: 'dangerousMethod tally := 0'.
+    Set compile: 'lovelyMethod ^Array'.
+    Set compile: 'dangerousMethod Array := 0'
+] value!
+
+![
+    Processor activeProcess makeUntrusted: true.
+    Set methodsFor: 'security checking'
+] value!
 
 lovelyMethod
     ^tally!




reply via email to

[Prev in Thread] Current Thread [Next in Thread]