develooper Front page | perl.perl6.internals | Postings from August 2002

imcc hack for perl6 regexes

From:
Sean O'Rourke
Date:
August 20, 2002 21:50
Subject:
imcc hack for perl6 regexes
Message ID:
Pine.GSO.4.32.0208202147260.12807-200000@gradlab.ucsd.edu
? languages/imcc/a.out
? languages/imcc/anyop.c
? languages/imcc/anyop.h
? languages/imcc/a.pasm
? languages/imcc/a.pbc
? languages/imcc/foo.imc
? languages/imcc/mine
? languages/imcc/imc.patch
? languages/imcc/imc-hack.tgz
Index: languages/imcc/Makefile
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/Makefile,v
retrieving revision 1.3
diff -p -u -w -r1.3 Makefile
--- languages/imcc/Makefile	5 Aug 2002 21:56:30 -0000	1.3
+++ languages/imcc/Makefile	20 Aug 2002 07:34:58 -0000
@@ -5,17 +5,20 @@
 DEBUG = -g
 # GCC
 #CC = gcc -efence -Wall -pedantic
-CC = gcc -Wall -pedantic
+CC = gcc -Wall -pedantic -I../../include
 YACC = bison -v -y
 LEX = flex
-LIBS =
+LIBS = -lm -ldl
 #LIBS = -lefence
 #LIBS = -ll -ly
 
-HEADERS = imc.h imcparser.h stacks.h cfg.h instructions.h cfg.h debug.h sets.h
+HEADERS = imc.h imcparser.h stacks.h cfg.h instructions.h cfg.h debug.h \
+	sets.h anyop.h
 
 default :
 	$(MAKE) imcc
+	cd ../..; $(MAKE) shared
+	cd ../..; $(MAKE) rx_ops.c
 
 clean :
 	rm -f core
@@ -70,6 +73,11 @@ sets.o: sets.c $(HEADERS)
 debug.o: debug.c $(HEADERS)
 	$(CC) $(DEBUG) -c debug.c
 
-imcc : imcparser.o imclexer.o imc.o stacks.o symreg.o instructions.o cfg.o sets.o debug.o
-	$(CC) $(DEBUG) -o imcc imc.o imcparser.o imclexer.o stacks.o symreg.o instructions.o cfg.o sets.o debug.o $(LIBS)
+anyop.o: anyop.c $(HEADERS)
+	$(CC) $(DEBUG) -c anyop.c
+
+imcc : imcparser.o imclexer.o imc.o stacks.o symreg.o instructions.o cfg.o \
+	sets.o debug.o anyop.o
+	$(CC) $(DEBUG) -o imcc imc.o imcparser.o imclexer.o stacks.o symreg.o \
+		instructions.o cfg.o sets.o debug.o anyop.o $(LIBS)
 
Index: languages/imcc/imc.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imc.c,v
retrieving revision 1.17
diff -p -u -w -r1.17 imc.c
--- languages/imcc/imc.c	7 Aug 2002 03:23:42 -0000	1.17
+++ languages/imcc/imc.c	20 Aug 2002 07:34:58 -0000
@@ -18,7 +18,7 @@
 
 /* Globals: */
 
-IntStack nodeStack;
+IMCStack nodeStack;
 int n_spilled;
 int lastbranch;
 
@@ -30,7 +30,7 @@ int lastbranch;
 void allocate() {
     int to_spill;
     
-    nodeStack = intstack_new(); 
+    nodeStack = imcstack_new(); 
     n_spilled = 0;
 
     while (1) {
@@ -238,7 +238,7 @@ int simplify (){
             if (IMCC_DEBUG) 
 	        fprintf(stderr, "#simplifying [%s]\n", g[x]->name);
 	    
-	    intstack_push(nodeStack, x);
+	    imcstack_push(nodeStack, x);
 	    
 	    g[x]->simplified = 1;
 	    changes = 1;
@@ -292,7 +292,7 @@ void order_spilling () {
 
 	if (min_node == -1) return; /* We are finished */
 		
-	intstack_push(nodeStack, min_node);
+	imcstack_push(nodeStack, min_node);
 	interference_graph[min_node]->simplified = 1;
     }
 }
@@ -326,8 +326,8 @@ int try_allocate() {
     char buf[256];
     SymReg ** graph = interference_graph;
 
-    while ((intstack_depth(nodeStack) > 0) ) {
-	x=intstack_pop(nodeStack);
+    while ((imcstack_depth(nodeStack) > 0) ) {
+	x=imcstack_pop(nodeStack);
 
         memset(colors, 0, sizeof(colors));
         free_colors = map_colors(x, graph, colors);
Index: languages/imcc/imcc.l
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.l,v
retrieving revision 1.6
diff -p -u -w -r1.6 imcc.l
--- languages/imcc/imcc.l	9 Aug 2002 20:11:18 -0000	1.6
+++ languages/imcc/imcc.l	20 Aug 2002 07:34:58 -0000
@@ -80,7 +80,7 @@ RANKSPEC        \[[,]*\]
 "addr"          return(ADDR);
 "global"        return(GLOBAL);
 "clone"         return(CLONE);
-"string"        return(STRING);
+"string"        return(STRINGV);
 "call"          return(CALL);
 "print"         return(PRINT);
 "push"          return(PUSH);
@@ -98,6 +98,7 @@ RANKSPEC        \[[,]*\]
 "=="            return(RELOP_EQ);
 "!="            return(RELOP_NE);
 "**"            return(POW);
+","             return(COMMA);
 
 {LETTER}{LETTERDIGIT}*":" {
 	yytext[yyleng-1] = 0;  /* trim last ':' */
Index: languages/imcc/imcc.y
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/imcc.y,v
retrieving revision 1.13
diff -p -u -w -r1.13 imcc.y
--- languages/imcc/imcc.y	9 Aug 2002 20:11:18 -0000	1.13
+++ languages/imcc/imcc.y	20 Aug 2002 07:34:58 -0000
@@ -13,11 +13,12 @@
 #include <stdio.h>
 #include <stdlib.h> 
 #include <sysexits.h>
+#include <assert.h>
 #include "imc.h"
+#include "anyop.h"
 
 #define YYDEBUG 1
 
-
 int         yyerror(char *);
 int         yylex();
 extern char yytext[];
@@ -348,6 +349,75 @@ SymReg * iEND() {
     return 0;
 }
 
+int nargs = 0;
+SymReg * args[16] = { NULL };
+
+SymReg * iANY(char * name) {
+    char type[16];
+    short dir[16];
+    int i;
+    int dirs = 0;
+    op_t op;
+    memset(dir, 0, sizeof(dir)); /* don't know argdirs */
+    for (i = 0; i < nargs; i++) {
+	type[i] = args[i]->set;
+    }
+    for ( ; i < 4; i++) {
+	args[i] = NULL;
+    }
+    op = op_findv(name, nargs, type, dir);
+    if (!same_op(op, NULLOP)) {
+	op_info_t * info = op_info(op);
+	char format[128];
+	int len;
+	if (IMCC_DEBUG) {
+	    fprintf(stderr, "Op %s (%d, %d)\n", name, op.lib, op.op);
+	    print_op_info(stderr, info);
+	}
+
+	sprintf(format, "%s  ", name);
+	for (i = 1; i < info->arg_count; i++) {
+	    switch (info->dirs[i]) {
+	    case PARROT_ARGDIR_IN:
+		dirs |= 1 << (i - 1);
+		break;
+
+	    case PARROT_ARGDIR_OUT:
+		dirs |= 1 << (4 + i - 1);
+		break;
+
+	    case PARROT_ARGDIR_INOUT:
+		dirs |= 1 << (i - 1) | 1 << (4 + i - 1);
+		break;
+
+	    default:
+		assert(0);
+	    };
+	    strcat(format, "%s, ");
+	}
+	if (info->jump) {
+	    /* XXX: assume the jump is relative to the last arg.
+	     * usually true. */
+	    dirs |= 1 << (8 + nargs - 2);
+	}
+	len = strlen(format);
+	len -= 2;
+	format[len] = '\0';
+	emitb(mk_instruction(format, args[0], args[1], args[2], args[3],
+			     dirs));
+    } else {
+	char c = '(';
+	fprintf(stderr, "NO Op %s<%d>", name, nargs);
+	for (i = 0; i < nargs; i++) {
+	    fprintf(stderr, "%c%c", c, args[i]->set);
+	    c = ',';
+	}
+	fputs(")\n", stderr);
+	exit(EX_SOFTWARE);
+    }
+    return NULL;
+}
+
 void relop_to_op(int relop, char * op) {
     switch(relop) {
         case RELOP_EQ:    strcpy(op, "eq"); return;
@@ -372,16 +442,18 @@ void relop_to_op(int relop, char * op) {
 
 %token <i> CALL GOTO BRANCH ARG RET PRINT IF UNLESS NEW END SAVEALL RESTOREALL
 %token <i> SUB NAMESPACE CLASS ENDCLASS SYM LOCAL PARAM PUSH POP INC DEC
-%token <i> SHIFT_LEFT SHIFT_RIGHT INT FLOAT STRING DEFINED LOG_XOR
+%token <i> SHIFT_LEFT SHIFT_RIGHT INT FLOAT STRINGV DEFINED LOG_XOR
 %token <i> RELOP_EQ RELOP_NE RELOP_GT RELOP_GTE RELOP_LT RELOP_LTE
 %token <i> GLOBAL ADDR CLONE RESULT RETURN POW
+%token <i> COMMA
 %token <s> EMIT LABEL
 %token <s> IREG NREG SREG PREG IDENTIFIER STRINGC INTC FLOATC
 %type <i> type program subs sub sub_start relop
-%type <s> classname
+%type <s> classname opname
 %type <sr> labels label statements statement
 %type <sr> instruction assignment if_statement
 %type <sr> target reg const var rc string
+%type <sr> vars _vars var_or_i
 
 %start program 
 
@@ -463,7 +535,7 @@ instruction:
 type:
         INT { $$ = 'I'; }
     |   FLOAT { $$ = 'N'; }
-    |   STRING { $$ = 'S'; }
+    |   STRINGV { $$ = 'S'; }
     |   classname { $$ = 'P'; }
     ;
 
@@ -496,6 +568,8 @@ assignment:
     |  labels target '=' ADDR IDENTIFIER        { $$ = iSET_ADDR($2, mk_address($5)); }
     |  labels target '=' GLOBAL string          { $$ = iGET_GLOBAL($2, $5); }
     |  labels GLOBAL string '=' var             { $$ = iSET_GLOBAL($3, $5); }
+    |  labels opname { nargs = 0; memset(args, 0, sizeof(args)); }
+                                    vars        { $$ = iANY($2); }
     ;
 
 if_statement:
@@ -516,12 +590,28 @@ relop:
     |  RELOP_LTE { $$ = RELOP_LTE; }
     ;
 
+opname:
+    IDENTIFIER { $$ = $1; }
+
 target:
        IDENTIFIER
        { $$ = get_sym($1); }
     |  reg 
     ;
 
+vars:  { $$ = NULL; }
+    |  _vars { $$ = $1; }
+    ;
+
+_vars: _vars COMMA var_or_i { args[nargs++] = $3; $$ = args[0]; }
+    |  var_or_i { args[nargs++] = $1; $$ = $1; }
+    ;
+
+var_or_i:
+       IDENTIFIER { $$ = mk_address($1); }
+    |  rc
+    ;
+
 var:
        IDENTIFIER
        { $$ = get_sym($1); }
@@ -584,6 +674,13 @@ int main(int argc, char * argv[])
         exit(EX_IOERR);
     }
    
+    if (IMCC_DEBUG)
+	fprintf(stderr, "loading libs...");
+    op_load_file("../../blib/lib/libparrot.so");
+    op_load_lib("core", 0, 0, 7);
+    if (IMCC_DEBUG)
+	fprintf(stderr, "done\n");
+   
     line = 1;
 
     if (IMCC_DEBUG)
@@ -619,6 +716,3 @@ int yyerror(char * s)
     fprintf(stderr, "Didn't create output asm.\n" );
     exit(EX_UNAVAILABLE);
 }
-
-
-
Index: languages/imcc/stacks.c
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/stacks.c,v
retrieving revision 1.1
diff -p -u -w -r1.1 stacks.c
--- languages/imcc/stacks.c	4 Jul 2002 02:58:30 -0000	1.1
+++ languages/imcc/stacks.c	20 Aug 2002 07:34:58 -0000
@@ -4,10 +4,10 @@
 
 /* Stack functions. Stolen from rxstacks.c */
 
-IntStack
-intstack_new()
+IMCStack
+imcstack_new()
 {
-    IntStack stack = malloc(sizeof(struct IntStack_chunk_t));
+    IMCStack stack = malloc(sizeof(struct IMCStack_chunk_t));
     stack->used = 0;
     stack->next = stack;
     stack->prev = stack;
@@ -15,9 +15,9 @@ intstack_new()
 }
 
 int
-intstack_depth(IntStack stack)
+imcstack_depth(IMCStack stack)
 {
-    IntStack_Chunk chunk;
+    IMCStack_Chunk chunk;
     int depth = stack->used;
 
     for (chunk = stack->next; chunk != stack; chunk = chunk->next)
@@ -27,17 +27,17 @@ intstack_depth(IntStack stack)
 }
 
 void
-intstack_push(IntStack stack, int data)
+imcstack_push(IMCStack stack, int data)
 {
-    IntStack_Chunk chunk = stack->prev;
-    IntStack_Entry entry = &chunk->entry[chunk->used];
+    IMCStack_Chunk chunk = stack->prev;
+    IMCStack_Entry entry = &chunk->entry[chunk->used];
 
     entry->value = data;
 
     /* Register the new entry */
     if (++chunk->used == STACK_CHUNK_DEPTH) {
         /* Need to add a new chunk */
-        IntStack_Chunk new_chunk = malloc(sizeof(*new_chunk));
+        IMCStack_Chunk new_chunk = malloc(sizeof(*new_chunk));
         new_chunk->used = 0;
         new_chunk->next = stack;
         new_chunk->prev = chunk;
@@ -48,10 +48,10 @@ intstack_push(IntStack stack, int data)
 }
 
 int
-intstack_pop(IntStack stack)
+imcstack_pop(IMCStack stack)
 {
-    IntStack_Chunk chunk = stack->prev;
-    IntStack_Entry entry;
+    IMCStack_Chunk chunk = stack->prev;
+    IMCStack_Entry entry;
 
     /* We may have an empty chunk at the end of the list */
     if (chunk->used == 0 && chunk != stack) {
Index: languages/imcc/stacks.h
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/stacks.h,v
retrieving revision 1.1
diff -p -u -w -r1.1 stacks.h
--- languages/imcc/stacks.h	4 Jul 2002 02:58:30 -0000	1.1
+++ languages/imcc/stacks.h	20 Aug 2002 07:34:58 -0000
@@ -3,20 +3,20 @@
 
 #define STACK_CHUNK_DEPTH 256
 
-typedef struct IntStack_entry_t {
+typedef struct IMCStack_entry_t {
    int value;
-} *IntStack_Entry;
+} *IMCStack_Entry;
 
-typedef struct IntStack_chunk_t {
+typedef struct IMCStack_chunk_t {
     int used;
-    struct IntStack_chunk_t *next;
-    struct IntStack_chunk_t *prev;
-    struct IntStack_entry_t entry[STACK_CHUNK_DEPTH];
-} *IntStack_Chunk;
+    struct IMCStack_chunk_t *next;
+    struct IMCStack_chunk_t *prev;
+    struct IMCStack_entry_t entry[STACK_CHUNK_DEPTH];
+} *IMCStack_Chunk;
 
-typedef IntStack_Chunk IntStack;
-IntStack intstack_new();
-int intstack_depth(IntStack);
-void intstack_push(IntStack, int);
-int intstack_pop(IntStack);
+typedef IMCStack_Chunk IMCStack;
+IMCStack imcstack_new();
+int imcstack_depth(IMCStack);
+void imcstack_push(IMCStack, int);
+int imcstack_pop(IMCStack);
 
Index: languages/imcc/examples/test_spilling.imc
===================================================================
RCS file: /cvs/public/parrot/languages/imcc/examples/test_spilling.imc,v
retrieving revision 1.2
diff -p -u -w -r1.2 test_spilling.imc
--- languages/imcc/examples/test_spilling.imc	4 Jul 2002 03:04:40 -0000	1.2
+++ languages/imcc/examples/test_spilling.imc	20 Aug 2002 07:34:58 -0000
@@ -47,45 +47,45 @@
 	.local int al
 	.local int am
 
-        a = 1
-	b = 2
-	c = 3
-	d = 4
-	e = 5
-	f = 6
-	g = 7
-	h = 8
-	i = 9
-	j = 10
-	k = 11
-	l = 12
-	m = 13
-	n = 14
-	o = 15
-	p = 16
-	q = 17
-	r = 18
-	s = 19
-	t = 20
-	u = 21
-	v = 22
-	w = 23
-	x = 24
-	y = 25
-	z = 26
-	aa = 27
-	ab = 28
-	ac = 29
-	ad = 30
-	ae = 31
-	af = 32
-	ag = 33 
-	ah = 34
-	ai = 35
-	aj = 36
-	ak = 37
-	al = 38
-	am = 39
+        set a,  1
+	set b,  2
+	set c,  3
+	set d,  4
+	set e,  5
+	set f,  6
+	set g,  7
+	set h,  8
+	set i,  9
+	set j,  10
+	set k,  11
+	set l,  12
+	set m,  13
+	set n,  14
+	set o,  15
+	set p,  16
+	set q,  17
+	set r,  18
+	set s,  19
+	set t,  20
+	set u,  21
+	set v,  22
+	set w,  23
+	set x,  24
+	set y,  25
+	set z,  26
+	set aa,  27
+	set ab,  28
+	set ac,  29
+	set ad,  30
+	set ae,  31
+	set af,  32
+	set ag,  33 
+	set ah,  34
+	set ai,  35
+	set aj,  36
+	set ak,  37
+	set al,  38
+	set am,  39
 	
 	print a
 	print "\n"



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About