# New Ticket Created by Leopold Toetsch
# Please include the string: [perl #17578]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17578 >
This patch obsoletes all previous imcc 0.0.9 patches and contains all
current fixes and improvements.
s. 17573, 17561, 17560, 17537, 17533
Please apply,
leo
BTW: I didn't include the generated files, but consensus on the list
was, to include them. Could the person, checking in, change MANIFEST
accordingly, and check them in too. I suppose, problems Andy has, to be
related with the parser.
Thanks
-- attachment 1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/38603/31354/592eb2/imcc-0_0_9_3.patch
--- parrot/config/gen/makefiles/imcc.in Sun Sep 22 21:21:25 2002
+++ parrot-leo/config/gen/makefiles/imcc.in Mon Sep 23 21:22:27 2002
@@ -23,7 +23,7 @@
#DO NOT ADD C COMPILER FLAGS HERE
#Add them in Configure.pl--look for the
#comment 'ADD C COMPILER FLAGS HERE'
-CFLAGS = ${ccflags} -I../../include -Wall -Wno-unused
+CFLAGS = ${ccflags} -I../../include
C_LIBS = ${libs}
--- parrot/languages/imcc/instructions.c Sun Sep 22 21:21:29 2002
+++ parrot-leo/languages/imcc/instructions.c Mon Sep 23 21:21:18 2002
@@ -49,7 +49,10 @@
/* next 2 functions are called very often, says gprof
* theys should be fast
*/
-inline int instruction_reads(Instruction* ins, SymReg* r) {
+#ifdef HAS_INLINE
+inline
+#endif
+int instruction_reads(Instruction* ins, SymReg* r) {
int f, i;
SymReg *key;
@@ -66,7 +69,10 @@
return 0;
}
-inline int instruction_writes(Instruction* ins, SymReg* r) {
+#ifdef HAS_INLINE
+inline
+#endif
+int instruction_writes(Instruction* ins, SymReg* r) {
int f, i;
SymReg *key;
@@ -202,7 +208,33 @@
else
regstr[i] = ins->r[i]->name;
- vsprintf(s, ins->fmt, regstr); /* XXX */
+ switch (ins->opsize-1) {
+ case -1: /* labels */
+ case 1:
+ sprintf(s, ins->fmt, regstr[0]);
+ break;
+ case 2:
+ sprintf(s, ins->fmt, regstr[0], regstr[1]);
+ break;
+ case 3:
+ sprintf(s, ins->fmt, regstr[0], regstr[1], regstr[2]);
+ break;
+ case 4:
+ sprintf(s, ins->fmt, regstr[0], regstr[1], regstr[2], regstr[3]);
+ break;
+ case 5:
+ sprintf(s, ins->fmt, regstr[0], regstr[1], regstr[2], regstr[3],
+ regstr[4]);
+ break;
+ case 6:
+ sprintf(s, ins->fmt, regstr[0], regstr[1], regstr[2], regstr[3],
+ regstr[4], regstr[5]);
+ break;
+ default:
+ fatal(1, "ins_fmt", "unhandled: opsize (%d), op %s, fmt %s\n",
+ ins->opsize, ins->op, ins->fmt);
+ break;
+ }
return s;
}
--- parrot/languages/imcc/pbc.c Sun Sep 22 19:41:25 2002
+++ parrot-leo/languages/imcc/pbc.c Sat Sep 21 17:15:12 2002
@@ -437,6 +437,9 @@
{
switch (r->set) {
case 'I':
+ if (r->name[0] == '0' && r->name[1] == 'x')
+ r->color = strtoul(r->name+2, 0, 16);
+ else
r->color = atoi(r->name);
break;
case 'S':
--- parrot/languages/imcc/imcc.y Sun Sep 22 21:21:28 2002
+++ parrot-leo/languages/imcc/imcc.y Wed Sep 25 08:10:27 2002
@@ -35,9 +35,12 @@
static SymReg *regs[IMCC_MAX_REGS];
+/* Bit vector saying whether argument i is a key */
+static int keyvec = 0;
static int nargs = 0;
static SymReg *keys[IMCC_MAX_REGS];
static int nkeys = 0;
+#define KEY_BIT(argnum) (1 << argnum)
static SymReg ** RR(int n, ...)
{
@@ -94,10 +97,17 @@
*/
+static void clear_state()
+{
+ nargs = 0;
+ keyvec = 0;
+ memset(regs, 0, sizeof(regs));
+}
static Instruction * iLABEL(SymReg * r0) {
Instruction *i = emitb(_mk_instruction("","%s:", R1(r0), 0));
i->type = ITLABEL;
+ clear_state();
return i;
}
@@ -113,8 +123,10 @@
*/
static Instruction * iINDEXFETCH(SymReg * r0, SymReg * r1, SymReg * r2) {
if(r0->set == 'S' && r1->set == 'S' && r2->set == 'I') {
- return MK_I("substr %s, %s, %s, 1", R3(r0, r1, r2));
+ SymReg * r3 = mk_const("1", 'I');
+ return MK_I("substr %s, %s, %s, 1", R4(r0, r1, r2, r3));
}
+ keyvec |= KEY_BIT(2);
return MK_I("set %s, %s[%s]", R3(r0,r1,r2));
}
@@ -124,9 +136,11 @@
static Instruction * iINDEXSET(SymReg * r0, SymReg * r1, SymReg * r2) {
if(r0->set == 'S' && r1->set == 'I' && r2->set == 'S') {
- MK_I("substr %s, %s, 1, %s", R3(r0, r1, r2));
+ SymReg * r3 = mk_const("1", 'I');
+ MK_I("substr %s, %s, 1, %s", R4(r0, r1,r3, r2));
}
else if (r0->set == 'P') {
+ keyvec |= KEY_BIT(1);
MK_I("set %s[%s], %s", R3(r0,r1,r2));
}
else {
@@ -187,7 +201,7 @@
continue;
}
/* if one ever wants num keys, they go with 'S' */
- if (args[i]->type & VTKEY) {
+ if (keyvec & KEY_BIT(i)) {
*dest++ = 'k';
if (args[i]->set == 'S' || args[i]->set == 'N' ||
args[i]->set == 'K') {
@@ -307,7 +321,7 @@
default:
assert(0);
};
- if (regs[i]->type & VTKEY) {
+ if (keyvec & KEY_BIT(i)) {
len = strlen(format);
len -= 2;
format[len] = '\0';
@@ -321,22 +335,16 @@
format[len] = '\0';
if (fmt && *fmt)
strcpy(format, fmt);
- for (i = nargs; i < IMCC_MAX_REGS; i++)
- regs[i] = 0;
+ memset(regs + nargs, 0, sizeof(*regs) * (IMCC_MAX_REGS - nargs));
#if 1
debug(1,"%s %s\t%s\n", name, format, fullname);
#endif
/* make the instruction */
ins = emitb(_mk_instruction(name, format, regs, dirs));
+ ins->keys |= keyvec;
/* fill iin oplib's info */
ins->opnum = op;
ins->opsize = info->arg_count;
- /* reset the VTKEY flag and remeber the info in ins->keys */
- for (i = 0; ins->r[i]; i++)
- if (ins->r[i]->type & VTKEY) {
- ins->r[i]->type &= ~VTKEY;
- ins->keys |= (1<<i);
- }
/* set up branch flags */
if (info->jump) {
if (!strcmp(name, "bsr") || !strcmp(name, "ret")) {
@@ -366,6 +374,7 @@
fataly(EX_SOFTWARE, "iANY", line,"op not found '%s' (%s<%d>)\n",
fullname, name, nargs);
}
+ clear_state();
return NULL;
}
@@ -378,7 +387,7 @@
Instruction *i;
}
-%token <t> CALL GOTO BRANCH ARG RET PRINT IF UNLESS NEW END SAVEALL RESTOREALL
+%token <t> CALL GOTO ARG RET PRINT IF UNLESS NEW END SAVEALL RESTOREALL
%token <t> SUB NAMESPACE CLASS ENDCLASS SYM LOCAL PARAM PUSH POP INC DEC
%token <t> SHIFT_LEFT SHIFT_RIGHT INTV FLOATV STRINGV DEFINED LOG_XOR
%token <t> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
@@ -417,9 +426,7 @@
pasmline: labels pasm_inst '\n' { $$ = 0; }
;
-pasm_inst: PARROT_OP { nargs = 0;
- memset(regs, 0, sizeof(regs)); }
- pasm_args { $$ = iANY($1,0,regs,1); free($1); }
+pasm_inst: PARROT_OP pasm_args { $$ = iANY($1,0,regs,1); free($1); }
| /* none */ { $$ = 0;}
;
@@ -428,13 +435,14 @@
;
emit:
- EMIT pasmcode { $$ = 0 }
- EOM '\n' { emit_flush(); clear_tables();$$=0 }
+ EMIT pasmcode { $$ = 0;}
+ EOM '\n' { emit_flush(); clear_tables();$$=0;}
;
nls:
'\n'
| nls '\n'
+ ;
subs: subs sub
| sub
@@ -447,8 +455,8 @@
emit_flush();
clear_tables();
}
- | emit{ $$=0 }
- | nls { $$=0 }
+ | emit{ $$=0; }
+ | nls { $$=0; }
;
sub_start: SUB IDENTIFIER '\n'
@@ -505,10 +513,7 @@
| SAVEALL { $$ = MK_I("saveall" ,R0()); }
| RESTOREALL { $$ = MK_I("restoreall" ,R0()); }
| END { $$ = MK_I("end" ,R0()); }
- | PARROT_OP { nargs = 0;
- memset(regs, 0, sizeof(regs));
- }
- vars { $$ = iANY($1,0,regs, 1); free($1); }
+ | PARROT_OP vars { $$ = iANY($1,0,regs, 1); free($1); }
| /* none */ { $$ = 0;}
;
@@ -540,7 +545,7 @@
| target '=' var '&' var { $$ = MK_I("band", R3($1, $3, $5)); }
| target '=' var '|' var { $$ = MK_I("bor", R3($1, $3, $5)); }
| target '=' var '~' var { $$ = MK_I("bxor", R3($1, $3, $5)); }
- | target '=' var '[' keylist ']'{ $$ = iINDEXFETCH($1, $3, $5); }
+ | target '=' var '[' keylist ']' { $$ = iINDEXFETCH($1, $3, $5); }
| var '[' keylist ']' '=' var { $$ = iINDEXSET($1, $3, $6); }
| target '=' NEW classname { $$ = iNEW($1, $4); }
| target '=' DEFINED var { $$ = MK_I("defined %s, %s",R2($1,$4)); }
@@ -586,26 +591,27 @@
| _var_or_i
;
-_var_or_i: var_or_i { regs[nargs++] = $1 }
+_var_or_i: var_or_i { regs[nargs++] = $1; }
| lhs '[' keylist ']' { regs[nargs++] = $1;
- regs[nargs++] = $3; $$= $1; }
+ keyvec |= KEY_BIT(nargs);
+ regs[nargs++] = $3; $$ = $1; }
;
var_or_i:
IDENTIFIER { $$ = mk_address($1, U_add_once); }
| var
- | MACRO { $$ = macro($1+1); free($1)}
+ | MACRO { $$ = macro($1+1); free($1); }
;
var: VAR
| rc
;
-keylist: { nkeys=0 }
+keylist: { nkeys=0; }
_keylist { $$ = link_keys(nkeys, keys); }
;
_keylist: key { keys[nkeys++] = $1; }
- | _keylist ';' key { keys[nkeys++] = $3; $$ = keys[0] }
+ | _keylist ';' key { keys[nkeys++] = $3; $$ = keys[0]; }
;
key: var
@@ -656,7 +662,7 @@
exit(0);
}
-#define setopt(flag) Parrot_setflag(interpreter, flag, (*argv)[0]+2);
+#define setopt(flag) Parrot_setflag(interpreter, flag, (*argv)[0]+2)
#define unsetopt(flag) Parrot_setflag(interpreter, flag, 0)
/* most stolen from test_main.c */
@@ -696,7 +702,9 @@
setopt(PARROT_TRACE_FLAG);
break;
case 'd':
+ if (!Interp_flags_TEST(interpreter, PARROT_DEBUG_FLAG))
setopt(PARROT_DEBUG_FLAG);
+ else
IMCC_DEBUG++;
break;
case 'w':
@@ -847,11 +855,11 @@
int main(int argc, char * argv[])
{
- void * stacktop;
+ int stacktop;
struct PackFile *pf;
interpreter = Parrot_new();
- Parrot_init(interpreter, stacktop);
+ Parrot_init(interpreter, (void*)&stacktop);
pf = PackFile_new();
interpreter->code = pf;
#ifdef OPTEST
--- parrot/languages/imcc/imcc.l Sun Sep 22 21:21:27 2002
+++ parrot-leo/languages/imcc/imcc.l Wed Sep 25 07:46:12 2002
@@ -27,6 +27,7 @@
LETTER [a-zA-Z_]
DIGIT [0-9]
+HEX 0x[0-9A-Fa-f]+
DOT [.]
LETTERDIGIT [a-zA-Z0-9_]
SIGN [-+]
@@ -85,7 +86,6 @@
".namespace" return(NAMESPACE);
".local" return(LOCAL);
".param" return(PARAM);
-"branch" return(BRANCH);
"end" return(END);
"goto" return(GOTO);
"if" return(IF);
@@ -158,7 +158,10 @@
yylval.s = str_dup(yytext);
return(INTC);
}
-
+<emit,INITIAL>{HEX} {
+ yylval.s = str_dup(yytext);
+ return(INTC);
+ }
<emit,INITIAL>{STRINGCONSTANT} {
yylval.s = str_dup(yytext); /* XXX delete quotes, -> emit, pbc */
return(STRINGC);
--- parrot/languages/imcc/imc.h Sun Sep 22 21:21:27 2002
+++ parrot-leo/languages/imcc/imc.h Wed Sep 25 08:25:40 2002
@@ -1,7 +1,7 @@
#ifndef __IMC_H
#define __IMC_H
-#define IMCC_VERSION "0.0.9.0"
+#define IMCC_VERSION "0.0.9.3"
#include <stdio.h>
#include <stdlib.h>
@@ -82,7 +82,7 @@
EXTERN char optimizer_opt[20];
EXTERN int dont_optimize;
-struct ostat {
+struct imcc_ostat {
int deleted_labels;
int if_branch;
int branch_branch;
@@ -90,7 +90,7 @@
int deleted_ins;
} ;
-EXTERN struct ostat ostat;
+EXTERN struct imcc_ostat ostat;
#endif
--- parrot/languages/imcc/symreg.c Sun Sep 22 21:21:30 2002
+++ parrot-leo/languages/imcc/symreg.c Wed Sep 25 08:14:08 2002
@@ -96,23 +96,22 @@
return _mk_address(hash, name, uniq);
}
-/* link keys to a keys structure = SymReg VTKEY
+/* link keys to a keys structure = SymReg
*
- * whe might have
+ * we might have
*
* what op type pbc.c:build_key()
- * --------------------------------------------------------------
- * int const _kic VTCONST | VTKEY no
- * int reg _ki VTREG | VTKEY no
- * str const _kc VTCONST | VTKEY yes
- * str reg _kc VTREG | VTKEY yes
- *
- * "key" ';' "key" _kc VTKEY -> (list of above) yes
- * "key" ';' $I0 _kc VTREGKEY ->(list of above) yes
- *
- * actually, the VTKEY flag lives only shortly, until the
- * instruction is built. Then the information, which reg should
- * be passed to build_key(), is in instruction.
+ * --------------------------------------------------
+ * int const _kic VTCONST no
+ * int reg _ki VTREG no
+ * str const _kc VTCONST yes
+ * str reg _kc VTREG yes
+ *
+ * "key" ';' "key" _kc -> (list of above) yes
+ * "key" ';' $I0 _kc VTREGKEY -> (list of above) yes
+ *
+ * The information about which reg should be passed to build_key() is
+ * in the instruction.
*
* A key containing a variable has a special flag VTREGKEY
* because this key must be considered for life analysis for
@@ -154,10 +153,8 @@
if (nargs == 0)
fatal(1, "link_keys", "hu? no keys\n");
first = keys[0];
- if (nargs == 1) {
- first->type |= VTKEY;
+ if (nargs == 1)
return first;
- }
*key_str = 0;
/* first look, if we already have this exact key chain */
for (i = 0; i < nargs && strlen(key_str)<200; i++) {
@@ -171,7 +168,7 @@
keychain = calloc(1, sizeof(SymReg));
if (!keychain)
fatal(1, "link_keys", "Out of mem\n");
- keychain->type = VTKEY | VTCONST;
+ keychain->type = VTCONST;
key = keychain;
for (i = 0; i < nargs; i++) {
/* if any component is a variable, we need to track it in
--- parrot/languages/imcc/symreg.h Sun Sep 22 21:21:30 2002
+++ parrot-leo/languages/imcc/symreg.h Wed Sep 25 08:15:01 2002
@@ -11,9 +11,8 @@
VTREG = 1 << 1, /* register */
VTIDENTIFIER= 1 << 2, /* identifier */
VTADDRESS = 1 << 3, /* address */
- VTKEY = 1 << 4, /* parrot key, one key*/
- VTREGKEY = 1 << 5, /* parrot [key;key..], including registers */
- VTPASM = 1 << 7 /* parrot register, colored from .emit */
+ VTREGKEY = 1 << 4, /* parrot [key;key..], including registers */
+ VTPASM = 1 << 5 /* parrot register, colored from .emit */
};
/* this VARTYPE needs register allocation and such */
--- parrot/languages/perl6/perl6 Sun Sep 22 21:21:30 2002
+++ parrot-leo/languages/perl6/perl6 Mon Sep 23 08:52:31 2002
@@ -20,8 +20,8 @@
use P6C::Parser;
use vars qw($IMCC $ASM $PARROT $PBC2C $HERE $CD $VERSION $PERL $slash $exe);
-use vars qw($PARROT_ROOT @temp_files $LIB $TEST_IMPORT);
-$VERSION = '0.0.8.1';
+use vars qw($PARROT_ROOT @temp_files $LIB $TEST_IMPORT $LIBPA);
+$VERSION = '0.0.8.2';
do 'perl6-config' or # read pconfig, which was generated by Makefile
die "'perl6-config' not found: $!";
@@ -36,6 +36,8 @@
$PARROT = "$PARROT_ROOT${slash}parrot$exe";
$CD = "cd $PARROT_ROOT; ";
$PBC2C = "$CD $PERL pbc2c.pl";
+$LIBPA = "$PARROT_ROOT${slash}" .$PConfig{blib_lib_libparrot_a};
+$LIBPA =~ s/\$\(A\)/$LIB/;
#
# imported meth's for Test::More
$TEST_IMPORT = 'skip is';
@@ -712,7 +714,7 @@
#
# in advance
#
- my $lib = !$OPT{shared} ? "libparrot$LIB" : '-L blib/lib -lparrot';
+ my $lib = !$OPT{shared} ? $LIBPA : '-L blib/lib -lparrot';
$cmd = "$CD $PConfig{link} $PConfig{linkflags} ".
"$PConfig{ld_out} $HERE/$filebase $HERE/$filebase$PConfig{'o'} ".
"$lib ".
@@ -721,7 +723,7 @@
if (system($cmd)) {
mydie($?,"Linking");
}
- $filebase = "./$filebase" if($filebase !~ m!/!); # XXX and unix
+ $filebase = ".$slash$filebase" if($filebase !~ m!/!);
verbose(1, "running $filebase @ARGV");
if (system("$filebase @ARGV") && !$OPT{'ignore-exitcode'}) {
mydie($?, $filebase);
