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

[Paolo Bonzini]

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  <address@hidden>

        * 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++;
       }