Return to user.c CVS log

Up to [local] / OpenXM_contrib2 / asir2000 / builtin

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

1.2     ! noro        1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/user.c,v 1.1 2002/08/14 03:51:38 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: pointer qtoz(Q);
        !            23: Q ztoq(pointer);
        !            24: pointer addz(pointer,pointer), subz(pointer,pointer), mulz(pointer,pointer);
        !            25: void Pzadd(NODE arg,Q *rp)
        !            26: {
        !            27:        pointer z0,z1,z2;
        !            28:
        !            29:        z0 = qtoz((Q)ARG0(arg));
        !            30:        z1 = qtoz((Q)ARG1(arg));
        !            31:        z2 = addz(z0,z1);
        !            32:        printz(z2); printf(" ");
        !            33:        *rp = ztoq(z2);
        !            34: }
        !            35:
        !            36: void Pzsub(NODE arg,Q *rp)
        !            37: {
        !            38:        pointer z0,z1,z2;
        !            39:
        !            40:        z0 = qtoz((Q)ARG0(arg));
        !            41:        z1 = qtoz((Q)ARG1(arg));
        !            42:        z2 = subz(z0,z1);
        !            43:        printz(z2); printf(" ");
        !            44:        *rp = ztoq(z2);
        !            45: }
        !            46:
        !            47: void Pzmul(NODE arg,Q *rp)
        !            48: {
        !            49:        pointer z0,z1,z2;
        !            50:
        !            51:        z0 = qtoz((Q)ARG0(arg));
        !            52:        z1 = qtoz((Q)ARG1(arg));
        !            53:        z2 = mulz(z0,z1);
        !            54:        printz(z2); printf(" ");
        !            55:        *rp = ztoq(z2);
        !            56: }
1.1       noro       57:
                     58: /*
                     59: void Ppartial_derivative(NODE arg,P *rp)
                     60: {
                     61:   asir_assert(ARG0(arg),O_P,"partial_derivative");
                     62:   asir_assert(ARG1(arg),O_P,"partial_derivative");
                     63:   partial_derivative(CO,(P)ARG0(arg),((P)ARG1(arg))->v,rp);
                     64: }
                     65:
                     66: void partial_derivative(VL vl,P p,V v,P *r)
                     67: {
                     68:   P t;
                     69:   DCP dc,dcr,dcr0;
                     70:
                     71:   if ( !p || NUM(p) ) *r = 0;
                     72:   else if ( v == p->v ) {
                     73:     for ( dc = p->dc, dcr0 = 0; dc && dc->d; dc = dc->next ) {
                     74:       mulp(vl,dc->c,(P)dc->d,&t);
                     75:       if ( t ) {
                     76:         NEXTDC(dcr0,dcr); subq(dc->d,ONE,&dcr->d); dcr->c = t;
                     77:       }
                     78:     }
                     79:     if ( !dcr0 ) *r = 0;
                     80:     else { dcr->next = 0; MKP(v,dcr0,*r); }
                     81:   } else {
                     82:     for ( dc = p->dc, dcr0 = 0; dc; dc = dc->next ) {
                     83:       partial_derivative(vl,dc->c,v,&t);
                     84:       if ( t ) { NEXTDC(dcr0,dcr); dcr->d = dc->d; dcr->c = t; }
                     85:     }
                     86:     if ( !dcr0 ) *r = 0;
                     87:     else { dcr->next = 0; MKP(p->v,dcr0,*r); }
                     88:   }
                     89: }
                     90: */