# 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";
