Return to user.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Annotation of OpenXM_contrib2/asir2000/builtin/user.c, Revision 1.3

1.3     ! noro        1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/user.c,v 1.2 2004/09/29 08:50:23 noro Exp $ */
1.1       noro        2:
                      3: /* a sample file for adding builtin functions */
                      4:
                      5: #include "ca.h"
                      6: #include "parse.h"
                      7:
                      8: void Ppartial_derivative();
                      9: void partial_derivative(VL vl,P p,V v,P *r);
1.2       noro       10: void Pzadd(),Pzsub(),Pzmul();
1.1       noro       11:
                     12: struct ftab user_tab[] = {
                     13: /*
                     14:   {"partial_derivative",Ppartial_derivative,2},
                     15: */
1.2       noro       16:   {"zadd",Pzadd,2},
                     17:   {"zsub",Pzsub,2},
                     18:   {"zmul",Pzmul,2},
1.1       noro       19:   {0,0,0},
                     20: };
1.2       noro       21:
                     22: void Pzadd(NODE arg,Q *rp)
                     23: {
1.3     ! noro       24:        Z z0,z1,z2;
1.2       noro       25:
                     26:        z0 = qtoz((Q)ARG0(arg));
                     27:        z1 = qtoz((Q)ARG1(arg));
                     28:        z2 = addz(z0,z1);
                     29:        printz(z2); printf(" ");
                     30:        *rp = ztoq(z2);
                     31: }
                     32:
                     33: void Pzsub(NODE arg,Q *rp)
                     34: {
1.3     ! noro       35:        Z z0,z1,z2;
1.2       noro       36:
                     37:        z0 = qtoz((Q)ARG0(arg));
                     38:        z1 = qtoz((Q)ARG1(arg));
                     39:        z2 = subz(z0,z1);
                     40:        printz(z2); printf(" ");
                     41:        *rp = ztoq(z2);
                     42: }
                     43:
                     44: void Pzmul(NODE arg,Q *rp)
                     45: {
1.3     ! noro       46:        Z z0,z1,z2;
1.2       noro       47:
                     48:        z0 = qtoz((Q)ARG0(arg));
                     49:        z1 = qtoz((Q)ARG1(arg));
                     50:        z2 = mulz(z0,z1);
                     51:        printz(z2); printf(" ");
                     52:        *rp = ztoq(z2);
                     53: }
1.1       noro       54:
                     55: /*
                     56: void Ppartial_derivative(NODE arg,P *rp)
                     57: {
                     58:   asir_assert(ARG0(arg),O_P,"partial_derivative");
                     59:   asir_assert(ARG1(arg),O_P,"partial_derivative");
                     60:   partial_derivative(CO,(P)ARG0(arg),((P)ARG1(arg))->v,rp);
                     61: }
                     62:
                     63: void partial_derivative(VL vl,P p,V v,P *r)
                     64: {
                     65:   P t;
                     66:   DCP dc,dcr,dcr0;
                     67:
                     68:   if ( !p || NUM(p) ) *r = 0;
                     69:   else if ( v == p->v ) {
                     70:     for ( dc = p->dc, dcr0 = 0; dc && dc->d; dc = dc->next ) {
                     71:       mulp(vl,dc->c,(P)dc->d,&t);
                     72:       if ( t ) {
                     73:         NEXTDC(dcr0,dcr); subq(dc->d,ONE,&dcr->d); dcr->c = t;
                     74:       }
                     75:     }
                     76:     if ( !dcr0 ) *r = 0;
                     77:     else { dcr->next = 0; MKP(v,dcr0,*r); }
                     78:   } else {
                     79:     for ( dc = p->dc, dcr0 = 0; dc; dc = dc->next ) {
                     80:       partial_derivative(vl,dc->c,v,&t);
                     81:       if ( t ) { NEXTDC(dcr0,dcr); dcr->d = dc->d; dcr->c = t; }
                     82:     }
                     83:     if ( !dcr0 ) *r = 0;
                     84:     else { dcr->next = 0; MKP(p->v,dcr0,*r); }
                     85:   }
                     86: }
                     87: */