# New Ticket Created by  Leopold Toetsch 
# Please include the string:  [perl #17537]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=17537 >


Attached patch fixes all currently known problems WRT imcc/perl6.

imcc 0.0.9 is rather fresh, so there are problems coming from different 
platforms which I can't test, but I'm sure, we will solve these.


Short checklist for testing:

- be sure, Perl6Grammar is up to date
   (=> perl6 --force-grammar -vw some.p6 )

- check running through assembler/parrot:

$ perl6 --test

- check running through imcc

$ perl6 --test -r

- check running througc imcc/PBC/parrot

$ perl6 --test -r -Rc

The latter additionally needs: #17193 (packout.c patch)

in case of troubles: please add the -v (verbose switch, to see run 
commands, add -w (warnings, to see output from stderr), try individual 
files or tests

$ perl6 --test t/compiler/1.t -vwk
......

$ perl6 --help


Please apply,
thanks,
leo


-- attachment  1 ------------------------------------------------------
url: http://rt.perl.org/rt2/attach/38419/31225/58f98c/imcc-0_0_9_2.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    Mon Sep 23 21:20:18 2002
@@ -113,7 +113,9 @@
  */
 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');
+        r2->type &= ~VTKEY;
+        return MK_I("substr %s, %s, %s, 1", R4(r0, r1, r2, r3));
     }
     return MK_I("set %s, %s[%s]", R3(r0,r1,r2));
 }
@@ -124,7 +126,9 @@
 
 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');
+        r1->type &= ~VTKEY;
+        MK_I("substr %s, %s, 1, %s", R4(r0, r1,r3, r2));
     }
     else if (r0->set == 'P') {
        MK_I("set %s[%s], %s", R3(r0,r1,r2));
@@ -428,8 +432,8 @@
     ;
 
 emit:
-      EMIT   pasmcode                    { $$ = 0 }
-       EOM '\n'                                { emit_flush(); clear_tables();$$=0 }
+      EMIT   pasmcode                    { $$ = 0;}
+       EOM '\n'                                { emit_flush(); clear_tables();$$=0;}
     ;
 
 nls:
@@ -447,8 +451,8 @@
          emit_flush();
          clear_tables();
         }
-        | emit{ $$=0 }
-        | nls { $$=0 }
+        | emit{ $$=0; }
+        | nls { $$=0; }
     ;
 
 sub_start: SUB IDENTIFIER '\n'
@@ -586,26 +590,26 @@
     |  _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; }
     ;
 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 +660,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 +700,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 +853,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    Sat Sep 21 16:56:06 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            [-+]
@@ -158,7 +159,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     Mon Sep 23 21:25:32 2002
@@ -1,7 +1,7 @@
 #ifndef __IMC_H
 #define __IMC_H
 
-#define IMCC_VERSION "0.0.9.0"
+#define IMCC_VERSION "0.0.9.2"
 
 #include <stdio.h>
 #include <stdlib.h>
--- 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);

Reply via email to