From: Alex Smith Date: Tue, 24 Jun 2008 18:28:11 +0000 (-0400) Subject: CREATEd expressions, finished but not documented and not very tested X-Git-Tag: 0.29~223 X-Git-Url: http://thyrsus.com/gitweb/?a=commitdiff_plain;h=a2be65d365fb927e1ed0a1f09e7e3246df8c136c;p=intercal.git CREATEd expressions, finished but not documented and not very tested --- diff --git a/src/abcess.h b/src/abcess.h index 638e4de..2d72cb1 100644 --- a/src/abcess.h +++ b/src/abcess.h @@ -214,7 +214,7 @@ extern ick_array* ick_tails; extern ick_bool* ick_tailforget; extern ick_array* ick_hybrids; extern ick_bool* ick_hyforget; -#if (MULTITHREAD != 0) +#if (MULTITHREAD != 0) || defined(ICK_EC) /*@null@*/ extern ick_overop* ick_oo_onespots; /*@null@*/ extern ick_overop* ick_oo_twospots; #endif diff --git a/src/dekludge.c b/src/dekludge.c index 92401d4..6f3a6c7 100644 --- a/src/dekludge.c +++ b/src/dekludge.c @@ -386,7 +386,8 @@ void nodefree(/*@keep@*/ /*@null@*/ node *np) { if(!np) return; /*@-mustfreeonly@*/ - if(np->opcode==SLAT) return; /* mustn't be freed yet */ + if(np->nextslat) return; /* don't free, has oo data */ + if(np==prevslat) return; /* likewise */ /*@=mustfreeonly@*/ /*@-keeptrans@*/ nodefree(np->lval); diff --git a/src/feh2.c b/src/feh2.c index a06d3e9..aca3ead 100644 --- a/src/feh2.c +++ b/src/feh2.c @@ -305,7 +305,9 @@ void typecast(node *np) else if (np->opcode == SELECT) np->width = np->rval->width; /* n-bit select has an n-bit result */ else if (np->opcode == UNKNOWNOP || np->opcode == INTERSECTION) /* AIS */ - np->width = (np->rval->width == 16 ? np->lval->width : 32); + np->width = (np->rval ? + np->lval ? np->rval->width == 16 ? np->lval->width : 32 : + np->rval->width : np->lval ? np->lval->width : 32); else if (np->opcode == BADCHAR) /* AIS */ np->width = 16; else if (np->opcode == SUB) @@ -1097,9 +1099,9 @@ static void revprexpr(node *np, FILE *fp, node *target) Technically speaking, np->rval could be casted to anything; but all implementations I've ever seen cast unique pointers to unique numbers, which is good enough for our purposes. */ - (void) fprintf(fp, ".get=ick_og%lx;\n ", (unsigned long)np); + (void) fprintf(fp, ".get=ick_og%lx;\n ", (unsigned long)np->rval); ooprvar(np->lval, fp, 0); - (void) fprintf(fp, ".set=ick_os%lx;\n", (unsigned long)np); + (void) fprintf(fp, ".set=ick_os%lx;\n", (unsigned long)np->rval); break; case AND: @@ -1257,10 +1259,23 @@ void prexpr(node *np, FILE *fp, int freenode) prunknownstr(np->lval, fp); if(freenode) free(np->lval); (void) fprintf(fp, "\", "); - prexpr(np->rval->lval, fp, freenode); + prexpr(np->rval->lval, fp, 0); (void) fprintf(fp, ", "); - prexpr(np->rval->rval, fp, freenode); - (void) fprintf(fp, ", lineno, \"%s\")", E000string); + prexpr(np->rval->rval, fp, 0); + (void) fprintf(fp, + ", ick_lineno, %luUL, %luUL, %luUL" + ", ick_og%lx, ick_og%lx, og2spot%lu" + ", ick_os%lx, ick_os%lx, os2spot%lu, \"%s\")", + intern(ick_TWOSPOT, 1601), + intern(ick_TWOSPOT, 1602), + intern(ick_TWOSPOT, 1603), + (unsigned long) np->rval->lval, + (unsigned long) np->rval->rval, + intern(ick_TWOSPOT, 1603), + (unsigned long) np->rval->lval, + (unsigned long) np->rval->rval, + intern(ick_TWOSPOT, 1603), + E000string); if(freenode) free(np->rval); break; @@ -1279,9 +1294,9 @@ void prexpr(node *np, FILE *fp, int freenode) Technically speaking, np->rval could be casted to anything; but all implementations I've ever seen cast unique pointers to unique numbers, which is good enough for our purposes. */ - (void) fprintf(fp, ".get=ick_og%lx),(", (unsigned long)np); + (void) fprintf(fp, ".get=ick_og%lx),(", (unsigned long)np->rval); ooprvar(np->lval, fp, 0); - (void) fprintf(fp, ".set=ick_os%lx),(", (unsigned long)np); + (void) fprintf(fp, ".set=ick_os%lx),(", (unsigned long)np->rval); prvar(np->lval, fp, freenode); /* np->rval will be freed later, when its expression is printed */ (void) fprintf(fp, "))"); @@ -1610,7 +1625,8 @@ static void prunknowncreatedata(node *np, FILE* fp) break; case US_ARRVAR: /* an array doesn't itself have a value */ ve=varextern(np->rval->constant,np->rval->opcode); - fprintf(fp,"\t\t{%d,1,%lu,{ick_ieg277,ick_ies277},0},\n",np->rval->width,ve); + fprintf(fp,"\t\t{%d,1,%lu,{ick_ieg277,ick_ies277},0},\n", + np->rval->width,ve); return; case US_ELEM: /* these two cases are actually treated the same way, */ case US_EXPR: /* because expressions can be assigned to */ @@ -1619,7 +1635,8 @@ static void prunknowncreatedata(node *np, FILE* fp) default: ick_lose(IE778, emitlineno, (char*) NULL); } if(createsused) - fprintf(fp,"{ick_og%lx,ick_os%lx},",(unsigned long)np,(unsigned long)np); + fprintf(fp,"{ick_og%lx,ick_os%lx},", + (unsigned long)np->rval,(unsigned long)np->rval); else fprintf(fp,"{0,0},"); prexpr(np->rval,fp,0); @@ -2397,7 +2414,7 @@ void emit(tuple *tn, FILE *fp) } fprintf(fp,"\t""if(ick_next) free(ick_next);\n"); if(useickec) - fprintf(fp,"\t""if(ick_next_jumpbufs) free(ick_next_jumpbufs);\n"); + fprintf(fp,"\t""if(ick_next_jmpbufs) free(ick_next_jmpbufs);\n"); } (void) fprintf(fp, "\t""exit(0);\n"); break; @@ -2774,12 +2791,12 @@ void emitslat(FILE* fp) " f(a,0);\n return;\n }\n l=1;\n", (unsigned long)np,t); temp=cons(C_A, 0, 0); - revprexpr(np->rval, fp, temp); /* revprexpr can't free */ + revprexpr(np, fp, temp); /* revprexpr can't free */ fprintf(fp," l=0;\n}\n"); fprintf(fp,"%s ick_og%lx(%s t)\n{\n %s a;\n static int l=0;\n" " if(l) return t;\n l=1;\n a=", t,(unsigned long)np,t,t); - prexpr(np->rval, fp, 0); + prexpr(np, fp, 0); fprintf(fp,";\n l=0;\n return a;\n}\n"); np=np->nextslat; } @@ -2799,8 +2816,7 @@ void emitslat(FILE* fp) while(np) { temp=np->nextslat; - nodefree(np->rval); - free(np); + nodefree(np); np=temp; } /* JH: clear firstslat */ diff --git a/src/ick_ec.c b/src/ick_ec.c index b0b0372..77839cc 100644 --- a/src/ick_ec.c +++ b/src/ick_ec.c @@ -50,13 +50,49 @@ static int ick_forgetamount = 0; unsigned long ick_global_goto; void* ick_global_createdata; +extern ick_overop* ick_oo_twospots; + /* Do a CREATEd operator check and call. */ /*@maynotreturn@*/ uint32_t ick_dounop(char* unopstr, uint32_t arg1, uint32_t arg2, int emitlineno, + unsigned long vi1, + unsigned long vi2, + unsigned long vi3, + ick_type32 (*og1)(ick_type32), + ick_type32 (*og2)(ick_type32), + ick_type32 (*og3)(ick_type32), + void (*os1)(ick_type32, void(*)()), + void (*os2)(ick_type32, void(*)()), + void (*os3)(ick_type32, void(*)()), /*@observer@*/ char* errstr) { + int st; + st = ick_jicmatch(unopstr); + if(st) + { + ick_createdata icd[3]={{16,0,1601,{og1,os1},arg1}, + {16,0,1602,{og2,os2},arg2}, + {16,0,1603,{og3,os3},0}}; + ick_stash(ick_TWOSPOT, vi1, ick_twospots+vi1, ick_oo_twospots); + ick_stash(ick_TWOSPOT, vi2, ick_twospots+vi2, ick_oo_twospots); + ick_stash(ick_TWOSPOT, vi3, ick_twospots+vi3, ick_oo_twospots); + ick_oo_twospots[vi1]=icd[0].accessors; + ick_oo_twospots[vi2]=icd[1].accessors; + ick_oo_twospots[vi3]=icd[2].accessors; + ick_global_createdata=icd; + ick_dogoto(st, emitlineno, 1); + ick_retrieve(ick_twospots+vi1, ick_TWOSPOT, vi1, + ick_twoforget[vi1], ick_oo_twospots); + ick_retrieve(ick_twospots+vi2, ick_TWOSPOT, vi2, + ick_twoforget[vi2], ick_oo_twospots); + ick_retrieve(ick_twospots+vi3, ick_TWOSPOT, vi3, + ick_twoforget[vi3], ick_oo_twospots); + } + else + ick_lose(IE000, emitlineno, errstr); + return og3(ick_twospots[vi3]); } /* Do a NEXT or goto. Gotos don't work with an empty NEXT stack, but that's diff --git a/src/ick_ec.h b/src/ick_ec.h index 78e16b7..0246090 100644 --- a/src/ick_ec.h +++ b/src/ick_ec.h @@ -240,7 +240,15 @@ void ick_scheduleforget(unsigned short); /*@noreturn@*/ void ick_doresume(unsigned short, int); /*@maynotreturn@*/ void ick_checksuckpoint(unsigned long); void ick_runstartups(void); -/*@maynotreturn@*/ uint32_t ick_dounop(char*, uint32_t, uint32_t, int, char*); +/*@maynotreturn@*/ uint32_t ick_dounop(char*, uint32_t, uint32_t, int, + unsigned long, unsigned long, unsigned long, + ick_type32(*)(ick_type32), + ick_type32(*)(ick_type32), + ick_type32(*)(ick_type32), + void(*)(ick_type32, void(*)()), + void(*)(ick_type32, void(*)()), + void(*)(ick_type32, void(*)()), + char*); void ick_allecfuncs(void); /* in generated program */ diff --git a/src/parser.y b/src/parser.y index 6e72bb4..c74c7bd 100644 --- a/src/parser.y +++ b/src/parser.y @@ -348,24 +348,24 @@ unknownsin : unknownaid {$$ = $1;} unknownatom : subscr {$$=cons(US_ELEM,0,$1); if(createsused){ opoverused=1; if(!firstslat) - firstslat=$$; else - prevslat->nextslat=$$; - prevslat=$$; - $$->nextslat=0;}} + firstslat=$1; else + prevslat->nextslat=$1; + prevslat=$1; + $1->nextslat=0;}} | scalar {$$=cons(US_SCALAR,0,$1); if(createsused){ opoverused=1; if(!firstslat) - firstslat=$$; else - prevslat->nextslat=$$; - prevslat=$$; - $$->nextslat=0;}} + firstslat=$1; else + prevslat->nextslat=$1; + prevslat=$1; + $1->nextslat=0;}} | notanlvalue {$$=cons(US_EXPR,0,$1); if(createsused){ opoverused=1; if(!firstslat) - firstslat=$$; else - prevslat->nextslat=$$; - prevslat=$$; - $$->nextslat=0;}} + firstslat=$1; else + prevslat->nextslat=$1; + prevslat=$1; + $1->nextslat=0;}} | ick_array {$$=cons(US_ARRVAR,0,$1);} ; @@ -519,13 +519,21 @@ expr : unambig {$$ = $1;} | unambig SELECT expr {$$ = cons(SELECT, $1, $3);} | unambig MINGLE expr {$$ = cons(MINGLE, $1, $3);} | unambig unop expr {$$ = cons(UNKNOWNOP, $2, - cons(INTERSECTION, $1, $3));} + cons(INTERSECTION, $1, $3)); + if(useickec && createsused) { + if(!firstslat) firstslat=$1; + else prevslat->nextslat=$1; + $1->nextslat=$3; prevslat=$3; + $3->nextslat=0; + intern(ick_TWOSPOT, 1601); + intern(ick_TWOSPOT, 1602); + intern(ick_TWOSPOT, 1603);}} /* AIS: Operand overloading */ | scalar SLAT expr {NEWFANGLED{$$ = cons(SLAT, $1, $3); opoverused=1; if(!firstslat) - firstslat=$$; else - prevslat->nextslat=$$; prevslat=$$; - $$->nextslat=0;}} + firstslat=$3; else + prevslat->nextslat=$3; prevslat=$3; + $3->nextslat=0;}} | subscr {$$ = $1;} | osubscr {$$ = $1;} ; @@ -536,12 +544,20 @@ notanlvalue:nlunambig {$$ = $1;} | unambig SELECT expr {$$ = cons(SELECT, $1, $3);} | unambig MINGLE expr {$$ = cons(MINGLE, $1, $3);} | unambig unop expr {$$ = cons(UNKNOWNOP, $2, - cons(INTERSECTION, $1, $3));} + cons(INTERSECTION, $1, $3)); + if(useickec && createsused) { + if(!firstslat) firstslat=$1; + else prevslat->nextslat=$1; + $1->nextslat=$3; prevslat=$3; + $3->nextslat=0; + intern(ick_TWOSPOT, 1601); + intern(ick_TWOSPOT, 1602); + intern(ick_TWOSPOT, 1603);}} | scalar SLAT expr {NEWFANGLED{$$ = cons(SLAT, $1, $3); opoverused=1; if(!firstslat) - firstslat=$$; else - prevslat->nextslat=$$; prevslat=$$; - $$->nextslat=0;}} + firstslat=$3; else + prevslat->nextslat=$3; prevslat=$3; + $3->nextslat=0;}} ; /* AIS: an expr that doesn't start with a unary operator */ @@ -549,12 +565,20 @@ limexpr : limunambig {$$ = $1;} | limunambig SELECT expr {$$ = cons(SELECT, $1, $3);} | limunambig MINGLE expr {$$ = cons(MINGLE, $1, $3);} | limunambig unop expr {$$ = cons(UNKNOWNOP, $2, - cons(INTERSECTION, $1, $3));} + cons(INTERSECTION, $1, $3)); + if(useickec && createsused) { + if(!firstslat) firstslat=$1; + else prevslat->nextslat=$1; + $1->nextslat=$3; prevslat=$3; + $3->nextslat=0; + intern(ick_TWOSPOT, 1601); + intern(ick_TWOSPOT, 1602); + intern(ick_TWOSPOT, 1603);}} | scalar SLAT expr {NEWFANGLED{$$ = cons(SLAT, $1, $3); opoverused=1; if(!firstslat) - firstslat=$$; else - prevslat->nextslat=$$; prevslat=$$; - $$->nextslat=0;}} + firstslat=$3; else + prevslat->nextslat=$3; prevslat=$3; + $3->nextslat=0;}} | subscr {$$ = $1;} | osubscr {$$ = $1;} ; diff --git a/src/perpet.c b/src/perpet.c index 9cd7696..f290bdb 100644 --- a/src/perpet.c +++ b/src/perpet.c @@ -1011,7 +1011,7 @@ int main(int argc, char *argv[]) "int onespotcount = %d;\n", nonespots); } - if(multithread || opoverused) /* AIS */ + if(multithread || opoverused || useickec) /* AIS */ { int temp=nonespots; (void) fprintf(ofp, @@ -1045,7 +1045,7 @@ int main(int argc, char *argv[]) "int twospotcount = %d;\n", ntwospots); } - if(multithread || opoverused) /* AIS */ + if(multithread || opoverused || useickec) /* AIS */ { int temp=ntwospots; (void) fprintf(ofp,