From c0afb55cf37a03ad5ffde0739e77ffa3584d3f16 Mon Sep 17 00:00:00 2001 From: Leopold Toetsch Date: Wed, 10 Mar 2004 15:02:55 +0000 Subject: [PATCH] PIR meth call syntax - 1 * first steps towards obj._meth() call syntax * no return values yet * no namespace handling * s. imcc/t/syn/objects.t for examples git-svn-id: https://svn.parrot.org/parrot/trunk@5603 d31e2699-5ff4-0310-a27c-f18f2fbe73fe --- MANIFEST | 1 + imcc/imcc.l | 8 ++++-- imcc/imcc.y | 36 +++++++++++++++++++-------- imcc/main.c | 2 +- imcc/pcc.c | 59 +++++++++++++++++++++++++++++++------------- imcc/symreg.h | 1 + imcc/t/syn/macro.t | 2 +- imcc/t/syn/objects.t | 56 +++++++++++++++++++++++++++++++++++++++++ t/pmc/pmc.t | 2 +- 9 files changed, 135 insertions(+), 32 deletions(-) create mode 100644 imcc/t/syn/objects.t diff --git a/MANIFEST b/MANIFEST index 082cea1981..4d6b45d130 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1675,6 +1675,7 @@ imcc/t/syn/keyed.t [] imcc/t/syn/labels.t [] imcc/t/syn/macro.t [] imcc/t/syn/namespace.t [] +imcc/t/syn/objects.t [] imcc/t/syn/pcc.t [] imcc/t/syn/pod.t [] imcc/t/syn/scope.t [] diff --git a/imcc/imcc.l b/imcc/imcc.l index b20dc45abf..3afd6f7e5b 100644 --- a/imcc/imcc.l +++ b/imcc/imcc.l @@ -249,6 +249,7 @@ SP [ ] "==" return(RELOP_EQ); "!=" return(RELOP_NE); "**" return(POW); +"->" return(POINTY); ".macro" { return read_macro(valp, interp); @@ -350,8 +351,11 @@ SP [ ] valp->s = buf; return INTC; } - if (!expand_macro(valp, interp, yytext+1)) - fataly(1, sourcefile, line, "unknown macro '%s'", yytext); + if (!expand_macro(valp, interp, yytext+1)) { + /* fataly(1, sourcefile, line, "unknown macro '%s'", yytext); */ + yyless(1); + return '.'; + } } {ID} { diff --git a/imcc/imcc.y b/imcc/imcc.y index 3757d9db7f..fdb979b5fa 100644 --- a/imcc/imcc.y +++ b/imcc/imcc.y @@ -239,6 +239,7 @@ itcall_sub(SymReg* sub) %token CALL GOTO ARG FLATTEN_ARG IF UNLESS END SAVEALL RESTOREALL %token NEW NEWSUB NEWCLOSURE NEWCOR NEWCONT %token NAMESPACE ENDNAMESPACE CLASS ENDCLASS FIELD METHOD +%token POINTY %token SUB SYM LOCAL CONST %token INC DEC GLOBAL_CONST %token SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV PMCV OBJECTV DEFINED LOG_XOR @@ -252,12 +253,13 @@ itcall_sub(SymReg* sub) %token EMIT EOM %token IREG NREG SREG PREG IDENTIFIER STRINGC INTC FLOATC REG MACRO ENDM %token PARROT_OP -%type type newsub -%type program class class_body member_decls member_decl field_decl method_decl +%type type newsub ptr +%type program class class_body member_decls member_decl field_decl +%type method_decl %type global constdef sub emit pcc_sub sub_body pcc_ret pcc_yield %type compilation_units compilation_unit %type classname relop -%type labels _labels label statements statement sub_call +%type labels _labels label statements statement sub_call meth_call %type pcc_sub_call %type sub_param sub_params pcc_arg pcc_result pcc_args pcc_results pcc_params pcc_param %type pcc_returns pcc_return pcc_call arg the_sub @@ -508,7 +510,7 @@ pcc_sub_call: pcc_call opt_label pcc_results - PCC_END '\n' { $$ = 0; } + PCC_END { $$ = 0; } ; opt_label: @@ -587,7 +589,7 @@ pcc_ret: i->type = ITPCCSUB | ITLABEL; } pcc_returns - PCC_END_RETURN '\n' + PCC_END_RETURN { $$ = 0; } ; @@ -608,7 +610,7 @@ pcc_yield: i->type = ITPCCSUB | ITLABEL | ITPCCYIELD; } pcc_returns - PCC_END_YIELD '\n' + PCC_END_YIELD { $$ = 0; } ; @@ -645,10 +647,6 @@ statement: helper_clear_state instruction { $$ = $2; } | MACRO '\n' { $$ = 0; } - | sub_call { $$ = 0; current_call = NULL; } - | pcc_sub_call { $$ = 0; } - | pcc_ret - | pcc_yield | FILECOMMENT { $$ = 0; } | LINECOMMENT { $$ = 0; } ; @@ -704,6 +702,11 @@ labeled_inst: | PARROT_OP vars { $$ = INS(interp, cur_unit, $1, 0, regs, nargs, keyvec, 1); free($1); } + | sub_call { $$ = 0; current_call = NULL; } + | meth_call { $$ = 0; current_call = NULL; } + | pcc_sub_call { $$ = 0; } + | pcc_ret + | pcc_yield | /* none */ { $$ = 0;} ; @@ -833,6 +836,19 @@ the_sub: IDENTIFIER { $$ = mk_sub_address($1); } */ ; +ptr: POINTY { $$=0; } + | '.' { $$=0; } + ; +meth_call: VAR ptr IDENTIFIER + { + $$ = create_itcall_label(); + itcall_sub(mk_sub_address($3)); + current_call->r[0]->pcc_sub->object = $1; + } + '(' arglist ')' + { $$ = $2; } + ; + sub_call: the_sub { diff --git a/imcc/main.c b/imcc/main.c index 5829d4c77a..831868488e 100644 --- a/imcc/main.c +++ b/imcc/main.c @@ -120,7 +120,7 @@ the GNU General Public License or the Artistic License for more details.\n\n"); static struct longopt_opt_decl options[] = { { '.', '.', 0, { "--wait" } }, { 'C', 'C', 0, { "--CGP-core" } }, - { 'E', 'E', 0, { "--pre-precess-only" } }, + { 'E', 'E', 0, { "--pre-process-only" } }, { 'G', 'G', 0, { "--no-gc" } }, { 'O', 'O', OPTION_optional_FLAG, { "--optimize" } }, { 'P', 'P', 0, { "--predereferenced-core" } }, diff --git a/imcc/pcc.c b/imcc/pcc.c index 9992b430ff..740edb8b7d 100644 --- a/imcc/pcc.c +++ b/imcc/pcc.c @@ -413,7 +413,7 @@ expand_pcc_sub(Parrot_Interp interpreter, IMC_Unit * unit, Instruction *ins) insINS(interpreter, unit, ins, "set", regs, 2); } /* - * check if there is a return + * check if there is a return */ if (unit->last_ins->type != (ITPCCSUB|ITLABEL) && @@ -422,7 +422,7 @@ expand_pcc_sub(Parrot_Interp interpreter, IMC_Unit * unit, Instruction *ins) strcmp(unit->last_ins->op, "end") ) { - if (sub->pcc_sub->cc_sym) + if (sub->pcc_sub->cc_sym) regs[0] = sub->pcc_sub->cc_sym; else regs[0] = mk_pasm_reg(str_dup("P1")); @@ -769,6 +769,7 @@ expand_pcc_sub_call(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins) int need_cc; int tail_call; int proto; + int meth_call = 0; #if IMC_TRACE PIO_eprintf(NULL, "expand_pcc_sub_call\n"); @@ -783,7 +784,11 @@ expand_pcc_sub_call(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins) * See if we need to create a temporary sub object */ if (ins->type & ITCALL) { - if (sub->pcc_sub->sub->type == VTADDRESS) { + if (sub->pcc_sub->object) { + add_pcc_sub(sub, sub->pcc_sub->sub); + meth_call = 1; + } + else if (sub->pcc_sub->sub->type == VTADDRESS) { #if IMC_TRACE fprintf(stderr, "generating sub object [sub->name = %s]\n", sub->pcc_sub->sub->name); @@ -836,19 +841,34 @@ expand_pcc_sub_call(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins) * setup P0, P1 */ arg = sub->pcc_sub->sub; - if (arg->reg->type & VTPASM) { -move_sub: - if (arg->reg->color != 0) { - reg = mk_pasm_reg(str_dup("P0")); - regs[0] = reg; - regs[1] = arg; - arg->reg->want_regno = 0; - ins = insINS(interp, unit, ins, "set", regs, 2); - } + if (meth_call) { + char buf[256]; + /* set S0, meth */ + regs[0] = get_pasm_reg("S0");; + sprintf(buf, "\"%s\"", arg->name); + regs[1] = mk_const(str_dup(buf), 'S'); + ins = insINS(interp, unit, ins, "set", regs, 2); + /* set P2, obj */ + regs[0] = get_pasm_reg("P2"); + regs[1] = sub->pcc_sub->object; + ins = insINS(interp, unit, ins, "set", regs, 2); } else { - /* TODO no move if possible */ - goto move_sub; + /* plain sub call */ + if (arg->reg->type & VTPASM) { +move_sub: + if (arg->reg->color != 0) { + reg = get_pasm_reg("P0"); + regs[0] = reg; + regs[1] = arg; + arg->reg->want_regno = 0; + ins = insINS(interp, unit, ins, "set", regs, 2); + } + } + else { + /* TODO no move if possible */ + goto move_sub; + } } arg = sub->pcc_sub->cc; @@ -857,7 +877,7 @@ expand_pcc_sub_call(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins) if (arg->reg->type & VTPASM) { move_cc: if (arg->reg->color != 1) { - reg = mk_pasm_reg(str_dup("P1")); + reg = get_pasm_reg("P1"); regs[0] = reg; regs[1] = arg; arg->reg->want_regno = 1; @@ -890,12 +910,17 @@ expand_pcc_sub_call(Parrot_Interp interp, IMC_Unit * unit, Instruction *ins) * emit a savetop for now */ ins = insINS(interp, unit, ins, "savetop", regs, 0); - ins = insINS(interp, unit, ins, need_cc ? "invokecc" : "invoke", regs, 0); + if (meth_call) + ins = insINS(interp, unit, ins, + need_cc ? "callmethodcc" : "callmethod", regs, 0); + else + ins = insINS(interp, unit, ins, + need_cc ? "invokecc" : "invoke", regs, 0); ins->type |= ITPCCSUB; /* * move the pcc_sub structure to the invoke */ - ins->r[0] = mk_pasm_reg(str_dup("P0")); + ins->r[0] = get_pasm_reg("P0"); /* XXX or P2 */ ins->r[0]->pcc_sub = sub->pcc_sub; sub->pcc_sub = NULL; sub = ins->r[0]; diff --git a/imcc/symreg.h b/imcc/symreg.h index f1dee9776e..0fd7515b97 100644 --- a/imcc/symreg.h +++ b/imcc/symreg.h @@ -143,6 +143,7 @@ struct pcc_sub_t { int calls_a_sub; int nci; int label; + SymReg * object; }; diff --git a/imcc/t/syn/macro.t b/imcc/t/syn/macro.t index 5da99530aa..efc3dea2e7 100644 --- a/imcc/t/syn/macro.t +++ b/imcc/t/syn/macro.t @@ -280,7 +280,7 @@ output_like( <<'CODE', < 2; + +############################## +# Parrot Calling Conventions + + +output_is(<<'CODE', <<'OUT', "meth call syntax"); +.sub _main + .local pmc class + .local pmc obj + find_global $P0, "_meth" + store_global "Foo", "_meth", $P0 + newclass class, "Foo" + find_type $I0, "Foo" + new obj, $I0 + obj._meth() + obj->_meth() + print "done\n" + end +.end +.sub _meth + print "in meth\n" +.end +CODE +in meth +in meth +done +OUT + +output_is(<<'CODE', <<'OUT', "meth call syntax(argc)"); +.sub _main + .local pmc class + .local pmc obj + find_global $P0, "_meth" + store_global "Foo", "_meth", $P0 + newclass class, "Foo" + find_type $I0, "Foo" + new obj, $I0 + $P0 = new PerlString + $P0 = "ok\n" + obj. _meth($P0) + print "done\n" + end +.end +.sub _meth + .param pmc s + print "in meth\n" + print s +.end +CODE +in meth +ok +done +OUT diff --git a/t/pmc/pmc.t b/t/pmc/pmc.t index af05c09427..ff69ba1ff5 100644 --- a/t/pmc/pmc.t +++ b/t/pmc/pmc.t @@ -2321,7 +2321,7 @@ output_like(<<'CODE', <<'OUTPUT', "new with a native type"); print "never\n" end CODE -/error:\w+:unknown macro '\.INTVAL'/ +/(unknown macro|unexpected '\.')/ OUTPUT output_is(<<'CODE', <