# New Ticket Created by Jürgen Bömmels # Please include the string: [perl #18747] # in the subject line of all future correspondence about this issue. # <URL: http://rt.perl.org/rt2/Ticket/Display.html?id=18747 >
Hi, I just hacked imcc to accept normal pasm files. About 85% of the test are still working, and its a major speed improvement. On my K6-350 I get the following timings: make test / new_assemble.pl real 4m16.003s user 3m19.490s sys 0m35.950s make test / assemble.pl real 18m57.069s user 17m41.600s sys 1m5.700s This is a speed improvement of about 350%. The remaining failing tests are mostly because of the use of macros. If this patch is acceptable I will try to get macros working in imcc. About the remainig failing test I'm not sure wether the test or imcc should be fixed. - Several tests use a form: set S0 "foobar" See the missing comma. Should this be accepted syntax or should the comma be mandatory - one or two tests use the form: set_i_ic I0, 42 Here's the patch (should I send patches to generated files also?) bye b. -- attachment 1 ------------------------------------------------------ url: http://rt.perl.org/rt2/attach/43194/34487/263395/imcc.diff -- attachment 2 ------------------------------------------------------ url: http://rt.perl.org/rt2/attach/43194/34488/23586c/new_assemble.pl
Index: languages/imcc/imcc.l =================================================================== RCS file: /cvs/public/parrot/languages/imcc/imcc.l,v retrieving revision 1.14 diff -u -b -r1.14 imcc.l --- languages/imcc/imcc.l 21 Oct 2002 08:50:36 -0000 1.14 +++ languages/imcc/imcc.l 29 Nov 2002 00:06:40 -0000 @@ -19,6 +19,7 @@ #define YY_NO_UNPUT extern long line; extern int expect_pasm; +extern int pasm_file; int state; int yyerror(char *); %} @@ -28,9 +29,11 @@ LETTER [a-zA-Z_] DIGIT [0-9] HEX 0x[0-9A-Fa-f]+ +BIN 0b[01]+ DOT [.] -LETTERDIGIT [a-zA-Z0-9_] SIGN [-+] +FLOATNUM {SIGN}?{DIGIT}+{DOT}{DIGIT}*([eE]{SIGN}?{DIGIT}+)? +LETTERDIGIT [a-zA-Z0-9_] STRINGCONSTANT \"(\\.|[^"\n]*)*["\n] CHARCONSTANT \'[^'\n]*\' RANKSPEC \[[,]*\] @@ -43,6 +46,10 @@ expect_pasm = 2; BEGIN(emit); } + if (pasm_file && YYSTATE != emit) { + BEGIN(emit); + return pasm_file == 1 ? EMIT : 0; + } <INITIAL,emit>{EOL} { if (expect_pasm == 2) @@ -152,7 +159,7 @@ return(is_op(yylval.s) ? PARROT_OP : IDENTIFIER); } -<emit,INITIAL>{SIGN}?{DIGIT}+"."{DIGIT}+ { +<emit,INITIAL>{FLOATNUM} { yylval.s = str_dup(yytext); return(FLOATC); } @@ -165,10 +172,18 @@ yylval.s = str_dup(yytext); return(INTC); } +<emit>{BIN} { + yylval.s = str_dup(yytext); + return(INTC); + } <emit,INITIAL>{STRINGCONSTANT} { yylval.s = str_dup(yytext); /* XXX delete quotes, -> emit, pbc */ return(STRINGC); } +<emit>{CHARCONSTANT} { + yylval.s = str_dup(yytext); + return(STRINGC); + } <emit,INITIAL>\$I[0-9]+ { yylval.s = str_dup(yytext); @@ -195,6 +210,16 @@ return yytext[0]; } +<emit><<EOF>> { + BEGIN (INITIAL); + if (pasm_file) { + pasm_file = 2; + return EOM; + } + return 0; + } + +<<EOF>> yyterminate(); %% #ifdef yywrap Index: languages/imcc/imcc.y =================================================================== RCS file: /cvs/public/parrot/languages/imcc/imcc.y,v retrieving revision 1.26 diff -u -b -r1.26 imcc.y --- languages/imcc/imcc.y 21 Oct 2002 08:50:36 -0000 1.26 +++ languages/imcc/imcc.y 29 Nov 2002 00:06:43 -0000 @@ -27,6 +27,7 @@ int yylex(); extern char yytext[]; int expect_pasm; +int pasm_file = 0; /* * Choosing instructions for Parrot is pretty easy since @@ -681,7 +682,7 @@ fgetc(stdin); break; case 'h': - usage(stdin); + usage(stdout); break; case 'V': version(); @@ -756,11 +757,17 @@ } else if (!strcmp(sourcefile, "-")) yyin = stdin; - else + else { + char *ext; if(!(yyin = fopen(sourcefile, "r"))) { fatal(EX_IOERR, "main", "Error reading source file %s.\n", sourcefile); } + ext = strrchr(sourcefile, '.'); + if (ext && strcmp (ext, ".pasm") == 0) { + pasm_file = 1; + } + } if (!output) output = str_dup(pbc ? "a.pbc" : "a.pasm"); @@ -797,8 +804,11 @@ if (!packed) fatal(1, "main", "Out of mem\n"); PackFile_pack(interpreter->code, packed); - if ((fp = fopen(output, "wb")) == 0) + if (strcmp (output, "-") == 0) + fp = stdout; + else if ((fp = fopen(output, "wb")) == 0) fatal(1, "main", "Couldn't open %s\n", output); + if ((1 != fwrite(packed, size, 1, fp)) ) fatal(1, "main", "Couldn't write %s\n", output); fclose(fp); Index: languages/imcc/pbc.c =================================================================== RCS file: /cvs/public/parrot/languages/imcc/pbc.c,v retrieving revision 1.3 diff -u -b -r1.3 pbc.c --- languages/imcc/pbc.c 13 Oct 2002 11:59:56 -0000 1.3 +++ languages/imcc/pbc.c 29 Nov 2002 00:06:45 -0000 @@ -293,6 +293,11 @@ l = unescape(buf); buf[--l] = '\0'; } + else if (*buf == '\'') { + buf++; + l = strlen(buf); + buf[--l] = '\0'; + } else { l = unescape(buf); } @@ -439,6 +444,8 @@ case 'I': if (r->name[0] == '0' && r->name[1] == 'x') r->color = strtoul(r->name+2, 0, 16); + else if (r->name[0] == '0' && r->name[1] == 'b') + r->color = strtoul(r->name+2, 0, 2); else r->color = atoi(r->name); break;
#!/usr/bin/perl -w use FindBin; use strict; my $files = []; my $args = {}; while (my $arg = shift @ARGV) { if($arg =~ /^-(c|-checksyntax)$/) { $args->{-c} = 1; } elsif($arg =~ /^-E$/) { $args->{-E} = 1; } elsif($arg =~ /^-(o|-output)$/) { $args->{-o} = shift @ARGV; } elsif($arg =~ /^-(h|-help)$/) { Usage(); exit 0; } elsif($arg =~ /^-./) { Fail("Invalid option '$arg'\n"); } else { push @$files,$arg; } } Fail("No files to process.\n") unless(@$files); Fail("File '$_' does not exist.\n") for grep { not (-e or /^-$/) } @$files; my $output = '-o -'; $output = "-o $args->{-o}" if exists $args->{-o}; exec "$FindBin::Bin/languages/imcc/imcc -c $output @$files";