lang/basic/src/func.c

   1 /*
   2  * (c) copyright 1987 by the Vrije Universiteit, Amsterdam, The Netherlands.
   3  * See the copyright notice in the ACK home directory, in the file "Copyright".
   4  */
   5
   6 #include "bem.h"
   7
   8 #ifndef NORSCID
   9 static char rcs_id[] = "$Id: func.c,v 1.3 1996/11/26 15:02:25 ceriel Exp $" ;
  10 #endif
  11
  12
  13 /* expression types for predefined functions are assembled */
  14 int     typetable[10];
  15 int     exprlimit;
  16
  17 /* handle all predefined functions */
  18 #define cv(X)   conversion(type,X); pop=X
  19
  20
  21
  22 parm(cnt)
  23 int cnt;
  24 {
  25         if( cnt> exprlimit)
  26                 error("Not enough arguments");
  27         if( cnt < exprlimit)
  28                 error("Too many arguments");
  29 }
  30
  31
  32
  33 callfcn(fcnnr,cnt,typetable)
  34 int fcnnr,cnt;
  35 int *typetable;
  36 {
  37         int pop=DOUBLETYPE;
  38         int res=DOUBLETYPE;
  39         int type;
  40
  41
  42         type= typetable[0];
  43         exprlimit=cnt;
  44         if(debug) print("fcn=%d\n",fcnnr);
  45
  46         switch(fcnnr)
  47         {
  48                 case ABSSYM:    cv(DOUBLETYPE);
  49                                 C_cal("_abr");
  50                                 parm(1);
  51                                 break;
  52                 case ASCSYM:    cv(STRINGTYPE);
  53                                 C_cal("_asc");
  54                                 res=INTTYPE;
  55                                 parm(1);
  56                                 break;
  57                 case ATNSYM:    cv(DOUBLETYPE);
  58                                 C_cal("_atn");
  59                                 parm(1);
  60                                 break;
  61                 case CDBLSYM:   cv(DOUBLETYPE);
  62                                 return(DOUBLETYPE);;
  63                 case CHRSYM:    cv(INTTYPE);
  64                                 C_cal("_chr");
  65                                 res=STRINGTYPE;
  66                                 parm(1);
  67                                 break;
  68                 case CSNGSYM:   cv(DOUBLETYPE);
  69                                 return(DOUBLETYPE);
  70                 case CINTSYM:   cv(INTTYPE);
  71                                 return(INTTYPE);
  72                 case COSSYM:    cv(DOUBLETYPE);
  73                                 C_cal("_cos");
  74                                 parm(1);
  75                                 break;
  76                 case CVISYM:    cv(STRINGTYPE);
  77                                 C_cal("_cvi");
  78                                 res=INTTYPE;
  79                                 parm(1);
  80                                 break;
  81                 case CVSSYM:    cv(STRINGTYPE);
  82                                 C_cal("_cvd");
  83                                 res=DOUBLETYPE;
  84                                 parm(1);
  85                                 break;
  86                 case CVDSYM:    cv(STRINGTYPE);
  87                                 C_cal("_cvd");
  88                                 res=DOUBLETYPE;
  89                                 parm(1);
  90                                 break;
  91                 case EOFSYM:
  92                                 if( cnt==0)
  93                                 {
  94                                         res= INTTYPE;
  95                                         pop= INTTYPE;
  96                                         C_loc((arith) -1);
  97                                 } else cv(INTTYPE);
  98                                 C_cal("_ioeof");
  99                                 res=INTTYPE;
 100                                 break;
 101                 case EXPSYM:    cv(DOUBLETYPE);
 102                                 C_cal("_exp");
 103                                 parm(1);
 104                                 break;
 105                 case FIXSYM:    cv(DOUBLETYPE);
 106                                 C_cal("_fix");
 107                                 res=INTTYPE;
 108                                 parm(1);
 109                                 break;
 110                 case INPSYM:
 111                 case LPOSSYM:
 112                 case FRESYM:    pop=0;
 113                                 warning("function not supported");
 114                                 parm(1);
 115                                 break;
 116                 case HEXSYM:    cv(INTTYPE);
 117                                 C_cal("_hex"); res=STRINGTYPE;
 118                                 parm(1);
 119                                 break;
 120                 case OUTSYM:
 121                 case INSTRSYM:  cv(DOUBLETYPE);
 122                                 C_cal("_instr");
 123                                 res=STRINGTYPE;
 124                                 parm(1);
 125                                 break;
 126                 case INTSYM:    cv(DOUBLETYPE);
 127                                 C_cal("_fcint");
 128                                 parm(1);
 129                                 break;
 130                 case LEFTSYM:   parm(2);
 131                                 extraconvert(type, STRINGTYPE,typetable[1]);
 132                                 type= typetable[1];
 133                                 cv(INTTYPE);
 134                                 C_cal("_left");
 135                                 res=STRINGTYPE;
 136                                 C_asp((arith) BEMPTRSIZE);
 137                                 C_asp((arith) BEMINTSIZE);
 138                                 C_lfr((arith) BEMPTRSIZE);
 139                                 return(STRINGTYPE);
 140                 case LENSYM:    cv(STRINGTYPE);
 141                                 C_cal("_length");
 142                                 res=INTTYPE;
 143                                 parm(1);
 144                                 break;
 145                 case LOCSYM:    cv(INTTYPE);
 146                                 C_cal("_loc");
 147                                 res=INTTYPE;
 148                                 parm(1);
 149                                 break;
 150                 case LOGSYM:    cv(DOUBLETYPE);
 151                                 C_cal("_log");
 152                                 parm(1);
 153                                 break;
 154                 case MKISYM:    cv(INTTYPE);
 155                                 C_cal("_mki");
 156                                 res=STRINGTYPE;
 157                                 parm(1);
 158                                 break;
 159                 case MKSSYM:    cv(DOUBLETYPE);
 160                                 C_cal("_mkd");
 161                                 res=STRINGTYPE;
 162                                 parm(1);
 163                                 break;
 164                 case MKDSYM:    cv(DOUBLETYPE);
 165                                 C_cal("_mkd");
 166                                 res=STRINGTYPE;
 167                                 parm(1);
 168                                 break;
 169                 case OCTSYM:    cv(INTTYPE);
 170                                 C_cal("_oct");
 171                                 res=STRINGTYPE;
 172                                 parm(1);
 173                                 break;
 174                 case PEEKSYM:   cv(INTTYPE);
 175                                 C_cal("_peek");
 176                                 res=INTTYPE;
 177                                 parm(1);
 178                                 break;
 179                 case POSSYM:    C_asp((arith) typestring(type));
 180                                 C_exa_dnam("_pos");
 181                                 C_loe_dnam("_pos",(arith) 0);
 182                                 return(INTTYPE);
 183                 case RIGHTSYM:  parm(2);
 184                                 extraconvert(type, STRINGTYPE,typetable[1]);
 185                                 type= typetable[1];
 186                                 cv(INTTYPE);
 187                                 C_cal("_right");
 188                                 res=STRINGTYPE;
 189                                 C_asp((arith) BEMINTSIZE);
 190                                 C_asp((arith) BEMPTRSIZE);
 191                                 C_lfr((arith) BEMPTRSIZE);
 192                                 return(STRINGTYPE);
 193                 case RNDSYM:    if( cnt==1) pop=type;
 194                                 else pop=0;
 195                                 C_cal("_rnd");
 196                                 res= DOUBLETYPE;
 197                                 break;
 198                 case SGNSYM:    cv(DOUBLETYPE);
 199                                 C_cal("_sgn");
 200                                 res=INTTYPE;
 201                                 parm(1);
 202                                 break;
 203                 case SINSYM:    cv(DOUBLETYPE);
 204                                 C_cal("_sin");
 205                                 parm(1);
 206                                 break;
 207                 case SPACESYM:  cv(INTTYPE);
 208                                 C_cal("_space");
 209                                 res=STRINGTYPE;
 210                                 parm(1);
 211                                 break;
 212                 case SPCSYM:    cv(INTTYPE);
 213                                 C_cal("_spc");
 214                                 res=0;
 215                                 parm(1);
 216                                 break;
 217                 case SQRSYM:    cv(DOUBLETYPE);
 218                                 C_cal("_sqt");
 219                                 parm(1);
 220                                 break;
 221                 case STRSYM:    cv(DOUBLETYPE);
 222                                 C_cal("_nstr");
 223                                 res=STRINGTYPE; /* NEW */
 224                                 parm(1);
 225                                 break;
 226                 case STRINGSYM:
 227                                 parm(2);        /* 2 is NEW */
 228                                 if (typetable[1] == STRINGTYPE) {
 229                                         C_cal("_asc");
 230                                         C_asp((arith)BEMPTRSIZE);
 231                                         C_lfr((arith)BEMINTSIZE);
 232                                         typetable[1] = INTTYPE;
 233                                 }
 234                                 extraconvert(type,
 235                                              DOUBLETYPE,
 236                                              typetable[1]);   /* NEW */
 237                                 type= typetable[1];
 238                                 cv(DOUBLETYPE);               /* NEW */
 239                                 C_cal("_string");
 240                                 res=STRINGTYPE;
 241                                 C_asp((arith)typestring(DOUBLETYPE)); /*NEW*/
 242                                 break;
 243                 case TABSYM:    cv(INTTYPE);
 244                                 C_cal("_tab");
 245                                 res=0;
 246                                 parm(1);
 247                                 break;
 248                 case TANSYM:    cv(DOUBLETYPE);
 249                                 C_cal("_tan");
 250                                 parm(1);
 251                                 break;
 252                 case VALSYM:    cv(STRINGTYPE);
 253                                 C_loi((arith)BEMPTRSIZE);
 254                                 C_cal("atoi");
 255                                 res=INTTYPE;
 256                                 parm(1);
 257                                 break;
 258                 case VARPTRSYM: cv(DOUBLETYPE);
 259                                 C_cal("_valptr");
 260                                 parm(1);
 261                                 break;
 262                 default:        error("unknown function");
 263         }
 264
 265         if(pop) C_asp((arith) typestring(pop));
 266         if(res) C_lfr((arith) typestring(res));
 267         return(res);
 268 }
 269