]> thyrsus.com Git - intercal.git/commitdiff
CREATEd expressions, finished but not documented and not very tested
authorAlex Smith <ais523@bham.ac.uk>
Tue, 24 Jun 2008 18:28:11 +0000 (14:28 -0400)
committerEric S. Raymond <esr@thyrsus.com>
Thu, 26 Aug 2010 00:34:59 +0000 (20:34 -0400)
src/abcess.h
src/dekludge.c
src/feh2.c
src/ick_ec.c
src/ick_ec.h
src/parser.y
src/perpet.c

index 638e4de329098abbbada829f08e5c3a955bf5e27..2d72cb164a0f22b9415db27f338ad2b3944d6095 100644 (file)
@@ -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
index 92401d492a0f8c82e7084ea25091d37f2ab8c951..6f3a6c7a925cc9bf95ef618de0063e096778cb2a 100644 (file)
@@ -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);
index a06d3e90caa8b0353d050b74d9f52b95d498690c..aca3eadf3aaa72d2c83f89ae616298d67e8da2d7 100644 (file)
@@ -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 */
index b0b03721903a85353037fa60080ed93d3d08f72f..77839cc2d580868281da64a9faee001a8c4acb78 100644 (file)
@@ -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
index 78e16b76d8cef4b2b0b338b53226af0612222756..0246090c117738756023333ca225264b2940cab2 100644 (file)
@@ -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 */
 
index 6e72bb436c7fd36e77478148970d6244b8afbc55..c74c7bd12bec0444e58c87eed85e801b6541f434 100644 (file)
@@ -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;}
        ;
index 9cd769616f884bbc6e1aec8180600b1220264f9c..f290bdb1cf4a02490240265b08d9543d97f46cae 100644 (file)
@@ -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,