Primitive operations - kevinlawler/kona GitHub Wiki

//Older version with modulo, GCC vectors, no macro expansion, for reference
//Modulo is very slow but easily handles differing sizes in {atom, vector} X {atom, vector}, conformable lists
//GCC vectors/SSE/SIMD won't make much difference on plus (von Neumann bottleneck) but may on slower operations
//Note z could be initialized as a or b instead of a new vector under certain conditions

typedef I veci __attribute__ ((vector_size (16)));

K plus(K a, K b) //compare plus() to times() or minus()
{
  I at=a->t, an=a->n, bt=b->t, bn=b->n;
  I type = MAX(ABS(at),ABS(bt));

  P(at <= 0 && bt <= 0 && an != bn,LE)
  P(type > 2,TE)

  //Determine our return values type
  I zt=type;                    //Starting point, worst known type
  if(MIN(at,bt) < 1) zt=-zt;    //Plural?
  if(!at || !bt) zt=0;          //Generic list trumps
  I zn=at>0?bn:an;              //Have to be careful if one is atom and one is [empty?] list
  K z=newK(zt,zn);U(z)          //Finally, we know what we're going to make

  if     (2==ABS(at) && 2==ABS(bt)) DO(zn,kF(z)[i]=kF(a)[i%an]+kF(b)[i%bn])
  else if(2==ABS(at) && 1==ABS(bt)) DO(zn,kF(z)[i]=kF(a)[i%an]+kI(b)[i%bn])
  else if(1==ABS(at) && 2==ABS(bt)) DO(zn,kF(z)[i]=kI(a)[i%an]+kF(b)[i%bn])
  else if(-1==    at  && -1==    bt ) { veci *c=(veci*)a,*d=(veci*)b,*e=(veci*)z; DO(((((zn+3)+1)&~1))/2, e[i]=c[i]+d[i] ) if(z!=b)z->c=1; z->t=zt; z->n=zn; } //demonstration purposes
  else if(1==ABS(at) && 1==ABS(bt)) DO(zn,kI(z)[i]=kI(a)[i%an]+kI(b)[i%bn])
  else if(0==at || 0==bt) dp(&z,plus,a,b);

  R z;
}

//Newer version without modulo, without GCC vectors. Macros are used to simplify replacing modulo.
//Macro expanded: gcc -x c -E - < va.c
K plus(K a, K b)
{
  I at=a->t, an=a->n, bt=b->t, bn=b->n;
  
  I type = (((((at) < 0 ? -(at) : (at))) > (((bt) < 0 ? -(bt) : (bt)))) ? (((at) < 0 ? -(at) : (at))) : (((bt) < 0 ? -(bt) : (bt)))); 
  
  {if(at <= 0 && bt <= 0 && an != bn)return(kerr("length"));}
  {if(type > 2)return(kerr("type"));}
  
  I zt=type; if((((at) < (bt)) ? (at) : (bt)) < 1) zt=-zt; if(!at || !bt) zt=0; I zn=at>0?bn:an;
  K z=newK(zt,zn);{if(!(z))return(0);}

  if (2==((at) < 0 ? -(at) : (at)) && 2==((bt) < 0 ? -(bt) : (bt))) { if (an==bn) { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((F*)(((K)a)->k)) [i]) + (((F*)(((K)b)->k)) [i]));}} } 
  
  else if (an==1) { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((F*)(((K)a)->k)) [0]) + (((F*)(((K)b)->k)) [i]));}} } else { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((F*)(((K)a)->k)) [i]) + (((F*)(((K)b)->k)) [0]));}} } }
  
  else if (2==((at) < 0 ? -(at) : (at)) && 1==((bt) < 0 ? -(bt) : (bt))) { if (an==bn) { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((F*)(((K)a)->k)) [i]) + (((I*)(((K)b)->k)) [i]));}} }
  
  else if (an==1) { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((F*)(((K)a)->k)) [0]) + (((I*)(((K)b)->k)) [i]));}} } else { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((F*)(((K)a)->k)) [i]) + (((I*)(((K)b)->k)) [0]));}} } } 
  
  else if (1==((at) < 0 ? -(at) : (at)) && 2==((bt) < 0 ? -(bt) : (bt))) { if (an==bn) { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((I*)(((K)a)->k)) [i]) + (((F*)(((K)b)->k)) [i]));}} } else if (an==1) { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((I*)(((K)a)->k)) [0]) + (((F*)(((K)b)->k)) [i]));}} } else { {I i=0,_i=(zn);for(;i<_i;++i){((F*)(((K)z)->k)) [i]= ((((I*)(((K)a)->k)) [i]) + (((F*)(((K)b)->k)) [0]));}} } } 
  
  else if (1==((at) < 0 ? -(at) : (at)) && 1==((bt) < 0 ? -(bt) : (bt))) { if (an==bn) { {I i=0,_i=(zn);for(;i<_i;++i){((I*)(((K)z)->k)) [i]= ((((I*)(((K)a)->k)) [i]) + (((I*)(((K)b)->k)) [i]));}} } else if (an==1) { {I i=0,_i=(zn);for(;i<_i;++i){((I*)(((K)z)->k)) [i]= ((((I*)(((K)a)->k)) [0]) + (((I*)(((K)b)->k)) [i]));}} } else { {I i=0,_i=(zn);for(;i<_i;++i){((I*)(((K)z)->k)) [i]= ((((I*)(((K)a)->k)) [i]) + (((I*)(((K)b)->k)) [0]));}} } } 
  
  else if (0==at || 0==bt) { dp(&z,plus,a,b); }


  return z;
}