Annotation of capa/capa51/pProj/capaFunction.c, revision 1.15

1.7       albertel    1: /* definition of all capa functions
                      2:    Copyright (C) 1992-2000 Michigan State University
                      3: 
                      4:    The CAPA system is free software; you can redistribute it and/or
1.9       albertel    5:    modify it under the terms of the GNU General Public License as
1.7       albertel    6:    published by the Free Software Foundation; either version 2 of the
                      7:    License, or (at your option) any later version.
                      8: 
                      9:    The CAPA system is distributed in the hope that it will be useful,
                     10:    but WITHOUT ANY WARRANTY; without even the implied warranty of
                     11:    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
1.9       albertel   12:    General Public License for more details.
1.7       albertel   13: 
1.9       albertel   14:    You should have received a copy of the GNU General Public
1.7       albertel   15:    License along with the CAPA system; see the file COPYING.  If not,
                     16:    write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
1.8       albertel   17:    Boston, MA 02111-1307, USA.
                     18: 
                     19:    As a special exception, you have permission to link this program
                     20:    with the TtH/TtM library and distribute executables, as long as you
                     21:    follow the requirements of the GNU GPL in regard to all of the
                     22:    software in the executable aside from TtH/TtM.
                     23: */
1.1       albertel   24: 
                     25: /* =||>>================================================================<<||= */
                     26: /* 45678901234567890123456789012345678901234567890123456789012345678901234567 */
1.8       albertel   27: /*  by Isaac Tsai, 1996, 1997, 1998, 1999, 2000                               */
1.1       albertel   28: /* =||>>================================================================<<||= */
                     29: 
                     30: #include <stdlib.h>
                     31: #include <string.h>
                     32: #include <math.h>
                     33: 
                     34: #include "capaParser.h"    /* Symbol_p */
                     35: #include "capaFunction.h"  /* RANDOM_F etc. */
                     36: #include "capaToken.h"
                     37: #include "capaCommon.h"
                     38: #include "ranlib.h"
                     39: 
                     40: char        Parse_class[QUARTER_K];
                     41: int         Parse_set;
                     42: int         Parse_section; 
                     43: char        Parse_student_number[MAX_STUDENT_NUMBER+1];
                     44: char        Parse_name[MAX_NAME_CHAR+1];
                     45: long        capaid_plus_gen;
1.3       albertel   46: int         managermode;
1.1       albertel   47: 
                     48: extern int         Parsemode_f;
                     49: 
                     50: extern int         Lexi_qnum; 
                     51: extern char        Opened_filename[MAX_OPENED_FILE][QUARTER_K];
                     52: extern int         Input_idx;
                     53: extern int         Current_line[MAX_OPENED_FILE];
                     54: 
                     55: extern int         Func_idx;
                     56: extern Symbol      FuncStack[MAX_FUNC_NEST];
                     57: 
1.6       albertel   58: #ifdef TTH
                     59: extern int textohtmldyn(char*,char**,char**,int);
                     60: char *tth_err;
                     61: #endif
                     62: 
1.1       albertel   63: /* --------------------------------------------------------------------------- */
                     64: int
                     65: match_function(func, argc) char *func; int argc;
                     66: {
                     67:   if( !strcmp(func,"random") )         return (((argc==2 || argc==3)? RANDOM_F : MIS_ARG_COUNT));
1.5       albertel   68:   if( !strcmp(func,"random_normal") )         return ((argc==5)? RANDOM_NORMAL_F : MIS_ARG_COUNT);
1.10      albertel   69:   if( !strcmp(func,"random_multivariate_normal") )  return ((argc==6)? RANDOM_MULTIVARIATE_NORMAL_F : MIS_ARG_COUNT);
1.5       albertel   70:   if( !strcmp(func,"random_beta") )           return ((argc==5)? RANDOM_BETA_F : MIS_ARG_COUNT);
                     71:   if( !strcmp(func,"random_gamma") )          return ((argc==5)? RANDOM_GAMMA_F : MIS_ARG_COUNT);
                     72:   if( !strcmp(func,"random_poisson") )        return ((argc==4)? RANDOM_POISSON_F : MIS_ARG_COUNT);
                     73:   if( !strcmp(func,"random_exponential") )    return ((argc==4)? RANDOM_EXPONENTIAL_F : MIS_ARG_COUNT);
                     74:   if( !strcmp(func,"random_chi") )            return ((argc==4)? RANDOM_CHI_F : MIS_ARG_COUNT);
1.6       albertel   75:   if( !strcmp(func,"random_noncentral_chi") )  return ((argc==5)? RANDOM_NONCENTRAL_CHI_F : MIS_ARG_COUNT);
1.1       albertel   76:   if( !strcmp(func,"choose") )         return (CHOOSE_F);
                     77:   if( !strcmp(func,"tex") )            return (((argc==2)? TEX_F: MIS_ARG_COUNT));
                     78:   if( !strcmp(func,"var_in_tex") )     return (VAR_IN_TEX_F);
                     79:   if( !strcmp(func,"html") )           return (((argc==1)? HTML_F: MIS_ARG_COUNT));
                     80:   if( !strcmp(func,"web") )            return (((argc==3)? WEB_F: MIS_ARG_COUNT));
                     81:   if( !strcmp(func,"pin") )            return (((argc<2)? PIN_F: MIS_ARG_COUNT));
                     82:   if( !strcmp(func,"capa_id") )        return (((argc<2)? PIN_F: MIS_ARG_COUNT));
                     83:   if( !strcmp(func,"class") )          return (((argc==0)? CLASS_F: MIS_ARG_COUNT));
                     84:   if( !strcmp(func,"section") )        return (((argc==0)? SECTION_F: MIS_ARG_COUNT));
                     85:   if( !strcmp(func,"set") )            return (((argc==0)? SET_F: MIS_ARG_COUNT));
                     86:   if( !strcmp(func,"problem") )        return (((argc==0)? PROBLEM_F: MIS_ARG_COUNT));
                     87:   if( !strcmp(func,"name") )           return (((argc==0)? NAME_F: MIS_ARG_COUNT));
                     88:   if( !strcmp(func,"student_number") ) return (((argc==0)? SNUMBER_F: MIS_ARG_COUNT));
                     89:   if( !strcmp(func,"due_date") )       return (((argc<2)? DUE_DATE_F: MIS_ARG_COUNT));
                     90:   if( !strcmp(func,"due_day") )        return (((argc<2)? DUE_DAY_F: MIS_ARG_COUNT));
                     91:   if( !strcmp(func,"open_date") )      return (((argc<2)? OPEN_DATE_F: MIS_ARG_COUNT));
                     92:   if( !strcmp(func,"answer_date") )    return (((argc<2)? ANSWER_DATE_F: MIS_ARG_COUNT));
                     93:   if( !strcmp(func,"to_string") )      return (((argc==1 || argc==2)? TO_STRING_F: MIS_ARG_COUNT));
                     94:   if( !strcmp(func,"sub_string") )     return (((argc==2 || argc==3)? SUB_STRING_F: MIS_ARG_COUNT));
                     95:   if( !strcmp(func,"strlen") )         return (((argc==1)? STRLEN_F: MIS_ARG_COUNT));
                     96:   if( !strcmp(func,"get_seed") )       return (((argc==0)? GET_SEED_F: MIS_ARG_COUNT));
                     97:   if( !strcmp(func,"set_seed") )       return (((argc==1)? SET_SEED_F: MIS_ARG_COUNT));
1.5       albertel   98:   if( !strcmp(func,"init_array") )     return (((argc==1)? INIT_ARRAY_F: MIS_ARG_COUNT));
1.1       albertel   99:   if( !strcmp(func,"array_index") )    return (((argc==1)? ARRAY_INDEX_F: MIS_ARG_COUNT));
                    100:   if( !strcmp(func,"array_sorted_index") )    return (((argc==2)? ARRAY_SORTED_INDEX_F: MIS_ARG_COUNT));
                    101:   if( !strcmp(func,"array_max") )      return (((argc==1)? ARRAY_MAX_F: MIS_ARG_COUNT));
                    102:   if( !strcmp(func,"array_min") )      return (((argc==1)? ARRAY_MIN_F: MIS_ARG_COUNT));
                    103:   if( !strcmp(func,"array_moments") )  return (((argc==2)? ARRAY_MOMENTS_F: MIS_ARG_COUNT));
                    104:   if( !strcmp(func,"array_var") )      return (((argc==1)? ARRAY_VARIANCE_F: MIS_ARG_COUNT));
                    105:   if( !strcmp(func,"array_std_dev") )  return (((argc==1)? ARRAY_STD_DEV_F: MIS_ARG_COUNT));
                    106:   if( !strcmp(func,"array_skewness") ) return (((argc==1)? ARRAY_SKEWNESS_F: MIS_ARG_COUNT));
                    107:   if( !strcmp(func,"to_int") )         return (((argc==1)? TO_INT_F: MIS_ARG_COUNT));
                    108:   if( !strcmp(func,"format") )         return (FORMAT_F);
                    109:   if( !strcmp(func,"pick") )           return (((argc> 1)? PICK_F: MIS_ARG_COUNT));
                    110:   if( !strcmp(func,"sin") )            return (((argc==1)? SIN_F:  MIS_ARG_COUNT));
                    111:   if( !strcmp(func,"cos") )            return (((argc==1)? COS_F:  MIS_ARG_COUNT));
                    112:   if( !strcmp(func,"tan") )            return (((argc==1)? TAN_F:  MIS_ARG_COUNT));
                    113:   if( !strcmp(func,"asin") )           return (((argc==1)? ASIN_F: MIS_ARG_COUNT));
                    114:   if( !strcmp(func,"acos") )           return (((argc==1)? ACOS_F: MIS_ARG_COUNT));
                    115:   if( !strcmp(func,"atan") )           return (((argc==1)? ATAN_F: MIS_ARG_COUNT));
                    116:   if( !strcmp(func,"sinh") )           return (((argc==1)? SINH_F:  MIS_ARG_COUNT));
                    117:   if( !strcmp(func,"cosh") )           return (((argc==1)? COSH_F:  MIS_ARG_COUNT));
                    118:   if( !strcmp(func,"tanh") )           return (((argc==1)? TANH_F:  MIS_ARG_COUNT));
                    119:   if( !strcmp(func,"asinh") )          return (((argc==1)? ASINH_F:  MIS_ARG_COUNT));
                    120:   if( !strcmp(func,"acosh") )          return (((argc==1)? ACOSH_F:  MIS_ARG_COUNT));
                    121:   if( !strcmp(func,"atanh") )          return (((argc==1)? ATANH_F:  MIS_ARG_COUNT));
                    122:   if( !strcmp(func,"atan2") )          return (((argc==2)? ATANTWO_F:  MIS_ARG_COUNT));
                    123:   if( !strcmp(func,"j0") )             return (((argc==1)? J_ZERO_F:  MIS_ARG_COUNT));
                    124:   if( !strcmp(func,"j1") )             return (((argc==1)? J_ONE_F:  MIS_ARG_COUNT));
                    125:   if( !strcmp(func,"jn") )             return (((argc==2)? J_N_F:  MIS_ARG_COUNT));
                    126:   if( !strcmp(func,"y0") )             return (((argc==1)? Y_ZERO_F:  MIS_ARG_COUNT));
                    127:   if( !strcmp(func,"y1") )             return (((argc==1)? Y_ONE_F:  MIS_ARG_COUNT));
                    128:   if( !strcmp(func,"yn") )             return (((argc==2)? Y_N_F:  MIS_ARG_COUNT));
                    129:   if( !strcmp(func,"log") )            return (((argc==1)? LOG_F:  MIS_ARG_COUNT));
                    130:   if( !strcmp(func,"log10") )          return (((argc==1)? LOG_TEN_F: MIS_ARG_COUNT));
                    131:   if( !strcmp(func,"exp") )            return (((argc==1)? EXP_F:  MIS_ARG_COUNT));
                    132:   if( !strcmp(func,"pow") )            return (((argc==2)? POW_F:  MIS_ARG_COUNT));
                    133:   if( !strcmp(func,"erf") )            return (((argc==1)? ERF_F:  MIS_ARG_COUNT));
                    134:   if( !strcmp(func,"erfc") )           return (((argc==1)? ERFC_F: MIS_ARG_COUNT));
                    135:   if( !strcmp(func,"sqrt") )           return (((argc==1)? SQRT_F: MIS_ARG_COUNT));
                    136:   if( !strcmp(func,"min") )            return (MIN_F);
                    137:   if( !strcmp(func,"max") )            return (MAX_F);
                    138:   if( !strcmp(func,"abs") )            return (((argc==1)? ABS_F: MIS_ARG_COUNT));
                    139:   if( !strcmp(func,"floor") )          return (((argc==1)? FLOOR_F: MIS_ARG_COUNT));
                    140:   if( !strcmp(func,"ceil") )           return (((argc==1)? CEIL_F: MIS_ARG_COUNT));
                    141:   if( !strcmp(func,"sgn") )            return (((argc==1)? SGN_F: MIS_ARG_COUNT));
                    142:   if( !strcmp(func,"mod") )            return (((argc==2)? MOD_F: MIS_ARG_COUNT));
                    143:   if( !strcmp(func,"remainder") )      return (((argc==2)? REMAINDER_F: MIS_ARG_COUNT));
                    144:   if( !strcmp(func,"factorial") )      return (((argc==1)? FACTORIAL_F: MIS_ARG_COUNT));
                    145:   if( !strcmp(func,"roundto") )        return (((argc==2)? ROUNDTO_F: MIS_ARG_COUNT));
                    146:   if( !strcmp(func,"eval_formula") )   return (((argc==3)? EVALUATE_F: MIS_ARG_COUNT));
                    147:   if( !strcmp(func,"capa_id_plus") )   return (((argc==1 || argc==2)? CAPAID_PLUS: MIS_ARG_COUNT));
                    148:   if( !strcmp(func,"seat_number") )    return (((argc <2)? SEAT_NUMBER: MIS_ARG_COUNT));
                    149:   if( !strcmp(func,"duration") )       return (((argc==0)? DURATION: MIS_ARG_COUNT));
                    150:   if( !strcmp(func,"is_open") )        return (((argc <2)? IS_OPEN_F: MIS_ARG_COUNT));
                    151:   if( !strcmp(func,"is_due") )         return (((argc <2)? IS_DUE_F: MIS_ARG_COUNT));
                    152:   if( !strcmp(func,"is_answer") )      return (((argc <2)? IS_ANSWER_F: MIS_ARG_COUNT));
1.3       albertel  153:   if( !strcmp(func,"correct") )        return (((argc <3)? CORRECT_F: MIS_ARG_COUNT));
                    154:   if( !strcmp(func,"grade") )          return (((argc <3)? GRADE_F: MIS_ARG_COUNT));
                    155:   if( !strcmp(func,"tries") )          return (((argc <3)? TRIES_F: MIS_ARG_COUNT));
                    156:   if( !strcmp(func,"managermode"))     return (((argc==0)? MANAGERMODE_F:MIS_ARG_COUNT));
1.1       albertel  157:   return (UNKNOWN_F);
                    158: }
                    159: 
                    160: /**********************************************************/
                    161: 
                    162: 
                    163: #ifdef    SGN
                    164: #undef    SGN
                    165: #endif
                    166: #define   SGN(xx)  ( (xx) > 0 ? 1 : ( (xx) == 0 ? 0 : -1) )
                    167: 
                    168: 
                    169: #define   MAX_DOUBLE         1.7976931348623157E+308
                    170: #define   MIN_DOUBLE         2.2250738585072014E-308
                    171: 
                    172: #define   INT_DIV     0
                    173: #define   REAL_DIV    1
                    174: #define   INT_LOWER   0
                    175: #define   REAL_LOWER  2
                    176: #define   INT_UPPER   0
                    177: #define   REAL_UPPER  4
                    178: 
                    179: #define   ALL_INTEGER  0
                    180: 
                    181: int which_set(argc,argp,resultp)
                    182: int         argc;
                    183: ArgNode_t  *argp; 
                    184: Symbol     *resultp;
                    185: {
                    186:   char        aline[MAX_BUFFER_SIZE], tmpS[MAX_BUFFER_SIZE];
                    187:   int result=Parse_set;
                    188:   if( argc == 1 ) {
                    189:     if( (FIRST_ARGTYPE(argp) == S_VAR ) || 
                    190: 	(FIRST_ARGTYPE(argp) == S_CONSTANT ) ) {
                    191:       sprintf(aline,"<<ARG TYPE MISMATCH>>");
                    192:       resultp->s_type = S_CONSTANT;
                    193:       resultp->s_str = strsave(aline);
                    194:       sprintf(tmpS, "function %s() cannot accept string as argument.\n", 
                    195: 	      FuncStack[Func_idx].s_name);
                    196:       capa_msg(MESSAGE_ERROR,tmpS);
                    197:       result=-1;
                    198:     } else {
                    199:       if( (FIRST_ARGTYPE(argp) == I_VAR ) || 
                    200: 	  (FIRST_ARGTYPE(argp) == I_CONSTANT ) ) {
                    201: 	result = FIRST_ARGINT(argp);
                    202:       } else {
                    203: 	result = FIRST_ARGREAL(argp);
                    204:       }
                    205:     }
                    206:   }
                    207:   return result;
                    208: }
                    209: 
                    210: Symbol *                
                    211: do_function(func,argc,argp) 
                    212: int         func;           
                    213: int         argc;
                    214: ArgNode_t  *argp; 
                    215: {                
                    216:   Symbol     *resultp;
                    217:   ArgNode_t  *tmpArgp;
                    218:   char        aline[MAX_BUFFER_SIZE], tmpS[MAX_BUFFER_SIZE], fmt_str[FORMAT_STRING_LENG];
                    219:   char        num_str[SMALL_LINE_BUFFER],date_str[SMALL_LINE_BUFFER];
                    220:   double      tmpA=0.0, tmpB=0.0;
                    221:   int         slots, noError, errCode, mo, yy, dd, hh, mm, tmpInt;
                    222:   long        rout;
                    223:   char       *wday[9] =  {"Sat,", "Sun,", "Mon,", "Tue,", "Wed,", "Thr,", "Fri,", "Sat,", "\0"};
1.2       albertel  224:   char       *month[14] =  { "UNKNOWN", "Jan", "Feb", "Mar", "Apr", "May", "Jun", 
                    225:                          "Jul", "Aug", "Sep", "Oct", "Nov", "Dec", "\0"};
1.1       albertel  226:   
                    227:   resultp = (Symbol *)capa_malloc(1,sizeof(Symbol));
                    228:   
                    229:   switch(func) {
                    230:     case RANDOM_F: { int    type_flag=0;
                    231:               double r_lower=0.0, r_upper=1.0, r_division=1.0;
                    232: 
                    233:               errCode = 0; rout = ignlgi();
                    234:               switch( FIRST_ARGTYPE(argp) ) {
                    235:                 case I_VAR: case I_CONSTANT: break;
                    236:                 case R_VAR: case R_CONSTANT: type_flag = (type_flag | 1); break;
                    237:                 case S_VAR: case S_CONSTANT: errCode = 1; break;
                    238:               }
                    239:               switch( SECOND_ARGTYPE(argp) ) {
                    240:                 case I_VAR: case I_CONSTANT: break;
                    241:                 case R_VAR: case R_CONSTANT: type_flag = (type_flag | 2); break;
                    242:                 case S_VAR: case S_CONSTANT: errCode = 2; break;
                    243:               }
                    244:               if( argc == 3 ) {
                    245:                 switch( THIRD_ARGTYPE(argp) ) {
                    246:                  case I_VAR: case I_CONSTANT: break;
                    247:                  case R_VAR: case R_CONSTANT: type_flag = (type_flag | 4); break;
                    248:                  case S_VAR: case S_CONSTANT: errCode = 4; break;
                    249:                 }
                    250:               }
                    251:               if( errCode == 0 ) {
                    252:                 if( argc == 3 ) {
                    253:                    switch(type_flag) {
                    254:                    case 0: r_division = (double)FIRST_ARGINT(argp); 
                    255:                            r_upper = (double)SECOND_ARGINT(argp);
                    256:                            r_lower = (double)THIRD_ARGINT(argp);    break;
                    257:                    case 2: r_division = (double)FIRST_ARGINT(argp);
                    258:                            r_upper = SECOND_ARGREAL(argp);
                    259:                            r_lower = (double)THIRD_ARGINT(argp);    break;
                    260:                    case 4: r_division = (double)FIRST_ARGINT(argp);
                    261:                            r_upper = (double)SECOND_ARGINT(argp);
                    262:                            r_lower = THIRD_ARGREAL(argp);           break;
                    263:                    case 6: r_division = (double)FIRST_ARGINT(argp);
                    264:                            r_upper = SECOND_ARGREAL(argp);
                    265:                            r_lower = THIRD_ARGREAL(argp);           break;
                    266:                    case 1: r_division = FIRST_ARGREAL(argp);
                    267:                            r_upper = (double)SECOND_ARGINT(argp);
                    268:                            r_lower = (double)THIRD_ARGINT(argp);    break;
                    269:                    case 3: r_division = FIRST_ARGREAL(argp);
                    270:                            r_upper = SECOND_ARGREAL(argp);
                    271:                            r_lower = (double)THIRD_ARGINT(argp);    break;
                    272:                    case 5: r_division = FIRST_ARGREAL(argp);
                    273:                            r_upper = (double)SECOND_ARGINT(argp);
                    274:                            r_lower = THIRD_ARGREAL(argp);           break;
                    275:                    case 7: r_division = FIRST_ARGREAL(argp);
                    276:                            r_upper = SECOND_ARGREAL(argp);
                    277:                            r_lower = THIRD_ARGREAL(argp);           break;
                    278:                   }
                    279:                 } else { /* two args */
                    280:                   switch(type_flag) {
                    281:                    case 0: r_upper = (double)FIRST_ARGINT(argp);
                    282:                            r_lower = (double)SECOND_ARGINT(argp);   break;
                    283:                    case 1: r_upper = FIRST_ARGREAL(argp);
                    284:                            r_lower = (double)SECOND_ARGINT(argp);   break;
                    285:                    case 2: r_upper = (double)FIRST_ARGINT(argp);
                    286:                            r_lower = SECOND_ARGREAL(argp);          break;
                    287:                    case 3: r_upper = FIRST_ARGREAL(argp);
                    288:                            r_lower = SECOND_ARGREAL(argp);          break;
                    289:                   }
                    290:                   r_division = 1.0;
                    291:                }
                    292:                if( r_upper >= r_lower ) {
                    293:                  slots = 1 + (int)floor( (r_upper - r_lower)/r_division );
                    294:                  if( type_flag == 0 ) {
                    295:                     resultp->s_type = I_CONSTANT;
                    296:                     resultp->s_int = (int)r_lower + ((int)r_division)*(rout % slots );
                    297:                  } else {
                    298:                     resultp->s_type = R_CONSTANT;
                    299:                     resultp->s_real = r_lower + r_division*(double)(rout % slots );
                    300:                  }
                    301:                } else {
                    302:                  resultp->s_type = S_CONSTANT;
                    303:                  resultp->s_str = strsave("<<2ND ARG MUST .GE. 1ST ARG>>");
                    304:                  sprintf(tmpS,"random()'s second arg. must be greater than the first arg.\n");
                    305:                  capa_msg(MESSAGE_ERROR,tmpS);
                    306:                }
                    307:               } else {
                    308:                 resultp->s_type = S_CONSTANT;
                    309:                 resultp->s_str = strsave("<<ARG CANNOT BE STRING>>");
                    310:                 sprintf(tmpS,"random() cannot accept string as argument.\n");
                    311:                 capa_msg(MESSAGE_ERROR,tmpS);
                    312:               }
                    313:           } break;
1.5       albertel  314: 
1.1       albertel  315:     case CHOOSE_F: { int        ii, pick=1;
                    316:                      ArgNode_t *tmpArgp;
                    317:                      
                    318:                      noError = 1;
                    319:                      tmpArgp = argp; ii=0;
                    320:                      while( ii < argc-1 ) {tmpArgp = tmpArgp->a_next; ii++; }
                    321:                      switch( FIRST_ARGTYPE(tmpArgp) ) {
                    322:                        case IDENTIFIER:
                    323:                          sprintf(tmpS,"The first argument to choose(): \"%s\" has not been defined yet. I will choose the first element.\n",FIRST_ARGNAME(tmpArgp));
                    324:                          capa_msg(MESSAGE_ERROR,tmpS);
                    325:                          pick = 1;
                    326:                          break;
                    327:                        case I_VAR: case I_CONSTANT:
                    328:                          pick = FIRST_ARGINT(tmpArgp); break;
                    329:                        case R_VAR: case R_CONSTANT:
                    330:                          pick = (int)FIRST_ARGREAL(tmpArgp); 
                    331:                          sprintf(tmpS,"The first argument to choose() is a real number: \"%.15g\", it must be an integer, I will use %d instead.\n",FIRST_ARGREAL(tmpArgp),pick);
                    332:                          capa_msg(MESSAGE_ERROR,tmpS);
                    333:                          break;
                    334:                        case S_VAR: case S_CONSTANT:
                    335:                          resultp->s_type = S_CONSTANT;
                    336:                          resultp->s_str = strsave("CHOOSE: first argument must be an integer");
                    337:                          sprintf(tmpS,"The first argument to choose() cannot be a string, I will choose the first element.\n");
                    338:                          capa_msg(MESSAGE_ERROR,tmpS);
                    339:                          pick = 1;
                    340:                          break;      
                    341:                      }
                    342:                      if( noError ) {
                    343:                        if( (pick <= 0) || (pick > argc-1) ) { 
                    344:                          sprintf(tmpS,"The first argument to choose() is out of bounds, tt is %d, but should be in the range [1,%d].\n", pick, argc-1);
                    345:                          capa_msg(MESSAGE_ERROR,tmpS);
                    346:                          pick = argc-1;
                    347:                        } else { pick = argc - pick; }
                    348:                        for(ii=1,tmpArgp = argp;(ii < pick)&&(ii < argc-1);ii++) { tmpArgp =  tmpArgp->a_next; }
                    349:                        
                    350:                        resultp->s_type = (tmpArgp->a_sp)->s_type;
                    351:                        switch((tmpArgp->a_sp)->s_type) {
                    352:                          case IDENTIFIER: 
                    353:                               sprintf(tmpS,"The variable \"%s\" selected by choose() has not yet been defined.\n",(tmpArgp->a_sp)->s_name);
                    354:                               capa_msg(MESSAGE_ERROR,tmpS);
                    355:                               resultp->s_type = S_CONSTANT;
                    356:                               resultp->s_str = strsave(tmpS);
                    357:                               break;
                    358:                          case I_VAR: case I_CONSTANT:
                    359:                               resultp->s_type = I_CONSTANT;
                    360:                               resultp->s_int = (tmpArgp->a_sp)->s_int; break;
                    361:                          case R_VAR: case R_CONSTANT:
                    362:                               resultp->s_type = R_CONSTANT;
                    363:                               resultp->s_real = (tmpArgp->a_sp)->s_real; break;
                    364:                          case S_VAR: case S_CONSTANT:
                    365:                               resultp->s_type = S_CONSTANT;
                    366:                               resultp->s_str = strsave((tmpArgp->a_sp)->s_str); break; /********* */
                    367:                        }
                    368:                        
                    369:                      }
                    370:                      
                    371:                  } break;
                    372:     case PIN_F: { 
                    373:                   if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
                    374:                   resultp->s_type = I_CONSTANT;
                    375:                   resultp->s_int=capa_PIN(Parse_student_number,tmpInt,0);
                    376:                 }
                    377:                 break;
                    378:     case CLASS_F: {
                    379:                   resultp->s_type = S_CONSTANT;
                    380:                   if(strlen(Parse_class) != 0 ) {
                    381:                     resultp->s_str=strsave(Parse_class);
                    382:                   } else {
                    383:                     resultp->s_str=strsave("UNKNOWN");
                    384:                   }
                    385:                  }
                    386:                   break;
                    387:     case SECTION_F:{ resultp->s_type = I_CONSTANT;
                    388:                      resultp->s_int = Parse_section;
                    389:                    } break;
                    390:     case PROBLEM_F:{ resultp->s_type = I_CONSTANT;
                    391:                      resultp->s_int= Lexi_qnum+1;
                    392:                    } break;
                    393:     case SET_F:    { resultp->s_type = I_CONSTANT;
                    394:                      resultp->s_int=Parse_set;
                    395:                    } break;
                    396:     case NAME_F:   {
                    397:                      resultp->s_type = S_CONSTANT;
                    398:                      resultp->s_str=strsave(Parse_name);
                    399:                    } break;
                    400:     case SNUMBER_F: {
                    401:                      resultp->s_type = S_CONSTANT;
                    402:                      resultp->s_str=strsave(Parse_student_number);
                    403:                    } break;
                    404:     case IS_DUE_F: 
                    405:     case IS_ANSWER_F: 
                    406:     case IS_OPEN_F: {
                    407:                       int whichDate=CHECK_OPEN_DATE;
                    408:                       if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
                    409: 		      resultp->s_type = I_CONSTANT;
                    410:                       switch(func) {
                    411: 		      case IS_OPEN_F: whichDate=CHECK_OPEN_DATE;break;
                    412: 		      case IS_DUE_F: whichDate=CHECK_DUE_DATE;break;
                    413: 		      case IS_ANSWER_F: whichDate=CHECK_ANS_DATE;break;
                    414: 		      }
                    415: 		      if( capa_check_date(whichDate,Parse_student_number,
                    416: 					  Parse_section,tmpInt) < 0 ) {
                    417: 			resultp->s_int = 0;
                    418: 		      } else {
                    419: 			resultp->s_int = 1;
                    420: 		      }
                    421:                     } break;
                    422:     case DUE_DATE_F:
                    423:              { if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
                    424:                resultp->s_type = S_CONSTANT;
                    425:                if(capa_get_date(CHECK_DUE_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
                    426:                  sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mo, &dd, &hh, &mm);
                    427:                  sprintf(aline, "%s %s %2d, %4d at %02d:%02d", 
                    428:                    wday[weekday(yy,mo,dd)], month[mo], dd, yy, hh, mm);
                    429:                  resultp->s_str= strsave(aline);
                    430:                } else {
                    431:                  resultp->s_str= strsave("UNKNOWN");
                    432:                }
                    433:              } break;
                    434:     case DUE_DAY_F:
                    435:              { if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
                    436:                resultp->s_type = S_CONSTANT;
                    437:                if(capa_get_date(CHECK_DUE_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
                    438:                  sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mm, &dd, &hh, &mm);
                    439:                  sprintf(aline, "%s %s %2d, %4d", 
                    440:                    wday[weekday(yy,mo,dd)], month[mo], dd, yy); 
                    441:                  resultp->s_str= strsave(aline);
                    442:                } else {
                    443:                  resultp->s_str= strsave("UNKNOWN");
                    444:                }
                    445:              } break;         
                    446:     case OPEN_DATE_F:
                    447:              { if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
                    448:                resultp->s_type = S_CONSTANT;
                    449:                if(capa_get_date(CHECK_OPEN_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
                    450:                  sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mm, &dd, &hh, &mm);
                    451:                  sprintf(aline, "%s %s %2d, %4d at %02d:%02d", 
                    452:                    wday[weekday(yy,mo,dd)], month[mo], dd, yy, hh, mm); 
                    453:                  resultp->s_str= strsave(aline);
                    454:                } else {
                    455:                  resultp->s_str= strsave("UNKNOWN");
                    456:                }
                    457:              } break;
                    458:     case ANSWER_DATE_F:
                    459:              { if (-1==(tmpInt=which_set(argc,argp,resultp))) break;
                    460:                resultp->s_type = S_CONSTANT;
                    461:                if(capa_get_date(CHECK_ANS_DATE,Parse_student_number,Parse_section,tmpInt,date_str) > 0 ) {
                    462:                  sscanf(date_str,"%4d/%2d/%2d %2d:%2d",&yy, &mo, &dd, &hh, &mm);
                    463:                  sprintf(aline, "%s %s %2d, %4d at %02d:%02d", 
                    464:                    wday[weekday(yy,mo,dd)], month[mo], dd, yy, hh, mm); 
                    465:                  resultp->s_str= strsave(aline);
                    466:                } else {
                    467:                  resultp->s_str= strsave("UNKNOWN");
                    468:                }
                    469:              } break;
                    470:     case STRLEN_F: {
                    471:                   resultp->s_type = I_CONSTANT;
                    472:                switch( FIRST_ARGTYPE(argp) ) {
                    473:                   case I_VAR:
                    474:                   case I_CONSTANT:
                    475:                          resultp->s_type = S_CONSTANT;
                    476:                          sprintf(tmpS,"strlen() only accepts string variable, not integer.\n");
                    477: 			 capa_msg(MESSAGE_ERROR,tmpS);
                    478: 			 resultp->s_str=strsave(tmpS);
                    479:                          break;
                    480:                   case R_VAR:
                    481:                   case R_CONSTANT:
                    482:                          resultp->s_type = S_CONSTANT;
                    483:                          sprintf(tmpS,"strlen() only accepts string variable, not float number.\n");
                    484: 			 capa_msg(MESSAGE_ERROR,tmpS);
                    485: 			 resultp->s_str=strsave(tmpS);
                    486:                          break;
                    487:                   case S_VAR:
                    488:                   case S_CONSTANT:
                    489:                          resultp->s_int = strlen( FIRST_ARGSTR(argp) );
                    490:                          break;
                    491: 		  case IDENTIFIER:
                    492: 			 sprintf(tmpS,"Unknown variable, %s, argument to function strlen()\n",argp->a_sp->s_name);
                    493: 			 capa_msg(MESSAGE_ERROR,tmpS);
                    494: 			 resultp->s_str=strsave(tmpS);
                    495: 			 break;
                    496:                }
                    497:              } break;
                    498:     case TO_STRING_F:
                    499:             { char aline[MAX_BUFFER_SIZE],rline[MAX_BUFFER_SIZE];
                    500:               
                    501:               resultp->s_type = S_CONSTANT;
                    502: 
                    503:               if( argc == 1 ) {
                    504:                 switch( FIRST_ARGTYPE(argp) ) {
                    505:                   case I_VAR:
                    506:                   case I_CONSTANT:
                    507:                          sprintf(aline,"%ld",FIRST_ARGINT(argp));
                    508:                          resultp->s_str = strsave(aline); break;
                    509:                   case R_VAR:
                    510:                   case R_CONSTANT:
                    511:                          sprintf(aline,"%.15g",FIRST_ARGREAL(argp));
                    512:                          resultp->s_str = strsave(aline); break;
                    513:                   case S_VAR:
                    514:                   case S_CONSTANT:
                    515:                          resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
                    516: 		  case IDENTIFIER:
                    517: 			 sprintf(tmpS,"Unknown variable, %s, argument to function to_string()\n",argp->a_sp->s_name);
                    518: 			 capa_msg(MESSAGE_ERROR,tmpS);
                    519: 			 resultp->s_str=strsave(tmpS);
                    520: 			 break;
                    521:                 }
                    522:               } else {
                    523:                 switch( FIRST_ARGTYPE(argp) ) {
                    524:                   case I_VAR:
                    525:                   case I_CONSTANT:
                    526:                   case R_VAR:
                    527:                   case R_CONSTANT: 
                    528:                          sprintf(tmpS,
                    529:                           "to_string()'s second arg. must be a string.\n");
                    530:                          capa_msg(MESSAGE_ERROR,tmpS);
                    531:                          sprintf(aline,"%%.15g");
                    532:                          break;
                    533:                   case S_VAR:
                    534:                   case S_CONSTANT: 
                    535:                          sprintf(aline,"%%%s",FIRST_ARGSTR(argp));
                    536:                          break;
                    537: 		  case IDENTIFIER:
                    538: 			 sprintf(tmpS,"Unknown variable, %s, argument to function to_string()\n",argp->a_next->a_sp->s_name);
                    539: 			 capa_msg(MESSAGE_ERROR,tmpS);
                    540: 			 resultp->s_str=strsave(tmpS);
                    541: 			 break;
                    542: 
                    543:                 }
                    544:                 switch( SECOND_ARGTYPE(argp) ) {
                    545:                   case I_VAR:
                    546:                   case I_CONSTANT:
                    547:                          sprintf(aline,"%ld",SECOND_ARGINT(argp));
                    548:                          resultp->s_str = strsave(aline);  break;
                    549:                   case R_VAR:
                    550:                   case R_CONSTANT:
                    551:                          sprintf(rline,aline,SECOND_ARGREAL(argp));
                    552:                          resultp->s_str = strsave(rline);  break;
                    553:                   case S_VAR:
                    554:                   case S_CONSTANT: 
                    555:                          resultp->s_str = strsave(SECOND_ARGSTR(argp));
                    556:                          break;
                    557: 		  case IDENTIFIER:
                    558: 			 sprintf(tmpS,"Unknown variable, %s, argument to function to_string()\n",argp->a_sp->s_name);
                    559: 			 capa_msg(MESSAGE_ERROR,tmpS);
                    560: 			 resultp->s_str=strsave(tmpS);
                    561: 			 break;
                    562:                 }
                    563:               }
                    564:             } break;
                    565:     case SUB_STRING_F: /* sub_string(str, 2), 1 is the first char */
                    566:                        /* sub_string(str, 3, 5) means start from the third char and take 5 chars */
                    567:             { int   idx=1, leng, rleng=0,ii;
                    568:               char *a_str, *b_str;
                    569:               
                    570:               resultp->s_type = S_CONSTANT;
                    571:               if( argc == 2 ) { /* two arguments format */
                    572:                 switch( FIRST_ARGTYPE(argp) ) {
                    573:                   case IDENTIFIER:
                    574:                          sprintf(tmpS,
                    575:                           "sub_string()'s second arg. must be an integer.\n");
                    576:                          capa_msg(MESSAGE_ERROR,tmpS);
                    577:                          break;
                    578:                   case I_VAR:
                    579:                   case I_CONSTANT:
                    580:                          idx = FIRST_ARGINT(argp);
                    581:                          break;
                    582:                   case R_VAR:
                    583:                   case R_CONSTANT: 
                    584:                          idx = (int) FIRST_ARGREAL(argp);
                    585:                          break;
                    586:                   case S_VAR:
                    587:                   case S_CONSTANT: 
                    588:                          sprintf(tmpS,
                    589:                           "sub_string()'s second arg. must be an integer.\n");
                    590:                          capa_msg(MESSAGE_ERROR,tmpS);
                    591:                          break;
                    592:                 }
                    593:                 switch( SECOND_ARGTYPE(argp) ) {
                    594:                   case IDENTIFIER:
                    595:                          sprintf(tmpS,
                    596:                           "sub_string()'s first arg. is not defined before use.\n");
                    597:                          capa_msg(MESSAGE_ERROR,tmpS);
                    598:                          break;
                    599:                   case I_VAR:
                    600:                   case I_CONSTANT:
                    601:                          sprintf(tmpS,
                    602:                           "sub_string()'s first arg. cannot be an integer.\n");
                    603:                          capa_msg(MESSAGE_ERROR,tmpS);
                    604:                          break;
                    605:                   case R_VAR:
                    606:                   case R_CONSTANT:
                    607:                          sprintf(tmpS,
                    608:                           "sub_string()'s first arg. cannot be a number.\n");
                    609:                          capa_msg(MESSAGE_ERROR,tmpS);
                    610:                          break;
                    611:                   case S_VAR:
                    612:                   case S_CONSTANT:
                    613:                          a_str = SECOND_ARGSTR(argp);
                    614:                          leng = strlen(a_str);
                    615:                          if( (idx<1) || (idx > leng) ) {
                    616:                            sprintf(tmpS, "sub_string()'s second arg. is out of range.\n");
                    617:                            capa_msg(MESSAGE_ERROR,tmpS);
                    618:                            idx = 1;
                    619:                          } 
                    620:                          b_str = (char *)&a_str[idx-1];
                    621:                          resultp->s_str = strsave(b_str);
                    622:                          
                    623:                          if( SECOND_ARGTYPE(argp) == S_CONSTANT) {
                    624: 			   /* freed in free arg_list */
                    625: 			   /* capa_mfree((char *)SECOND_ARGSTR(argp)); */
                    626:                          }
                    627:                          break;
                    628:                 }
                    629:               } else { /* three arguments format sub_string(string, start, length) */
                    630:                 switch( FIRST_ARGTYPE(argp) ) {
                    631:                   case IDENTIFIER:
                    632:                          sprintf(tmpS,
                    633:                           "sub_string()'s third arg. must be an integer.\n");
                    634:                          capa_msg(MESSAGE_ERROR,tmpS);
                    635:                          break;
                    636:                   case I_VAR:
                    637:                   case I_CONSTANT:
                    638:                          rleng = FIRST_ARGINT(argp);
                    639:                          break;
                    640:                   case R_VAR:
                    641:                   case R_CONSTANT: 
                    642:                          rleng = (int) FIRST_ARGREAL(argp);
                    643:                          break;
                    644:                   case S_VAR:
                    645:                   case S_CONSTANT: 
                    646:                          sprintf(tmpS,
                    647:                           "sub_string()'s third arg. must be an integer.\n");
                    648:                          capa_msg(MESSAGE_ERROR,tmpS);
                    649:                          break;
                    650:                 }
                    651:                 switch( SECOND_ARGTYPE(argp) ) {
                    652:                   case IDENTIFIER:
                    653:                          sprintf(tmpS,
                    654:                           "sub_string()'s second arg. must be an integer.\n");
                    655:                          capa_msg(MESSAGE_ERROR,tmpS);
                    656:                          break;
                    657:                   case I_VAR:
                    658:                   case I_CONSTANT:
                    659:                          idx = SECOND_ARGINT(argp);
                    660:                          break;
                    661:                   case R_VAR:
                    662:                   case R_CONSTANT: 
                    663:                          idx = (int) SECOND_ARGREAL(argp);
                    664:                          break;
                    665:                   case S_VAR:
                    666:                   case S_CONSTANT: 
                    667:                          sprintf(tmpS,
                    668:                           "sub_string()'s second arg. must be an integer.\n");
                    669:                          capa_msg(MESSAGE_ERROR,tmpS);
                    670:                          break;
                    671:                 }
                    672:                 switch( THIRD_ARGTYPE(argp) ) {
                    673:                   case IDENTIFIER:
                    674:                          sprintf(tmpS,
                    675:                           "sub_string()'s first arg. is not defined before use.\n");
                    676:                          capa_msg(MESSAGE_ERROR,tmpS);
                    677:                          break;
                    678:                   case I_VAR:
                    679:                   case I_CONSTANT:
                    680:                          sprintf(tmpS,
                    681:                           "sub_string()'s first arg. cannot be an integer.\n");
                    682:                          capa_msg(MESSAGE_ERROR,tmpS);
                    683:                          break;
                    684:                   case R_VAR:
                    685:                   case R_CONSTANT:
                    686:                          sprintf(tmpS,
                    687:                           "sub_string()'s first arg. cannot be a number.\n");
                    688:                          capa_msg(MESSAGE_ERROR,tmpS);
                    689:                          break;
                    690:                   case S_VAR:
                    691:                   case S_CONSTANT:
                    692:                          a_str = THIRD_ARGSTR(argp);
                    693:                          leng = strlen(a_str);
                    694:                          if( (idx < 1) || (idx > leng) ) {
                    695:                            sprintf(tmpS, "sub_string()'s second arg. is out of range.\n");
                    696:                            capa_msg(MESSAGE_ERROR,tmpS);
                    697:                            idx = 1;
                    698:                          }
                    699:                          if( (rleng<1) || ((rleng+idx-1) > leng)) {
                    700:                            
                    701:                            rleng = leng - idx + 1;
                    702:                          }
                    703:                          b_str = (char *)capa_malloc((rleng+1)*sizeof(char),1);
                    704:                          for(ii=idx-1;ii<(rleng+idx-1);ii++) {
                    705:                              b_str[ii-idx+1] = a_str[ii];
                    706:                          }
                    707:                          resultp->s_str = strsave(b_str);
                    708:                          capa_mfree(b_str);
                    709:                          
                    710:                          if( THIRD_ARGTYPE(argp) == S_CONSTANT) {
                    711: 			   /* handled in free_arglist() */
                    712: 			   /* capa_mfree((char *)THIRD_ARGSTR(argp)); */
                    713:                          }
                    714:                          break;
                    715:                 }
                    716:               }
                    717:             } break;
                    718:     case PICK_F: { int    ii, pick=1;
                    719:               ArgNode_t  *tmpArgp;
                    720:               
                    721:               noError = 1;
                    722:               rout = ignlgi();
                    723:               tmpArgp = argp; ii=0;
                    724:               while( ii < argc-1 ) {tmpArgp = tmpArgp->a_next; ii++; }
                    725:               switch( FIRST_ARGTYPE(tmpArgp) ) {
                    726:                 case I_VAR:
                    727:                 case I_CONSTANT:
                    728:                        pick = FIRST_ARGINT(tmpArgp); 
                    729:                        if( (pick <= 0 ) || (pick > argc-1) )  {
                    730:                          noError = 0;
                    731:                          resultp->s_type = S_CONSTANT;
                    732:                          resultp->s_str = strsave("PICK: first arg out of bound.");
                    733:                        }
                    734:                        break;
                    735:                 case R_VAR:
                    736:                 case R_CONSTANT:
                    737:                        pick = (int)FIRST_ARGREAL(tmpArgp);
                    738:                        if( (pick <= 0 ) || (pick > argc-1) )  {
                    739:                          noError = 0;
                    740:                          resultp->s_type = S_CONSTANT;
                    741:                          resultp->s_str = strsave("PICK: first arg out of bound.");
                    742:                        }
                    743:                        break;
                    744:                 case S_VAR:
                    745:                 case S_CONSTANT: noError = 0;
                    746:                        resultp->s_type = S_CONSTANT;
                    747:                        resultp->s_str = strsave("PICK: first arg must be int");
                    748:                        break;      
                    749:               }
                    750:               if( noError ) {
                    751:                 for( ii=0; ii< pick; ii++) {
                    752:                 }
                    753:               }
                    754:             }
                    755:             break;
                    756:     case GET_SEED_F: 
                    757:             { long  seed1, seed2;
                    758:               char *tmp;
                    759:               
                    760:               getsd(&seed1,&seed2);
                    761:               tmp = (char *)capa_malloc(32,1);
                    762:               sprintf(tmp,"%ld,%ld",seed1,seed2);
                    763:               resultp->s_type = S_CONSTANT;
                    764:               resultp->s_str  = strsave(tmp);
                    765:               capa_mfree(tmp);
                    766:             } break;
                    767:     case SET_SEED_F:
                    768:             { long  seed1, seed2;
                    769: 	      int leng;
                    770:               
                    771:               switch( FIRST_ARGTYPE(argp) ) {
                    772:                 case I_VAR: case I_CONSTANT: break;
                    773:                 case R_VAR: case R_CONSTANT: break;
                    774:                 case S_VAR: case S_CONSTANT: 
                    775:                        leng = strlen(FIRST_ARGSTR(argp));
1.15    ! albertel  776: 		       if( (index(FIRST_ARGSTR(argp), ',') != NULL) ) {
1.1       albertel  777: 			 sscanf(FIRST_ARGSTR(argp),"%ld,%ld", &seed1, &seed2);
                    778:                          setall(seed1,seed2);
                    779:                        }
                    780:                        
                    781:                        break;
                    782:               }
                    783:               resultp->s_type = I_CONSTANT;
                    784:               resultp->s_int  = 0;
                    785:             } break;
1.5       albertel  786:    /* generate random numbers according to a pre-defined distributions and a seed */
1.10      albertel  787:    case RANDOM_MULTIVARIATE_NORMAL_F:
                    788:        /* random_multivariate_normal(return_array,item_cnt,seed,dimen,mean_vector,covariance_vector) */
                    789:        /* the dimension of both mean_vector and covariance_vector should be the same as item_cnt */
                    790:        /* It will return item_cnt numbers in standard normal deviate in return_array */
1.11      albertel  791:        /* item_cnt, seed, dimen, mean_vec, cov_vec 
                    792:           are all destroyed after this function !!!*/
1.10      albertel  793:         {  char     *mean_vec_str, *cov_vec_str, *seed_str, *out_vec_str;
                    794:            int      dimen, item_cnt, tmp_int;
                    795:            long     tmp_long;
                    796:            Symbol   *r_p;
                    797:            
                    798:            errCode = 0;
                    799:            switch( FIRST_ARGTYPE(argp) ) { /* parameter one covariance_matrix of size dimen*dimen */
                    800:                   case I_VAR: case I_CONSTANT:   
                    801:                   case R_VAR: case R_CONSTANT: 
                    802:                         resultp->s_type = S_CONSTANT;
                    803:                         resultp->s_str  = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                    804:                         sprintf(tmpS,"%s()'s last arg. must be an array name.\n",FuncStack[Func_idx].s_name);
                    805:                         capa_msg(MESSAGE_ERROR,tmpS);
                    806:                         errCode = 1;
                    807:                        break;
                    808:                   case S_VAR: case S_CONSTANT:
                    809:                         cov_vec_str = strsave( FIRST_ARGSTR(argp) );
                    810:                        break;
                    811:                   case IDENTIFIER:
                    812:                         cov_vec_str = strsave( FIRST_ARGNAME(argp) );
                    813:                         /*
                    814:                         resultp->s_type = S_CONSTANT;
                    815:                         resultp->s_str  = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE AN ARRAY WITH DATA>>");
                    816:                         sprintf(tmpS,"%s()'s last arg. must be an array with data (covariance array).\n",FuncStack[Func_idx].s_name);
                    817:                         capa_msg(MESSAGE_ERROR,tmpS);
                    818:                         errCode = 1;
                    819:                         */
                    820:                        break;
                    821:            }
                    822:            if(errCode == 0) {
                    823:               switch( SECOND_ARGTYPE(argp) ) { /* parameter two mean_vector */
                    824:                     case I_VAR: case I_CONSTANT:   
                    825:                     case R_VAR: case R_CONSTANT: 
                    826:                         resultp->s_type = S_CONSTANT;
                    827:                         resultp->s_str  = strsave("<<THE FIFTH ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                    828:                         sprintf(tmpS,"%s()'s fifth arg. must be an array name.\n",FuncStack[Func_idx].s_name);
                    829:                         capa_msg(MESSAGE_ERROR,tmpS);
                    830:                         errCode = 1;
                    831:                         break;
                    832:                     case S_VAR: case S_CONSTANT:
1.12      albertel  833:                         mean_vec_str = strsave( SECOND_ARGSTR(argp) );
1.10      albertel  834:                         break;
                    835:                     case IDENTIFIER:
1.12      albertel  836:                         mean_vec_str = strsave( SECOND_ARGNAME(argp) );
1.10      albertel  837:                         /*
                    838:                         resultp->s_type = S_CONSTANT;
                    839:                         resultp->s_str  = strsave("<<THE FIFTH ARG. OF THIS FUNCTION MUST BE AN ARRAY WITH DATA>>");
                    840:                         sprintf(tmpS,"%s()'s fifth arg. must be an array with data (mean array).\n",FuncStack[Func_idx].s_name);
                    841:                         capa_msg(MESSAGE_ERROR,tmpS);
                    842:                         errCode = 1;
                    843:                         */
                    844:                         break;
                    845:               }
                    846:               if(errCode == 0 ) {
                    847:                  switch( THIRD_ARGTYPE(argp) ) { /* parameter three dimen */
                    848:                     case I_VAR: case I_CONSTANT:
                    849:                            dimen = THIRD_ARGINT(argp);
                    850:                            break;
                    851:                     case R_VAR: case R_CONSTANT: 
                    852:                            dimen = (int)THIRD_ARGREAL(argp);
                    853:                            break;
                    854:                     case S_VAR: case S_CONSTANT: 
                    855:                     case IDENTIFIER:
                    856:                            resultp->s_type = S_CONSTANT;
                    857:                            resultp->s_str  = strsave("<<THE FOURTH ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                    858:                            sprintf(tmpS,"%s()'s fourth arg. must be a number.\n",FuncStack[Func_idx].s_name);
                    859:                            capa_msg(MESSAGE_ERROR,tmpS);
                    860:                            errCode = 1;
                    861:                            break;
                    862:                   }
                    863:                   if(errCode == 0 ) {  /* parameter four seed */
                    864:                     switch( FOURTH_ARGTYPE(argp) ) { /* seed */
                    865:                         case I_VAR: case I_CONSTANT:
                    866:                                   seed_str = (char *)capa_malloc(32,1);
                    867:                                   sprintf(seed_str,"%ld",FOURTH_ARGINT(argp) );
                    868:                                 break;
                    869:                          case R_VAR: case R_CONSTANT: 
                    870:                                   tmp_long = (long)FOURTH_ARGREAL(argp);
                    871:                                   seed_str = (char *)capa_malloc(32,1);
                    872:                                   sprintf(seed_str,"%ld",tmp_long);
                    873:                                 break;
                    874:                          case S_VAR: case S_CONSTANT: 
                    875:                                   seed_str = strsave(FOURTH_ARGSTR(argp));
                    876:                                 break;
                    877:                          case IDENTIFIER:
                    878:                                   resultp->s_type = S_CONSTANT;
                    879:                                   resultp->s_str  = strsave("<<THIRD ARG. OF THIS FUNCTION MUST BE A NUMBER OR STRING>>");
                    880:                                sprintf(tmpS,"%s()'s third arg. must be a number or a string.\n",FuncStack[Func_idx].s_name);
                    881:                                   capa_msg(MESSAGE_ERROR,tmpS);
                    882:                                   errCode = 1;
                    883:                                 break;
                    884:                     }
                    885:                     if(errCode == 0 ) {
                    886:                        switch( FIFTH_ARGTYPE(argp) ) { /* parameter five item_cnt */
                    887:                           case I_VAR: case I_CONSTANT:
                    888:                                   item_cnt = FIFTH_ARGINT(argp);
                    889:                                  break;
                    890:                           case R_VAR: case R_CONSTANT: 
                    891:                                   item_cnt = (int)FIFTH_ARGREAL(argp);
                    892:                                  break;
                    893:                           case S_VAR: case S_CONSTANT: 
                    894:                           case IDENTIFIER:
                    895:                                  resultp->s_type = S_CONSTANT;
                    896:                                  resultp->s_str  = strsave("<<SECOND ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                    897:                                  sprintf(tmpS,"%s()'s second arg. must be a number.\n",FuncStack[Func_idx].s_name);
                    898:                                  capa_msg(MESSAGE_ERROR,tmpS);
                    899:                                  errCode = 1;
                    900:                                  break;
                    901:                         }
                    902:                         if(errCode == 0 ) { /* array_name, clear the content of this array first */
                    903:                            switch( SIXTH_ARGTYPE(argp) ) { 
                    904:                               case I_VAR: case I_CONSTANT: 
                    905:                               case R_VAR: case R_CONSTANT: 
                    906:                                    resultp->s_type = S_CONSTANT;
                    907:                                    resultp->s_str  = strsave("<<FIRST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                    908:                                  sprintf(tmpS,"%s()'s first arg. must be a name of an array.\n",FuncStack[Func_idx].s_name);
                    909:                                    capa_msg(MESSAGE_ERROR,tmpS);
                    910:                                    errCode = 1;
                    911:                                 break;
                    912:                                case S_VAR: case S_CONSTANT:
                    913:                                    tmp_int = free_array(SIXTH_ARGSTR(argp));
                    914:                                    
                    915:                                    out_vec_str= strsave(SIXTH_ARGSTR(argp));
                    916:                                 break;
                    917:                                case IDENTIFIER:
                    918:                                    tmp_int = free_array(SIXTH_ARGNAME(argp));
                    919:                                    
                    920:                                    out_vec_str= strsave(SIXTH_ARGNAME(argp));
                    921:                                    
                    922:                                 break;
                    923:                             } /* send switch */
                    924:                           } /* end if array_name check */
                    925:                         } /* end if (item_cnt) check */
                    926:                       } /* end if (seed) check */
                    927:                     } /* end if (dimen) check */
                    928:                   } /* end if (mean_vector) check */
                    929:                   if(errCode == 0 ) { /* all the parameter checks OK */
                    930:                     r_p = gen_multivariate_normal(out_vec_str,seed_str,item_cnt,dimen,mean_vec_str,cov_vec_str);
                    931:                     capa_mfree((char *)resultp);
                    932:                     resultp = r_p;
                    933:                     
                    934:                   }
                    935:                   if( out_vec_str != NULL )   capa_mfree((char *)out_vec_str);
                    936:                   if( seed_str != NULL )      capa_mfree((char *)seed_str);
                    937:                   if( mean_vec_str != NULL )  capa_mfree((char *)mean_vec_str);
                    938:                   if( cov_vec_str != NULL )   capa_mfree((char *)cov_vec_str);
                    939:                   
                    940:         } break;
1.5       albertel  941:    case RANDOM_NORMAL_F: /* random_normal(return_array,item_cnt,seed,av,std_dev) */
                    942:    case RANDOM_BETA_F: /* random_beta(return_array,item_cnt,seed,aa,bb) */
                    943:    case RANDOM_GAMMA_F: /* random_gamma(return_array,item_cnt,seed,a,r) */
                    944:    case RANDOM_POISSON_F: /* random_poisson(return_array,item_cnt,seed,mu) */
                    945:    case RANDOM_EXPONENTIAL_F:
                    946:         /* random_exponential(return_array,item_cnt,seed,av) */
                    947:    case RANDOM_CHI_F:  /* random_chi(return_array,item_cnt,seed,df) */
                    948:    case RANDOM_NONCENTRAL_CHI_F: 
                    949:         /* random_noncentral_chi(return_array,item_cnt,seed,df,xnonc) */
                    950:         /* gen_random_by_selector(output_p,sel,seed,item_cnt,p1,p2) */
                    951:             { int      sel, item_cnt, tmp_int;
                    952:               float    para1, para2;
                    953:               char    *tmp_str;
                    954:               long     tmp_long;
                    955:               Symbol  *r_p;
                    956:               
                    957:               switch(func) { /* assigns the function selector */
                    958:                 case RANDOM_NORMAL_F:          sel = NORMAL_DIS;         break;
                    959:                 case RANDOM_BETA_F:            sel = BETA_DIS;           break;
                    960:                 case RANDOM_GAMMA_F:           sel = GAMMA_DIS;          break;
                    961:                 case RANDOM_POISSON_F:         sel = POISSON_DIS;        break;
                    962:                 case RANDOM_EXPONENTIAL_F:     sel = EXPONENTIAL_DIS;    break;
                    963:                 case RANDOM_CHI_F:             sel = CHI_DIS;            break;
                    964:                 case RANDOM_NONCENTRAL_CHI_F:  sel = NONCENTRAL_CHI_DIS; break;
                    965:               }
                    966:               switch(func) {
                    967:                 case RANDOM_NORMAL_F: 
                    968:                 case RANDOM_BETA_F:  
                    969:                 case RANDOM_GAMMA_F:  /* two-parameter functions */
1.6       albertel  970:                 case RANDOM_NONCENTRAL_CHI_F:
1.5       albertel  971:                        { errCode = 0;
                    972:                          switch( FIRST_ARGTYPE(argp) ) { /* parameter two */
                    973:                            case I_VAR: case I_CONSTANT:
                    974:                                   para2 = (float)FIRST_ARGINT(argp);
                    975:                                 break;
                    976:                            case R_VAR: case R_CONSTANT: 
                    977:                                   para2 = (float)FIRST_ARGREAL(argp);
                    978:                                 break;
                    979:                            case S_VAR: case S_CONSTANT: 
                    980:                            case IDENTIFIER:
                    981:                                   resultp->s_type = S_CONSTANT;
                    982:                                   resultp->s_str  = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                    983:                                 sprintf(tmpS,"%s()'s last arg. must be a number.\n",FuncStack[Func_idx].s_name);
                    984:                                   capa_msg(MESSAGE_ERROR,tmpS);
                    985:                                   errCode = 1;
                    986:                                 break;
                    987:                          }
                    988:                          if(errCode == 0 ) {
                    989:                            switch( SECOND_ARGTYPE(argp) ) { /* parameter one */
                    990:                            case I_VAR: case I_CONSTANT:
                    991:                                   para1 = (float)SECOND_ARGINT(argp);
                    992:                                 break;
                    993:                            case R_VAR: case R_CONSTANT: 
                    994:                                   para1 = (float)SECOND_ARGREAL(argp);
                    995:                                 break;
                    996:                            case S_VAR: case S_CONSTANT: 
                    997:                            case IDENTIFIER:
                    998:                                   resultp->s_type = S_CONSTANT;
                    999:                                   resultp->s_str  = strsave("<<FOURTH ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                   1000:                                sprintf(tmpS,"%s()'s fourth arg. must be a number.\n",FuncStack[Func_idx].s_name);
                   1001:                                   capa_msg(MESSAGE_ERROR,tmpS);
                   1002:                                   errCode = 1;
                   1003:                                 break;
                   1004:                            }
                   1005:                            if(errCode == 0 ) {
                   1006:                              switch( THIRD_ARGTYPE(argp) ) { /* seed */
                   1007:                                case I_VAR: case I_CONSTANT:
                   1008:                                   tmp_str = (char *)capa_malloc(32,1);
                   1009:                                   sprintf(tmp_str,"%ld",THIRD_ARGINT(argp) );
                   1010:                                 break;
                   1011:                                case R_VAR: case R_CONSTANT: 
                   1012:                                   tmp_long = (long)THIRD_ARGREAL(argp);
                   1013:                                   tmp_str = (char *)capa_malloc(32,1);
                   1014:                                   sprintf(tmp_str,"%ld",tmp_long);
                   1015:                                 break;
                   1016:                                case S_VAR: case S_CONSTANT: 
                   1017:                                   tmp_str = strsave(THIRD_ARGSTR(argp));
                   1018:                                 break;
                   1019:                                case IDENTIFIER:
                   1020:                                   resultp->s_type = S_CONSTANT;
                   1021:                                   resultp->s_str  = strsave("<<THIRD ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                   1022:                                sprintf(tmpS,"%s()'s third arg. must be a number.\n",FuncStack[Func_idx].s_name);
                   1023:                                   capa_msg(MESSAGE_ERROR,tmpS);
                   1024:                                   errCode = 1;
                   1025:                                 break;
                   1026:                              }
                   1027:                              if(errCode == 0 ) {
                   1028:                                switch( FOURTH_ARGTYPE(argp) ) { /* item_cnt */
                   1029:                                  case I_VAR: case I_CONSTANT:
                   1030:                                         item_cnt = FOURTH_ARGINT(argp);
                   1031:                                       break;
                   1032:                                  case R_VAR: case R_CONSTANT: 
                   1033:                                         item_cnt = (int)FOURTH_ARGREAL(argp);
                   1034:                                       break;
                   1035:                                  case S_VAR: case S_CONSTANT: 
                   1036:                                  case IDENTIFIER:
                   1037:                                         resultp->s_type = S_CONSTANT;
                   1038:                                         resultp->s_str  = strsave("<<SECOND ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                   1039:                                   sprintf(tmpS,"%s()'s second arg. must be a number.\n",FuncStack[Func_idx].s_name);
                   1040:                                         capa_msg(MESSAGE_ERROR,tmpS);
                   1041:                                         errCode = 1;
                   1042:                                       break;
                   1043:                                }
                   1044:                                if(errCode == 0 ) {
                   1045:                                  switch( FIFTH_ARGTYPE(argp) ) { /* array_name, clear the content of this array first */
                   1046:                                    case I_VAR: case I_CONSTANT: 
                   1047:                                    case R_VAR: case R_CONSTANT: 
                   1048:                                          resultp->s_type = S_CONSTANT;
                   1049:                                          resultp->s_str  = strsave("<<FIRST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                   1050:                                  sprintf(tmpS,"%s()'s first arg. must be a name of an array.\n",FuncStack[Func_idx].s_name);
                   1051:                                          capa_msg(MESSAGE_ERROR,tmpS);
                   1052:                                          errCode = 1;
                   1053:                                          break;
                   1054:                                    case S_VAR: case S_CONSTANT:
                   1055:                                          tmp_int = free_array(FIFTH_ARGSTR(argp));
                   1056:                                          r_p = gen_random_by_selector(FIFTH_ARGSTR(argp),sel,tmp_str,item_cnt,para1,para2);
                   1057:                                          capa_mfree((char *)resultp);
                   1058:                                          resultp = r_p;
                   1059:                                          break;
                   1060:                                    case IDENTIFIER:
                   1061:                                          tmp_int = free_array(FIFTH_ARGNAME(argp));
1.6       albertel 1062:                                          r_p = gen_random_by_selector(FIFTH_ARGNAME(argp),sel,tmp_str,item_cnt,para1,para2);
1.5       albertel 1063:                                          capa_mfree((char *)resultp);
                   1064:                                          resultp = r_p;
                   1065:                                          break;
                   1066:                                  } 
                   1067:                                } /* the fourth argument of this function (item_cnt) */
                   1068:                              } /* the third argument of this function (seed) */
                   1069:                            } /* the second argument of this function (paramenter one) */
                   1070:                          } /* the first argument of this function (parameter two) */
                   1071: 
                   1072:                        } 
                   1073:                      break;
                   1074:                 case RANDOM_POISSON_F:
                   1075:                 case RANDOM_EXPONENTIAL_F:
1.6       albertel 1076:                 case RANDOM_CHI_F: /* one parameter functions */
1.5       albertel 1077:                        { errCode = 0;
                   1078:                          switch( FIRST_ARGTYPE(argp) ) { /* parameter one */
                   1079:                            case I_VAR: case I_CONSTANT:
1.6       albertel 1080:                                   para1 = (float)FIRST_ARGINT(argp);
1.5       albertel 1081:                                 break;
                   1082:                            case R_VAR: case R_CONSTANT: 
1.6       albertel 1083:                                   para1 = (float)FIRST_ARGREAL(argp);
1.5       albertel 1084:                                 break;
                   1085:                            case S_VAR: case S_CONSTANT: 
                   1086:                            case IDENTIFIER:
                   1087:                                   resultp->s_type = S_CONSTANT;
                   1088:                                   resultp->s_str  = strsave("<<LAST ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                   1089:                                 sprintf(tmpS,"%s()'s last arg. must be a number.\n",FuncStack[Func_idx].s_name);
                   1090:                                   capa_msg(MESSAGE_ERROR,tmpS);
                   1091:                                   errCode = 1;
                   1092:                                 break;
                   1093:                          }
                   1094:                          if(errCode == 0 ) {
                   1095:                            switch( SECOND_ARGTYPE(argp) ) { /* seed */
                   1096:                                case I_VAR: case I_CONSTANT:
                   1097:                                   tmp_str = (char *)capa_malloc(32,1);
                   1098:                                   sprintf(tmp_str,"%ld",SECOND_ARGINT(argp) );
                   1099:                                 break;
                   1100:                                case R_VAR: case R_CONSTANT: 
                   1101:                                   tmp_long = (long)SECOND_ARGREAL(argp);
                   1102:                                   tmp_str = (char *)capa_malloc(32,1);
                   1103:                                   sprintf(tmp_str,"%ld",tmp_long);
                   1104:                                 break;
                   1105:                                case S_VAR: case S_CONSTANT: 
                   1106:                                   tmp_str = strsave(SECOND_ARGSTR(argp));
                   1107:                                 break;
                   1108:                                case IDENTIFIER:
                   1109:                                   resultp->s_type = S_CONSTANT;
                   1110:                                   resultp->s_str  = strsave("<<THIRD ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                   1111:                                sprintf(tmpS,"%s()'s third arg. must be a number.\n",FuncStack[Func_idx].s_name);
                   1112:                                   capa_msg(MESSAGE_ERROR,tmpS);
                   1113:                                   errCode = 1;
                   1114:                                 break;
                   1115:                            }
                   1116:                            if(errCode == 0 ) {
                   1117:                              switch( THIRD_ARGTYPE(argp) ) { /* item_cnt */
                   1118:                                  case I_VAR: case I_CONSTANT:
                   1119:                                         item_cnt = THIRD_ARGINT(argp);
                   1120:                                       break;
                   1121:                                  case R_VAR: case R_CONSTANT: 
                   1122:                                         item_cnt = (int)THIRD_ARGREAL(argp);
                   1123:                                       break;
                   1124:                                  case S_VAR: case S_CONSTANT: 
                   1125:                                  case IDENTIFIER:
                   1126:                                         resultp->s_type = S_CONSTANT;
                   1127:                                         resultp->s_str  = strsave("<<SECOND ARG. OF THIS FUNCTION MUST BE A NUMBER>>");
                   1128:                                   sprintf(tmpS,"%s()'s second arg. must be a number.\n",FuncStack[Func_idx].s_name);
                   1129:                                         capa_msg(MESSAGE_ERROR,tmpS);
                   1130:                                         errCode = 1;
                   1131:                                       break;
                   1132:                              }
                   1133:                              if(errCode == 0 ) {
                   1134:                                  switch( FOURTH_ARGTYPE(argp) ) { /* array_name, clear the content of this array first */
                   1135:                                    case I_VAR: case I_CONSTANT: 
                   1136:                                    case R_VAR: case R_CONSTANT: 
                   1137:                                          resultp->s_type = S_CONSTANT;
                   1138:                                          resultp->s_str  = strsave("<<FIRST ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                   1139:                                  sprintf(tmpS,"%s()'s first arg. must be a name of an array.\n",FuncStack[Func_idx].s_name);
                   1140:                                          capa_msg(MESSAGE_ERROR,tmpS);
                   1141:                                          errCode = 1;
                   1142:                                          break;
                   1143:                                    case S_VAR: case S_CONSTANT:
                   1144:                                          tmp_int = free_array(FOURTH_ARGSTR(argp));
                   1145:                                          r_p = gen_random_by_selector(FOURTH_ARGSTR(argp),sel,tmp_str,item_cnt,para1,para2);
                   1146:                                          capa_mfree((char *)resultp);
                   1147:                                          resultp = r_p;
                   1148:                                          break;
                   1149:                                    case IDENTIFIER:
                   1150:                                          tmp_int = free_array(FOURTH_ARGNAME(argp));
1.6       albertel 1151:                                          r_p = gen_random_by_selector(FOURTH_ARGNAME(argp),sel,tmp_str,item_cnt,para1,para2);
1.5       albertel 1152:                                          capa_mfree((char *)resultp);
                   1153:                                          resultp = r_p;
                   1154:                                          break;
                   1155:                                  } 
                   1156:                                
                   1157:                              } /* the third argument of this function (seed) */
                   1158:                            } /* the second argument of this function (paramenter one) */
                   1159:                          } /* the first argument of this function (parameter two) */
                   1160:                        }
                   1161:                      break;
                   1162:               } /* end second switch */
                   1163:             } break;
1.12      albertel 1164:    case ARRAY_MOMENTS_F: /*  array_moments(output,input) */
1.1       albertel 1165:             { 
                   1166:               char       *tmp_input;
                   1167:               Symbol     *r_p;
                   1168:               
                   1169:               switch( FIRST_ARGTYPE(argp) ) {
                   1170:                 case I_VAR: case I_CONSTANT:
                   1171:                 case R_VAR: case R_CONSTANT: 
                   1172:                       resultp->s_type = S_CONSTANT;
                   1173:                       resultp->s_str  = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                   1174:                       sprintf(tmpS,"array_moments()'s arg. must be a name of an array.\n");
                   1175:                       capa_msg(MESSAGE_ERROR,tmpS);
                   1176:                       errCode = 1;
                   1177:                       break;
                   1178:                 case S_VAR: case S_CONSTANT: 
                   1179:                        tmp_input = strsave(FIRST_ARGSTR(argp));
                   1180:                        errCode = 0;
                   1181:                        break;
                   1182:                 case IDENTIFIER:
                   1183:                        tmp_input = strsave(FIRST_ARGNAME(argp));
                   1184:                        errCode = 0;
                   1185:                        break;
                   1186:               }
                   1187:               if( errCode == 0 ) {
                   1188:                 switch( SECOND_ARGTYPE(argp) ) {
                   1189:                   case I_VAR: case I_CONSTANT: 
                   1190:                   case R_VAR: case R_CONSTANT: 
                   1191:                       resultp->s_type = S_CONSTANT;
                   1192:                       resultp->s_str  = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                   1193:                       sprintf(tmpS,"array_moments()'s arg. must be a name of an array.\n");
                   1194:                       capa_msg(MESSAGE_ERROR,tmpS);
                   1195:                       errCode = 1;
                   1196:                       break;
                   1197:                   case S_VAR: case S_CONSTANT:
                   1198:                       r_p = array_moments(SECOND_ARGSTR(argp),tmp_input);
                   1199:                       capa_mfree((char *)tmp_input);
                   1200:                       /* fprintf(stdout,"DONE array_moments()\n"); fflush(stdout); */
                   1201:                       break;
                   1202:                   case IDENTIFIER:
                   1203:                       r_p = array_moments(SECOND_ARGNAME(argp),tmp_input);
                   1204:                       capa_mfree((char *)tmp_input);
                   1205:                       
                   1206:                       break;
                   1207:                 }
                   1208:                 if(errCode == 0 ) {
                   1209:                   capa_mfree((char *)resultp);
                   1210:                   resultp = r_p;
                   1211:                 }
                   1212:               }
                   1213:               
                   1214:             } break;
                   1215:     case ARRAY_SORTED_INDEX_F:  /* array_sorted_index(array_name_str, sort_type) */
                   1216:             {              
                   1217:               switch( FIRST_ARGTYPE(argp) ) {
                   1218:                 case I_VAR: case I_CONSTANT: 
                   1219:                        switch( FIRST_ARGINT(argp) ) {
                   1220:                            case  ASCEND_SORT:     break;
                   1221:                            case  DESCEND_SORT:    break;
                   1222:                            case  NUMERICAL_SORT:  break;
                   1223:                            default: break;
                   1224:                        }
                   1225:                        
                   1226:                        break;
                   1227:                 case R_VAR: case R_CONSTANT: break;
                   1228:                 case S_VAR: case S_CONSTANT: 
                   1229:                        
                   1230:                        
                   1231:                        break;
                   1232:               }
                   1233:               resultp->s_type = S_CONSTANT;
                   1234:               resultp->s_str  = strsave("NOT YET");
                   1235:             } break;
                   1236:     
1.4       albertel 1237:     case INIT_ARRAY_F:
                   1238:             { int         rr;
                   1239:               
                   1240:               switch( FIRST_ARGTYPE(argp) ) {
                   1241:                 case I_VAR: case I_CONSTANT: 
                   1242:                 case R_VAR: case R_CONSTANT: 
                   1243:                       resultp->s_type = S_CONSTANT;
                   1244:                       resultp->s_str  = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                   1245:                       sprintf(tmpS,"init_array()'s arg. must be a name of an array.\n");
                   1246:                       capa_msg(MESSAGE_ERROR,tmpS);
                   1247:                       break;
                   1248:                 case S_VAR: case S_CONSTANT: /* allows the use of init_array(array[1]) which array[1]="another" */
                   1249:                       rr = free_array(FIRST_ARGSTR(argp));
                   1250:                       resultp->s_type = I_CONSTANT;
                   1251:                       resultp->s_int  = rr;
                   1252:                       break;
                   1253:                 case IDENTIFIER:
                   1254:                       rr = free_array(FIRST_ARGNAME(argp));
                   1255:                       resultp->s_type = I_CONSTANT;
                   1256:                       resultp->s_int  = rr;
                   1257:                       break;
                   1258:               }
                   1259:             } break;       
1.1       albertel 1260:     case ARRAY_MAX_F: 
                   1261:     case ARRAY_MIN_F:
                   1262:             { int         min;
                   1263:               Symbol     *r_p;
                   1264:               
                   1265:               min = ((func==ARRAY_MIN_F)? 1 : 0);           
                   1266:               switch( FIRST_ARGTYPE(argp) ) {
                   1267:                 case I_VAR: case I_CONSTANT: 
                   1268:                 case R_VAR: case R_CONSTANT: 
                   1269:                       resultp->s_type = S_CONSTANT;
                   1270:                       resultp->s_str  = strsave("<<ARG. OF THIS FUNCTION MUST BE AN ARRAY NAME>>");
                   1271:                       sprintf(tmpS,"%s()'s arg. must be a name of an array.\n",(min ? "min" : "max"));
                   1272:                       capa_msg(MESSAGE_ERROR,tmpS);
                   1273:                       break;
                   1274:                 case S_VAR: case S_CONSTANT: /* this allows the use of min(array[1]) which array[1]="another" */
                   1275:                       r_p = array_min_max(FIRST_ARGSTR(argp),min);
                   1276:                       if( r_p == NULL ) { /* array name is not in array tree */
                   1277:                         resultp->s_type = S_CONSTANT;
                   1278:                         resultp->s_str  = strsave("<<STRING ARRAY NAME IS NOT YET DEFINED!>>");
                   1279:                       } else {
                   1280:                       /*
                   1281:                        fprintf(stdout,"min_max():: STR arg. R=%g\n",r_p->s_real); fflush(stdout);
                   1282:                       */
                   1283:                         capa_mfree((char *)resultp);
                   1284:                         resultp = r_p;
                   1285:                       }
                   1286:                       break;
                   1287:                 case IDENTIFIER:
                   1288:                       r_p = array_min_max(FIRST_ARGNAME(argp),min);
                   1289:                       if( r_p == NULL ) { /* array name is not in array tree */
                   1290:                         /* fprintf(stdout,"min_max() return NULL\n"); fflush(stdout); */
                   1291:                         resultp->s_type = S_CONSTANT;
                   1292:                         resultp->s_str  = strsave("<<ARRAY NAME IS NOT YET DEFINED!>>");
                   1293:                       } else {
                   1294:                         /*
                   1295:                          fprintf(stdout,"min_max():: ID arg. R=%g\n",r_p->s_real); fflush(stdout);
                   1296:                         */
                   1297:                         capa_mfree((char *)resultp);
                   1298:                         resultp = r_p;
                   1299:                       }
                   1300:                       break;
                   1301:               }
                   1302:             } break;       
                   1303:     case SIN_F:
                   1304:     case COS_F:
                   1305:     case TAN_F:
                   1306:     case ASIN_F:
                   1307:     case ACOS_F:
                   1308:     case ATAN_F:
                   1309:     case SINH_F:
                   1310:     case COSH_F:
                   1311:     case TANH_F:
                   1312:     case ASINH_F:
                   1313:     case ACOSH_F:
                   1314:     case ATANH_F:
                   1315:     case J_ZERO_F:
                   1316:     case J_ONE_F:
                   1317:     case Y_ZERO_F:
                   1318:     case Y_ONE_F:
                   1319:     case LOG_F:
                   1320:     case LOG_TEN_F:
                   1321:     case EXP_F:
                   1322:     case ERF_F:
                   1323:     case ERFC_F:
                   1324:     case ABS_F:
                   1325:     case SQRT_F:
                   1326:     case FLOOR_F:
                   1327:     case CEIL_F:
                   1328:     case SGN_F:{  if( (FIRST_ARGTYPE(argp) == S_VAR ) || (FIRST_ARGTYPE(argp) == S_CONSTANT ) ) {
                   1329:                     sprintf(aline,"<<ARG TYPE MISMATCH>>");
                   1330:                     resultp->s_type = S_CONSTANT;
                   1331:                     resultp->s_str = strsave(aline);
                   1332:                     sprintf(tmpS,"function %s() cannot accept string as argument.\n", FuncStack[Func_idx].s_name);
                   1333:                     capa_msg(MESSAGE_ERROR,tmpS);
                   1334:                   } else {
                   1335:                     if( (FIRST_ARGTYPE(argp) == I_VAR ) || (FIRST_ARGTYPE(argp) == I_CONSTANT ) ) {
                   1336:                       tmpA = (double)FIRST_ARGINT(argp);
                   1337:                     } else {
                   1338:                       tmpA = (double)FIRST_ARGREAL(argp);
                   1339:                     }
                   1340:                     resultp->s_type = R_CONSTANT;
                   1341:                     switch(func) {
                   1342:                        case SIN_F:     resultp->s_real = sin(tmpA); break;
                   1343:                        case COS_F:     resultp->s_real = cos(tmpA); break;
                   1344:                        case TAN_F:     resultp->s_real = tan(tmpA); break;
                   1345:                        case ASIN_F:    if(fabs(tmpA) <= 1.0) {
                   1346:                                          resultp->s_real = asin(tmpA);
                   1347:                                        } else {
                   1348:                                          resultp->s_type = S_CONSTANT;
                   1349:                                          sprintf(aline,"<<ARG OUT OF BOUND>>");
                   1350:                                          resultp->s_str = strsave(aline);
                   1351:                                          sprintf(tmpS, "asin()'s arg. is not in the range of [-1.0,+1.0].\n");
                   1352:                                          capa_msg(MESSAGE_ERROR,tmpS);
                   1353:                                        }
                   1354:                                        break;
                   1355:                        case ACOS_F:    if(fabs(tmpA) <= 1.0) {
                   1356:                                          resultp->s_real = acos(tmpA); 
                   1357:                                        } else {
                   1358:                                          resultp->s_type = S_CONSTANT;
                   1359:                                          sprintf(aline,"<<ARG OUT OF BOUND>>");
                   1360:                                          resultp->s_str = strsave(aline);
                   1361:                                          sprintf(tmpS,"acos()'s arg. is not in the range of [-1.0,+1.0].\n");
                   1362:                                          capa_msg(MESSAGE_ERROR,tmpS);
                   1363:                                        }
                   1364:                                        break;
                   1365:                        case ATAN_F:    resultp->s_real = atan(tmpA);  break;
                   1366:                        case SINH_F:    resultp->s_real = sinh(tmpA);  break;
                   1367:                        case COSH_F:    resultp->s_real = cosh(tmpA);  break;
                   1368:                        case TANH_F:    resultp->s_real = tanh(tmpA);  break;
                   1369:                        case ASINH_F:   resultp->s_real = asinh(tmpA); break;
                   1370:                        case ACOSH_F:   resultp->s_real = acosh(tmpA); break;
                   1371:                        case ATANH_F:   resultp->s_real = atanh(tmpA); break;
                   1372:                        case J_ZERO_F:  resultp->s_real = j0(tmpA);    break;
                   1373:                        case J_ONE_F:   resultp->s_real = j1(tmpA);    break;
                   1374:                        case Y_ZERO_F:  resultp->s_real = y0(tmpA);    break;
                   1375:                        case Y_ONE_F:   resultp->s_real = y1(tmpA);    break;
                   1376:                        case LOG_F:     resultp->s_real = log(tmpA);   break;
                   1377:                        case LOG_TEN_F: resultp->s_real = log10(tmpA); break;
                   1378:                        case EXP_F:     resultp->s_real = exp(tmpA);   break;
                   1379:                        case ERF_F:     resultp->s_real = erf(tmpA);   break;
                   1380:                        case ERFC_F:    resultp->s_real = erfc(tmpA);  break;
                   1381:                        case ABS_F:     resultp->s_real = fabs(tmpA);  break;
                   1382:                        case SQRT_F:    if( tmpA >= 0.0) {
                   1383:                                          resultp->s_real = sqrt(tmpA);
                   1384:                                        } else {
                   1385:                                          resultp->s_type = S_CONSTANT;
                   1386:                                          sprintf(aline,"<<ARG OUT OF BOUND>>");
                   1387:                                          resultp->s_str = strsave(aline);
                   1388:                                          sprintf(tmpS, "sqrt()'s arg. is not in the range of [0.0,+Inf].\n");
                   1389:                                          capa_msg(MESSAGE_ERROR,tmpS);
                   1390:                                        }
                   1391:                                        break;
                   1392:                        case FLOOR_F:   resultp->s_type = I_CONSTANT;
                   1393:                                        resultp->s_int = (long)floor(tmpA);  break;
                   1394:                        case CEIL_F:    resultp->s_type = I_CONSTANT;
                   1395:                                        resultp->s_int = (long)ceil(tmpA);  break;
                   1396:                        case SGN_F:     resultp->s_type = I_CONSTANT;
                   1397:                                        resultp->s_int = (int)SGN(tmpA);  break;
                   1398:                     }
                   1399:                   }
                   1400:                 }
                   1401:                 break;
                   1402:     case ATANTWO_F:
                   1403:     case J_N_F:
                   1404:     case Y_N_F:
                   1405:     case POW_F: {    noError = 1;
                   1406:                      switch(FIRST_ARGTYPE(argp)) {
                   1407:                       case I_VAR:
                   1408:                       case I_CONSTANT: tmpA = (double)FIRST_ARGINT(argp); break;
                   1409:                       case R_VAR:
                   1410:                       case R_CONSTANT: tmpA = FIRST_ARGREAL(argp); break;
                   1411:                       case S_VAR:
                   1412:                       case S_CONSTANT: noError = 0;
                   1413:                                        resultp->s_str = strsave("<<MIS TYPE>>"); 
                   1414:                                        sprintf(tmpS,"%s()'s second arg. cannot be string.\n",FuncStack[Func_idx].s_name);
                   1415:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1416:                                        break;
                   1417:                      }
                   1418:                      switch(SECOND_ARGTYPE(argp)) {
                   1419:                       case I_VAR:
                   1420:                       case I_CONSTANT: tmpB = (double)SECOND_ARGINT(argp); break;
                   1421:                       case R_VAR:
                   1422:                       case R_CONSTANT: tmpB = SECOND_ARGREAL(argp); break;
                   1423:                       case S_VAR:
                   1424:                       case S_CONSTANT: noError = 0;
                   1425:                                        resultp->s_str = strsave("<<MIS TYPE>>"); 
                   1426:                                        sprintf(tmpS,"%s()'s first arg. cannot be string.\n",FuncStack[Func_idx].s_name);
                   1427:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1428:                                        break;
                   1429:                      }
                   1430: 		     if ( POW_F == func ) {
                   1431: 		       if ((!(((double)((int)tmpA)) == tmpA)) && (tmpB < 0.0)) {
                   1432: 			 resultp->s_str = strsave("<<ARG OUT OF BOUND>>"); 
                   1433: 			 sprintf(tmpS,
                   1434: 				 "%s()'s arguments would result in a complex number.\n",
                   1435: 				 FuncStack[Func_idx].s_name);
                   1436: 			 capa_msg(MESSAGE_ERROR,tmpS);
                   1437: 			 noError=0;
                   1438: 		       }
                   1439: 		     }
                   1440:                      if(noError) {
                   1441:                        resultp->s_type = R_CONSTANT;
                   1442:                        switch( func ) {
                   1443:                          case J_N_F: resultp->s_real = jn((int)tmpB, tmpA); break;
                   1444:                          case Y_N_F: resultp->s_real = yn((int)tmpB, tmpA); break;
                   1445:                          case POW_F: resultp->s_real = pow(tmpB, tmpA); break;
                   1446:                          case ATANTWO_F: resultp->s_real = atan2(tmpB, tmpA); break;
                   1447:                        }
                   1448:                      }else {
                   1449:                        resultp->s_type = S_CONSTANT;
                   1450:                      }
                   1451:                      
                   1452:                 }
                   1453:                 break;
                   1454:     case TEX_F: { if (Parsemode_f != TeX_MODE) {
1.6       albertel 1455: #ifdef TTH
                   1456: #define CHARLEN 1024*1024
                   1457: 		     {
                   1458: 		       char *html;
                   1459: 		       if ( (Parsemode_f==HTML_MODE) && 
                   1460: 			    ((SECOND_ARGTYPE(argp) == S_VAR) || 
                   1461: 			     (SECOND_ARGTYPE(argp) == S_CONSTANT))
                   1462: 			    ) {
                   1463: 		       printf("Hi There %s\n",SECOND_ARGSTR(argp));
                   1464: 		       resultp->s_type = SECOND_ARGTYPE(argp);
                   1465: 			 if(tth_err) { free(tth_err); tth_err=NULL; }
                   1466: 			 textohtmldyn(SECOND_ARGSTR(argp),&html,&tth_err,CHARLEN);
                   1467: 			 if(html) {
                   1468: 			   resultp->s_str=strsave(html);
                   1469: 			   capa_mfree(html);
                   1470: 			 } else {
                   1471: 			   resultp->s_str=strsave("");
                   1472: 			 }
                   1473: 			 break;
                   1474: 		       }
                   1475: 		     }
                   1476: #undef CHARLEN
                   1477: #endif
1.1       albertel 1478:                      resultp->s_type =  FIRST_ARGTYPE(argp);
                   1479:                      switch(FIRST_ARGTYPE(argp)) {
                   1480:                       case I_VAR:
                   1481:                       case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp); break;
                   1482:                       case R_VAR:
                   1483:                       case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
                   1484:                       case S_VAR:
                   1485:                       case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
                   1486:                      }
                   1487:                   } else {
                   1488:                      resultp->s_type =  SECOND_ARGTYPE(argp);
                   1489:                      switch(SECOND_ARGTYPE(argp)) {
                   1490:                       case I_VAR:
                   1491:                       case I_CONSTANT: resultp->s_int = SECOND_ARGINT(argp); break;
                   1492:                       case R_VAR:
                   1493:                       case R_CONSTANT: resultp->s_real = SECOND_ARGREAL(argp); break;
                   1494:                       case S_VAR:
                   1495:                       case S_CONSTANT: resultp->s_str = strsave(SECOND_ARGSTR(argp)); break;
                   1496:                      }
                   1497:                   }
                   1498:                 }       break;
                   1499:     case VAR_IN_TEX_F:{
                   1500:                   
                   1501:                   if (Parsemode_f == TeX_MODE) {
                   1502:                      resultp->s_type =  FIRST_ARGTYPE(argp);
                   1503:                      
                   1504:                      switch(FIRST_ARGTYPE(argp)) {
                   1505:                       case I_VAR:
                   1506:                       case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp); break;
                   1507:                       case R_VAR:
                   1508:                       case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
                   1509:                       case S_VAR:
                   1510:                       case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
                   1511:                      }
                   1512:                   } else {
                   1513:                      resultp->s_type =  S_CONSTANT;
                   1514:                      resultp->s_str = strsave("");
                   1515:                      
                   1516:                   }
                   1517:                 }  break;
                   1518:     case HTML_F: {  if (Parsemode_f == HTML_MODE) {
                   1519:                       resultp->s_type =  FIRST_ARGTYPE(argp);
                   1520:                       switch(FIRST_ARGTYPE(argp)) {
                   1521:                         case I_VAR:
                   1522:                         case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp);   break;
                   1523:                         case R_VAR:
                   1524:                         case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
                   1525:                         case S_VAR:
                   1526:                         case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
                   1527:                       }
                   1528:                     } else {
                   1529:                       resultp->s_type =  S_CONSTANT;
                   1530:                       resultp->s_str = strsave("");
                   1531:                     }
                   1532:                     /* printf("HTML:%s\n",resultp->s_str); */
                   1533:                 }   break;
                   1534:     case WEB_F:
                   1535:     case FORMAT_F: {  /*   web(ASCII,TeX,HTML)      */
                   1536:                     if( argc == 3 ) {
                   1537:                       switch(Parsemode_f) {
                   1538:                         case HTML_MODE: {
                   1539:                           resultp->s_type =  FIRST_ARGTYPE(argp);
                   1540:                             switch(FIRST_ARGTYPE(argp)) {
                   1541:                               case I_VAR:
                   1542:                               case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp);   break;
                   1543:                               case R_VAR:
                   1544:                               case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
                   1545:                               case S_VAR:
                   1546:                               case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
                   1547:                             }
                   1548:                           }  break;
                   1549:                         case TeX_MODE: {
                   1550:                           resultp->s_type =  SECOND_ARGTYPE(argp);
                   1551:                             switch(SECOND_ARGTYPE(argp)) {
                   1552:                               case I_VAR:
                   1553:                               case I_CONSTANT: resultp->s_int = SECOND_ARGINT(argp); break;
                   1554:                               case R_VAR:
                   1555:                               case R_CONSTANT: resultp->s_real = SECOND_ARGREAL(argp); break;
                   1556:                               case S_VAR:
                   1557:                               case S_CONSTANT: resultp->s_str = strsave(SECOND_ARGSTR(argp)); break;
                   1558:                             }
                   1559:                           }  break;
                   1560:                         default:       {
                   1561:                           resultp->s_type =  THIRD_ARGTYPE(argp);
                   1562:                             switch(THIRD_ARGTYPE(argp)) {
                   1563:                               case I_VAR:
                   1564:                               case I_CONSTANT: resultp->s_int = THIRD_ARGINT(argp); break;
                   1565:                               case R_VAR:
                   1566:                               case R_CONSTANT: resultp->s_real = THIRD_ARGREAL(argp); break;
                   1567:                               case S_VAR:
                   1568:                               case S_CONSTANT: resultp->s_str = strsave(THIRD_ARGSTR(argp)); break;
                   1569:                             }
                   1570:                           }  break;
                   1571:                       }
                   1572:                     } else {  /* argc == 2 */
                   1573:                       switch(Parsemode_f) {
                   1574:                         case TeX_MODE: {
                   1575:                           resultp->s_type =  FIRST_ARGTYPE(argp);
                   1576:                             switch(FIRST_ARGTYPE(argp)) {
                   1577:                               case I_VAR:
                   1578:                               case I_CONSTANT: resultp->s_int = FIRST_ARGINT(argp);   break;
                   1579:                               case R_VAR:
                   1580:                               case R_CONSTANT: resultp->s_real = FIRST_ARGREAL(argp); break;
                   1581:                               case S_VAR:
                   1582:                               case S_CONSTANT: resultp->s_str = strsave(FIRST_ARGSTR(argp)); break;
                   1583:                             }
                   1584:                           }  break;
                   1585:                         default :      {
                   1586:                           resultp->s_type =  SECOND_ARGTYPE(argp);
                   1587:                             switch(SECOND_ARGTYPE(argp)) {
                   1588:                               case I_VAR:
                   1589:                               case I_CONSTANT: resultp->s_int = SECOND_ARGINT(argp); break;
                   1590:                               case R_VAR:
                   1591:                               case R_CONSTANT: resultp->s_real = SECOND_ARGREAL(argp); break;
                   1592:                               case S_VAR:
                   1593:                               case S_CONSTANT: resultp->s_str = strsave(SECOND_ARGSTR(argp)); break;
                   1594:                             }
                   1595:                           }  break;
                   1596:                       }
                   1597:                     }
                   1598:                 }   break;
                   1599:     case FACTORIAL_F: { 
                   1600:                      int                 ii;
                   1601:                      unsigned long long  l_fac;
                   1602:                      double              d_fac;
                   1603:                      
                   1604:                      switch(FIRST_ARGTYPE(argp)) {
                   1605:                       case I_VAR:
                   1606:                       case I_CONSTANT: {
                   1607:                               if( FIRST_ARGINT(argp) < 0 ) {
                   1608:                                 sprintf(aline,"<<FACTORIAL ERROR>>");
                   1609:                                 resultp->s_type = S_CONSTANT;
                   1610:                                 resultp->s_str = strsave(aline);
                   1611:                                 sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n",FuncStack[Func_idx].s_name);
                   1612:                                 capa_msg(MESSAGE_ERROR,tmpS);
                   1613:                               } else {
1.14      albertel 1614:                                 if( FIRST_ARGINT(argp) <= 12 ) {
1.1       albertel 1615:                                   resultp->s_type =  I_CONSTANT;
                   1616:                                   l_fac = 1;
                   1617:                                   for(ii=2; ii <= FIRST_ARGINT(argp); ii++) { l_fac *= ii;  }
                   1618:                                   resultp->s_int = l_fac;
                   1619:                                 } else {
                   1620:                                   resultp->s_type =  R_CONSTANT;
                   1621:                                   d_fac = 362880.0;
                   1622:                                   for(ii=10; ii <= FIRST_ARGINT(argp); ii++) { d_fac *= ii; }
                   1623:                                   resultp->s_real = d_fac;
                   1624:                                 }
                   1625:                               }
                   1626:                             }
                   1627:                             break;
                   1628:                       case R_VAR:
                   1629:                       case R_CONSTANT: {
                   1630:                               if( FIRST_ARGREAL(argp) < 0.0 ) {
                   1631:                                 sprintf(aline,"<<FACTORIAL ERROR>>");
                   1632:                                 resultp->s_type = S_CONSTANT;
                   1633:                                 resultp->s_str = strsave(aline);
                   1634:                                 sprintf(tmpS,"%s()'s arg. cannot be less than zero.\n", FuncStack[Func_idx].s_name);
                   1635:                                 capa_msg(MESSAGE_ERROR,tmpS);
                   1636:                               } else {
1.13      albertel 1637:                                 if( FIRST_ARGREAL(argp) <= 13.0 ) {
1.1       albertel 1638:                                   resultp->s_type =  I_CONSTANT;
                   1639:                                   l_fac = 1;
                   1640:                                   for(ii=2; ii <= FIRST_ARGREAL(argp); ii++)  { l_fac *= ii; }
                   1641:                                   resultp->s_int = l_fac;
                   1642:                                 } else {
                   1643:                                   resultp->s_type =  R_CONSTANT;
                   1644:                                   d_fac = 362880.0;
                   1645:                                   for(ii=10; ii <= FIRST_ARGREAL(argp); ii++) { d_fac *= ii; }
                   1646:                                   resultp->s_real = d_fac;
                   1647:                                 }
                   1648:                               }
                   1649:                             }
                   1650:                             break;
                   1651:                       case S_VAR:
                   1652:                       case S_CONSTANT: {
                   1653:                               sprintf(aline,"<<FACTORIAL ERROR>>");
                   1654:                               resultp->s_type = S_CONSTANT;
                   1655:                               resultp->s_str = strsave(aline);
                   1656:                               sprintf(tmpS,"%s()'s arg. cannot be of string type.\n",FuncStack[Func_idx].s_name);
                   1657:                               capa_msg(MESSAGE_ERROR,tmpS);
                   1658:                             }
                   1659:                             break;
                   1660:                     }
                   1661:                 }       break;
                   1662:     case MOD_F:         break;
                   1663:     case REMAINDER_F:   break;
                   1664:     case MAX_F:
                   1665:     case MIN_F: {  int  ii, idx, type;
                   1666:     
                   1667:                    tmpArgp = argp;
                   1668:                    tmpA = ((func == MIN_F)? MAX_DOUBLE : - MAX_DOUBLE);
                   1669:                    type = R_CONSTANT; idx = -1;
                   1670:                    noError = 1;
                   1671:                    for(ii = 0; (ii < argc)&&(noError); ii++) {
                   1672:                      switch (FIRST_ARGTYPE(tmpArgp)) {
                   1673:                        case I_VAR:
                   1674:                        case I_CONSTANT:
                   1675:                                if( type == S_CONSTANT) {
                   1676:                                  sprintf(aline,"<<ARG TYPE>>");
                   1677:                                  resultp->s_type = S_CONSTANT;
                   1678:                                  resultp->s_str = strsave(aline);
                   1679:                                  sprintf(tmpS,"%s()'s arg. type cannot mix string with int or real.\n",FuncStack[Func_idx].s_name);
                   1680:                                  capa_msg(MESSAGE_ERROR,tmpS);
                   1681:                                  noError = 0;
                   1682:                                } else {
                   1683:                                  switch(func) {
                   1684:                                    case MIN_F:
                   1685:                                     if( tmpA <= FIRST_ARGINT(tmpArgp) ) {
                   1686:                                      } else {
                   1687:                                       idx = ii; type = I_CONSTANT;
                   1688:                                       tmpA = (double)FIRST_ARGINT(tmpArgp);
                   1689:                                     }
                   1690:                                     break;
                   1691:                                    case MAX_F:
                   1692:                                     if( tmpA >= FIRST_ARGINT(tmpArgp) ) {
                   1693:                                      } else {
                   1694:                                       idx = ii; type = I_CONSTANT;
                   1695:                                       tmpA = (double)FIRST_ARGINT(tmpArgp);
                   1696:                                     }
                   1697:                                     break;
                   1698:                                  }
                   1699:                                }
                   1700:                                break;
                   1701:                        case R_VAR:
                   1702:                        case R_CONSTANT:
                   1703:                                if( type == S_CONSTANT ) {
                   1704:                                  sprintf(aline,"<<ARG TYPE>>");
                   1705:                                  resultp->s_type = S_CONSTANT;
                   1706:                                  resultp->s_str = strsave(aline);
                   1707:                                  sprintf(tmpS,"%s()'s arg. type cannot mix string with int or real.\n",FuncStack[Func_idx].s_name);
                   1708:                                  capa_msg(MESSAGE_ERROR,tmpS);
                   1709:                                  noError = 0;
                   1710:                                } else {
                   1711:                                  switch(func) {
                   1712:                                    case MIN_F:
                   1713:                                     if( tmpA <= FIRST_ARGREAL(tmpArgp) ) {
                   1714:                                     } else {
                   1715:                                      idx = ii; type = R_CONSTANT;
                   1716:                                      tmpA = FIRST_ARGREAL(tmpArgp);
                   1717:                                     }
                   1718:                                     break;
                   1719:                                    case MAX_F:
                   1720:                                     if( tmpA >= FIRST_ARGREAL(tmpArgp) ) {
                   1721:                                     } else {
                   1722:                                      idx = ii; type = R_CONSTANT;
                   1723:                                      tmpA = FIRST_ARGREAL(tmpArgp);
                   1724:                                     }
                   1725:                                     break;
                   1726:                                   }
                   1727:                                }
                   1728:                                break;
                   1729:                        case S_VAR:      
                   1730:                        case S_CONSTANT:
                   1731:                               if( (ii != 0)&&(type != S_CONSTANT) ) {
                   1732:                                  sprintf(aline,"<<ARG TYPE>>");
                   1733:                                  resultp->s_type = S_CONSTANT;
                   1734:                                  resultp->s_str = strsave(aline);
                   1735:                                  sprintf(tmpS," %s()'s arg. type cannot mix string with int or real.\n",FuncStack[Func_idx].s_name);
                   1736:                                  capa_msg(MESSAGE_ERROR,tmpS);
                   1737:                                  noError = 0;
                   1738:                               } else {
                   1739:                                 if( ii == 0 )  { idx = 0; strcpy(tmpS, FIRST_ARGSTR(tmpArgp)); }
                   1740:                                 type = S_CONSTANT;
                   1741:                                 switch( func) {
                   1742:                                  case MIN_F:
                   1743:                                   if( strcmp(tmpS, FIRST_ARGSTR(tmpArgp)) <= 0 ) {
                   1744:                                   } else {
                   1745:                                     idx = ii;
                   1746:                                     strcpy(tmpS, FIRST_ARGSTR(tmpArgp));
                   1747:                                   }
                   1748:                                   break;
                   1749:                                  case MAX_F:
                   1750:                                   if( strcmp(tmpS, FIRST_ARGSTR(tmpArgp)) >= 0 ) {
                   1751:                                   } else {
                   1752:                                     idx = ii;
                   1753:                                     strcpy(tmpS, FIRST_ARGSTR(tmpArgp));
                   1754:                                   }
                   1755:                                   break;
                   1756:                                 }
                   1757:                               }
                   1758:                               break;
                   1759:                      }
                   1760:                      tmpArgp = tmpArgp->a_next;
                   1761:                    }
                   1762:                    if( noError ) {
                   1763:                      for(tmpArgp=argp,ii=0; ii<idx; ii++) { tmpArgp=tmpArgp->a_next; }
                   1764:                      resultp->s_type = type;
                   1765:                      switch(type) {
                   1766:                        case I_CONSTANT: resultp->s_int = (tmpArgp->a_sp)->s_int;
                   1767:                                       break;
                   1768:                        case R_CONSTANT: resultp->s_real = (tmpArgp->a_sp)->s_real;
                   1769:                                       break;
                   1770:                        case S_CONSTANT: resultp->s_str = strsave((tmpArgp->a_sp)->s_str);
                   1771:                                       break;
                   1772:                      }
                   1773:                    }
                   1774:                    
                   1775:                 }
                   1776:                 break;
                   1777:     case ROUNDTO_F: {
                   1778:                      noError = 1; hh = 0;  /* reuse integer hh  and mm */
                   1779:                      switch(FIRST_ARGTYPE(argp)) {
                   1780:                       case I_VAR:
                   1781:                       case I_CONSTANT: mm = FIRST_ARGINT(argp);    break;
                   1782:                       case R_VAR:
                   1783:                       case R_CONSTANT: mm = (int)FIRST_ARGREAL(argp); break;
                   1784:                       case S_VAR:
                   1785:                       case S_CONSTANT: noError = 0;
                   1786:                                        resultp->s_type = S_CONSTANT;
                   1787:                                        resultp->s_str = strsave("<<MIS TYPE>>"); 
                   1788:                                        sprintf(tmpS, 
                   1789:                                            "%s()'s second arg. cannot be string.\n",FuncStack[Func_idx].s_name);
                   1790:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1791:                                        break;
                   1792:                      }
                   1793:                      switch(SECOND_ARGTYPE(argp)) {
                   1794:                       case I_VAR:
                   1795:                       case I_CONSTANT: hh = SECOND_ARGINT(argp); break;
                   1796:                       case R_VAR:
                   1797:                       case R_CONSTANT: tmpA = SECOND_ARGREAL(argp); break;
                   1798:                       case S_VAR:
                   1799:                       case S_CONSTANT: noError = 0;
                   1800:                                        resultp->s_type = S_CONSTANT;
                   1801:                                        resultp->s_str = strsave("<<MIS TYPE>>"); 
                   1802:                                        sprintf(tmpS, 
                   1803:                                            "%s()'s first arg. cannot be string.\n",
                   1804: 					       FuncStack[Func_idx].s_name);
                   1805:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1806:                                        break;
                   1807:                      }
                   1808:                      if(noError) {
                   1809:                        resultp->s_type = R_CONSTANT;
                   1810:                        if( hh != 0 ) {
                   1811:                          resultp->s_type = I_CONSTANT;
                   1812:                          resultp->s_int  = hh;
                   1813:                        } else {
                   1814:                          if ( mm >= 0 ) {
                   1815:                            sprintf(fmt_str,"%%.%df",mm);
                   1816:                            sprintf(num_str,fmt_str,tmpA);
                   1817:                            tmpB = atof(num_str);
                   1818:                            resultp->s_real = tmpB;
                   1819:                          } else {
                   1820:                            sprintf(tmpS,"%s()'s second arg. cannot be negative (%d).\n",
                   1821: 				   FuncStack[Func_idx].s_name,mm);
                   1822:                            capa_msg(MESSAGE_ERROR,tmpS);
                   1823:                            resultp->s_real = tmpA;  /* not changed */
                   1824:                          }
                   1825:                        }
                   1826:                      }
                   1827:                     }    break;
                   1828:     case EVALUATE_F: { char    *f_str, *v_str, *pt_str, *out_come;
                   1829:                      noError = 1;
                   1830:                      switch(FIRST_ARGTYPE(argp)) { /* now only accepts string like "0.0,0.1,0.2,0.3,0.4,0.5"  */
                   1831:                       case I_VAR:
                   1832:                       case I_CONSTANT: noError = 0;
                   1833:                                        resultp->s_type = S_CONSTANT;
                   1834:                                        resultp->s_str = strsave("<<Evaulate Formula: Pts TYPE incorrect>>");
                   1835:                                        sprintf(tmpS, 
                   1836:                                            "%s()'s third arg. cannot be integer.\n",FuncStack[Func_idx].s_name);
                   1837:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1838:                                      break;
                   1839:                       case R_VAR:
                   1840:                       case R_CONSTANT: noError = 0;
                   1841:                                        resultp->s_type = S_CONSTANT;
                   1842:                                        resultp->s_str = strsave("<<Evaulate Formula: Pts TYPE incorrect>>");
                   1843:                                        sprintf(tmpS, 
                   1844:                                            "%s()'s third arg. cannot be integer.\n",FuncStack[Func_idx].s_name);
                   1845:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1846:                                      break;
                   1847:                       case S_VAR:
                   1848:                       case S_CONSTANT: 
                   1849:                                        pt_str = FIRST_ARGSTR(argp);
                   1850:                                      break;
                   1851:                      }
                   1852:                      switch(SECOND_ARGTYPE(argp)) {
                   1853:                       case I_VAR:
                   1854:                       case I_CONSTANT: 
                   1855:                       case R_VAR:
                   1856:                       case R_CONSTANT: noError = 0;
                   1857:                                        resultp->s_type = S_CONSTANT;
                   1858:                                        resultp->s_str = strsave("<<Evaluate Formula: Var list TYPE incorrect>>");
                   1859:                                        sprintf(tmpS, 
                   1860:                                            "%s()'s second arg. cannot be number.\n",FuncStack[Func_idx].s_name);
                   1861:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1862:                                      break;
                   1863: 
                   1864:                       case S_VAR:
                   1865:                       case S_CONSTANT: v_str = SECOND_ARGSTR(argp);
                   1866:                                      break;
                   1867:                      }
                   1868:                      switch(THIRD_ARGTYPE(argp)) {
                   1869:                       case I_VAR:
                   1870:                       case I_CONSTANT: 
                   1871:                       case R_VAR:
                   1872:                       case R_CONSTANT: noError = 0;
                   1873:                                        resultp->s_type = S_CONSTANT;
                   1874:                                        resultp->s_str = strsave("<<Evaluate Formula: Formula TYPE incorrect>>");
                   1875:                                        sprintf(tmpS, 
                   1876:                                            "%s()'s first arg. cannot be number.\n",FuncStack[Func_idx].s_name);
                   1877:                                        capa_msg(MESSAGE_ERROR,tmpS);
                   1878:                                       break;
                   1879:                       case S_VAR:
                   1880:                       case S_CONSTANT: f_str = THIRD_ARGSTR(argp);
                   1881:                                       break;
                   1882:                      }
                   1883:                      if(noError) {
                   1884:                        resultp->s_type = S_CONSTANT;
                   1885:                        /* printf("EVALUATE:::%s,%s,%s\n",f_str, v_str, pt_str); */
                   1886:                        out_come = eval_formula_range_str(f_str, v_str, pt_str);
                   1887:                        if( !out_come ) {
                   1888:                          resultp->s_str = strsave("<<Evaluate formula:: NULL>>");
                   1889:                          sprintf(tmpS, 
                   1890:                            "%s() cannot evaluate the formula correctly.\n",FuncStack[Func_idx].s_name);
                   1891:                            capa_msg(MESSAGE_ERROR,tmpS);
                   1892:                        } else {
                   1893:                          resultp->s_str = out_come;
                   1894:                        }
                   1895:                      }
                   1896:                     }
                   1897:                     break;
                   1898:     case CAPAID_PLUS:
                   1899:                     {
                   1900: 		      extern Problem_t* FirstProblem_p;
                   1901: 		      extern Problem_t* LexiProblem_p;
                   1902: 		      Problem_t* problem; 
                   1903: 		      int        num_char,pin;
                   1904: 		      errCode = 0;
                   1905: 		      if (argc==1) {
                   1906: 			switch( FIRST_ARGTYPE(argp) ) {
                   1907: 			case I_VAR: case I_CONSTANT: num_char=FIRST_ARGINT(argp); break;
                   1908: 			case R_VAR: case R_CONSTANT: errCode = 1; break;
                   1909: 			case S_VAR: case S_CONSTANT: errCode = 1; break;
                   1910: 			}
                   1911: 		      } else {
                   1912: 			switch( SECOND_ARGTYPE(argp) ) {
                   1913: 			case I_VAR: case I_CONSTANT: num_char=SECOND_ARGINT(argp); break;
                   1914: 			case R_VAR: case R_CONSTANT: errCode = 1; break;
                   1915: 			case S_VAR: case S_CONSTANT: errCode = 1; break;
                   1916: 			}
                   1917: 		      }
                   1918: 		      
                   1919: 		      if( errCode == 0 ) {
                   1920: 			if ( FirstProblem_p ) {
                   1921: 			  problem=FirstProblem_p;
                   1922: 			} else {
                   1923: 			  problem=LexiProblem_p;
                   1924: 			}
                   1925: 			if (!(problem->capaidplus)) capa_mfree(problem->capaidplus);
                   1926: 			if (-1==(tmpInt=which_set(argc-1,argp,resultp))) break;
                   1927: 			pin=capa_PIN(Parse_student_number,tmpInt,0);
                   1928: 			problem->capaidplus = capa_id_plus(Parse_student_number,
                   1929: 							   tmpInt,num_char);
                   1930: 			resultp->s_type = S_CONSTANT;
                   1931: 			resultp->s_str = strsave(problem->capaidplus);
                   1932: 		      } else {
                   1933: 			resultp->s_type = S_CONSTANT;
                   1934: 			resultp->s_str = strsave("<<INCORRECT ARGS TO CAPAID_PLUS>>");
                   1935: 		      }
                   1936: 		    }
                   1937: 		    break;
                   1938:     case SEAT_NUMBER:
                   1939:                     { 
                   1940: 		      int filenum;
                   1941: 		      double filedoub;
                   1942: 		      char *filename;
                   1943: 		      if ( argc == 1 ) {
                   1944: 			switch( FIRST_ARGTYPE(argp)) {
                   1945: 			case I_VAR: case I_CONSTANT: filenum=FIRST_ARGINT(argp); 
                   1946: 			  filename=capa_malloc(TMP_LINE_LENGTH,1);
                   1947: 			  sprintf(filename,"%d",filenum);
                   1948: 			  break;
                   1949: 			case R_VAR: case R_CONSTANT: filedoub=FIRST_ARGREAL(argp); 
                   1950: 			  filename=capa_malloc(TMP_LINE_LENGTH,1);
                   1951: 			  sprintf(filename,"%f",filedoub);
                   1952: 			  break;
                   1953: 			case S_VAR: case S_CONSTANT: 
                   1954: 			  filename=strsave(FIRST_ARGSTR(argp)); break;
                   1955: 			}
                   1956: 		      } else {
                   1957: 			filename=NULL;
                   1958: 		      }
                   1959: 		      resultp->s_type = S_CONSTANT;
                   1960:                       resultp->s_str = capa_get_seat(Parse_student_number,filename);
                   1961: 		      if ( filename != NULL ) capa_mfree(filename);
                   1962:                       break;
                   1963:                     }
                   1964:     case DURATION: { resultp->s_type = I_CONSTANT;
                   1965:                      resultp->s_int=capa_get_duration(Parse_student_number,
                   1966: 						      Parse_section,Parse_set);
                   1967:                    } break;
1.3       albertel 1968:     case MANAGERMODE_F: { resultp->s_type = I_CONSTANT;
                   1969:                           resultp->s_int=managermode;
                   1970:                         }break;
                   1971:     case CORRECT_F: {
                   1972:       
                   1973:                     }break;
                   1974: 
                   1975:     case TRIES_F: {
                   1976:                       
                   1977:                   }break;
                   1978: 
                   1979:     case GRADE_F: {
                   1980:                       
                   1981:                   }break;
                   1982: 
1.1       albertel 1983:     case MIS_ARG_COUNT:
                   1984:                     { resultp->s_type = S_CONSTANT;
                   1985:                       resultp->s_str = strsave("<<ARG COUNT>>");
1.3       albertel 1986:                       sprintf(tmpS,"%s()'s arg. count is not correct.\n",
                   1987: 			      FuncStack[Func_idx].s_name);
1.1       albertel 1988:                       capa_msg(MESSAGE_ERROR,tmpS);
                   1989:                     } break;
                   1990:     case UNKNOWN_F: 
                   1991:     default:        { resultp->s_type = S_CONSTANT;
                   1992:                       resultp->s_str = strsave("<<UNKNOWN FUNCTION>>");
                   1993:                       sprintf(tmpS,"%s() unknown.\n",FuncStack[Func_idx].s_name);
                   1994:                       capa_msg(MESSAGE_ERROR,tmpS);
                   1995:                       
                   1996:                     } break;
                   1997:   }
                   1998:   
                   1999:   return (resultp);
                   2000: }
                   2001: 

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