[PATCH] late binding of globals, part 1/n

Actually, we want

Eval [
   [ Object subclass: #Case. Case new ] value
]

to work; not only

Eval [
   Object subclass: #Case. Case new
]

So, undeclared variables need to bound later than at compilation time.
This patch starts the work by allowing non-Associations to be used as
variable bindings.  #value/#value: is then sent to the binding, allowing
Smalltalk code to do the late binding.

It's only 50 lines of code, which is quite cool.

Paolo

2007-08-19  Paolo Bonzini  <[hidden email]>

        * libgst/vm.def: Support non-Associations storing global variables.
        * libgst/xlat.c: Support non-Associations storing global variables.
        * libgst/print.c: Support LookupKeys storing global variables.
        * libgst/dict.c: Reload _gst_lookup_key_class on startup.


--- orig/libgst/dict.c
+++ mod/libgst/dict.c
@@ -390,7 +390,7 @@ static const class_definition class_info
    "LargeNegativeInteger", NULL, NULL, NULL },
 
   {&_gst_lookup_key_class, &_gst_magnitude_class,
-   ISP_FIXED, false, 1,
+   ISP_FIXED, true, 1,
    "LookupKey", "key", NULL, NULL },
 
   {&_gst_association_class, &_gst_lookup_key_class,


--- orig/libgst/print.c
+++ mod/libgst/print.c
@@ -130,7 +130,7 @@ print_association_key_to_stream (STREAM
   gst_association association;
 
   if (!IS_OOP (associationOOP)
-      || !is_a_kind_of (OOP_CLASS(associationOOP), _gst_association_class))
+      || !is_a_kind_of (OOP_CLASS(associationOOP), _gst_lookup_key_class))
     {
       stream_printf (stream, "<non-association %O in association context>",
                      associationOOP);


--- orig/libgst/vm.def
+++ mod/libgst/vm.def
@@ -88,9 +88,6 @@
 #define STORE_METHOD_LITERAL(index, oop)    _gst_literals[index] = (oop)
 #endif
 
-#define METHOD_VARIABLE(index)    ASSOCIATION_VALUE (METHOD_LITERAL (index))
-#define STORE_METHOD_VARIABLE(index, oop)   SET_ASSOCIATION_VALUE (METHOD_LITERAL (index), oop)
-
 #ifndef OPEN_CODE_MATH
 
 #define RAW_INT_OP(op, op1, op2, iop)
@@ -697,7 +694,19 @@ operation PUSH_OUTER_TEMP n scopes ( --
 }
 
 operation PUSH_LIT_VARIABLE n ( -- tos ) {
-  tos = METHOD_VARIABLE (n);
+  tos = METHOD_LITERAL (n);
+  if (UNCOMMON (IS_INT (tos))
+      || UNCOMMON (!is_a_kind_of (OOP_CLASS (tos), _gst_association_class)))
+    {
+      PREPARE_STACK ();
+      PUSH_OOP (tos);
+      EXPORT_REGS ();
+      SEND_MESSAGE (_gst_builtin_selectors[VALUE_SPECIAL].symbol, 0);
+      IMPORT_REGS ();
+      FETCH (dispatch_vec);
+    }
+  else
+    tos = ASSOCIATION_VALUE (tos);
 }
 
 operation PUSH_RECEIVER_VARIABLE n ( -- tos ) {
@@ -724,7 +733,20 @@ operation STORE_OUTER_TEMP n scopes ( to
 }
 
 operation STORE_LIT_VARIABLE n ( tos -- tos ) {
-  STORE_METHOD_VARIABLE (n, tos);
+  OOP var = METHOD_LITERAL (n), value = tos;
+  if (UNCOMMON (IS_INT (var))
+      || UNCOMMON (!is_a_kind_of (OOP_CLASS (var), _gst_association_class)))
+    {
+      PREPARE_STACK ();
+      SET_STACKTOP (var);
+      PUSH_OOP (value);
+      EXPORT_REGS ();
+      SEND_MESSAGE (_gst_builtin_selectors[VALUE_COLON_SPECIAL].symbol, 1);
+      IMPORT_REGS ();
+      FETCH (dispatch_vec);
+    }
+  else
+    SET_ASSOCIATION_VALUE (var, value);
 }
 
 operation STORE_RECEIVER_VARIABLE n ( tos -- tos ) {


--- orig/libgst/xlat.c
+++ mod/libgst/xlat.c
@@ -778,26 +778,31 @@ set_top_node_extra (int extra, int jumpO
   node->jumpDest = this_label[jumpOffset];
 }
 
-code_tree *
-push_send_node (gst_uchar *bp, OOP selector, int numArgs, mst_Boolean super, int operation, int imm)
+static inline inline_cache *
+set_inline_cache (OOP selector, int numArgs, mst_Boolean super, int operation, int imm)
 {
-  code_tree *args, *node;
-  int tot_args;
-
   curr_inline_cache->numArgs = numArgs;
   curr_inline_cache->selector = selector;
   curr_inline_cache->cachedIP = super ? do_super_code : do_send_code;
   curr_inline_cache->is_super = super;
   curr_inline_cache->more = true;
   curr_inline_cache->imm = imm;
+  return curr_inline_cache++;
+}
+
+code_tree *
+push_send_node (gst_uchar *bp, OOP selector, int numArgs, mst_Boolean super, int operation, int imm)
+{
+  code_tree *args, *node;
+  int tot_args;
+  inline_cache *ic = set_inline_cache (selector, numArgs, super, operation, imm);
 
   /* Remember that we must pop an extra node for the receiver! */
   tot_args = numArgs + (super ? 2 : 1);
   for (args = NULL; tot_args--;)
     args = pop_tree_node (args);
 
-  node =
-    push_tree_node (bp, args, operation, (PTR) curr_inline_cache++);
+  node = push_tree_node (bp, args, operation, (PTR) ic);
   return (node);
 }
 
@@ -3330,8 +3335,16 @@ decode_bytecode (gst_uchar *bp)
     }
 
     PUSH_LIT_VARIABLE {
-      push_tree_node_oop (IP0, NULL, TREE_PUSH | TREE_LIT_VAR,
-                          literals[n]);
+      if (is_a_kind_of (OOP_INT_CLASS (literals[n]), _gst_association_class))
+        push_tree_node_oop (IP0, NULL, TREE_PUSH | TREE_LIT_VAR,
+                            literals[n]);
+      else
+ {
+          push_tree_node_oop (IP0, NULL, TREE_PUSH | TREE_LIT_CONST,
+                              literals[n]);
+          push_send_node (IP0, _gst_builtin_selectors[VALUE_SPECIAL].symbol,
+  0, false, TREE_SEND, 0);
+ }
     }
 
     PUSH_SELF {
@@ -3370,9 +3383,22 @@ decode_bytecode (gst_uchar *bp)
                       (PTR) (uintptr_t) n);
     }
     STORE_LIT_VARIABLE {
-      push_tree_node_oop (IP0, pop_tree_node (NULL),
-                          TREE_STORE | TREE_LIT_VAR,
-                          literals[n]);
+      if (is_a_kind_of (OOP_INT_CLASS (literals[n]), _gst_association_class))
+        push_tree_node_oop (IP0, pop_tree_node (NULL),
+    TREE_STORE | TREE_LIT_VAR, literals[n]);
+      else
+ {
+  code_tree *value = pop_tree_node (NULL);
+          code_tree *var = push_tree_node_oop (IP0, NULL,
+       TREE_PUSH | TREE_LIT_CONST,
+       literals[n]);
+          inline_cache *ic =
+    set_inline_cache (_gst_builtin_selectors[VALUE_COLON_SPECIAL].symbol,
+      1, false, TREE_SEND, 0);
+
+  var->next = value;
+  push_tree_node (IP0, var, TREE_SEND, (PTR) ic);
+ }
     }
 
     SEND {
@@ -3556,15 +3582,20 @@ translate_method (OOP methodOOP, OOP rec
   for (inlineCacheCount = 0, bp = bc; bp < end; )
     MATCH_BYTECODES (XLAT_COUNT_SENDS, bp, (
       PUSH_RECEIVER_VARIABLE, PUSH_TEMPORARY_VARIABLE,
-      PUSH_LIT_CONSTANT, PUSH_LIT_VARIABLE, PUSH_SELF,
+      PUSH_LIT_CONSTANT, PUSH_SELF,
       PUSH_SPECIAL, PUSH_INTEGER, RETURN_METHOD_STACK_TOP,
       RETURN_CONTEXT_STACK_TOP, LINE_NUMBER_BYTECODE,
       STORE_RECEIVER_VARIABLE, STORE_TEMPORARY_VARIABLE,
-      STORE_LIT_VARIABLE, POP_INTO_NEW_STACKTOP,
+      POP_INTO_NEW_STACKTOP,
       POP_STACK_TOP, DUP_STACK_TOP, PUSH_OUTER_TEMP,
       STORE_OUTER_TEMP, JUMP, POP_JUMP_TRUE, POP_JUMP_FALSE,
       MAKE_DIRTY_BLOCK, EXIT_INTERPRETER, INVALID { }
 
+      PUSH_LIT_VARIABLE, STORE_LIT_VARIABLE {
+ if (!is_a_kind_of (OOP_INT_CLASS (literals[n]), _gst_association_class))
+  inlineCacheCount++;
+      }
+
       SEND_ARITH, SEND_SPECIAL, SEND_IMMEDIATE, SEND {
         inlineCacheCount++;
       }




_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk

This is the big part of the patch to allow this to work:

   Eval [ Object subclass: #Case. Case new ]

For now, I still don't have

   Eval [ Object subclass: #Case. Foo.Bar new ]

working, but that can easily be built on top of this.

The reason I'm not doing everything at once, is that allowing
non-Associations to be used as variable bindings requires me to
recompute the bytecode set. :-(  This is because our "superoperators"
must end at a send, and pushing/storing into global variables can now be
sends.  So, this patch temporarily disables superoperators (I should be
able to rerun the superoperator search, and revert part of this patch,
later).

Paolo

2007-08-20  Paolo Bonzini  <[hidden email]>

        * kernel/CompildMeth.st: Temporarily disable #isValidCCall.
        * kernel/DeferBinding.st: New.

        * packages/stinst/parser/STCompiler.st: User store+pop+push sequence
        for pushing literal variables.

        * libgst/comp.c: Make make_constant_oop global, adjust for new
        return value of _gst_find_variable_binding, create
        DeferredVariableBinding objects.  Compile store-into-
        variable to store+pop+push.  Adjust equal_constant to
        support CONST_DEFERRED_BINDING and adjusting for the new return value
        of _gst_find_variable_binding.
        * libgst/comp.h: Declare _gst_find_variable_binding.
        * libgst/dict.c: Add DeferredVariableBinding.
        * libgst/dict.h: Add DeferredVariableBinding and
        struct gst_deferred_variable_binding.
        * libgst/files.c: Add DeferBinding.st, load LookupKey hierarchy early.
        * libgst/opt.c: Temporarily disable superoperators.  Pass LookupKeys
        in the verifier.
        * libgst/sym.c: Return a tree_node from _gst_find_variable_binding,
        adjust _gst_find_variable, add _gst_get_undeclared_dictionary.
        * libgst/sym.h: Adjust declarations.
        * libgst/tree.c: Add _gst_make_deferred_binding_constant.
        * libgst/tree.h: Add _gst_make_deferred_binding_constant.


* looking for [hidden email]--2004b/smalltalk--devo--2.2--patch-527 to compare with
* auto-adding [hidden email]--2004b/smalltalk--devo--2.2--patch-527 to greedy revision library /Users/bonzinip/Archives/revlib
* found immediate ancestor revision in library ([hidden email]--2004b/smalltalk--devo--2.2--patch-526)
* patching for this revision ([hidden email]--2004b/smalltalk--devo--2.2--patch-527)
* comparing to [hidden email]--2004b/smalltalk--devo--2.2--patch-527
A  kernel/.arch-ids/DeferBinding.st.id
A  kernel/DeferBinding.st
M  scripts/Package.st
M  packages/stinst/parser/STCompiler.st
M  kernel/CompildMeth.st
M  packages.xml
M  libgst/comp.c
M  libgst/files.c
M  libgst/comp.h
M  libgst/opt.c
M  libgst/dict.c
M  libgst/sym.c
M  libgst/sym.h
M  libgst/dict.h
M  libgst/tree.c
M  libgst/tree.h
M  superops/superops.cc

* modified files

--- orig/kernel/CompildMeth.st
+++ mod/kernel/CompildMeth.st
@@ -522,11 +522,12 @@ binaryRepresentationObject
 !CompiledMethod methodsFor: 'c call-outs'!
 
 isValidCCall
-    ^(self bytecodeAt: 1) == 67
+    ^true
+    "^(self bytecodeAt: 1) == 67
         and: [ (self bytecodeAt: 2) == 0
         and: [ self numLiterals == 0
         and: [ self numTemps == 0
-        and: [ self flags == 5 ]]]]!
+        and: [ self flags == 5 ]]]]"!
 
 rewriteAsCCall: func for: aClass
     | args |


--- orig/libgst/comp.c
+++ mod/libgst/comp.c
@@ -7,7 +7,7 @@
 
 /***********************************************************************
  *
- * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2005,2006
+ * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2005,2006,2007
  * Free Software Foundation, Inc.
  * Written by Steve Byrne.
  *
@@ -206,12 +206,6 @@ static mst_Boolean compile_statements (t
    them into a symbol OOP and returns that symbol.  */
 static OOP compute_selector (tree_node selectorExpr);
 
-/* Given CONSTEXPR, a section of the syntax tree that represents a
-   Smalltalk constant, this routine creates and returns an OOP to be
-   stored as a method literal in the method that's currently being
-   compiled.  */
-static OOP make_constant_oop (tree_node constExpr);
-
 /* Creates a new Array object that contains the literals for the
    method that's being compiled and returns it.  As a side effect, the
    currently allocated working literal vector is freed.  If there were
@@ -1090,7 +1084,7 @@ compile_constant (tree_node constExpr)
      bytecode, or add it to the literals.  */
   if (index == -1)
     {
-      constantOOP = make_constant_oop (constExpr);
+      constantOOP = _gst_make_constant_oop (constExpr);
       if (IS_INT (constantOOP))
         {
           intVal = TO_INT (constantOOP);
@@ -1954,7 +1948,14 @@ compile_assignments (tree_node varList)
  _gst_compile_byte (STORE_RECEIVER_VARIABLE, variable.varIndex);
 
       else
- _gst_compile_byte (STORE_LIT_VARIABLE, variable.varIndex);
+ {
+  /* This can become a message send, which might not return the
+     value.  Compile it in a way that can be easily peephole
+     optimized. */
+  _gst_compile_byte (STORE_LIT_VARIABLE, variable.varIndex);
+  _gst_compile_byte (POP_STACK_TOP, 0);
+  _gst_compile_byte (PUSH_LIT_VARIABLE, variable.varIndex);
+ }
     }
 }
 
@@ -2059,13 +2060,26 @@ equal_constant (OOP oop,
  }
       break;
 
-    case CONST_OOP:
-      if (oop == constExpr->v_const.val.oopVal)
- return (true);
+    case CONST_DEFERRED_BINDING:
+      if (IS_OOP (oop) && OOP_CLASS (oop) == _gst_deferred_variable_binding_class)
+ {
+  gst_deferred_variable_binding binding =
+    (gst_deferred_variable_binding) OOP_TO_OBJ (oop);
+  if (binding->key == constExpr->v_const.val.oopVal)
+    return (true);
+ }
       break;
 
     case CONST_BINDING:
-      if (oop == _gst_find_variable_binding (constExpr->v_const.val.aVal, false))
+      constExpr = _gst_find_variable_binding (constExpr->v_const.val.aVal,      false);
+      if (!constExpr)
+ return (false);
+
+      assert (constExpr->v_const.constType != CONST_BINDING);
+      return equal_constant (oop, constExpr);
+
+    case CONST_OOP:
+      if (oop == constExpr->v_const.val.oopVal)
  return (true);
       break;
 
@@ -2097,9 +2111,9 @@ equal_constant (OOP oop,
 }
 
 OOP
-make_constant_oop (tree_node constExpr)
+_gst_make_constant_oop (tree_node constExpr)
 {
-  tree_node arrayElt;
+  tree_node subexpr;
   int len, i;
   OOP resultOOP, elementOOP;
   inc_ptr incPtr;
@@ -2115,8 +2129,8 @@ make_constant_oop (tree_node constExpr)
 
   else if (constExpr->nodeType == TREE_ARRAY_ELT_LIST)
     {
-      for (len = 0, arrayElt = constExpr; arrayElt;
-   len++, arrayElt = arrayElt->v_list.next);
+      for (len = 0, subexpr = constExpr; subexpr;
+   len++, subexpr = subexpr->v_list.next);
 
       incPtr = INC_SAVE_POINTER ();
 
@@ -2126,10 +2140,10 @@ make_constant_oop (tree_node constExpr)
       instantiate_with (_gst_array_class, len, &resultOOP);
       INC_ADD_OOP (resultOOP);
 
-      for (i = 0, arrayElt = constExpr; i < len;
-   i++, arrayElt = arrayElt->v_list.next)
+      for (i = 0, subexpr = constExpr; i < len;
+   i++, subexpr = subexpr->v_list.next)
  {
-  elementOOP = make_constant_oop (arrayElt->v_list.value);
+  elementOOP = _gst_make_constant_oop (subexpr->v_list.value);
   result = OOP_TO_OBJ (resultOOP);
   result->data[i] = elementOOP;
  }
@@ -2160,9 +2174,6 @@ make_constant_oop (tree_node constExpr)
       MAKE_OOP_READONLY (resultOOP, true);
       return (resultOOP);
 
-    case CONST_OOP:
-      return (constExpr->v_const.val.oopVal);
-
     case CONST_BYTE_OBJECT:
       bo = constExpr->v_const.val.boVal;
       result = instantiate_with (bo->class, bo->size, &resultOOP);
@@ -2170,30 +2181,46 @@ make_constant_oop (tree_node constExpr)
       MAKE_OOP_READONLY (resultOOP, true);
       return (resultOOP);
 
+    case CONST_DEFERRED_BINDING:
+      {
+ gst_deferred_variable_binding dvb;
+        result = instantiate (_gst_deferred_variable_binding_class, &resultOOP);
+        dvb = (gst_deferred_variable_binding) result;
+ dvb->key = constExpr->v_const.val.oopVal;
+ dvb->class = _gst_this_class;
+ dvb->defaultDictionary = _gst_get_undeclared_dictionary ();
+ dvb->association = _gst_nil_oop;
+        return (resultOOP);
+      }
+
     case CONST_BINDING:
-      resultOOP = _gst_find_variable_binding (constExpr->v_const.val.aVal,
-      false);
-      if (IS_NIL (resultOOP))
+      subexpr = _gst_find_variable_binding (constExpr->v_const.val.aVal,
+    false);
+      if (!subexpr)
  {
   _gst_errorf_at (constExpr->location.first_line,
   "invalid variable binding");
           EXIT_COMPILATION ();
  }
 
-      return (resultOOP);
+      assert (subexpr->v_const.constType != CONST_BINDING);
+      return _gst_make_constant_oop (subexpr);
+
+    case CONST_OOP:
+      return (constExpr->v_const.val.oopVal);
 
     case CONST_ARRAY:
-      for (len = 0, arrayElt = constExpr->v_const.val.aVal; arrayElt;
-   len++, arrayElt = arrayElt->v_list.next);
+      for (len = 0, subexpr = constExpr->v_const.val.aVal; subexpr;
+   len++, subexpr = subexpr->v_list.next);
 
       incPtr = INC_SAVE_POINTER ();
       result = instantiate_with (_gst_array_class, len, &resultOOP);
       INC_ADD_OOP (resultOOP);
 
-      for (i = 0, arrayElt = constExpr->v_const.val.aVal; i < len;
-   i++, arrayElt = arrayElt->v_list.next)
+      for (i = 0, subexpr = constExpr->v_const.val.aVal; i < len;
+   i++, subexpr = subexpr->v_list.next)
  {
-  elementOOP = make_constant_oop (arrayElt->v_list.value);
+  elementOOP = _gst_make_constant_oop (subexpr->v_list.value);
   result = OOP_TO_OBJ (resultOOP);
   result->data[i] = elementOOP;
  }
@@ -2327,7 +2354,7 @@ _gst_make_attribute (tree_node attribute
  }
 
       argsArray = OOP_TO_OBJ (argsArrayOOP);
-      argsArray->data[i] = make_constant_oop (value);
+      argsArray->data[i] = _gst_make_constant_oop (value);
     }
 
   messageOOP = _gst_message_new_args (selectorOOP, argsArrayOOP);


--- orig/libgst/comp.h
+++ mod/libgst/comp.h
@@ -269,6 +269,12 @@ extern mst_Boolean _gst_untrusted_method
 extern OOP _gst_compute_keyword_selector (tree_node selectorExpr)
   ATTRIBUTE_HIDDEN;
 
+/* Given CONSTEXPR, a section of the syntax tree that represents a
+   Smalltalk constant, this routine creates and returns an OOP to be
+   stored as a method literal in the method that's currently being
+   compiled.  */
+extern OOP _gst_make_constant_oop (tree_node constExpr);
+
 /* 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.


--- orig/libgst/dict.c
+++ mod/libgst/dict.c
@@ -102,6 +102,7 @@ OOP _gst_compiled_method_class = NULL;
 OOP _gst_context_part_class = NULL;
 OOP _gst_continuation_class = NULL;
 OOP _gst_date_class = NULL;
+OOP _gst_deferred_variable_binding_class = NULL;
 OOP _gst_delay_class = NULL;
 OOP _gst_dictionary_class = NULL;
 OOP _gst_directed_message_class = NULL;
@@ -393,6 +394,11 @@ static const class_definition class_info
    ISP_FIXED, true, 1,
    "LookupKey", "key", NULL, NULL },
 
+  {&_gst_deferred_variable_binding_class, &_gst_lookup_key_class,
+   ISP_FIXED, true, 3,
+   "DeferredVariableBinding", "class defaultDictionary association",
+   NULL, NULL },
+
   {&_gst_association_class, &_gst_lookup_key_class,
    ISP_FIXED, true, 1,
    "Association", "value", NULL, NULL },


--- orig/libgst/dict.h
+++ mod/libgst/dict.h
@@ -164,6 +164,16 @@ typedef struct gst_class_description
 }
  *gst_class_description;
 
+typedef struct gst_deferred_variable_binding
+{
+  OBJ_HEADER;
+  OOP key;
+  OOP class;
+  OOP defaultDictionary;
+  OOP association;
+}
+ *gst_deferred_variable_binding;
+
 typedef struct gst_association
 {
   OBJ_HEADER;
@@ -320,6 +330,7 @@ extern OOP _gst_compiled_method_class AT
 extern OOP _gst_context_part_class ATTRIBUTE_HIDDEN;
 extern OOP _gst_continuation_class ATTRIBUTE_HIDDEN;
 extern OOP _gst_date_class ATTRIBUTE_HIDDEN;
+extern OOP _gst_deferred_variable_binding_class ATTRIBUTE_HIDDEN;
 extern OOP _gst_delay_class ATTRIBUTE_HIDDEN;
 extern OOP _gst_dictionary_class ATTRIBUTE_HIDDEN;
 extern OOP _gst_directed_message_class ATTRIBUTE_HIDDEN;


--- orig/libgst/files.c
+++ mod/libgst/files.c
@@ -7,7 +7,7 @@
 
 /***********************************************************************
  *
- * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2006
+ * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2006,2007
  * Free Software Foundation, Inc.
  * Written by Steve Byrne.
  *
@@ -170,6 +170,11 @@ static const char standard_files[] = {
   "False.st\0"
   "True.st\0"
   "Magnitude.st\0"
+  "LookupKey.st\0"
+  "DeferBinding.st\0"
+  "Association.st\0"
+  "HomedAssoc.st\0"
+  "VarBinding.st\0"
   "Integer.st\0"
   "Date.st\0"
   "Time.st\0"
@@ -183,10 +188,6 @@ static const char standard_files[] = {
   "SmallInt.st\0"
   "Character.st\0"
   "UniChar.st\0"
-  "LookupKey.st\0"
-  "Association.st\0"
-  "HomedAssoc.st\0"
-  "VarBinding.st\0"
   "Link.st\0"
   "Process.st\0"
   "CallinProcess.st\0"


--- orig/libgst/opt.c
+++ mod/libgst/opt.c
@@ -69,7 +69,7 @@
 /* Define this to disable superoperators in the peephole bytecode
    optimizer.  Some simple optimizations will still be done, making
    the output suitable for searching superoperator candidates.  */
-/* #define NO_SUPEROPERATORS */
+#define NO_SUPEROPERATORS
 
 /* Define this to disable bytecode verification.  */
 /* #define NO_VERIFIER */
@@ -676,9 +676,10 @@ optimize_basic_block (gst_uchar * from,
   break;
 
         case PUSH_TEMPORARY_VARIABLE:
-        case PUSH_LIT_VARIABLE:
         case PUSH_RECEIVER_VARIABLE:
-  /* Leave only the store in store/pop/push sequences.  */
+  /* Leave only the store in store/pop/push sequences.  Don't do this
+     for STORE_LIT_VARIABLE, as it fails if #value: is sent and,
+     for example, self is returned.  */
   if (opt >= from + 4
       && (opt == from + 4 || opt[-6] != EXT_BYTE)
       && opt[-4] == bp[0] + (STORE_TEMPORARY_VARIABLE - PUSH_TEMPORARY_VARIABLE)
@@ -1130,8 +1131,8 @@ typedef struct partially_constructed_arr
 #define CHECK_LIT_VARIABLE(store, n) \
   CHECK_LITERAL (n); \
   if (IS_INT (literals[(n)]) || \
-      !is_a_kind_of (OOP_CLASS (literals[(n)]), _gst_association_class)) \
-    return ("Association expected"); \
+      !is_a_kind_of (OOP_CLASS (literals[(n)]), _gst_lookup_key_class)) \
+    return ("LookupKey expected"); \
   else if (store \
    && untrusted \
    && !IS_OOP_UNTRUSTED (literals[(n)])) \


--- orig/libgst/sym.c
+++ mod/libgst/sym.c
@@ -7,7 +7,7 @@
 
 /***********************************************************************
  *
- * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2005,2006
+ * Copyright 1988,89,90,91,92,94,95,99,2000,2001,2002,2003,2005,2006,2007
  * Free Software Foundation, Inc.
  * Written by Steve Byrne.
  *
@@ -572,63 +572,66 @@ _gst_pop_temporaries_dictionary (OOP dic
 }
 
 
-OOP
+tree_node
 _gst_find_variable_binding (tree_node list, mst_Boolean declare_temporary)
 {
-  OOP symbol, root, assocOOP, undeclaredDictionaryOOP;
+  OOP symbol, root, assocOOP;
+  tree_node elt;
 
   symbol = _gst_intern_string (list->v_list.name);
   assocOOP = find_class_variable (symbol);
 
-  while (assocOOP != _gst_nil_oop && (list = list->v_list.next))
+  for (elt = list; assocOOP != _gst_nil_oop && (elt = elt->v_list.next); )
     {
       root = ASSOCIATION_VALUE (assocOOP);
-      symbol = _gst_intern_string (list->v_list.name);
+      symbol = _gst_intern_string (elt->v_list.name);
       assocOOP = _gst_namespace_association_at (root, symbol);
     }
 
-  if (IS_NIL (assocOOP) && !(list->v_list.next))
-    {
-      char *varName;
-
-      varName = STRING_OOP_CHARS (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);
+  if (!IS_NIL (assocOOP))
+    return _gst_make_oop_constant (&list->location, assocOOP);
 
-      else
- undeclaredDictionaryOOP = _gst_nil_oop;
-
-      if (!IS_NIL (undeclaredDictionaryOOP))
- {
-          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);
-    }
- }
-    }
+  else if (_gst_use_undeclared == UNDECLARED_GLOBALS
+   && !elt->v_list.next
+   && isupper (*STRING_OOP_CHARS (symbol)))
+    {
+      OOP dictOOP = dictionary_at (_gst_smalltalk_dictionary,
+   _gst_undeclared_symbol);
+      assocOOP = _gst_namespace_association_at (dictOOP, symbol);
+      if (IS_NIL (assocOOP))
+        assocOOP = NAMESPACE_AT_PUT (dictOOP, symbol, _gst_nil_oop);
+      return _gst_make_oop_constant (&list->location, assocOOP);
+    }
+
+  /* For temporaries, make a deferred binding so that we can try using
+     a global variable.  Unlike namespaces, the temporaries dictionary
+     does not know anything about Undeclared.  */
+  else if (_gst_use_undeclared == UNDECLARED_TEMPORARIES
+   && !list->v_list.next
+   && declare_temporary)
+    return _gst_make_deferred_binding_constant (&list->location, symbol);
 
-  return (assocOOP);
+  else
+    return NULL;
 }
 
+OOP
+_gst_get_undeclared_dictionary ()
+{
+  assert (_gst_use_undeclared == UNDECLARED_TEMPORARIES);
+  return temporaries_dictionary;
+}
 
 mst_Boolean
 _gst_find_variable (symbol_entry * se,
     tree_node list)
 {
-  OOP varAssoc;
+  tree_node resolved;
   int index;
   unsigned int scopeDistance;
   scope scope;
   symbol_list s;
+  OOP varAssoc;
   OOP symbol;
 
   symbol = _gst_intern_string (list->v_list.name);
@@ -683,10 +686,11 @@ _gst_find_variable (symbol_entry * se,
       return (true);
     }
 
-  varAssoc = _gst_find_variable_binding (list, true);
-  if (IS_NIL (varAssoc))
+  resolved = _gst_find_variable_binding (list, true);
+  if (!resolved)
     return (false);
 
+  varAssoc = _gst_make_constant_oop (resolved);
   index = _gst_add_forced_object (varAssoc);
 
   fill_symbol_entry (se, SCOPE_GLOBAL,


--- orig/libgst/sym.h
+++ mod/libgst/sym.h
@@ -219,11 +219,16 @@ extern OOP _gst_make_class_variable_dict
 extern OOP _gst_make_pool_array (const char * poolNames)
   ATTRIBUTE_HIDDEN;
 
-/* This resolves to an Association the variable binding constant expressed
-   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)
+/* This resolves the variable binding constant expressed by the LIST parse
+   tree node.  Unless DECLARE_TEMPORARY is false, temporary variables
+   may be automatically declared.  */
+extern tree_node _gst_find_variable_binding (tree_node list,
+     mst_Boolean declare_temporary)
+  ATTRIBUTE_HIDDEN;
+
+/* This returns the dictionary in which to define an undeclared variable
+   binding.  */
+extern OOP _gst_get_undeclared_dictionary ()
   ATTRIBUTE_PURE
   ATTRIBUTE_HIDDEN;
 


--- orig/libgst/tree.c
+++ mod/libgst/tree.c
@@ -341,6 +341,19 @@ _gst_make_string_constant (YYLTYPE *loca
 }
 
 tree_node
+_gst_make_deferred_binding_constant (YYLTYPE *location,
+     OOP keyOOP)
+{
+  tree_node result;
+
+  result = make_tree_node (location, TREE_CONST_EXPR);
+  result->v_const.constType = CONST_DEFERRED_BINDING;
+  result->v_const.val.oopVal = keyOOP;
+
+  return (result);
+}
+
+tree_node
 _gst_make_oop_constant (YYLTYPE *location,
         OOP oval)
 {


--- orig/libgst/tree.h
+++ mod/libgst/tree.h
@@ -141,6 +141,7 @@ typedef enum
   CONST_STRING,
   CONST_OOP,
   CONST_BINDING,
+  CONST_DEFERRED_BINDING,
   CONST_ARRAY
 }
 const_type;
@@ -334,6 +335,12 @@ extern tree_node _gst_make_string_consta
       const char *sval)
   ATTRIBUTE_HIDDEN;
 
+/* Create a const_node storing a deferred variable binding, whose key
+   is the symbol KEYOOP.  */
+extern tree_node _gst_make_deferred_binding_constant (YYLTYPE *location,
+      OOP keyOOP)
+  ATTRIBUTE_HIDDEN;
+
 /* Create a const_node for an array whose elements are
    described by the nodes in the list, AVAL.  */
 extern tree_node _gst_make_array_constant (YYLTYPE *location,


--- orig/packages.xml
+++ mod/packages.xml
@@ -102,6 +102,7 @@
   <file>CompiledBlk.st</file>
   <file>Magnitude.st</file>
   <file>Semaphore.st</file>
+  <file>DeferBinding.st</file>
   <file>Association.st</file>
   <file>HomedAssoc.st</file>
   <file>ContextPart.st</file>


--- orig/packages/stinst/parser/STCompiler.st
+++ mod/packages/stinst/parser/STCompiler.st
@@ -893,7 +893,9 @@ compileAssignmentFor: aNode
  ^self compileByte: StoreReceiverVariable arg: definition.
     ].
     
-    ^self compileByte: StoreLitVariable arg: definition.
+    self compileByte: StoreLitVariable arg: definition.
+    self compileByte: PopStackTop.
+    self compileByte: PushLitVariable arg: definition
 !
 
 acceptVariableNode: aNode


--- orig/superops/superops.cc
+++ mod/superops/superops.cc
@@ -487,6 +487,11 @@ main (int argc, char **argv)
     "         (b >= 40 and: [ b <= 43 ])"
     "            ifTrue: [ breaks add: (self nextBytecodeIndex: i) ]."
 
+    ///////// "Split after push/store literal variable"
+    "         (b = 34 or: [ b = 38 ])"
+    "            ifTrue: [ breaks add: (self nextBytecodeIndex: i) ]"
+    "     ]."
+
     ///////// "Split after sends"
     "         (b < 32 and: [ (b + 12 bitAnd: 250) ~= 32 ])"
     "            ifTrue: [ breaks add: (self nextBytecodeIndex: i) ]"



* added files

--- /dev/null
+++ mod/kernel/DeferBinding.st
@@ -0,0 +1,117 @@
+"======================================================================
+|
+|   DeferredVariableBinding Method Definitions
+|
+|
+ ======================================================================"
+
+
+"======================================================================
+|
+| Copyright 1999, 2000, 2001, 2002 Free Software Foundation, Inc.
+| Written by Paolo Bonzini.
+|
+| This file is part of the GNU Smalltalk class library.
+|
+| The GNU Smalltalk class library is free software; you can redistribute it
+| and/or modify it under the terms of the GNU Lesser General Public License
+| as published by the Free Software Foundation; either version 2.1, or (at
+| your option) any later version.
+|
+| The GNU Smalltalk class library is distributed in the hope that it will be
+| useful, but WITHOUT ANY WARRANTY; without even the implied warranty of
+| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Lesser
+| General Public License for more details.
+|
+| You should have received a copy of the GNU Lesser General Public License
+| along with the GNU Smalltalk class library; see the file COPYING.LIB.
+| If not, write to the Free Software Foundation, 59 Temple Place - Suite
+| 330, Boston, MA 02110-1301, USA.  
+|
+ ======================================================================"
+
+
+LookupKey subclass: #DeferredVariableBinding
+  instanceVariableNames: 'class defaultDictionary association'
+  classVariableNames: ''
+  poolDictionaries: ''
+  category: 'Language-Data types'
+!
+
+DeferredVariableBinding comment:
+'I represent a binding to a variable that is not tied to a particular
+dictionary until the first access.  Then, lookup rules for global variables
+in the scope of a given class are used.'!
+
+
+
+!DeferredVariableBinding class methodsFor: 'basic'!
+
+key: aSymbol class: aClass defaultDictionary: aDictionary
+    ^(self key: aSymbol)
+        class: aClass;
+        defaultDictionary: aDictionary;
+ yourself! !
+
+!DeferredVariableBinding methodsFor: 'basic'!
+
+value
+    "Answer a new instance of the receiver with the given key and value"
+    association isNil ifTrue: [ association := self resolveBinding ].
+    ^association value
+!
+
+value: anObject
+    "Answer a new instance of the receiver with the given key and value"
+    association isNil ifTrue: [ association := self resolveBinding ].
+    association value: anObject
+! !
+
+
+
+!DeferredVariableBinding methodsFor: 'private'!
+
+class: aClass
+    class := aClass!
+
+defaultDictionary: aDictionary
+    defaultDictionary := aDictionary!
+
+resolveBinding
+    "Look for a pool dictionary of class that includes the key.  If not found,
+     add the variable to the defaultDictionary.  If already bound, reuse the
+     bound that was found on the previous lookup."
+
+    "See if a previous access has created the binding."
+    association := defaultDictionary associationAt: self key ifAbsent: [ nil ].
+    association isNil ifFalse: [ ^self ].
+
+    "Look for the binding in the class environment."
+    class withAllSuperclassesDo: [ :env || pools assoc |
+        assoc := env environment associationAt: self key ifAbsent: [ nil ].
+        assoc isNil ifFalse: [ ^assoc ].
+
+ pools := env sharedPoolDictionaries.
+ pools isNil ifFalse: [
+    pools do: [ :each |
+        assoc := each associationAt: self key ifAbsent: [ nil ].
+        assoc isNil ifFalse: [ ^assoc ] ] ] ].
+
+    "Create it as a temporary."
+    defaultDictionary at: self key ifAbsentPut: [ nil ].
+    ^defaultDictionary associationAt: self key
+! !
+
+
+
+
+!DeferredVariableBinding methodsFor: 'storing'!
+
+storeOn: aStream
+    "Put on aStream some Smalltalk code compiling to the receiver"
+    aStream nextPut: $#.
+    aStream nextPut: ${.
+    aStream nextPutAll: self key.
+    aStream nextPut: $}
+! !

_______________________________________________
help-smalltalk mailing list
[hidden email]
http://lists.gnu.org/mailman/listinfo/help-smalltalk