Permalink
Browse files

MMD 16 - builtin infix multis

* see note on p6i

* renamed is_equal_str MMD to is_equal_string
* fixed bad bug during PMC registration:
  the iglobals was created to late so that
  NCI registration ever and ever recreated the
  the NCI function Hash
* add I, N NCI signatures
* removed duplicate find_method entries


git-svn-id: https://svn.parrot.org/parrot/trunk@7767 d31e2699-5ff4-0310-a27c-f18f2fbe73fe
  • Loading branch information...
1 parent 9960098 commit 8155c8a86388007680fca6406114877b12444c9d Leopold Toetsch committed Apr 4, 2005
@@ -40,6 +40,8 @@ =head1 SEE ALSO
( p => [1,0,0,1,0], # Returning a pointer that we PMC stuff
P => [1,0,0,1,0], # PMC
S => [1,0,1,0,0], # STR
+ I => [1,1,0,0,0], # INTVAL
+ N => [1,0,0,0,1], # FLOATVAL
i => [1,1,0,0,0], # Returning an int
3 => [1,1,0,0,0], # Returning an int pointer
l => [1,1,0,0,0], # Returning a long
@@ -68,8 +70,10 @@ =head1 SEE ALSO
v => "void",
# b => "void *",
# B => "void **",
- P => "void *",
+ P => "PMC *",
S => "STRING *",
+ I => "INTVAL",
+ N => "FLOATVAL",
);
my %proto_type =
@@ -87,8 +91,10 @@ =head1 SEE ALSO
v => "void",
J => "Interp *",
P => "PMC *",
+ O => "PMC *", # object
S => "STRING *",
- O => "PMC *",
+ I => "INTVAL",
+ N => "FLOATVAL",
b => "void *",
B => "void **",
L => "long *",
@@ -117,20 +123,24 @@ =head1 SEE ALSO
v => "void *",
# b => "void *",
# B => "void **",
- P => "void *",
+ P => "PMC *",
S => "STRING *",
+ I => "INTVAL",
+ N => "FLOATVAL",
);
my %ret_assign =
( p => "PMC_data(final_destination) = return_data;\n REG_PMC(5) = final_destination;",
i => "REG_INT(5) = return_data;",
+ I => "REG_INT(5) = return_data;",
3 => "REG_INT(5) = *return_data;",
l => "REG_INT(5) = return_data;",
4 => "REG_INT(5) = *return_data;",
c => "REG_INT(5) = return_data;",
2 => "REG_INT(5) = *return_data;",
f => "REG_NUM(5) = return_data;",
d => "REG_NUM(5) = return_data;",
+ N => "REG_NUM(5) = return_data;",
P => "REG_PMC(5) = return_data;",
S => "REG_STR(5) = return_data;",
v => "",
@@ -155,6 +165,8 @@ =head1 SEE ALSO
t => "return_data = ",
P => "return_data = ",
S => "return_data = ",
+ I => "return_data = ",
+ N => "return_data = ",
# B => "return_data = ",
v => "",
);
@@ -270,6 +282,9 @@ sub make_arg {
/l/ && do {my $reg_num = $reg_ref->{i}++;
return "(long)REG_INT($reg_num)";
};
+ /I/ && do {my $reg_num = $reg_ref->{i}++;
+ return "REG_INT($reg_num)";
+ };
/4/ && do {my $reg_num = $reg_ref->{p}++;
return "(long*)&PMC_int_val(REG_PMC($reg_num))";
};
@@ -288,6 +303,9 @@ sub make_arg {
/d/ && do {my $reg_num = $reg_ref->{n}++;
return "(double)REG_NUM($reg_num)";
};
+ /N/ && do {my $reg_num = $reg_ref->{n}++;
+ return "REG_NUM($reg_num)";
+ };
/t/ && do {my $reg_num = $reg_ref->{s}++;
my $temp_num = ${$temp_cnt_ref}++;
push @{$extra_preamble_ref}, "char *tempvar$temp_num = string_to_cstring(interpreter, REG_STR($reg_num));\n";
@@ -472,25 +490,23 @@ sub print_tail {
iglobals = interpreter->iglobals;
- if (iglobals)
- HashPointer = VTABLE_get_pmc_keyed_int(interpreter, iglobals,
+ if (PMC_IS_NULL(iglobals))
+ PANIC("iglobals isnÄt created yet");
+ HashPointer = VTABLE_get_pmc_keyed_int(interpreter, iglobals,
IGLOBALS_NCI_FUNCS);
if (!HashPointer) {
HashPointer = pmc_new(interpreter, enum_class_Hash);
+ VTABLE_set_pmc_keyed_int(interpreter, iglobals, IGLOBALS_NCI_FUNCS,
+ HashPointer);
$put_pointer
- if (iglobals)
- {
- VTABLE_set_pmc_keyed_int(interpreter, iglobals, IGLOBALS_NCI_FUNCS,
- HashPointer);
- }
}
b = VTABLE_get_pmc_keyed_str(interpreter, HashPointer, signature);
- if (b && (b->vtable->type(interpreter, b) == enum_class_UnManagedStruct) )
+ if (b && b->vtable->base_type == enum_class_UnManagedStruct)
return F2DPTR(PMC_data(b));
/*
View
@@ -392,7 +392,10 @@ Store the method as a global in the namespace of this class.
PMC* find_method(STRING* method_name) {
- return Parrot_find_method_with_cache(INTERP, SELF, method_name);
+ PMC *method = Parrot_find_method_with_cache(INTERP, SELF, method_name);
+ if (method && method->vtable->base_type == enum_class_MultiSub)
+ return Parrot_MMD_search_default_func(interpreter,
+ method_name, REG_STR(1));
}
void add_method(STRING *method_name, PMC *sub_pmc) {
View
@@ -77,7 +77,7 @@ Almost all methods are auto-generated in lib/Parrot/Pmc2c.pm
#define VTABLE_cmp_string(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STRCMP)
#define VTABLE_is_equal(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_EQ)
#define VTABLE_is_equal_num(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_NUMEQ)
-#define VTABLE_is_equal_str(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
+#define VTABLE_is_equal_string(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
#define VTABLE_pow(i, l, r, d) mmd_dispatch_v_ppp(i, l, r, d, MMD_POW)
#define VTABLE_pow_float(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d, MMD_POW_FLOAT)
#define VTABLE_pow_int(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d, MMD_POW_INT)
View
@@ -92,6 +92,7 @@ Creates and returns a clone of the NCI.
* ManagedStruct or Buffer?
*/
PMC_data(ret) = PMC_data(SELF);
+ PObj_get_FLAGS(ret) |= (PObj_get_FLAGS(SELF) & 0x3);
return ret;
}
@@ -124,14 +125,21 @@ shifted down.
void* invoke (void * next) {
Parrot_csub_t func = (Parrot_csub_t)D2FPTR(PMC_data(SELF));
PMC *obj;
+ UINTVAL flags;
/*
* If the invocant is a class or there is no invocant
* shift down arguments.
* But not if it's a plain NCI function created
* from dlfunc.
+ *
+ * NCI flags:
+ * private0 ... builtin multi method
+ * private1 ... created via dlfunc
+ *
*/
obj = REG_PMC(2);
- if (!(PObj_get_FLAGS(SELF) & PObj_private1_FLAG) &&
+ flags = PObj_get_FLAGS(SELF);
+ if (!(flags & PObj_private1_FLAG) &&
(PMC_IS_NULL(obj) || PObj_is_class_TEST(obj) ||
obj->vtable->class == obj)) {
INTVAL i, n;
@@ -141,6 +149,13 @@ shifted down.
REG_PMC(i) = REG_PMC(i+1);
}
}
+ else if ((flags & PObj_private0_FLAG) && obj) {
+ INTVAL i = REG_INT(3)++;
+ while (i--)
+ REG_PMC(6+i)=REG_PMC(5+i);
+ REG_PMC(5) = REG_PMC(2);
+ ++REG_INT(3);
+ }
func(INTERP, SELF);
return next;
}
View
@@ -95,27 +95,9 @@ Returns whether the class is or inherits from C<*classname>.
return Parrot_object_isa(INTERP, SELF, class);
}
-/*
-
-=item C<PMC *find_method(STRING *name)>
-
-Figure out which method PMC we need. By default we just defer to the
-system method lookup code.
-
-=cut
-
-*/
-
- PMC* find_method(STRING* name) {
- return Parrot_find_method_with_cache(INTERP, SELF, name);
- }
/*
-=item C<INTVAL can(STRING *method)>
-
-Returns whether the class can perform C<*method>.
-
=item C<PMC *get_class()>
Return SELF.
@@ -129,10 +111,6 @@ classes.
*/
- INTVAL can(STRING* method) {
- return VTABLE_find_method(INTERP, SELF, method) != NULL;
- }
-
PMC* get_class() {
return SELF;
}
View
@@ -137,7 +137,7 @@ Return the class of this object.
PMC* find_method(STRING* name) {
PMC *class = VTABLE_get_class(INTERP, SELF);
- return Parrot_find_method_with_cache(INTERP, class, name);
+ return VTABLE_find_method(INTERP, class, name);
}
PMC* get_attr(INTVAL idx) {
View
@@ -77,7 +77,7 @@ C<Parrot::Pmc2c>.
#define VTABLE_cmp_string(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STRCMP)
#define VTABLE_is_equal(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_EQ)
#define VTABLE_is_equal_num(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_NUMEQ)
-#define VTABLE_is_equal_str(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
+#define VTABLE_is_equal_string(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
#define VTABLE_pow(i, l, r, d) mmd_dispatch_v_ppp(i, l, r, d, MMD_POW)
#define VTABLE_pow_float(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d, MMD_POW_FLOAT)
#define VTABLE_pow_int(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d, MMD_POW_INT)
View
@@ -89,7 +89,7 @@ we can relax that a bit.
#define VTABLE_cmp_string(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STRCMP)
#define VTABLE_is_equal(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_EQ)
#define VTABLE_is_equal_num(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_NUMEQ)
-#define VTABLE_is_equal_str(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
+#define VTABLE_is_equal_string(i,l,r) mmd_dispatch_i_pp(i,l,r,MMD_STREQ)
#define VTABLE_pow(i, l, r, d) mmd_dispatch_v_ppp(i, l, r, d, MMD_POW)
#define VTABLE_pow_float(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d, MMD_POW_FLOAT)
#define VTABLE_pow_int(i, l, r, d) mmd_dispatch_v_pnp(i, l, r, d, MMD_POW_INT)
View
@@ -444,15 +444,15 @@ C<value>; returns true if they match.
/*
-=item C<INTVAL is_equal_str(PMC* value)>
+=item C<INTVAL is_equal_string(PMC* value)>
Compares the string with C<value>; returns FALSE if they match.
=cut
*/
- INTVAL is_equal_str (PMC* value) {
+ INTVAL is_equal_string (PMC* value) {
STRING *s = PMC_str_val(SELF);
STRING *v = VTABLE_get_string(INTERP, value);
return string_equal(INTERP, s, v) == 0;
View
@@ -100,7 +100,8 @@ END
foreach (@pmcs[0..$#pmcs-1]);
print OUT <<"END";
if (!pass) {
- PMC *classname_hash;
+ PMC *classname_hash, *iglobals;
+ int i;
/* Need an empty stash */
interp->globals = mem_sys_allocate(sizeof(struct Stash));
interp->globals->stash_hash =
@@ -110,6 +111,13 @@ END
interp->class_hash = classname_hash =
pmc_new(interp, enum_class_Hash);
Parrot_register_core_pmcs(interp, classname_hash);
+ /* init the interpreter globals array */
+ iglobals = pmc_new(interp, enum_class_SArray);
+ interp->iglobals = iglobals;
+ VTABLE_set_integer_native(interp, iglobals, (INTVAL)IGLOBALS_SIZE);
+ /* clear the array */
+ for (i = 0; i < (INTVAL)IGLOBALS_SIZE; i++)
+ VTABLE_set_pmc_keyed_int(interp, iglobals, i, NULL);
}
}
}
@@ -116,6 +116,10 @@ about the state of the PMC passed in here after the call is made.
The fully qualified name of the method or sub being called
+=item S1
+
+Call signature used for MMD only.
+
=item I0
1 if the sub is being called with fully prototyped parameters,
View
@@ -822,18 +822,24 @@ static Instruction*
pcc_insert_signature(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins,
struct pcc_sub_t *pcc_sub)
{
- int i, n;
+ int i, n, m;
SymReg *regs[IMCC_MAX_REGS];
char buffer[20]; /* TODO is there a limit? */
n = pcc_sub->nargs;
buffer[0] = '"';
+ if (pcc_sub->object) {
+ buffer[1] = 'O';
+ m = 2;
+ }
+ else
+ m = 1;
for (i = 0; i < n && i < 15; ++i) {
- buffer[i + 1] = pcc_sub->args[i]->set;
+ buffer[m++] = pcc_sub->args[i]->set;
}
- buffer[i + 1] = '"';
- buffer[i + 2] = '\0';
- regs[0] = get_pasm_reg(interp, "S0");
+ buffer[m++] = '"';
+ buffer[m] = '\0';
+ regs[0] = get_pasm_reg(interp, "S1");
regs[1] = mk_const(interp, str_dup(buffer), 'S');
ins = insINS(interp, unit, ins, "set", regs, 2);
return ins;
@@ -915,9 +921,8 @@ expand_pcc_sub_call(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins)
* a possible MMD call can inspect the passed arguments
*/
if (get_name) {
- /* for now, put a call signature in S0 */
- if (!meth_call)
- ins = pcc_insert_signature(interp, unit, ins, sub->pcc_sub);
+ /* for now, put a call signature in S1 */
+ ins = pcc_insert_signature(interp, unit, ins, sub->pcc_sub);
insert_ins(unit, ins, get_name);
ins = get_name;
}
@@ -946,6 +951,7 @@ expand_pcc_sub_call(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins)
else
ins = insINS(interp, unit, ins, "set", regs, 2);
}
+ ins = pcc_insert_signature(interp, unit, ins, sub->pcc_sub);
if (sub->pcc_sub->nci)
goto move_sub;
}
View
@@ -49,6 +49,8 @@ typedef struct _MMD_table {
in question */
} MMD_table;
+
+PMC *Parrot_MMD_search_default_func(Interp *, STRING *meth, STRING *signature);
/*
* in src/objects.c :
*/
View
@@ -154,10 +154,13 @@ Parrot_find_builtin(Interp *interpreter, STRING *func)
{
int i;
PMC *m;
+ STRING *ns;
i = find_builtin_s(interpreter, func);
- if (i < 0)
- return NULL;
+ if (i < 0) {
+ ns = CONST_STRING(interpreter, "__parrot_core");
+ return Parrot_find_global(interpreter, ns, func);
+ }
m = Parrot_find_global(interpreter,
builtins[i].namespace,
builtins[i].meth_name);
View
@@ -59,6 +59,12 @@ d d
d JOd # Parrot builtins
d v
+v JPPP # infix MMD
+v JPIP
+v JPSP
+v JPNP
+I JPP # MMD compare
+
f # t/pmc/nci.t
f ff # t/pmc/nci.t
f is
Oops, something went wrong.

0 comments on commit 8155c8a

Please sign in to comment.