rexx/src/rexxfunc.c

   1 /*
   2  * $Header$
   3  * $Log$
   4  * Revision 1.1  2001/04/04 05:43:39  wang
   5  * First commit: compiles on Linux, Amiga, Windows, Windows CE, generic gcc
   6  *
   7  * Revision 1.2  1999/11/26 13:13:47  bnv
   8  * Added: Windows CE routines.
   9  *
  10  * Revision 1.1  1998/07/02 17:34:50  bnv
  11  * Initial revision
  12  *
  13  */
  14
  15 #include <math.h>
  16
  17 #include <lerror.h>
  18 #include <lstring.h>
  19
  20 #include <rexx.h>
  21 #include <rxdefs.h>
  22 #include <compile.h>
  23
  24 #ifdef WCE
  25 #       include <cefunc.h>
  26 #endif
  27
  28 #define DECL( A )  void R_##A ( const int );
  29
  30 DECL( SSoI     )   DECL( SIoC  )  DECL( S   )   DECL( SIoI )
  31 DECL( SSoIoIoC )   DECL( SoSoC )  DECL( SoI )   DECL( IoI  )
  32 DECL( O        )   DECL( SI    )  DECL( C   )   DECL( oSoS )
  33 DECL( SS       )   DECL( SoSoS )
  34
  35 DECL( arg       )  DECL( compare   )  DECL( copies    )  DECL( close     )
  36 DECL( datatype  )  DECL( eof       )  DECL( errortext )
  37 DECL( filesize  )  DECL( format    )  DECL( intr      )  DECL( load      )
  38 DECL( max       )  DECL( min       )  DECL( open      )  DECL( random    )
  39 DECL( read      )  DECL( seek      )  DECL( substr    )  DECL( sourceline)
  40 DECL( strip     )  DECL( storage   )  DECL( space     )  DECL( translate )
  41 DECL( trunc     )  DECL( verify    )  DECL( write     )  DECL( xrange    )
  42
  43 DECL( dropbuf   )
  44 DECL( changestr )
  45 DECL( flush     )
  46 DECL( port      )
  47
  48 DECL( charslines )
  49 DECL( charlinein )
  50 DECL( charlineout )
  51 DECL( stream )
  52
  53 /* Math routines */
  54 DECL( abs_sign  )
  55 DECL( math )
  56 DECL( atanpow )
  57 #undef DECL
  58
  59 #ifdef WCE
  60 #define DECL( A )  void CE_##A ( const int );
  61 DECL( MsgBox    )  DECL( O         )  DECL( gotoxy     )  DECL( oS       )
  62 DECL( S         )  DECL( SS        )  DECL( Clipboard  )  DECL( Dir      )
  63 #undef DECL
  64 #endif
  65
  66 /* ------------- Register Functions Tree ----------- */
  67 static BinTree  *ExtraFuncs = NULL;
  68 /* !!!!!!!!!!!! WARNING THE LIST MUST BE SORTED !!!!!!!!!!! */
  69 static
  70 TBltFunc
  71 rexx_routine[] = {
  72 #ifdef WCE
  73         { "A2U",        R_S             ,f_a2u          },
  74 #endif
  75         { "ABBREV",     R_SSoI          ,f_abbrev       },
  76         { "ABS",        R_abs_sign      ,f_abs          },
  77         { "ACOS",       R_math          ,f_acos         },
  78         { "ADDR",       R_SoSoS         ,f_addr         },
  79         { "ADDRESS",    R_O             ,f_address      },
  80         { "ARG",        R_arg           ,f_arg          },
  81         { "ASIN",       R_math          ,f_asin         },
  82         { "ATAN",       R_math          ,f_atan         },
  83         { "ATAN2",      R_atanpow       ,f_atan2        },
  84         { "B2X",        R_S             ,f_b2x          },
  85         { "BITAND",     R_SoSoC         ,f_bitand       },
  86         { "BITOR",      R_SoSoC         ,f_bitor        },
  87         { "BITXOR",     R_SoSoC         ,f_bitxor       },
  88         { "C2D",        R_SoI           ,f_c2d          },
  89         { "C2X",        R_S             ,f_c2x          },
  90         { "CENTER",     R_SIoC          ,f_center       },
  91         { "CENTRE",     R_SIoC          ,f_center       },
  92         { "CHANGESTR",  R_changestr     ,f_changestr    },
  93         { "CHARIN",     R_charlinein    ,f_charin       },
  94         { "CHAROUT",    R_charlineout   ,f_charout      },
  95         { "CHARS",      R_charslines    ,f_chars        },
  96 #ifdef WCE
  97         { "CLIPBOARD",  CE_Clipboard,   0               },
  98 #endif
  99         { "CLOSE",      R_close         ,f_close        },
 100 #ifdef WCE
 101         { "CLREOL",     CE_O,           f_clreol        },
 102         { "CLRSCR",     CE_O,           f_clrscr        },
 103 #endif
 104         { "COMPARE",    R_compare       ,f_compare      },
 105         { "COPIES",     R_copies        ,f_copies       },
 106 #ifdef WCE
 107         { "COPYFILE",   CE_SS,          f_copyfile      },
 108 #endif
 109         { "COS",        R_math          ,f_cos          },
 110         { "COSH",       R_math          ,f_cosh         },
 111         { "COUNTSTR",   R_SS            ,f_countstr     },
 112         { "D2C",        R_IoI           ,f_d2c          },
 113         { "D2X",        R_IoI           ,f_d2x          },
 114         { "DATATYPE",   R_datatype      ,f_datatype     },
 115         { "DATE",       R_C             ,f_date         },
 116 #ifdef WCE
 117         { "DELFILE",    CE_S,           f_deletefile    },
 118 #endif
 119         { "DELSTR",     R_SIoI          ,f_delstr       },
 120         { "DELWORD",    R_SIoI          ,f_delword      },
 121         { "DESBUF",     R_O             ,f_desbuf       },
 122         { "DIGITS",     R_O             ,f_digits       },
 123 #ifdef WCE
 124         { "DIR",        CE_Dir,         0               },
 125 #endif
 126         { "DROPBUF",    R_dropbuf       ,f_dropbuf      },
 127         { "EOF",        R_eof           ,f_eof          },
 128         { "ERRORTEXT",  R_errortext     ,f_errortext    },
 129         { "EXP",        R_math          ,f_exp          },
 130         { "FIND",       R_SSoI          ,f_find         },
 131         { "FLUSH",      R_flush         ,f_flush        },
 132         { "FORM",       R_O             ,f_form         },
 133         { "FORMAT",     R_format        ,f_format       },
 134         { "FUZZ",       R_O             ,f_fuzz         },
 135 #ifdef WCE
 136         { "GETCH",      CE_O,           f_getch         },
 137 #endif
 138 #ifndef WCE
 139         { "GETENV",     R_S             ,f_getenv       },
 140 #endif
 141 #ifdef WCE
 142         { "GOTOXY",     CE_gotoxy,      0               },
 143 #endif
 144         { "INDEX",      R_SSoI          ,f_index        },
 145         { "INSERT",     R_SSoIoIoC      ,f_insert       },
 146 #if defined(__BORLANDC__) && !defined(__WIN32__) && !defined(WCE)
 147         { "INTR",       R_intr          ,f_intr         },
 148 #endif
 149         { "JUSTIFY",    R_SIoC          ,f_justify      },
 150 #ifdef WCE
 151         { "KBHIT",      CE_O,           f_kbhit         },
 152         { "LASTERROR",  R_O             ,f_lasterror    },
 153 #endif
 154         { "LASTPOS",    R_SSoI          ,f_lastpos      },
 155         { "LEFT",       R_SIoC          ,f_left         },
 156         { "LENGTH",     R_S             ,f_length       },
 157         { "LINEIN",     R_charlinein    ,f_linein       },
 158         { "LINEOUT",    R_charlineout   ,f_lineout      },
 159         { "LINES",      R_charslines    ,f_lines        },
 160         { "LOAD",       R_load          ,f_load         },
 161         { "LOG",        R_math          ,f_log          },
 162         { "LOG10",      R_math          ,f_log10        },
 163         { "MAKEBUF",    R_O             ,f_makebuf      },
 164         { "MAX",        R_max           ,f_max          },
 165         { "MIN",        R_min           ,f_min          },
 166 #ifdef WCE
 167         { "MKDIR",      CE_S,           f_createdirectory       },
 168         { "MOVEFILE",   CE_SS,          f_movefile      },
 169         { "MSGBOX",     CE_MsgBox,      0               },
 170 #endif
 171         { "OPEN",       R_open          ,f_open         },
 172         { "OVERLAY",    R_SSoIoIoC      ,f_overlay      },
 173 #if defined(__BORLANDC__) && !defined(__WIN32__) && !defined(WCE)
 174         { "PORT",       R_port          ,f_port         },
 175 #endif
 176         { "POS",        R_SSoI          ,f_pos          },
 177         { "POW",        R_atanpow       ,f_pow          },
 178         { "POW10",      R_math          ,f_pow10        },
 179 #ifndef WCE
 180         { "PUTENV",     R_SS            ,f_putenv       },
 181 #endif
 182         { "QUEUED",     R_C             ,f_queued       },
 183         { "RANDOM",     R_random        ,f_random       },
 184         { "READ",       R_read          ,f_read         },
 185         { "REVERSE",    R_S             ,f_reverse      },
 186         { "RIGHT",      R_SIoC          ,f_right        },
 187 #ifdef WCE
 188         { "RMDIR",      CE_S,           f_removedirectory       },
 189 #endif
 190         { "SEEK",       R_seek          ,f_seek         },
 191         { "SIGN",       R_abs_sign      ,f_sign         },
 192         { "SIN",        R_math          ,f_sin          },
 193         { "SINH",       R_math          ,f_sinh         },
 194         { "SOUNDEX",    R_S             ,f_soundex      },
 195         { "SOURCELINE", R_sourceline    ,f_sourceline   },
 196         { "SPACE",      R_space         ,f_space        },
 197         { "SQRT",       R_math          ,f_sqrt         },
 198         { "STORAGE",    R_storage       ,f_storage      },
 199         { "STREAM",     R_stream        ,f_stream       },
 200         { "STRIP",      R_strip         ,f_strip        },
 201         { "SUBSTR",     R_substr        ,f_substr       },
 202         { "SUBWORD",    R_SIoI          ,f_subword      },
 203         { "SYMBOL",     R_S             ,f_symbol       },
 204         { "TAN",        R_math          ,f_tan          },
 205         { "TANH",       R_math          ,f_tanh         },
 206         { "TIME",       R_C             ,f_time         },
 207         { "TRACE",      R_C             ,f_trace        },
 208         { "TRANSLATE",  R_translate     ,f_translate    },
 209         { "TRUNC",      R_trunc         ,f_trunc        },
 210 #ifdef WCE
 211         { "U2A",        R_S             ,f_u2a          },
 212 #endif
 213         { "VALUE",      R_SoSoS         ,f_value        },
 214         { "VARDUMP",    R_oSoS          ,f_vartree      },
 215         { "VERIFY",     R_verify        ,f_verify       },
 216 #ifdef WCE
 217         { "WHEREX",     CE_O,           f_wherex        },
 218         { "WHEREY",     CE_O,           f_wherey        },
 219         { "WINDOWTITLE",CE_oS,          f_windowtitle   },
 220 #endif
 221         { "WORD",       R_SI            ,f_word         },
 222         { "WORDINDEX",  R_SI            ,f_wordindex    },
 223         { "WORDLENGTH", R_SI            ,f_wordlength   },
 224         { "WORDPOS",    R_SSoI          ,f_wordpos      },
 225         { "WORDS",      R_S             ,f_words        },
 226         { "WRITE",      R_write         ,f_write        },
 227         { "X2B",        R_S             ,f_x2b          },
 228         { "X2C",        R_S             ,f_x2c          },
 229         { "X2D",        R_SoI           ,f_x2d          },
 230         { "XRANGE",     R_xrange        ,f_xrange       }
 231 };
 232
 233 /* ------------- C_isBuiltin --------------- */
 234 TBltFunc *
 235 C_isBuiltin( PLstr func )
 236 {
 237         int     first, middle, last, cmp;
 238         PBinLeaf        leaf;
 239
 240         first = 0;      /* Use binary search to find intruction */
 241         last  = DIMENSION(rexx_routine)-1;
 242
 243         while (first<=last)   {
 244                 middle = (first+last)/2;
 245                 if ((cmp=Lcmp(func,rexx_routine[middle].name))==0)
 246                         return (rexx_routine+middle);
 247                 else
 248                 if (cmp<0)
 249                         last  = middle-1;
 250                 else
 251                         first = middle+1;
 252         }
 253
 254         /* try to see if it exists in the extra functions */
 255         if (ExtraFuncs) {
 256                 leaf = BinFind(ExtraFuncs,func);
 257                 if (leaf)
 258                         return (TBltFunc*)(leaf->value);
 259         }
 260         return NULL;
 261 } /* C_isBuiltin */
 262
 263 /* ----------- RxRegFunction ------------- */
 264 /* returns TRUE if an error occurs */
 265 int
 266 RxRegFunction( char *name, void (*func)(int), int opt )
 267 {
 268         Lstr    fn;
 269         TBltFunc *fp;
 270
 271         if (ExtraFuncs==NULL) {
 272                 ExtraFuncs = (BinTree*)MALLOC(sizeof(BinTree),"ExtraFuncs");
 273                 BINTREEINIT(*ExtraFuncs);
 274         }
 275
 276         LINITSTR(fn);
 277         Lscpy(&fn,name);
 278         Lupper(&fn);    /* translate to upper case */
 279
 280         fp = (TBltFunc*)MALLOC(sizeof(TBltFunc),"RegFunc");
 281
 282         if (!fp) return TRUE;
 283         fp->name = NULL;
 284         fp->func = func;
 285         fp->opt  = opt;
 286         BinAdd(ExtraFuncs,&fn,fp);
 287         LFREESTR(fn);
 288         return FALSE;
 289 } /* RxRegFunction */
 290
 291 /* ----------- RxRegFunctionDone --------- */
 292 void
 293 RxRegFunctionDone( void )
 294 {
 295         if (!ExtraFuncs) return;
 296         BinDisposeLeaf(ExtraFuncs,ExtraFuncs->parent,FREE);
 297         FREE(ExtraFuncs);
 298         ExtraFuncs = NULL;
 299 } /* RxRegFunctionDone */