cvsuser 03/07/29 06:35:24
Modified: languages/imcc ChangeLog cfg.c cfg.h imc.c imcc.l imcc.y
instructions.h jit.c main.c symreg.c symreg.h
languages/imcc/docs calling_conventions.pod
languages/imcc/t/imcpasm sub.t
Log:
PCC-1: s. ChangeLog and calling_conventions.pod
Revision Changes Path
1.19 +8 -0 parrot/languages/imcc/ChangeLog
Index: ChangeLog
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/ChangeLog,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -w -r1.18 -r1.19
--- ChangeLog 9 Jul 2003 12:40:14 -0000 1.18
+++ ChangeLog 29 Jul 2003 13:35:21 -0000 1.19
@@ -1,3 +1,11 @@
+- 2003-07-29 leo
+
+ * version 0.0.10.2
+ * first try on implementing PCC from docs/calling_conventions.pod
+ - no optimizations
+ - only upper half of registers are preserved
+ - s. t/imcpasm/pcc.t for generated code
+
- 2003-07-09 leo
* version 0.0.10.1
1.30 +234 -8 parrot/languages/imcc/cfg.c
Index: cfg.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/cfg.c,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -w -r1.29 -r1.30
--- cfg.c 26 Jun 2003 11:20:14 -0000 1.29
+++ cfg.c 29 Jul 2003 13:35:21 -0000 1.30
@@ -20,8 +20,222 @@
/* Code: */
+static void
+expand_pcc_sub(Parrot_Interp interpreter, Instruction *ins)
+{
+ SymReg *arg, *sub;
+ int next[4], i, j, n;
+ char types[] = "INSP";
-void find_basic_blocks () {
+ UNUSED(interpreter);
+ for (i = 0; i < 4; i++)
+ next[i] = 5;
+ sub = ins->r[1];
+ /* insert params */
+ n = sub->pcc_sub->nargs;
+ for (i = 0; i < n; i++) {
+ arg = sub->pcc_sub->args[i];
+ for (j = 0; j < 4; j++) {
+ if (arg->set == types[j]) {
+ if (arg->color == next[j]) {
+ next[j]++;
+ break;
+ }
+ arg->reg->color = next[j]++;
+ break;
+ }
+ }
+ }
+}
+
+static void
+expand_pcc_sub_ret(Parrot_Interp interpreter, Instruction *ins)
+{
+ SymReg *arg, *sub, *reg, *regs[IMCC_MAX_REGS];
+ int next[4], i, j, n;
+ char types[] = "INSP";
+ Instruction *tmp;
+
+ for (i = 0; i < 4; i++)
+ next[i] = 5;
+ /* the first ins holds the sub SymReg */
+ sub = instructions->r[1];
+ n = sub->pcc_sub->nret;
+ for (i = 0; i < n; i++) {
+ arg = sub->pcc_sub->ret[i];
+ /* if arg is constant, set register */
+ switch (arg->type) {
+ case VT_CONSTP:
+ arg = arg->reg;
+ /* goon */
+ case VTCONST:
+lazy:
+ for (j = 0; j < 4; j++) {
+ if (arg->set == types[j]) {
+ char buf[128];
+ if (arg->color == next[j]) {
+ next[j]++;
+ break;
+ }
+ sprintf(buf, "%c%d", arg->set, next[j]++);
+ reg = mk_pasm_reg(str_dup(buf));
+ regs[0] = reg;
+ regs[1] = arg;
+ tmp = INS(interpreter, "set", NULL, regs, 2, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ break;
+ }
+ }
+ break;
+ default:
+ if (arg->type & VTREGISTER) {
+ /* TODO for now just emit a register move */
+ goto lazy;
+ }
+ }
+
+ }
+ /*
+ * insert return invoke
+ */
+ reg = mk_pasm_reg(str_dup("P1"));
+ regs[0] = reg;
+ tmp = INS(interpreter, "invoke", NULL, regs, 1, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+}
+
+static void
+expand_pcc_sub_call(Parrot_Interp interpreter, Instruction *ins)
+{
+ SymReg *arg, *sub, *reg, *regs[IMCC_MAX_REGS];
+ int next[4], i, j, n;
+ char types[] = "INSP";
+ Instruction *tmp;
+
+ for (i = 0; i < 4; i++)
+ next[i] = 5;
+ sub = ins->r[0];
+ /*
+ * insert arguments
+ */
+ n = sub->pcc_sub->nargs;
+ for (i = 0; i < n; i++) {
+ arg = sub->pcc_sub->args[i];
+ /* if arg is constant, set register */
+ switch (arg->type) {
+ case VT_CONSTP:
+ arg = arg->reg;
+ /* goon */
+ case VTCONST:
+lazy:
+ for (j = 0; j < 4; j++) {
+ if (arg->set == types[j]) {
+ char buf[128];
+ if (arg->color == next[j]) {
+ next[j]++;
+ break;
+ }
+ sprintf(buf, "%c%d", arg->set, next[j]++);
+ reg = mk_pasm_reg(str_dup(buf));
+ regs[0] = reg;
+ regs[1] = arg;
+ tmp = INS(interpreter, "set", NULL, regs, 2, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ break;
+ }
+ }
+ break;
+ default:
+ if (arg->type & VTREGISTER) {
+ /* TODO for now just emit a register move */
+ goto lazy;
+ }
+ }
+
+ }
+ /*
+ * insert invoke
+ */
+ 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;
+ tmp = INS(interpreter, "set", NULL, regs, 2, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ }
+ }
+ else {
+ /* TODO no move if possible */
+ goto move_sub;
+ }
+
+ arg = sub->pcc_sub->cc;
+ if (arg->reg->type & VTPASM) {
+move_cc:
+ if (arg->reg->color != 1) {
+ reg = mk_pasm_reg(str_dup("P1"));
+ regs[0] = reg;
+ regs[1] = arg;
+ tmp = INS(interpreter, "set", NULL, regs, 2, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ }
+ }
+ else {
+ /* TODO no move */
+ goto move_cc;
+ }
+ tmp = INS(interpreter, "savetop", NULL, regs, 0, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ tmp = INS(interpreter, "invoke", NULL, regs, 0, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ /*
+ * locate return label
+ */
+ while (ins->type != ITLABEL)
+ ins = ins->next;
+ tmp = INS(interpreter, "restoretop", NULL, regs, 0, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ /*
+ * handle return results
+ */
+ for (i = 0; i < 4; i++)
+ next[i] = 5;
+ n = sub->pcc_sub->nret;
+ for (i = 0; i < n; i++) {
+ arg = sub->pcc_sub->ret[i];
+ for (j = 0; j < 4; j++) {
+ if (arg->set == types[j]) {
+ char buf[128];
+ if (arg->reg->color == next[j]) {
+ next[j]++;
+ break;
+ }
+ sprintf(buf, "%c%d", arg->set, next[j]++);
+ reg = mk_pasm_reg(str_dup(buf));
+ regs[0] = arg;
+ regs[1] = reg;
+ tmp = INS(interpreter, "set", NULL, regs, 2, 0, 0);
+ insert_ins(ins, tmp);
+ ins = tmp;
+ break;
+ }
+ }
+ }
+}
+
+
+void find_basic_blocks (Parrot_Interp interpreter) {
Basic_block *bb;
Instruction *ins;
int nu = 0;
@@ -37,6 +251,11 @@
}
ins = instructions;
+ if (ins->type == ITLABEL && ins->r[1]) {
+ debug(DEBUG_CFG, "pcc_sub %s nparams %d\n",
+ ins->r[0]->name, ins->r[1]->pcc_sub->nargs);
+ expand_pcc_sub(interpreter, ins);
+ }
ins->index = i = 0;
bb = make_basic_block(ins);
@@ -70,7 +289,17 @@
add_instruc_writes(ins, p0);
add_instruc_writes(ins, p1);
}
- if ( (ins->type & ITLABEL)) {
+ if (ins->type & ITPCCSUB) {
+ if (ins->type & ITLABEL) {
+ expand_pcc_sub_ret(interpreter, ins);
+ ins->type &= ~ITLABEL;
+ }
+ else {
+ /* if this is a pcc_sub_call expand it */
+ expand_pcc_sub_call(interpreter, ins);
+ }
+ }
+ else if (ins->type & ITLABEL) {
/* set the labels address (ins) */
ins->r[0]->first_ins = ins;
}
@@ -80,10 +309,6 @@
if (nu)
nu = 0;
else if ( (ins->type & ITLABEL)) {
- /* XXX look at this change bb->end did include the label,
- * now no more
- * s. t/rx/basic_6
- */
bb->end = ins->prev;
bb = make_basic_block(ins);
}
@@ -101,7 +326,8 @@
*
* ignore set_addr - no new basic block
*/
- if (!strcmp(ins->op, "bsr") || !strcmp(ins->op, "set_addr")) {
+ if (!strcmp(ins->op, "bsr") || !strcmp(ins->op, "set_addr") ||
+ !strcmp(ins->op, "newsub")) {
char *name = ins->r[0]->name;
SymReg *r = get_sym(name);
if (*ins->op == 'b') { /* bsr */
@@ -125,7 +351,7 @@
}
}
else {
- /* don't treat set_addr as jump source */
+ /* don't treat set_addr/newsub as jump source */
found = 0;
}
}
1.10 +1 -1 parrot/languages/imcc/cfg.h
Index: cfg.h
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/cfg.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -w -r1.9 -r1.10
--- cfg.h 6 Mar 2003 08:58:50 -0000 1.9
+++ cfg.h 29 Jul 2003 13:35:21 -0000 1.10
@@ -44,7 +44,7 @@
/* Functions: */
-void find_basic_blocks (void);
+void find_basic_blocks (Parrot_Interp);
void build_cfg(void);
void bb_findadd_edge(Basic_block*, SymReg*);
void bb_add_edge(Basic_block*, Basic_block*);
1.49 +13 -9 parrot/languages/imcc/imc.c
Index: imc.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imc.c,v
retrieving revision 1.48
retrieving revision 1.49
diff -u -w -r1.48 -r1.49
--- imc.c 12 Jun 2003 10:05:01 -0000 1.48
+++ imc.c 29 Jul 2003 13:35:21 -0000 1.49
@@ -67,7 +67,7 @@
todo = first = 1;
while (todo) {
- find_basic_blocks();
+ find_basic_blocks(interpreter);
build_cfg();
if (first && (IMCC_DEBUG & DEBUG_CFG))
@@ -79,7 +79,7 @@
todo = first = 1;
while (todo) {
if (!first) {
- find_basic_blocks();
+ find_basic_blocks(interpreter);
build_cfg();
}
first = 0;
@@ -122,7 +122,7 @@
* do life analysis there for only the involved regs
*/
#if DOIT_AGAIN_SAM
- find_basic_blocks();
+ find_basic_blocks(interpreter);
build_cfg();
build_reglist();
life_analysis();
@@ -644,13 +644,14 @@
if (reglist[x]->set == typ && reglist[x]->color == -1) {
free_colors = map_colors(x, graph, colors, typ);
if (free_colors > 0) {
- for(color = 0; color < MAX_COLOR - (typ=='P'); color++) {
- if(!colors[color]) {
- reglist[x]->color = color;
+ for (color = 0; color < MAX_COLOR; color++) {
+ int c = (color + 16) % 32;
+ if (!colors[c]) {
+ reglist[x]->color = c;
debug(DEBUG_IMC, "#[%s] provisionally gets color [%d]"
"(%d free colors, score %d)\n",
- reglist[x]->name, color,
+ reglist[x]->name, c,
free_colors, reglist[x]->score);
break;
}
@@ -685,6 +686,9 @@
SymReg * r;
int color, free_colors;
memset(colors, 0, sizeof(colors[0]) * MAX_COLOR);
+ /* reserved for spilling */
+ if (typ == 'P')
+ colors[31] = 1;
for(y = 0; y < n_symbols; y++) {
if((r = graph[x*n_symbols+y])
&& r->color != -1
@@ -692,7 +696,7 @@
colors[r->color] = 1;
}
}
- for(color = free_colors = 0; color < MAX_COLOR - (typ=='P'); color++)
+ for(color = free_colors = 0; color < MAX_COLOR; color++)
if(!colors[color])
free_colors++;
return free_colors;
1.38 +8 -1 parrot/languages/imcc/imcc.l
Index: imcc.l
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.l,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -w -r1.37 -r1.38
--- imcc.l 3 Jul 2003 11:15:09 -0000 1.37
+++ imcc.l 29 Jul 2003 13:35:21 -0000 1.38
@@ -1,6 +1,6 @@
%{
/*
- * imc.l
+ * imcc.l
*
* Intermediate Code Compiler for Parrot
*
@@ -140,6 +140,13 @@
".arg" return(ARG);
".sub" return(SUB);
".end" return(ESUB);
+".pcc_begin" return(PCC_BEGIN);
+".pcc_end" return(PCC_END);
+".pcc_call" return(PCC_CALL);
+".pcc_sub" return(PCC_SUB);
+".pcc_begin_return" return(PCC_BEGIN_RETURN);
+".pcc_end_return" return(PCC_END_RETURN);
+
".result" return(RESULT);
".return" return(RETURN);
".class" return(CLASS);
1.68 +105 -5 parrot/languages/imcc/imcc.y
Index: imcc.y
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.y,v
retrieving revision 1.67
retrieving revision 1.68
diff -u -w -r1.67 -r1.68
--- imcc.y 9 Jul 2003 15:50:12 -0000 1.67
+++ imcc.y 29 Jul 2003 13:35:21 -0000 1.68
@@ -408,14 +408,19 @@
%token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
%token <t> GLOBAL ADDR CLONE RESULT RETURN POW SHIFT_RIGHT_U LOG_AND LOG_OR
%token <t> COMMA ESUB
+%token <t> PCC_BEGIN PCC_END PCC_CALL PCC_SUB PCC_BEGIN_RETURN PCC_END_RETURN
%token <s> LABEL
%token <t> EMIT EOM
%token <s> IREG NREG SREG PREG IDENTIFIER STRINGC INTC FLOATC REG MACRO ENDM
%token <s> PARROT_OP
%type <t> type
-%type <i> program sub sub_start emit
+%type <i> program sub sub_start emit nsub pcc_sub sub_body pcc_ret
%type <s> classname relop
%type <i> labels _labels label statements statement
+%type <i> pcc_sub_call
+%type <sr> pcc_arg pcc_result pcc_args pcc_results pcc_params pcc_param
+%type <sr> pcc_returns pcc_return
+%type <t> pcc_proto
%type <i> instruction assignment if_statement labeled_inst
%type <sr> target reg const var rc string
%type <sr> key keylist _keylist
@@ -463,16 +468,22 @@
emit_flush(interp); $$=0;}
;
+nsub: sub_start
+ sub_body
+ ;
-
-sub: sub_start
+sub_body:
statements ESUB
{
$$ = 0;
allocate(interp);
emit_flush(interp);
}
- | emit { $$=0; }
+ ;
+
+sub: nsub
+ | pcc_sub
+ | emit
;
sub_start: SUB { open_comp_unit(); }
@@ -481,6 +492,93 @@
iSUBROUTINE(mk_address($3, U_add_uniq_sub));
}
;
+pcc_sub: PCC_SUB { open_comp_unit(); }
+ IDENTIFIER '\n'
+ {
+ Instruction *i =iSUBROUTINE(mk_address($3, U_add_uniq_sub));
+ i->r[1] = $<sr>$ = mk_pcc_sub(str_dup($3), 0);
+ }
+ pcc_params
+ sub_body { $$ = 0; }
+ ;
+
+pcc_params: /* empty */ { $$ = 0; }
+ | pcc_param '\n' { add_pcc_param($<sr>0, $1);}
+ | pcc_params pcc_param '\n' { add_pcc_param($<sr>0, $2);}
+ ;
+
+pcc_param: PARAM { is_def=1; }
+ type IDENTIFIER { $$ = mk_ident($4, $3); is_def=0; }
+ ;
+
+pcc_sub_call: PCC_BEGIN pcc_proto '\n' {
+ char name[128];
+ SymReg * r;
+ Instruction *i;
+
+ sprintf(name, "#pcc_sub_call_%d", line - 1);
+ $<sr>$ = r = mk_pcc_sub(str_dup(name), 0);
+ /* this mid rule action has the semantic value of the
+ sub SymReg.
+ This is used below to append args & results
+ */
+ i = iLABEL(r);
+ i->type = ITPCCSUB;
+
+ }
+ pcc_args
+ PCC_CALL var COMMA var '\n' {
+ add_pcc_sub($<sr>4, $7);
+ add_pcc_cc($<sr>4, $9);
+ }
+ label '\n'
+ pcc_results
+ PCC_END '\n' { $$ = 0; }
+ ;
+
+pcc_proto: /* empty */ { $$ = 0; }
+ ;
+
+pcc_args: /* empty */ { $$ = 0; }
+ | pcc_arg '\n' { add_pcc_arg($<sr>0, $1);}
+ | pcc_args pcc_arg '\n' { add_pcc_arg($<sr>0, $2);}
+ ;
+
+pcc_arg: ARG var { $$ = $2; }
+ ;
+
+pcc_results: /* empty */ { $$ = 0; }
+ | pcc_result '\n' { if($1) add_pcc_result($<sr>-9, $1); }
+ | pcc_results pcc_result '\n' { if($2) add_pcc_result($<sr>-9, $2); }
+ ;
+
+pcc_ret: PCC_BEGIN_RETURN '\n' {
+ Instruction *i, *ins = instructions;
+ char name[128];
+ if (!ins || !ins->r[1] || ins->r[1]->type != VT_PCC_SUB)
+ fataly(EX_SOFTWARE, "pcc_ret", line,
+ "pcc_return not inside pcc subroutine\n");
+ $<sr>$ = ins->r[1];
+ sprintf(name, "#pcc_sub_ret_%d:", line - 1);
+ i = _mk_instruction("", name, NULL, 0);
+ i = emitb(i);
+ i->type = ITPCCSUB | ITLABEL;
+ }
+ pcc_returns
+ PCC_END_RETURN '\n' { $$ = 0; }
+ ;
+
+pcc_returns: /* empty */ { $$ = 0; }
+ | pcc_returns '\n' { if($1) add_pcc_return($<sr>0, $1); }
+ | pcc_returns pcc_return '\n' { if($2) add_pcc_return($<sr>0, $2); }
+ ;
+
+pcc_return: RETURN var { $$ = $2; }
+ ;
+
+pcc_result: RESULT var { $$ = $2; }
+ | LOCAL { is_def=1; } type IDENTIFIER { mk_ident($4, $3);is_def=0; $$=0; }
+ ;
statements: statement
| statements statement
@@ -489,6 +587,8 @@
statement: { clear_state(); }
instruction { $$ = $2; }
| MACRO '\n' { $$ = 0; }
+ | pcc_sub_call { $$ = 0; }
+ | pcc_ret
;
labels: /* none */ { $$ = NULL; }
1.24 +2 -1 parrot/languages/imcc/instructions.h
Index: instructions.h
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/instructions.h,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -w -r1.23 -r1.24
--- instructions.h 6 Jul 2003 09:23:59 -0000 1.23
+++ instructions.h 29 Jul 2003 13:35:21 -0000 1.24
@@ -10,7 +10,8 @@
ITADDR = 0x200000, /* set_addr P, addr*/
ITSPILL = 0x400000, /* set P31,x ; set x, p31 spilling */
ITEXT = 0x800000, /* instruction is extcall in JIT */
- ITSAVES = 0x1000000 /* saveall/restoreall in a bsr */
+ ITSAVES = 0x1000000, /* saveall/restoreall in a bsr */
+ ITPCCSUB = 0x2000000 /* PCC sub call */
};
1.4 +1 -1 parrot/languages/imcc/jit.c
Index: jit.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/jit.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- jit.c 24 Jul 2003 18:53:04 -0000 1.3
+++ jit.c 29 Jul 2003 13:35:21 -0000 1.4
@@ -292,7 +292,7 @@
}
}
- find_basic_blocks();
+ find_basic_blocks(interpreter);
/* allocate a jit_info packfile segment holding
* some CFG and register usage info
*/
1.34 +1 -1 parrot/languages/imcc/main.c
Index: main.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/main.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -w -r1.33 -r1.34
--- main.c 21 Jul 2003 18:00:47 -0000 1.33
+++ main.c 29 Jul 2003 13:35:21 -0000 1.34
@@ -20,7 +20,7 @@
#include "pbc.h"
#include "parser.h"
-#define IMCC_VERSION "0.0.10.1"
+#define IMCC_VERSION "0.0.10.2"
static int run_pbc, write_pbc, pre_process;
static char optimizer_opt[20];
1.20 +65 -0 parrot/languages/imcc/symreg.c
Index: symreg.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/symreg.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -w -r1.19 -r1.20
--- symreg.c 31 May 2003 23:37:42 -0000 1.19
+++ symreg.c 29 Jul 2003 13:35:21 -0000 1.20
@@ -8,6 +8,7 @@
/* Code: */
void delete_sym(const char * name);
+static SymReg * dup_sym(SymReg *r);
void push_namespace(char * name) {
@@ -57,6 +58,7 @@
}
r->name = name;
r->color = -1;
+ r->want_regno = -1;
r->set = t;
r->type = VTREG;
@@ -67,6 +69,69 @@
SymReg * mk_symreg(char * name, char t) {
return _mk_symreg(hash, name, t);
+}
+
+SymReg * mk_pcc_sub(char * name, char proto) {
+ SymReg *r = _mk_symreg(hash, name, proto);
+ r->type = VT_PCC_SUB;
+ r->pcc_sub = calloc(1, sizeof(struct pcc_sub_t));
+ return r;
+}
+
+void
+add_pcc_arg(SymReg *r, SymReg * arg)
+{
+ int n = r->pcc_sub->nargs;
+ r->pcc_sub->args = realloc(r->pcc_sub->args, (n + 1) * sizeof(SymReg *));
+ r->pcc_sub->args[n] = dup_sym(arg);
+ if (arg->type & VTREGISTER) {
+ r->pcc_sub->args[n]->reg = arg;
+ r->pcc_sub->args[n]->type = VT_REGP;
+ }
+ r->pcc_sub->nargs++;
+}
+
+void
+add_pcc_param(SymReg *r, SymReg * arg)
+{
+ add_pcc_arg(r, arg);
+}
+
+void
+add_pcc_result(SymReg *r, SymReg * arg)
+{
+ int n = r->pcc_sub->nret;
+ r->pcc_sub->ret = realloc(r->pcc_sub->ret, (n + 1) * sizeof(SymReg *));
+ r->pcc_sub->ret[n] = dup_sym(arg);
+ if (arg->type & VTREGISTER) {
+ r->pcc_sub->ret[n]->reg = arg;
+ r->pcc_sub->ret[n]->type = VT_REGP;
+ }
+ else
+ fataly(EX_SOFTWARE, "add_pcc_result", line,
+ "result is not a variable '%s'\n", arg->name);
+ r->pcc_sub->nret++;
+}
+
+void
+add_pcc_return(SymReg *r, SymReg * arg)
+{
+ add_pcc_result(r, arg);
+}
+
+void
+add_pcc_sub(SymReg *r, SymReg * arg)
+{
+ r->pcc_sub->sub = dup_sym(arg);
+ r->pcc_sub->sub->reg = arg;
+ r->pcc_sub->sub->type = VT_REGP;
+}
+void
+add_pcc_cc(SymReg *r, SymReg * arg)
+{
+ r->pcc_sub->cc = dup_sym(arg);
+ r->pcc_sub->cc->reg = arg;
+ r->pcc_sub->cc->type = VT_REGP;
}
SymReg * mk_pasm_reg(char * name) {
1.18 +23 -2 parrot/languages/imcc/symreg.h
Index: symreg.h
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/symreg.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -w -r1.17 -r1.18
--- symreg.h 4 Jun 2003 12:34:55 -0000 1.17
+++ symreg.h 29 Jul 2003 13:35:21 -0000 1.18
@@ -14,7 +14,8 @@
VTREGKEY = 1 << 4, /* parrot [key;key..], including registers */
VTPASM = 1 << 5, /* parrot register, colored from .emit */
VT_REGP = 1 << 6, /* pointer to register */
- VT_CONSTP = 1 << 7 /* pointer to constant value */
+ VT_CONSTP = 1 << 7, /* pointer to constant value */
+ VT_PCC_SUB = 1 << 8 /* PCC subroutine call */
};
/* this VARTYPE needs register allocation and such */
@@ -51,6 +52,7 @@
int set; /* Which register set/file it belongs to */
int color; /* Color: parrot register number
and parrot const table index of VTCONST*/
+ int want_regno; /* wanted register number */
int score; /* How costly is to spill this symbol */
int use_count; /* how often is this sym used */
int lhs_use_count; /* how often is this sym written to */
@@ -62,6 +64,7 @@
/* also used by labels as position of label and last reference */
struct _SymReg * nextkey; /* keys */
struct _SymReg * reg; /* key->register for VTREGKEYs */
+ struct pcc_sub_t *pcc_sub; /* PCC subroutine */
} SymReg;
@@ -88,6 +91,24 @@
SymReg * mk_const(char *, char t);
SymReg * mk_const_ident(char *, char t, SymReg *);
SymReg * mk_address(char *, int uniq);
+SymReg * mk_pcc_sub(char *, char proto);
+void add_pcc_arg(SymReg *r, SymReg * arg);
+void add_pcc_sub(SymReg *r, SymReg * arg);
+void add_pcc_cc(SymReg *r, SymReg * arg);
+void add_pcc_result(SymReg *r, SymReg * arg);
+void add_pcc_param(SymReg *r, SymReg * arg);
+void add_pcc_return(SymReg *r, SymReg * arg);
+
+struct pcc_sub_t {
+ SymReg ** args;
+ int nargs;
+ SymReg *sub;
+ SymReg *cc;
+ SymReg ** ret;
+ int nret;
+};
+
+
enum uniq_t {
U_add_once,
U_add_uniq_label,
1.6 +18 -2 parrot/languages/imcc/docs/calling_conventions.pod
Index: calling_conventions.pod
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/docs/calling_conventions.pod,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -w -r1.5 -r1.6
--- calling_conventions.pod 7 Jul 2003 21:56:21 -0000 1.5
+++ calling_conventions.pod 29 Jul 2003 13:35:23 -0000 1.6
@@ -102,7 +102,8 @@
=head2 PASM Subroutines
- newsub $P0, $P1, Sub, Continuation, _sub_label, ret_addr
+ newsub $P0, .Sub, _sub_label
+ newsub $P1, .Continuation, ret_addr
...
.pcc_begin prototyped|non_prototyped
.arg x # I5
@@ -125,6 +126,21 @@
...
.end
+Notes:
+
+=over 4
+
+=item * The B<prototyped> args are unimplemented and must not be given.
+
+=item * The B<.param> function params must be the first statements in the
+sub.
+
+=item * B<newsub> currently needs the B<.dot> B<Class> syntax.
+
+=item * Only the top half of registers are preserverd currently.
+
+=back
+
=head2 NCI
Proposed syntax:
@@ -148,7 +164,7 @@
=head2 Status
-Unimplemented.
+Partially implemented, s. t/imcpasm/pcc.t.
=head1 Exception handlers
1.4 +10 -24 parrot/languages/imcc/t/imcpasm/sub.t
Index: sub.t
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/t/imcpasm/sub.t,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -w -r1.3 -r1.4
--- sub.t 27 Apr 2003 07:42:25 -0000 1.3
+++ sub.t 29 Jul 2003 13:35:24 -0000 1.4
@@ -43,27 +43,20 @@
output_like(<<'CODE', <<'OUT', "non-constant dest bsr, invoke");
.sub _main
- .local PerlUndef _SV_r23
- _SV_r23 = new PerlUndef
$P26 = new Sub
$I15 = addr _sub1
$P26 = $I15
- _SV_r23 = clone $P26
- invoke _SV_r23
- bsr $I15
+ invoke $P26
ret
_sub1:
ret
.end
CODE
/^_main:
- new P0, \d+ # .PerlUndef
- new P1, \d+ # .Sub
- set_addr I0, _sub1
- set P1, I0
- clone P0, P1
- invoke P0
- bsr I0
+ new P16, \d+ # .Sub
+ set_addr I16, _sub1
+ set P16, I16
+ invoke P16
ret
_sub1:
ret/
@@ -71,14 +64,10 @@
output_like(<<'CODE', <<'OUT', "nonlocal bsr");
.sub _main
- .local PerlUndef _SV_r23
- _SV_r23 = new PerlUndef
$P26 = new Sub
$I15 = addr _f
$P26 = $I15
- _SV_r23 = clone $P26
- invoke _SV_r23
- bsr $I15
+ invoke $P26
ret
.end
.sub _f
@@ -86,13 +75,10 @@
.end
CODE
/^_main:
- new P0, \d+ # .PerlUndef
- new P1, \d+ # .Sub
- set_addr I0, _f
- set P1, I0
- clone P0, P1
- invoke P0
- bsr I0
+ new P16, \d+ # .Sub
+ set_addr I16, _f
+ set P16, I16
+ invoke P16
ret
_f:
ret/
