[BACK]Return to parif.c CVS log [TXT][DIR] Up to [local] / OpenXM_contrib2 / asir2000 / builtin

Annotation of OpenXM_contrib2/asir2000/builtin/parif.c, Revision 1.24

1.24    ! noro        1: /* $OpenXM: OpenXM_contrib2/asir2000/builtin/parif.c,v 1.23 2015/08/07 08:00:30 takayama Exp $ */
1.1       noro        2: #include "ca.h"
                      3: #include "parse.h"
1.19      noro        4: #include "ox.h"
1.1       noro        5:
1.19      noro        6: Q ox_pari_stream;
                      7: int ox_pari_stream_initialized = 0;
1.1       noro        8:
1.24    ! noro        9: typedef void (*mpfr_func)(NODE,Obj *);
        !            10:
        !            11: void Pmpfr_ai();
        !            12: void Pmpfr_eint(), Pmpfr_erf(),Pmpfr_li2();
        !            13: void Pmpfr_zeta();
        !            14: void Pmpfr_j0(), Pmpfr_j1();
        !            15: void Pmpfr_y0(), Pmpfr_y1();
        !            16: void Pmpfr_gamma(), Pmpfr_lngamma(), Pmpfr_digamma();
        !            17: void Pmpfr_floor(), Pmpfr_round(), Pmpfr_ceil();
        !            18:
        !            19: struct mpfr_tab_rec {
        !            20:   char *name;
        !            21:   mpfr_func func;
        !            22: } mpfr_tab[] = {
        !            23:        {"ai",Pmpfr_ai},
        !            24:        {"zeta",Pmpfr_zeta},
        !            25:        {"j0",Pmpfr_j0},
        !            26:        {"j1",Pmpfr_j1},
        !            27:        {"y0",Pmpfr_y0},
        !            28:        {"y1",Pmpfr_y1},
        !            29:        {"eint",Pmpfr_eint},
        !            30:        {"erf",Pmpfr_erf},
        !            31:        {"li2",Pmpfr_li2},
        !            32:        {"gamma",Pmpfr_gamma},
        !            33:        {"lngamma",Pmpfr_gamma},
        !            34:        {"digamma",Pmpfr_gamma},
        !            35:        {"floor",Pmpfr_floor},
        !            36:        {"ceil",Pmpfr_ceil},
        !            37:        {"round",Pmpfr_round},
        !            38: };
        !            39:
        !            40: mpfr_func mpfr_search(char *name)
        !            41: {
        !            42:   int i,n;
        !            43:
        !            44:   n = sizeof(mpfr_tab)/sizeof(struct mpfr_tab_rec);
        !            45:   for ( i = 0; i < n; i++ )
        !            46:     if ( !strcmp(name,mpfr_tab[i].name) )
        !            47:       return mpfr_tab[i].func;
        !            48:   return 0;
        !            49: }
        !            50:
1.19      noro       51: pointer evalparif(FUNC f,NODE arg)
1.1       noro       52: {
1.19      noro       53:   int ac,intarg,opt,prec;
                     54:   Q q,r,narg;
                     55:   NODE nd,oxarg;
                     56:   STRING name;
                     57:   USINT ui;
                     58:   Obj ret,dmy;
1.24    ! noro       59:   mpfr_func mpfr_function;
1.19      noro       60:
1.24    ! noro       61:   if ( mpfr_function = mpfr_search(f->name) ) {
        !            62:      (*mpfr_function)(arg,&ret);
        !            63:      return (pointer) ret;
1.20      takayama   64:   }
1.24    ! noro       65:
1.19      noro       66:   if ( !ox_pari_stream_initialized ) {
                     67:          MKSTR(name,"ox_pari");
                     68:          nd = mknode(2,NULL,name);
                     69:          Pox_launch(nd,&r);
                     70:          ox_pari_stream = r;
                     71:     ox_pari_stream_initialized = 1;
                     72:   }
1.1       noro       73:        switch ( f->type ) {
1.9       noro       74:                case 0: /* in/out : integer */
                     75:                        ac = argc(arg);
1.19      noro       76:                        if ( ac > 1 ) {
1.9       noro       77:                                fprintf(stderr,"argument mismatch in %s()\n",NAME(f));
                     78:                                error("");
1.10      noro       79:                                /* NOTREACHED */
                     80:                                return 0;
1.9       noro       81:                        }
1.19      noro       82:       intarg = ac == 0 ? 0 : QTOS((Q)ARG0(arg));
                     83:       MKUSINT(ui,intarg);
                     84:       oxarg = mknode(2,ox_pari_stream,ui);
                     85:       Pox_push_cmo(oxarg,&dmy);
                     86:       MKSTR(name,f->name);
                     87:       oxarg = mknode(3,ox_pari_stream,name,ONE);
                     88:       Pox_execute_function(oxarg,&dmy);
                     89:       oxarg = mknode(1,ox_pari_stream);
                     90:       Pox_pop_cmo(oxarg,&r);
                     91:       return r;
1.9       noro       92:
1.1       noro       93:                case 1:
                     94:                        ac = argc(arg);
                     95:                        if ( !ac || ( ac > 2 ) ) {
                     96:                                fprintf(stderr,"argument mismatch in %s()\n",NAME(f));
                     97:                                error("");
1.10      noro       98:                                /* NOTREACHED */
                     99:                                return 0;
1.1       noro      100:                        }
1.19      noro      101:       /* arg1 : prec */
                    102:       prec = ac == 1 ? 0 : QTOS((Q)ARG1(arg));
                    103:       MKUSINT(ui,prec);
                    104:       oxarg = mknode(2,ox_pari_stream,ui);
                    105:       Pox_push_cmo(oxarg,&dmy);
                    106:
                    107:       /* arg0 : arg */
                    108:       oxarg = mknode(2,ox_pari_stream,ARG0(arg));
                    109:       Pox_push_cmo(oxarg,&dmy);
                    110:
                    111:       MKSTR(name,f->name);
                    112:       STOQ(2,narg);
                    113:       oxarg = mknode(3,ox_pari_stream,name,narg);
                    114:       Pox_execute_function(oxarg,&dmy);
                    115:       oxarg = mknode(1,ox_pari_stream);
                    116:       Pox_pop_cmo(oxarg,&r);
                    117:       return r;
1.8       noro      118:
                    119:                case 2:
                    120:                        ac = argc(arg);
                    121:                        if ( !ac || ( ac > 2 ) ) {
                    122:                                fprintf(stderr,"argument mismatch in %s()\n",NAME(f));
                    123:                                error("");
1.10      noro      124:                                /* NOTREACHED */
                    125:                                return 0;
1.8       noro      126:                        }
                    127:                        if ( ac == 1 )
                    128:                                opt = 0;
                    129:                        else
                    130:                                opt = QTOS((Q)ARG1(arg));
                    131:                        return r;
                    132:
1.1       noro      133:                default:
                    134:                        error("evalparif : not implemented yet.");
1.10      noro      135:                        /* NOTREACHED */
                    136:                        return 0;
1.1       noro      137:        }
                    138: }
                    139:
                    140: struct pariftab {
                    141:        char *name;
1.19      noro      142:   int dmy;
1.1       noro      143:        int type;
                    144: };
                    145:
1.8       noro      146: /*
                    147:  * type = 1 => argc = 1, second arg = precision
                    148:  * type = 2 => argc = 1, second arg = optional (long int)
                    149:  *
                    150:  */
1.19      noro      151: /*
                    152: {"abs",0,1},
                    153: {"adj",0,1},
                    154: */
1.8       noro      155:
1.1       noro      156: struct pariftab pariftab[] = {
1.19      noro      157: {"arg",0,1},
                    158: {"bigomega",0,1},
                    159: {"binary",0,1},
                    160: {"ceil",0,1},
                    161: {"centerlift",0,1},
                    162: {"cf",0,1},
                    163: {"classno",0,1},
                    164: {"classno2",0,1},
                    165: {"conj",0,1},
                    166: {"content",0,1},
                    167: {"denom",0,1},
                    168: {"det",0,1},
                    169: {"det2",0,1},
                    170: {"dilog",0,1},
                    171: {"disc",0,1},
                    172: {"discf",0,1},
                    173: {"divisors",0,1},
                    174: {"eigen",0,1},
                    175: {"eintg1",0,1},
                    176: {"erfc",0,1},
                    177: {"eta",0,1},
                    178: {"floor",0,1},
                    179: {"frac",0,1},
                    180: {"galois",0,1},
                    181: {"galoisconj",0,1},
                    182: {"gamh",0,1},
                    183: {"gamma",0,1},
                    184: {"hclassno",0,1},
                    185: {"hermite",0,1},
                    186: {"hess",0,1},
                    187: {"imag",0,1},
                    188: {"image",0,1},
                    189: {"image2",0,1},
                    190: {"indexrank",0,1},
                    191: {"indsort",0,1},
                    192: {"initalg",0,1},
                    193: {"isfund",0,1},
                    194: {"ispsp",0,1},
                    195: {"isqrt",0,1},
                    196: {"issqfree",0,1},
                    197: {"issquare",0,1},
                    198: {"jacobi",0,1},
                    199: {"jell",0,1},
                    200: {"ker",0,1},
                    201: {"keri",0,1},
                    202: {"kerint",0,1},
                    203: {"kerintg1",0,1},
                    204: {"length",0,1},
                    205: {"lexsort",0,1},
                    206: {"lift",0,1},
                    207: {"lindep",0,1},
                    208: {"lll",0,1},
                    209: {"lllgen",0,1},
                    210: {"lllgram",0,1},
                    211: {"lllgramgen",0,1},
                    212: {"lllgramint",0,1},
                    213: {"lllgramkerim",0,1},
                    214: {"lllgramkerimgen",0,1},
                    215: {"lllint",0,1},
                    216: {"lllkerim",0,1},
                    217: {"lllkerimgen",0,1},
                    218: {"lngamma",0,1},
                    219: {"logagm",0,1},
                    220: {"mat",0,1},
                    221: {"matrixqz2",0,1},
                    222: {"matrixqz3",0,1},
                    223: {"matsize",0,1},
                    224: {"modreverse",0,1},
                    225: {"mu",0,1},
                    226: {"nextprime",0,1},
                    227: {"norm",0,1},
                    228: {"norml2",0,1},
                    229: {"numdiv",0,1},
                    230: {"numer",0,1},
                    231: {"omega",0,1},
                    232: {"order",0,1},
                    233: {"ordred",0,1},
                    234: {"phi",0,1},
                    235: {"pnqn",0,1},
                    236: {"polred",0,1},
                    237: {"polred2",0,1},
                    238: {"primroot",0,1},
                    239: {"psi",0,1},
                    240: {"quadgen",0,1},
                    241: {"quadpoly",0,1},
                    242: {"real",0,1},
                    243: {"recip",0,1},
                    244: {"redreal",0,1},
                    245: {"regula",0,1},
                    246: {"reorder",0,1},
                    247: {"reverse",0,1},
                    248: {"rhoreal",0,1},
                    249: {"roots",0,1},
                    250: {"round",0,1},
                    251: {"sigma",0,1},
                    252: {"signat",0,1},
                    253: {"simplify",0,1},
                    254: {"smalldiscf",0,1},
                    255: {"smallfact",0,1},
                    256: {"smallpolred",0,1},
                    257: {"smallpolred2",0,1},
                    258: {"smith",0,1},
                    259: {"smith2",0,1},
                    260: {"sort",0,1},
                    261: {"sqr",0,1},
                    262: {"sqred",0,1},
                    263: {"sqrt",0,1},
                    264: {"supplement",0,1},
                    265: {"trace",0,1},
                    266: {"trans",0,1},
                    267: {"trunc",0,1},
                    268: {"unit",0,1},
                    269: {"vec",0,1},
                    270: {"wf",0,1},
                    271: {"wf2",0,1},
                    272: {"zeta",0,1},
                    273: {"factor",0,1},
                    274:
                    275: {"allocatemem",0,0},
                    276:
                    277: {"isprime",0,2},
                    278: {"factorint",0,2},
1.1       noro      279: {0,0,0},
                    280: };
                    281:
                    282: void parif_init() {
                    283:        int i;
                    284:
                    285:        for ( i = 0, parif = 0; pariftab[i].name; i++ )
1.19      noro      286:                 appendparif(&parif,pariftab[i].name, 0,pariftab[i].type);
1.1       noro      287: }

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>