[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Help-smalltalk] Re: [RFT] scripting improvements, part 2 take 2
|
From: |
Paolo Bonzini |
|
Subject: |
[Help-smalltalk] Re: [RFT] scripting improvements, part 2 take 2 |
|
Date: |
Fri, 30 Mar 2007 11:13:58 +0200 |
|
User-agent: |
Thunderbird 1.5.0.10 (Macintosh/20070221) |
>> No, it won't. The temporaries don't leak, it is just an
>> implementation detail that they are implemented using an
>> internal BindingDictionary.
>
> Oh, in that case I would expect, having no other input, that it stuffs
> the value in Namespace current, as messy as that may seem from a
> Smalltalk perspective.
>
>> Sure, that was clear. Your example could be actually as
>> simple as
>>
>> a := 42.
>> Object compile: 'gotcha "shouldn''t compile!" ^a'.
>
> So compiling a method captures the current temporaries dictionary?
No, sorry, I wasn't clear.
The automatic temporaries are kept in an otherwise inaccessible
BindingDictionary because the two evaluations
a := 42
a printNl
are compiled as separate methods. So there is no other way to
share the temporaries between them.
However, when compiling a method we will switch back to
explicitly declared temporaries -- which is the same way
workspaces and the Transcript work in Smalltalk IDEs.
So, compiling a method does *not* capture the dictionary:
That's why I wrote...
a := 42.
Object compile: 'gotcha "shouldn''t compile!" ^a'.
^^^^^^^^^^^^^^^^^^^^
which actually fails with the patch I had posted, because
that was work in progress.
Other changes I had in the meanwhile, include automatically
deducing a '.' at end-of-line (unless the last token was
a keyword or binary operator, and unless we're inside
parentheses). I attach the new patch, against the
repository head. This has no testsuite failure.
Paolo
* looking for address@hidden/smalltalk--devo--2.2--patch-291 to compare with
* comparing to address@hidden/smalltalk--devo--2.2--patch-291
M doc/gst.1
M browser/PText.st
M libgst/gst-parse.c
M libgst/gstpriv.h
M libgst/comp.c
M libgst/input.c
M libgst/interp.c
M libgst/interp.h
M libgst/lex.c
M libgst/lib.c
M libgst/comp.h
M libgst/sym.c
M libgst/sym.h
M libgst/tree.c
M libgst/tree.h
M tests/compiler.ok
M tests/compiler.st
M tests/exceptions.st
M tests/objects.st
M tests/untrusted.ok
M tests/untrusted.st
M libgst/prims.def
* modified files
--- orig/browser/PText.st
+++ mod/browser/PText.st
@@ -38,7 +38,7 @@ Primitive subclass: #PText
PText comment:
nil!
-STInST RBProgramNodeVisitor subclass: #WorksheetVariableTracker
+STInST.RBProgramNodeVisitor subclass: #WorksheetVariableTracker
instanceVariableNames: 'vars class '
classVariableNames: ''
poolDictionaries: ''
--- orig/doc/gst.1
+++ mod/doc/gst.1
@@ -13,60 +13,63 @@ mandatory for a long option, it is also
currently defined set of flags is:
.TP
\fB\-a\fR \fB\-\-smalltalk\-args\fR
-Pass the remaining arguments to Smalltalk
+Pass the remaining arguments to Smalltalk.
.TP
\fB\-c\fR \fB\-\-core\-dump\fR
-Dump core on fatal signal
+Dump core on fatal signal.
.TP
\fB\-D\fR \fB\-\-declaration\-trace\fR
-Trace compilation of all loaded files
+Trace compilation of all loaded files.
.TP
\fB\-E\fR \fB\-\-execution\-trace\fR
-Trace execution of all loaded files
+Trace execution of all loaded files.
.TP
\fB\-g\fR \fB\-\-no\-gc\-message\fR
-Do not print garbage collection messages
+Do not print garbage collection messages.
.TP
\fB\-H\fR \fB\-\-help\fR
-Print this message and exit
+Print this message and exit.
.TP
\fB\-i\fR \fB\-\-rebuild\-image\fR
-Ignore the image file; rebuild it from scratch
+Ignore the image file; rebuild it from scratch.
.TP
\fB\-I\fR \fB\-\-image\-file\fR FILE
Instead of `gst.im', use FILE as the image
-file, and ignore the kernel files' timestamps
+file, and ignore the kernel files' timestamps.
.TP
\fB\-K\fR \fB\-\-kernel\-file\fR FILE
Make FILE's path relative to the image path.
.TP
\fB\-q\fR \fB\-\-quiet\fR \fB\-\-silent\fR
-Do not print execution information
+Do not print execution information.
.TP
\fB\-r\fR \fB\-\-regression\-test\fR
Run in regression test mode, i.e. make
-printed messages constant
+printed messages constant.
.TP
\fB\-S\fR \fB\-\-snapshot\fR
-Save a snapshot just before exiting
+Save a snapshot just before exiting.
.TP
\fB\-v\fR \fB\-\-version\fR
-Print the Smalltalk version number and exit
+Print the Smalltalk version number and exit.
.TP
\fB\-V\fR \fB\-\-verbose\fR
-Print names of loaded files and execution stats
+Print names of loaded files and execution stats.
.TP
-\fB\-\-kernel\-dir\fR DIR
-Look for kernel files in directory DIR.
+\fB\-\-emacs\-mode\fR
+Execute as a `process' (from within Emacs)
.TP
\fB\-\-image\-dir\fR DIR
Look for the image in directory DIR.
.TP
-\fB\-\-emacs\-mode\fR
-Execute as a `process' (from within Emacs)
+\fB\-\-kernel\-dir\fR DIR
+Look for kernel files in directory DIR.
+.TP
+\fB\-\-no\-user\-files\fR
+Don't read user customization files.
.TP
-
-Read input from standard input explicitly
+Read input from standard input explicitly.
.PP
Files are loaded one after the other. After the last one is loaded,
Smalltalk will exit. If no files are specified, Smalltalk reads from
--- orig/libgst/comp.c
+++ mod/libgst/comp.c
@@ -608,8 +608,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;
@@ -620,13 +621,14 @@ _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
+ || _gst_verbosity < 2
+ || !_gst_get_cur_stream_prompt ())
+ quiet = true;
oldClass = _gst_this_class;
oldCategory = _gst_this_category;
@@ -644,16 +646,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_set_undeclared (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_set_undeclared (oldUndeclared);
_gst_set_compilation_class (oldClass);
_gst_set_compilation_category (oldCategory);
@@ -666,9 +674,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;
@@ -696,61 +701,49 @@ _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 ");
-
- printf ("%O\n", _gst_last_returned_value);
+ if (!quiet)
+ {
+ /* Do more frequent flushing to ensure the result are well placed */
+ if (_gst_regression_testing || _gst_verbosity >= 3)
+ {
+ printf ("returned value is ");
+ fflush(stdout);
+ }
- if (_gst_regression_testing)
- fflush(stdout);
+ if (_gst_regression_testing)
+ {
+ printf ("%O\n", _gst_last_returned_value);
+ fflush(stdout);
+ }
+ else
+ _gst_str_msg_send (_gst_last_returned_value, "printNl", NULL);
+ }
- if (_gst_verbosity < 3)
+ if (quiet || _gst_regression_testing || _gst_verbosity < 3)
return (_gst_last_returned_value);
deltaTime = endTime - startTime;
- deltaTime += (deltaTime == 0); /* it could be zero which would
- core dump */
-
#ifdef ENABLE_JIT_TRANSLATION
-#define GIVING_X_BYTECODES_PER_SEC
-#define BYTECODES_PER_SEC
- printf ("Execution");
+ printf ("Execution took %.3f seconds", 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)
+#ifdef HAVE_GETRUSAGE
deltaTime = ((endRusage.ru_utime.tv_sec * 1000) +
(endRusage.ru_utime.tv_usec / 1000)) -
((startRusage.ru_utime.tv_sec * 1000) +
(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 (" (%.3fs user", deltaTime / 1000.0);
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 ("+%.3fs sys)", deltaTime / 1000.0);
#endif
+ printf ("\n");
#ifdef ENABLE_JIT_TRANSLATION
if (!_gst_sample_counter)
@@ -765,9 +758,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);
@@ -777,15 +769,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
@@ -2068,6 +2057,11 @@ equal_constant (OOP oop,
return (true);
break;
+ case CONST_BINDING:
+ if (oop == _gst_find_variable_binding (constExpr->v_const.val.aVal,
false))
+ return (true);
+ break;
+
case CONST_ARRAY:
if (IS_OOP (oop) && OOP_CLASS (oop) == _gst_array_class)
{
@@ -2167,6 +2161,18 @@ make_constant_oop (tree_node constExpr)
memcpy (result->data, bo->body, bo->size);
return (resultOOP);
+ case CONST_BINDING:
+ resultOOP = _gst_find_variable_binding (constExpr->v_const.val.aVal,
+ false);
+ if (IS_NIL (resultOOP))
+ {
+ _gst_errorf_at (constExpr->location.first_line,
+ "invalid variable binding");
+ EXIT_COMPILATION ();
+ }
+
+ return (resultOOP);
+
case CONST_ARRAY:
for (len = 0, arrayElt = constExpr->v_const.val.aVal; arrayElt;
len++, arrayElt = arrayElt->v_list.next);
@@ -2302,9 +2308,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
@@ -264,13 +264,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,50 @@ 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_get_cur_stream_prompt () && _gst_verbosity >= 3)))
+ {
+ printf ("\nExecution begins...\n");
+ first = false;
+ }
+
+ _gst_execute_statements (NULL, statement, UNDECLARED_TEMPORARIES,
+ _gst_regression_testing);
+ }
+
+ _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);
+
+ if (_gst_regression_testing && !first)
+ printf ("returned value is %O\n", _gst_last_returned_value);
- /* Do not lex until after _gst_free_tree, or we lose a token! */
- if (p->token != EOF)
+ while (p->token == '!')
lex (p);
+
+ _gst_pop_temporaries_dictionary (oldTemporaries);
}
@@ -373,7 +402,12 @@ parse_method (gst_parser *p)
pat, temps, attrs, stmts);
if (!_gst_had_error && !_gst_skip_compilation)
- _gst_compile_method (method, false, true);
+ {
+ enum undeclared_strategy oldUndeclared;
+ oldUndeclared = _gst_set_undeclared (UNDECLARED_GLOBALS);
+ _gst_compile_method (method, false, true);
+ _gst_set_undeclared (oldUndeclared);
+ }
_gst_free_tree ();
_gst_had_error = false;
@@ -889,7 +923,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);
}
@@ -908,12 +947,7 @@ parse_binding_constant (gst_parser *p)
node = parse_variable_primary (p);
lex_skip_mandatory (p, '}');
- if (!(node = _gst_make_binding_constant (&node->location, node)))
- {
- _gst_errorf ("invalid variable binding");
- recover_error (p);
- }
- return node;
+ return _gst_make_binding_constant (&node->location, node);
}
--- 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/input.c
+++ mod/libgst/input.c
@@ -502,7 +502,7 @@ my_getc (input_stream stream)
mst_Boolean
_gst_get_cur_stream_prompt (void)
{
- return (in_stream && in_stream->prompt);
+ return !_gst_emacs_process && in_stream && in_stream->prompt;
}
stream_type
--- 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
@@ -427,9 +427,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/lex.c
+++ mod/libgst/lex.c
@@ -90,6 +90,12 @@ char *_gst_first_error_str = NULL;
char *_gst_first_error_file = NULL;
int _gst_first_error_line = 0;
+/* Last returned token. */
+static int last_token;
+
+/* Balance of parentheses. Used to turn a newline into a period. */
+static int parenthesis_depth;
+
/* Answer true if IC is a valid base-10 digit. */
static mst_Boolean is_digit (int ic);
@@ -138,6 +144,26 @@ static int comment (int c,
static int char_literal (int c,
YYSTYPE * lvalp);
+/* Remember the current balance of open/close parentheses, used to treat
+ newlines as periods. */
+static int scan_open_paren (int c,
+ YYSTYPE * lvalp);
+
+/* Remember the current balance of open/close parentheses, used to treat
+ newlines as periods. */
+static int scan_close_paren (int c,
+ YYSTYPE * lvalp);
+
+/* Remember the current balance of open/close parentheses, used to treat
+ newlines as periods. */
+static int scan_reset_paren (int c,
+ YYSTYPE * lvalp);
+
+/* If the current balance of open/close parentheses is zero, and the
+ last token was not a period or bang, treat the newline as a period. */
+static int scan_newline (int c,
+ YYSTYPE * lvalp);
+
/* Parse a binary operator. C is the first symbol in the selector */
static int scan_bin_op (int c,
YYSTYPE * lvalp);
@@ -207,7 +233,7 @@ static const lex_tab_elt char_table[128]
/* 7 */ {invalid, 0, 0},
/* 8 */ {invalid, 0, 0},
/* 9 */ {0, 0, WHITE_SPACE},
-/* 10 */ {0, 0, WHITE_SPACE},
+/* 10 */ {scan_newline, 0, 0},
/* 11 */ {invalid, 0, 0},
/* 12 */ {0, 0, WHITE_SPACE},
/* 13 */ {0, 0, WHITE_SPACE},
@@ -230,15 +256,15 @@ static const lex_tab_elt char_table[128]
/* 30 */ {invalid, 0, 0},
/* 31 */ {invalid, 0, 0},
/* */ {0, 0, WHITE_SPACE},
-/* ! */ {0, '!', 0},
+/* ! */ {scan_reset_paren, 0, 0},
/* " */ {comment, 0, 0},
/* # */ {scan_symbol, 0, 0},
/* $ */ {char_literal, 0, ID_CHAR | SYMBOL_CHAR},
/* % */ {scan_bin_op, 0, BIN_OP_CHAR},
/* & */ {scan_bin_op, 0, BIN_OP_CHAR},
/* ' */ {string_literal, 0, 0},
-/* ( */ {0, '(', 0},
-/* ) */ {0, ')', 0},
+/* ( */ {scan_open_paren, 0, 0},
+/* ) */ {scan_close_paren, 0, 0},
/* * */ {scan_bin_op, 0, BIN_OP_CHAR},
/* + */ {scan_bin_op, 0, BIN_OP_CHAR},
/* , */ {scan_bin_op, 0, BIN_OP_CHAR},
@@ -288,9 +314,9 @@ static const lex_tab_elt char_table[128]
/* X */ {scan_ident, 0, ID_CHAR | SYMBOL_CHAR},
/* Y */ {scan_ident, 0, ID_CHAR | SYMBOL_CHAR},
/* Z */ {scan_ident, 0, ID_CHAR | SYMBOL_CHAR},
-/* [ */ {0, '[', 0},
+/* [ */ {scan_open_paren, 0, 0},
/* \ */ {scan_bin_op, 0, BIN_OP_CHAR},
-/* ] */ {0, ']', 0},
+/* ] */ {scan_close_paren, 0, 0},
/* ^ */ {0, '^', 0},
/* _ */ {0, ASSIGNMENT, ID_CHAR | SYMBOL_CHAR},
/* ` */ {invalid, 0, 0},
@@ -320,9 +346,9 @@ static const lex_tab_elt char_table[128]
/* x */ {scan_ident, 0, ID_CHAR | SYMBOL_CHAR},
/* y */ {scan_ident, 0, ID_CHAR | SYMBOL_CHAR},
/* z */ {scan_ident, 0, ID_CHAR | SYMBOL_CHAR},
-/* { */ {0, '{', 0},
+/* { */ {scan_open_paren, 0, 0},
/* | */ {scan_bin_op, 0, BIN_OP_CHAR},
-/* } */ {0, '}', 0},
+/* } */ {scan_close_paren, 0, 0},
/* ~ */ {scan_bin_op, 0, BIN_OP_CHAR},
/* ^? */ {invalid, 0, 0}
};
@@ -358,13 +384,15 @@ _gst_yylex (PTR lvalp, YYLTYPE *llocp)
*llocp = _gst_get_location ();
assert (ct->lexFunc || ct->retToken);
if (ct->lexFunc)
+ result = (*ct->lexFunc) (ic, (YYSTYPE *) lvalp);
+ else
+ result = ct->retToken;
+
+ if (result)
{
- result = (*ct->lexFunc) (ic, (YYSTYPE *) lvalp);
- if (result)
- return (result);
+ last_token = result;
+ return (result);
}
- else if (ct->retToken)
- return (ct->retToken);
}
}
@@ -399,7 +427,46 @@ invalid (int c,
return (0); /* tell the lexer to ignore this */
}
+
+int
+scan_reset_paren (int c,
+ YYSTYPE * lvalp)
+{
+ parenthesis_depth = 0;
+ return c;
+}
+
+int
+scan_open_paren (int c,
+ YYSTYPE * lvalp)
+{
+ parenthesis_depth++;
+ return c;
+}
+
+int
+scan_close_paren (int c,
+ YYSTYPE * lvalp)
+{
+ parenthesis_depth--;
+ return c;
+}
+
+int
+scan_newline (int c,
+ YYSTYPE * lvalp)
+{
+ if (_gst_get_cur_stream_prompt ()
+ && parenthesis_depth == 0
+ && last_token != '.' && last_token != '!' && last_token != KEYWORD
+ && last_token != BINOP && last_token != '|' && last_token != '<'
+ && last_token != '>')
+ return ('.');
+ else
+ return 0;
+}
+
int
comment (int c,
YYSTYPE * lvalp)
--- orig/libgst/lib.c
+++ mod/libgst/lib.c
@@ -831,6 +831,7 @@ process_stdin ()
mst_Boolean
process_file (const char *fileName)
{
+ enum undeclared_strategy old;
int fd;
fd = _gst_open_file (fileName, "r");
@@ -840,11 +841,11 @@ process_file (const char *fileName)
if (_gst_verbosity == 3)
printf ("Processing %s\n", fileName);
- _gst_use_undeclared++;
+ old = _gst_set_undeclared (UNDECLARED_GLOBALS);
_gst_push_unix_file (fd, fileName);
_gst_parse_stream (false);
_gst_pop_stream (true);
- _gst_use_undeclared--;
+ _gst_set_undeclared (old);
return (true);
}
--- orig/libgst/prims.def
+++ mod/libgst/prims.def
@@ -3390,7 +3390,7 @@ primitive VMpr_SystemDictionary_setTrace
oop1 = POP_OOP ();
if (IS_INT (oop1))
{
- mst_Boolean *varAddr;
+ int *varAddr;
intptr_t arg1 = TO_INT (oop1);
varAddr = bool_addr_index (arg1);
if (varAddr != NULL)
@@ -5100,6 +5100,7 @@ primitive VMpr_Object_makeWeak [succeed,
primitive VMpr_Stream_fileIn [succeed,fail]
{
+ enum undeclared_strategy old;
OOP streamOOP = STACKTOP ();
_gst_primitives_executed++;
@@ -5120,9 +5121,9 @@ primitive VMpr_Stream_fileIn [succeed,fa
}
_gst_push_stream_oop (streamOOP);
- _gst_use_undeclared++;
+ old = _gst_set_undeclared (UNDECLARED_GLOBALS);
parse_stream_with_protection (false);
- _gst_use_undeclared--;
+ _gst_set_undeclared (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,10 +540,36 @@ find_class_variable (OOP varName)
}
+int
+_gst_set_undeclared (enum undeclared_strategy new)
+{
+ enum undeclared_strategy old = _gst_use_undeclared;
+ if (new != UNDECLARED_CURRENT)
+ _gst_use_undeclared = new;
+ return old;
+}
+
OOP
-_gst_find_variable_binding (tree_node list)
+_gst_push_temporaries_dictionary (void)
{
- OOP symbol, root, assocOOP, undeclaredDictionary;
+ 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, mst_Boolean declare_temporary)
+{
+ OOP symbol, root, assocOOP, undeclaredDictionaryOOP;
symbol = _gst_intern_string (list->v_list.name);
assocOOP = find_class_variable (symbol);
@@ -558,23 +586,27 @@ _gst_find_variable_binding (tree_node li
char *varName;
varName = STRING_OOP_CHARS (symbol);
- if (!isupper (*varName) || !_gst_use_undeclared)
- return (assocOOP);
-
- undeclaredDictionary =
- dictionary_at (_gst_smalltalk_dictionary,
- _gst_undeclared_symbol);
+ if (_gst_use_undeclared == UNDECLARED_TEMPORARIES
+ && declare_temporary)
+ undeclaredDictionaryOOP = temporaries_dictionary;
+
+ else if (_gst_use_undeclared == UNDECLARED_GLOBALS
+ && isupper (*varName))
+ undeclaredDictionaryOOP = dictionary_at (_gst_smalltalk_dictionary,
+ _gst_undeclared_symbol);
- assocOOP =
- dictionary_association_at (undeclaredDictionary, symbol);
+ else
+ undeclaredDictionaryOOP = _gst_nil_oop;
- if (IS_NIL (assocOOP))
+ if (!IS_NIL (undeclaredDictionaryOOP))
{
- assocOOP =
- NAMESPACE_AT_PUT (undeclaredDictionary, symbol,
- _gst_nil_oop);
-
- MAKE_OOP_UNTRUSTED (assocOOP, _gst_untrusted_methods);
+ assocOOP = dictionary_association_at (undeclaredDictionaryOOP,
symbol);
+ if (IS_NIL (assocOOP))
+ {
+ assocOOP =
+ NAMESPACE_AT_PUT (undeclaredDictionaryOOP, symbol,
_gst_nil_oop);
+ MAKE_OOP_UNTRUSTED (assocOOP, _gst_untrusted_methods);
+ }
}
}
@@ -645,7 +677,7 @@ _gst_find_variable (symbol_entry * se,
return (true);
}
- varAssoc = _gst_find_variable_binding (list);
+ varAssoc = _gst_find_variable_binding (list, true);
if (IS_NIL (varAssoc))
return (false);
--- 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;
@@ -199,8 +217,10 @@ extern OOP _gst_make_pool_array (const c
ATTRIBUTE_HIDDEN;
/* This resolves to an Association the variable binding constant expressed
- by the LIST parse tree node. */
-extern OOP _gst_find_variable_binding (tree_node list)
+ by the LIST parse tree node. Unless DECLARE_TEMPORARY is false,
+ temporary variables may be automatically declared. */
+extern OOP _gst_find_variable_binding (tree_node list,
+ mst_Boolean declare_temporary)
ATTRIBUTE_PURE
ATTRIBUTE_HIDDEN;
--- orig/libgst/tree.c
+++ mod/libgst/tree.c
@@ -457,14 +457,10 @@ _gst_make_binding_constant (YYLTYPE *loc
tree_node variables)
{
tree_node result;
- OOP assocOOP = _gst_find_variable_binding (variables);
-
- if (IS_NIL (assocOOP))
- return (NULL);
result = make_tree_node (location, TREE_CONST_EXPR);
- result->v_const.constType = CONST_OOP;
- result->v_const.val.oopVal = assocOOP;
+ result->v_const.constType = CONST_BINDING;
+ result->v_const.val.aVal = variables;
return (result);
}
--- orig/libgst/tree.h
+++ mod/libgst/tree.h
@@ -140,6 +140,7 @@ typedef enum
CONST_FLOATQ,
CONST_STRING,
CONST_OOP,
+ CONST_BINDING,
CONST_ARRAY
}
const_type;
--- orig/tests/compiler.ok
+++ mod/tests/compiler.ok
@@ -24,7 +24,15 @@ 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
+
+Execution begins...
+a Smalltalk string:1: undefined variable a referenced
+returned value is nil
+
+Execution begins...
+ error: did not understand #gotcha
+returned value is nil
--- orig/tests/compiler.st
+++ mod/tests/compiler.st
@@ -118,3 +118,9 @@ c
"... this does not."
^#(#-123) size!
+
+
+"Compiling a method should not capture the current temporaries dictionary."
+a:=42.
+Object compile: 'gotcha "shouldn''t compile!" ^a'!
+nil gotcha!
--- 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/objects.st
+++ mod/tests/objects.st
@@ -84,6 +84,10 @@ ObjectsTest testFinalize!
^ObjectsTest testWeak!
+"TODO: use Eval here, we want 'abc' to survive through the entire
+ execution."
+[
+
| a b |
a := WeakArray new: 5.
a at: 1 put: 'abc'.
@@ -99,7 +103,9 @@ ObjectsTest testFinalize!
((1 to: 5) collect: [ :each | a isAlive: each ]) printNl.
1 to: 5 do: [ :index | a clearGCFlag: index ].
((1 to: 5) collect: [ :each | a isAlive: each ]) printNl.
- ((1 to: 5) collect: [ :each | b isAlive: each ]) printNl!
+ ((1 to: 5) collect: [ :each | b isAlive: each ]) printNl
+
+] value!
"Test lightweight class"
--- 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!