[svn:parrot] r42038 - in trunk: . src src/call src/pmc t/native_pbc

bacek at svn.parrot.org bacek at svn.parrot.org
Fri Oct 23 15:09:05 UTC 2009


Author: bacek
Date: Fri Oct 23 15:09:02 2009
New Revision: 42038
URL: https://trac.parrot.org/parrot/changeset/42038

Log:
[core] Replace RPA of CPointers for handling returns with single
CallSingatureReturns PMC.

This decrease number of allocated GC objects by ~1M in fib.pir and
improve performance by ~11%.

This is temporary solution to bring some speed loss after PCC refactors.
Will probably removed after 2.0 release with unification of args/returns
handling.

Added:
   trunk/src/pmc/callsignaturereturns.pmc
Modified:
   trunk/PBC_COMPAT
   trunk/src/call/args.c
   trunk/src/extend.c
   trunk/t/native_pbc/annotations.pbc
   trunk/t/native_pbc/integer_1.pbc
   trunk/t/native_pbc/number_1.pbc

Modified: trunk/PBC_COMPAT
==============================================================================
--- trunk/PBC_COMPAT	Fri Oct 23 14:47:55 2009	(r42037)
+++ trunk/PBC_COMPAT	Fri Oct 23 15:09:02 2009	(r42038)
@@ -27,10 +27,11 @@
 
 # please insert tab separated entries at the top of the list
 
+5.3	2009.10.23	bacek	add CallSignatureReturns
 5.2	2009.09.16	darbelo	remove pic.ops
 5.2	2009.08.06	dukeleto	remove Random PMC
-5.1	2009.08.06	cotto	remove branch_cs opcode 
-5.0	2009.07.21	cotto	released 1.4.0 
+5.1	2009.08.06	cotto	remove branch_cs opcode
+5.0	2009.07.21	cotto	released 1.4.0
 4.0	2009.03.17	allison	released 1.0.0
 3.0	2007.07.23	jonathan	implementing new PBC header format
 2.0	2005.11.22	leo	changed PBC format (HLL_info)

Modified: trunk/src/call/args.c
==============================================================================
--- trunk/src/call/args.c	Fri Oct 23 14:47:55 2009	(r42037)
+++ trunk/src/call/args.c	Fri Oct 23 15:09:02 2009	(r42038)
@@ -76,11 +76,12 @@
         __attribute__nonnull__(5);
 
 static void assign_default_result_value(PARROT_INTERP,
-    ARGMOD(PMC *result),
+    ARGMOD(PMC *results),
+    INTVAL index,
     INTVAL result_flags)
         __attribute__nonnull__(1)
         __attribute__nonnull__(2)
-        FUNC_MODIFIES(*result);
+        FUNC_MODIFIES(*results);
 
 PARROT_CAN_RETURN_NULL
 static PMC* clone_key_arg(PARROT_INTERP, ARGIN(PMC *key))
@@ -341,7 +342,7 @@
     , PARROT_ASSERT_ARG(accessor))
 #define ASSERT_ARGS_assign_default_result_value __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
-    , PARROT_ASSERT_ARG(result))
+    , PARROT_ASSERT_ARG(results))
 #define ASSERT_ARGS_clone_key_arg __attribute__unused__ int _ASSERT_ARGS_CHECK = (\
        PARROT_ASSERT_ARG(interp) \
     , PARROT_ASSERT_ARG(key))
@@ -730,9 +731,10 @@
     PMC            *call_object;
     STRING         *string_sig;
     INTVAL          arg_index;
-    INTVAL          arg_count = VTABLE_elements(interp, raw_sig);
-    PMC            *ctx       = CURRENT_CONTEXT(interp);
-    PMC            *returns   = pmc_new(interp, enum_class_ResizablePMCArray);
+    INTVAL          arg_count   = VTABLE_elements(interp, raw_sig);
+    PMC            *ctx         = CURRENT_CONTEXT(interp);
+    PMC            *returns     = pmc_new(interp, enum_class_CallSignatureReturns);
+    INTVAL          returns_pos = 0;
 
     if (PMC_IS_NULL(signature))
         call_object = pmc_new(interp, enum_class_CallSignature);
@@ -763,39 +765,35 @@
 
         /* Returns store a pointer to the register, so they can pass
          * the result back to the caller. */
-        PMC * const val_pointer = pmc_new(interp, enum_class_CPointer);
-
         switch (PARROT_ARG_TYPE_MASK_MASK(arg_flags)) {
             case PARROT_ARG_INTVAL:
-                VTABLE_set_pointer(interp, val_pointer, (void *) &(CTX_REG_INT(ctx, raw_index)));
-                VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "I"));
-                VTABLE_push_pmc(interp, returns, val_pointer);
+                VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                        &(CTX_REG_INT(ctx, raw_index)));
+                VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
                 break;
             case PARROT_ARG_FLOATVAL:
-                VTABLE_set_pointer(interp, val_pointer, (void *) &(CTX_REG_NUM(ctx, raw_index)));
-                VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "N"));
-                VTABLE_push_pmc(interp, returns, val_pointer);
+                VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                        &(CTX_REG_NUM(ctx, raw_index)));
+                VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
                 break;
             case PARROT_ARG_STRING:
                 if (arg_flags & PARROT_ARG_NAME) {
-                    PMC *name_string = pmc_new(interp, enum_class_String);
                     STRING * string_val = arg_flags & PARROT_ARG_CONSTANT
                                           ? Parrot_pcc_get_string_constant(interp, ctx, raw_index)
                                           : CTX_REG_STR(ctx, raw_index);
-                    VTABLE_set_string_native(interp, name_string, string_val);
-                    VTABLE_push_pmc(interp, returns, name_string);
+                    VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                            string_val);
                 }
                 else {
-                    VTABLE_set_pointer(interp, val_pointer,
-                                       (void *) &(CTX_REG_STR(ctx, raw_index)));
-                    VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "S"));
-                    VTABLE_push_pmc(interp, returns, val_pointer);
+                    VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                            &(CTX_REG_STR(ctx, raw_index)));
+                    VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
                 }
                 break;
             case PARROT_ARG_PMC:
-                VTABLE_set_pointer(interp, val_pointer, (void *) &(CTX_REG_PMC(ctx, raw_index)));
-                VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "P"));
-                VTABLE_push_pmc(interp, returns, val_pointer);
+                VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                        &(CTX_REG_PMC(ctx, raw_index)));
+                VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
                 break;
             default:
                 break;
@@ -837,6 +835,7 @@
     INTVAL       in_return_sig      = 0;
     INTVAL       i;
     int          append_pi          = 1;
+    INTVAL       returns_pos        = 0;
 
     if (!sig_len)
         return call_object;
@@ -851,7 +850,7 @@
 
         /* Only create the returns array if it's needed */
         if (in_return_sig && PMC_IS_NULL(returns)) {
-            returns = pmc_new(interp, enum_class_ResizablePMCArray);
+            returns = pmc_new(interp, enum_class_CallSignatureReturns);
             VTABLE_set_attr_str(interp, call_object, CONST_STRING(interp, "returns"), returns);
         }
 
@@ -859,25 +858,26 @@
             STRING * const signature = CONST_STRING(interp, "signature");
             /* Returns store the original passed-in pointer so they can pass
              * the result back to the caller. */
-            PMC * const val_pointer = pmc_new(interp, enum_class_CPointer);
-            VTABLE_push_pmc(interp, returns, val_pointer);
-
             switch (type) {
                 case 'I':
-                    VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, INTVAL *));
-                    VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "I"));
+                    VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                            (void *)va_arg(args, INTVAL *));
+                    VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
                     break;
                 case 'N':
-                    VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, FLOATVAL *));
-                    VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "N"));
+                    VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                            (void *)va_arg(args, FLOATVAL *));
+                    VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
                     break;
                 case 'S':
-                    VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, STRING **));
-                    VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "S"));
+                    VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                            (void *)va_arg(args, STRING **));
+                    VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
                     break;
                 case 'P':
-                    VTABLE_set_pointer(interp, val_pointer, (void *)va_arg(args, PMC **));
-                    VTABLE_set_string_keyed_str(interp, val_pointer, signature, CONST_STRING(interp, "P"));
+                    VTABLE_set_pointer_keyed_int(interp, returns, returns_pos++,
+                            (void *)va_arg(args, PMC **));
+                    VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
                     break;
                 default:
                     Parrot_ex_throw_from_c_args(interp, NULL,
@@ -1396,8 +1396,8 @@
 
 /*
 
-=item C<static void assign_default_result_value(PARROT_INTERP, PMC *result,
-INTVAL result_flags)>
+=item C<static void assign_default_result_value(PARROT_INTERP, PMC *results,
+INTVAL index, INTVAL result_flags)>
 
 Assign an appropriate default value to the result depending on its type
 
@@ -1406,21 +1406,21 @@
 */
 
 static void
-assign_default_result_value(PARROT_INTERP, ARGMOD(PMC *result), INTVAL result_flags)
+assign_default_result_value(PARROT_INTERP, ARGMOD(PMC *results), INTVAL index, INTVAL result_flags)
 {
     ASSERT_ARGS(assign_default_result_value)
     switch (PARROT_ARG_TYPE_MASK_MASK(result_flags)) {
         case PARROT_ARG_INTVAL:
-            VTABLE_set_integer_native(interp, result, 0);
+            VTABLE_set_integer_keyed_int(interp, results, index, 0);
             break;
         case PARROT_ARG_FLOATVAL:
-            VTABLE_set_number_native(interp, result, 0.0);
+            VTABLE_set_number_keyed_int(interp, results, index, 0.0);
             break;
         case PARROT_ARG_STRING:
-            VTABLE_set_string_native(interp, result, NULL);
+            VTABLE_set_string_keyed_int(interp, results, index, NULL);
             break;
         case PARROT_ARG_PMC:
-            VTABLE_set_pmc(interp, result, PMCNULL);
+            VTABLE_set_pmc_keyed_int(interp, results, index, PMCNULL);
             break;
         default:
             Parrot_ex_throw_from_c_args(interp, NULL,
@@ -1593,7 +1593,6 @@
 
     while (1) {
         INTVAL result_flags;
-        PMC *result_item;
 
         /* Check if we've used up all the results. */
         if (result_index >= result_count) {
@@ -1613,7 +1612,6 @@
         }
 
         result_flags = VTABLE_get_integer_keyed_int(interp, result_sig, result_index);
-        result_item  = VTABLE_get_pmc_keyed_int(interp, result_list, result_index);
 
         /* If the result is slurpy, collect all remaining positional
          * returns into an array.*/
@@ -1678,7 +1676,7 @@
                 }
                 return_index++;
             }
-            VTABLE_set_pmc(interp, result_item, collect_positional);
+            VTABLE_set_pmc_keyed_int(interp, result_list, result_index, collect_positional);
             result_index++;
             break; /* Terminate the positional return loop. */
         }
@@ -1694,13 +1692,12 @@
                 if (!(result_flags & PARROT_ARG_STRING))
                     Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                             "named results must have a name specified");
-                result_name = VTABLE_get_string(interp, result_item);
+                result_name = VTABLE_get_string_keyed_int(interp, result_list, result_index);
                 named_count++;
                 result_index++;
                 if (result_index >= result_count)
                     continue;
                 result_flags = VTABLE_get_integer_keyed_int(interp, result_sig, result_index);
-                result_item  = VTABLE_get_pmc_keyed_int(interp, result_list, result_index);
 
                 /* Mark the name as used, cannot be filled again. */
                 if (PMC_IS_NULL(named_used_list)) /* Only created if needed. */
@@ -1719,26 +1716,26 @@
             switch (PARROT_ARG_TYPE_MASK_MASK(return_flags)) {
                 case PARROT_ARG_INTVAL:
                     if (constant)
-                        VTABLE_set_integer_native(interp, result_item,
+                        VTABLE_set_integer_keyed_int(interp, result_list, result_index,
                             accessor->intval_constant(interp, return_info, return_index));
                     else
-                        VTABLE_set_integer_native(interp, result_item,
+                        VTABLE_set_integer_keyed_int(interp, result_list, result_index,
                             accessor->intval(interp, return_info, return_index));
                     break;
                 case PARROT_ARG_FLOATVAL:
                     if (constant)
-                        VTABLE_set_number_native(interp, result_item,
+                        VTABLE_set_number_keyed_int(interp, result_list, result_index,
                             accessor->numval_constant(interp, return_info, return_index));
                     else
-                        VTABLE_set_number_native(interp, result_item,
+                        VTABLE_set_number_keyed_int(interp, result_list, result_index,
                             accessor->numval(interp, return_info, return_index));
                     break;
                 case PARROT_ARG_STRING:
                     if (constant)
-                        VTABLE_set_string_native(interp, result_item,
+                        VTABLE_set_string_keyed_int(interp, result_list, result_index,
                             accessor->string_constant(interp, return_info, return_index));
                     else
-                        VTABLE_set_string_native(interp, result_item,
+                        VTABLE_set_string_keyed_int(interp, result_list, result_index,
                             accessor->string(interp, return_info, return_index));
                     break;
                 case PARROT_ARG_PMC:
@@ -1767,7 +1764,7 @@
                                 return_index--; /* we want to stay on the same item */
                             }
                         }
-                        VTABLE_set_pmc(interp, result_item, return_item);
+                        VTABLE_set_pmc_keyed_int(interp, result_list, result_index, return_item);
                         break;
                     }
                 default:
@@ -1785,9 +1782,7 @@
                             result_sig, result_index + 1);
                     if (next_result_flags & PARROT_ARG_OPT_FLAG) {
                         result_index++;
-                        result_item = VTABLE_get_pmc_keyed_int(interp, result_list,
-                                result_index);
-                        VTABLE_set_integer_native(interp, result_item, 1);
+                        VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
                     }
                 }
             }
@@ -1802,7 +1797,7 @@
             if (result_flags & PARROT_ARG_NAME)
                 break;
 
-            assign_default_result_value(interp, result_item, result_flags);
+            assign_default_result_value(interp, result_list, result_index, result_flags);
 
             /* Mark the option flag for the result to FALSE, it was filled
              * with a default value. */
@@ -1811,9 +1806,7 @@
                         result_sig, result_index + 1);
                 if (next_result_flags & PARROT_ARG_OPT_FLAG) {
                     result_index++;
-                    result_item = VTABLE_get_pmc_keyed_int(interp, result_list,
-                            result_index);
-                    VTABLE_set_integer_native(interp, result_item, 0);
+                    VTABLE_set_integer_keyed_int(interp, result_list, result_index, 0);
                 }
             }
         }
@@ -1912,7 +1905,6 @@
      * temporary hash of named returns. */
     while (1) {
         STRING *result_name    = NULL;
-        PMC *result_item;
         INTVAL result_flags;
 
         /* Check if we've used up all the results. We'll check for leftover
@@ -1921,7 +1913,6 @@
             break;
 
         result_flags = VTABLE_get_integer_keyed_int(interp, result_sig, result_index);
-        result_item  = VTABLE_get_pmc_keyed_int(interp, result_list, result_index);
 
         /* All remaining results must be named. */
         if (!(result_flags & PARROT_ARG_NAME))
@@ -1934,7 +1925,7 @@
                 named_return_list = pmc_new(interp,
                         Parrot_get_ctx_HLL_type(interp, enum_class_Hash));
 
-            VTABLE_set_pmc(interp, result_item, named_return_list);
+            VTABLE_set_pmc_keyed_int(interp, result_list, result_index, named_return_list);
             break; /* End of named results. */
         }
 
@@ -1942,7 +1933,7 @@
         if (!(result_flags & PARROT_ARG_STRING))
             Parrot_ex_throw_from_c_args(interp, NULL, EXCEPTION_INVALID_OPERATION,
                     "named results must have a name specified");
-        result_name = VTABLE_get_string(interp, result_item);
+        result_name = VTABLE_get_string_keyed_int(interp, result_list, result_index);
 
         if (!STRING_IS_NULL(result_name)) {
             /* The next result is the actual value. */
@@ -1950,7 +1941,6 @@
             if (result_index >= result_count)
                 continue;
             result_flags = VTABLE_get_integer_keyed_int(interp, result_sig, result_index);
-            result_item  = VTABLE_get_pmc_keyed_int(interp, result_list, result_index);
 
             if (VTABLE_exists_keyed_str(interp, named_return_list, result_name)) {
 
@@ -1959,19 +1949,19 @@
                 /* Fill the named result. */
                 switch (PARROT_ARG_TYPE_MASK_MASK(result_flags)) {
                     case PARROT_ARG_INTVAL:
-                        VTABLE_set_integer_native(interp, result_item,
+                        VTABLE_set_integer_keyed_int(interp, result_list, result_index,
                             VTABLE_get_integer_keyed_str(interp, named_return_list, result_name));
                         break;
                     case PARROT_ARG_FLOATVAL:
-                        VTABLE_set_number_native(interp, result_item,
+                        VTABLE_set_number_keyed_int(interp, result_list, result_index,
                             VTABLE_get_number_keyed_str(interp, named_return_list, result_name));
                         break;
                     case PARROT_ARG_STRING:
-                        VTABLE_set_string_native(interp, result_item,
+                        VTABLE_set_string_keyed_int(interp, result_list, result_index,
                             VTABLE_get_string_keyed_str(interp, named_return_list, result_name));
                         break;
                     case PARROT_ARG_PMC:
-                        VTABLE_set_pmc(interp, result_item,
+                        VTABLE_set_pmc_keyed_int(interp, result_list, result_index,
                             VTABLE_get_pmc_keyed_str(interp, named_return_list, result_name));
                         break;
                     default:
@@ -1990,9 +1980,7 @@
                                 raw_sig, result_index + 1);
                         if (next_result_flags & PARROT_ARG_OPT_FLAG) {
                             result_index++;
-                            result_item = VTABLE_get_pmc_keyed_int(interp,
-                                    result_list, result_index);
-                            VTABLE_set_integer_native(interp, result_item, 1);
+                            VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
                         }
                     }
                 }
@@ -2000,7 +1988,7 @@
             else if (result_flags & PARROT_ARG_OPTIONAL) {
                 INTVAL next_result_flags;
 
-                assign_default_result_value(interp, result_item, result_flags);
+                assign_default_result_value(interp, result_list, result_index, result_flags);
 
                 /* Mark the option flag for the result to FALSE, it was filled
                  * with a default value. */
@@ -2009,9 +1997,7 @@
                             result_sig, result_index + 1);
                     if (next_result_flags & PARROT_ARG_OPT_FLAG) {
                         result_index++;
-                        result_item = VTABLE_get_pmc_keyed_int(interp,
-                                          result_list, result_index);
-                        VTABLE_set_integer_native(interp, result_item, 1);
+                        VTABLE_set_integer_keyed_int(interp, result_list, result_index, 1);
                     }
                 }
             }

Modified: trunk/src/extend.c
==============================================================================
--- trunk/src/extend.c	Fri Oct 23 14:47:55 2009	(r42037)
+++ trunk/src/extend.c	Fri Oct 23 15:09:02 2009	(r42038)
@@ -1027,7 +1027,6 @@
     ASSERT_ARGS(append_result)
     Parrot_String full_sig;
     Parrot_PMC    returns;
-    Parrot_PMC    return_pointer;
     Parrot_PMC    return_flags;
 
     Parrot_String return_name       = Parrot_str_new_constant(interp, "returns");
@@ -1039,16 +1038,12 @@
     Parrot_str_concat(interp, full_sig, Parrot_str_new_constant(interp, "->"), 0);
     Parrot_str_concat(interp, full_sig, type, 0);
 
-    return_pointer = pmc_new(interp, enum_class_CPointer);
-
     returns = VTABLE_get_attr_str(interp, sig_object, return_name);
     if (PMC_IS_NULL(returns)) {
-        returns = pmc_new(interp, enum_class_ResizablePMCArray);
+        returns = pmc_new(interp, enum_class_CallSignatureReturns);
         VTABLE_set_attr_str(interp, sig_object, return_name, returns);
     }
-    VTABLE_set_pointer(interp, return_pointer, result);
-    VTABLE_set_string_keyed_str(interp, return_pointer, sig_name, type);
-    VTABLE_push_pmc(interp, returns, return_pointer);
+    VTABLE_set_pointer_keyed_int(interp, returns, VTABLE_elements(interp, returns), result);
 
     /* Update returns_flag */
     return_flags = VTABLE_get_attr_str(interp, sig_object, return_flags_name);
@@ -1057,10 +1052,22 @@
         VTABLE_set_attr_str(interp, sig_object, return_flags_name, return_flags);
     }
     switch (Parrot_str_indexed(interp, type, 0)) {
-        case 'I': VTABLE_push_integer(interp, return_flags, PARROT_ARG_INTVAL); break;
-        case 'N': VTABLE_push_integer(interp, return_flags, PARROT_ARG_FLOATVAL); break;
-        case 'S': VTABLE_push_integer(interp, return_flags, PARROT_ARG_STRING); break;
-        case 'P': VTABLE_push_integer(interp, return_flags, PARROT_ARG_PMC); break;
+        case 'I':
+            VTABLE_push_integer(interp, return_flags, PARROT_ARG_INTVAL);
+            VTABLE_push_integer(interp, returns, PARROT_ARG_INTVAL);
+            break;
+        case 'N':
+            VTABLE_push_integer(interp, return_flags, PARROT_ARG_FLOATVAL);
+            VTABLE_push_integer(interp, returns, PARROT_ARG_FLOATVAL);
+            break;
+        case 'S':
+            VTABLE_push_integer(interp, return_flags, PARROT_ARG_STRING);
+            VTABLE_push_integer(interp, returns, PARROT_ARG_STRING);
+            break;
+        case 'P':
+            VTABLE_push_integer(interp, return_flags, PARROT_ARG_PMC);
+            VTABLE_push_integer(interp, returns, PARROT_ARG_PMC);
+            break;
         default:
             Parrot_ex_throw_from_c_args(interp, NULL,
                 EXCEPTION_INVALID_OPERATION,

Added: trunk/src/pmc/callsignaturereturns.pmc
==============================================================================
--- /dev/null	00:00:00 1970	(empty, because file is newly added)
+++ trunk/src/pmc/callsignaturereturns.pmc	Fri Oct 23 15:09:02 2009	(r42038)
@@ -0,0 +1,322 @@
+/*
+Copyright (C) 2001-2008, Parrot Foundation.
+$Id$
+
+=head1 NAME
+
+src/pmc/callsignaturereturns.pmc - resizable array for typed pointers 
+
+=head1 DESCRIPTION
+
+This class stores typed pointers used to fill results in CallSignature.
+
+
+=head1 SYNOPSIS
+
+  # VTABLEs are too tight to implement something more beatyful
+
+  # Create signature
+  rets = new CallSignatureReturns
+  rets.push_pointer(&intval, 0);
+  rest.push_integer(PARROT_ARG_INTVAL);
+
+  rets.push_pointer(&floatval, 1);
+  rest.push_integer(PARROT_ARG_FLOATVAL);
+
+  rets.push_pointer(&string, 2);
+  rest.push_integer(PARROT_ARG_STRING);
+
+  rets.push_pointer(&pmc, 3);
+  rest.push_integer(PARROT_ARG_PMC);
+
+  # Fill
+  rets.set_integer_keyed_int(intval, 0);
+  rets.set_number_keyed_int(floatval, 1);
+  rets.set_string_keyed_int(string, 2);
+  rets.set_pmc_keyed_int(pmc, 3);
+
+CallSignatureReturns will behave like CPointer with autocasting values.
+
+=head2 Functions
+
+=over 4
+
+=cut
+
+*/
+
+
+/* mask off lower two bits (1 + 2 = 3) for pointer tags */
+#define TAG_BITS 3
+#define UNTAG_CELL(c) INTVAL2PTR(void *, (PTR2INTVAL(c)) & ~TAG_BITS)
+#define CELL_TYPE_MASK(c) (PTR2INTVAL(c)) & 3
+
+pmclass CallSignatureReturns auto_attrs provides array {
+    ATTR INTVAL     size;     /* number of stored elements */
+    ATTR void     **values;   /* stored pointers */
+    ATTR INTVAL     resize_threshold;   /* max size before array needs to be resized */
+
+/*
+
+=item C<void set_integer_native(INTVAL size)>
+
+Resizes the array to C<size> elements.
+
+=cut
+
+*/
+
+    VTABLE void set_integer_native(INTVAL size) {
+        void    **values;
+        INTVAL    resize_threshold;
+
+        GET_ATTR_values(INTERP, SELF, values);
+        GET_ATTR_resize_threshold(INTERP, SELF, resize_threshold);
+
+        if (!values) {
+            /* Empty. Allocate 8 elements (arbitary number) */
+            values = mem_allocate_n_zeroed_typed(8, void*);
+            SET_ATTR_values(INTERP, SELF, values);
+            SET_ATTR_size(INTERP, SELF, size);
+            SET_ATTR_resize_threshold(INTERP, SELF, 8);
+        }
+        else if (size <= resize_threshold) {
+            SET_ATTR_size(INTERP, SELF, size);
+            return;
+        }
+        else {
+            INTVAL  cur = resize_threshold;
+
+            if (cur < 8192)
+                cur = size < 2 * cur ? 2 * cur : size;
+            else {
+                INTVAL needed = size - cur;
+                cur          += needed + 4096;
+                cur          &= ~0xfff;
+            }
+
+            values = (void**) mem_sys_realloc((void*) values, cur * sizeof (void *));
+            SET_ATTR_values(INTERP, SELF, values);
+            SET_ATTR_size(INTERP, SELF, size);
+            SET_ATTR_resize_threshold(INTERP, SELF, cur);
+        }
+    }
+
+/*
+
+=item C<INTVAL elements()>
+
+Returns the number of elements in the array.
+
+=cut
+
+*/
+
+    VTABLE INTVAL elements() {
+        INTVAL size;
+        GET_ATTR_size(INTERP, SELF, size);
+        return size;
+    }
+
+/*
+
+*/
+    VTABLE void set_pointer_keyed_int(INTVAL key, void *value) {
+        void   **values;
+        INTVAL   size;
+
+        GET_ATTR_size(INTERP, SELF, size);
+        if (key >= size)
+            STATICSELF.set_integer_native(key + 1);
+
+        GET_ATTR_values(INTERP, SELF, values);
+        values[key] = value;
+    }
+
+/*
+
+=item C<void push_pointer(void* value)>
+
+Push pointer to self. Increase size of storage.
+
+=cut
+
+*/
+
+    VTABLE void push_pointer(void *value) {
+        INTVAL idx = STATICSELF.elements();
+        STATICSELF.set_pointer_keyed_int(idx, value);
+    }
+
+/*
+
+=item C<void push_integer(INTVAL value)>
+
+Set type of last pushed pointer.
+
+=cut
+
+*/
+
+    VTABLE void push_integer(INTVAL type) {
+        INTVAL   idx = STATICSELF.elements() - 1;
+        void   **values;
+
+        PARROT_ASSERT((type >=0 && type < 4) || !"Wrong pointer type");
+
+        GET_ATTR_values(INTERP, SELF, values);
+        values[idx] = INTVAL2PTR(void *, PTR2INTVAL(UNTAG_CELL(values[idx])) | type);
+    }
+
+/*
+
+=item C<void set_integer_keyed_int(INTVAL key, INTVAL value)>
+
+=item C<void set_number_keyed_int(INTVAL key, FLOATVAL value)>
+
+=item C<void set_string_keyed_int(INTVAL key, STRING *value)>
+
+=item C<void set_pmc_keyed_int(INTVAL key, PMC *value)>
+
+Sets the value of the element at index C<key> to C<value> with casting if nessesary.
+
+=cut
+
+*/
+
+    VTABLE void set_integer_keyed_int(INTVAL key, INTVAL value) {
+        void *cell = STATICSELF.get_pointer_keyed_int(key);
+        void *ptr  = UNTAG_CELL(cell);
+
+        switch((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+            case PARROT_ARG_INTVAL:
+                *(INTVAL *)ptr = value;
+                break;
+            case PARROT_ARG_FLOATVAL:
+                *(FLOATVAL *)ptr = value;
+                break;
+            case PARROT_ARG_STRING:
+                *(STRING **)ptr = Parrot_str_from_int(INTERP, value);
+                break;
+            case PARROT_ARG_PMC:
+                *(PMC **)ptr = get_integer_pmc(INTERP, value);
+                break;
+            default:
+                PARROT_ASSERT(!"Impossible type");
+        }
+    }
+
+    VTABLE void set_number_keyed_int(INTVAL key, FLOATVAL value) {
+        void *cell = STATICSELF.get_pointer_keyed_int(key);
+        void *ptr  = UNTAG_CELL(cell);
+
+        switch((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+            case PARROT_ARG_INTVAL:
+                *(INTVAL *)ptr = value;
+                break;
+            case PARROT_ARG_FLOATVAL:
+                *(FLOATVAL *)ptr = value;
+                break;
+            case PARROT_ARG_STRING:
+                *(STRING **)ptr = Parrot_str_from_num(INTERP, value);
+                break;
+            case PARROT_ARG_PMC:
+                *(PMC **)ptr = get_number_pmc(INTERP, value);
+                break;
+            default:
+                PARROT_ASSERT(!"Impossible type");
+        }
+    }
+
+    VTABLE void set_string_keyed_int(INTVAL key, STRING *value) {
+        void *cell = STATICSELF.get_pointer_keyed_int(key);
+        void *ptr  = UNTAG_CELL(cell);
+
+        switch((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+            case PARROT_ARG_INTVAL:
+                *(INTVAL *)ptr = Parrot_str_to_int(INTERP, value);
+                break;
+            case PARROT_ARG_FLOATVAL:
+                *(FLOATVAL *)ptr = Parrot_str_to_num(INTERP, value);
+                break;
+            case PARROT_ARG_STRING:
+                *(STRING **)ptr = value;
+                break;
+            case PARROT_ARG_PMC:
+                *(PMC **)ptr = get_string_pmc(INTERP, value);
+                break;
+            default:
+                PARROT_ASSERT(!"Impossible type");
+        }
+    }
+
+    VTABLE void set_pmc_keyed_int(INTVAL key, PMC *value) {
+        void *cell = STATICSELF.get_pointer_keyed_int(key);
+        void *ptr  = UNTAG_CELL(cell);
+
+        switch((Call_bits_enum_t)CELL_TYPE_MASK(cell)) {
+            case PARROT_ARG_INTVAL:
+                *(INTVAL *)ptr = VTABLE_get_integer(INTERP, value);
+                break;
+            case PARROT_ARG_FLOATVAL:
+                *(FLOATVAL *)ptr = VTABLE_get_number(INTERP, value);
+                break;
+            case PARROT_ARG_STRING:
+                *(STRING **)ptr = VTABLE_get_string(INTERP, value);
+                break;
+            case PARROT_ARG_PMC:
+                *(PMC **)ptr = value;
+                break;
+            default:
+                PARROT_ASSERT(!"Impossible type");
+        }
+    }
+
+/*
+
+*/
+    VTABLE STRING *get_string_keyed_int(INTVAL key) {
+        void *cell  = STATICSELF.get_pointer_keyed_int(key);
+        void *ptr   = UNTAG_CELL(cell);
+        return (STRING *)ptr;
+    }
+
+/*
+
+=item C<void *get_pointer_keyed_int(INTVAL key)>
+
+Get raw pointer for result.
+
+=cut
+
+*/
+
+    VTABLE void *get_pointer_keyed_int(INTVAL key) {
+        void   **values;
+        INTVAL   size;
+
+        GET_ATTR_size(INTERP, SELF, size);
+        PARROT_ASSERT((key < size) || !"Wrong index");
+
+        GET_ATTR_values(INTERP, SELF, values);
+        return values[key];
+    }
+}
+/*
+
+=back
+
+=head1 SEE ALSO
+
+F<docs/pdds/pdd03_calling_conventions.pod>.
+
+=cut
+
+*/
+
+/*
+ * Local variables:
+ *   c-file-style: "parrot"
+ * End:
+ * vim: expandtab shiftwidth=4:
+ */

Modified: trunk/t/native_pbc/annotations.pbc
==============================================================================
Binary file (source and/or target). No diff available.

Modified: trunk/t/native_pbc/integer_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.

Modified: trunk/t/native_pbc/number_1.pbc
==============================================================================
Binary file (source and/or target). No diff available.


More information about the parrot-commits mailing list