[Top][All Lists]
[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!
- [Help-smalltalk] [RFT] scripting improvements, part 2,
Paolo Bonzini <=