home *** CD-ROM | disk | FTP | other *** search
/ Fish 'n' More 2 / fishmore-publicdomainlibraryvol.ii1991xetec.iso / dirs / xlispstat_386.lzh / XLispStat / src1.lzh / XLisp / xlftab.c < prev    next >
C/C++ Source or Header  |  1990-10-03  |  18KB  |  399 lines
  1. /* xlftab.c - xlisp function table */
  2. /* Copyright (c) 1989, by David Michael Betz.                            */
  3. /* You may give out copies of this software; for conditions see the file */
  4. /* COPYING included with this distribution.                              */
  5.  
  6. #include "xlisp.h"
  7. #include "osdef.h"
  8. #ifdef ANSI
  9. #include "xlproto.h"
  10. #include "xlsproto.h"
  11. #include "iviewproto.h"
  12. #include "osproto.h"
  13. #else
  14. #include "xlfun.h"
  15. #include "xlsfun.h"
  16. #include "iviewfun.h"
  17. #include "osfun.h"
  18. #endif ANSI
  19.  
  20. /* SUBR/FSUBR indicator */
  21. #define S   SUBR
  22. #define F   FSUBR
  23.  
  24. /* forward declarations */
  25. #ifdef ANSI
  26. LVAL xnotimp(void);
  27. #else
  28. LVAL xnotimp();
  29. #endif ANSI
  30.  
  31. /* the function table */
  32. FUNDEF funtab[] = {
  33.  
  34.     /* read macro functions */
  35. {   NULL,               S, rmhash       }, /*   0 */
  36. {   NULL,               S, rmquote      }, /*   1 */
  37. {   NULL,               S, rmdquote     }, /*   2 */
  38. {   NULL,               S, rmbquote     }, /*   3 */
  39. {   NULL,               S, rmcomma      }, /*   4 */
  40. {   NULL,               S, rmlpar       }, /*   5 */
  41. {   NULL,               S, rmrpar       }, /*   6 */
  42. {   NULL,               S, rmsemi       }, /*   7 */
  43. {   NULL,               S, xnotimp      }, /*   8 */
  44. {   NULL,               S, xnotimp      }, /*   9 */
  45.  
  46.     /* methods */
  47. {   NULL,               S, clnew        }, /*  10 */
  48. {   NULL,               S, clisnew      }, /*  11 */
  49. {   NULL,               S, clanswer     }, /*  12 */
  50. {   NULL,               S, obisnew      }, /*  13 */
  51. {   NULL,               S, obclass      }, /*  14 */
  52. {   NULL,               S, obshow       }, /*  15 */
  53. {   NULL,               S, xnotimp      }, /*  16 */
  54. {   NULL,               S, xnotimp      }, /*  17 */
  55. {   NULL,               S, xnotimp      }, /*  18 */
  56. {   NULL,               S, xnotimp      }, /*  19 */
  57.  
  58.     /* evaluator functions */
  59. {   "EVAL",             S, xeval        }, /*  20 */
  60. {   "APPLY",            S, xapply       }, /*  21 */
  61. {   "FUNCALL",          S, xfuncall     }, /*  22 */
  62. {   "QUOTE",            F, xquote       }, /*  23 */
  63. {   "FUNCTION",         F, xfunction    }, /*  24 */
  64. {   "BACKQUOTE",        F, xbquote      }, /*  25 */
  65. {   "LAMBDA",           F, xlambda      }, /*  26 */
  66.  
  67.     /* symbol functions */
  68. {   "SET",              S, xset         }, /*  27 */
  69. {   "SETQ",             F, xsetq        }, /*  28 */
  70. {   "SETF",             F, xsetf        }, /*  29 */
  71. {   "DEFUN",            F, xdefun       }, /*  30 */
  72. {   "DEFMACRO",         F, xdefmacro    }, /*  31 */
  73. {   "GENSYM",           S, xgensym      }, /*  32 */
  74. {   "MAKE-SYMBOL",      S, xmakesymbol  }, /*  33 */
  75. {   "INTERN",           S, xintern      }, /*  34 */
  76. {   "SYMBOL-NAME",      S, xsymname     }, /*  35 */
  77. {   "SYMBOL-VALUE",     S, xsymvalue    }, /*  36 */
  78. {   "SYMBOL-PLIST",     S, xsymplist    }, /*  37 */
  79. {   "GET",              S, xget         }, /*  38 */
  80. {   "PUTPROP",          S, xputprop     }, /*  39 */
  81. {   "REMPROP",          S, xremprop     }, /*  40 */
  82. {   "HASH",             S, xhash        }, /*  41 */
  83.  
  84.     /* array functions */
  85. {   "MAKE-ARRAY",       S, xmkarray     }, /*  42 */
  86. {   "AREF",             S, xaref        }, /*  43 */
  87.             
  88.     /* list functions */
  89. {   "CAR",              S, xcar         }, /*  44 */
  90. {   "CDR",              S, xcdr         }, /*  45 */
  91.             
  92. {   "CAAR",             S, xcaar        }, /*  46 */
  93. {   "CADR",             S, xcadr        }, /*  47 */
  94. {   "CDAR",             S, xcdar        }, /*  48 */
  95. {   "CDDR",             S, xcddr        }, /*  49 */
  96.  
  97. {   "CAAAR",            S, xcaaar       }, /*  50 */
  98. {   "CAADR",            S, xcaadr       }, /*  51 */
  99. {   "CADAR",            S, xcadar       }, /*  52 */
  100. {   "CADDR",            S, xcaddr       }, /*  53 */
  101. {   "CDAAR",            S, xcdaar       }, /*  54 */
  102. {   "CDADR",            S, xcdadr       }, /*  55 */
  103. {   "CDDAR",            S, xcddar       }, /*  56 */
  104. {   "CDDDR",            S, xcdddr       }, /*  57 */
  105.  
  106. {   "CAAAAR",           S, xcaaaar      }, /*  58 */
  107. {   "CAAADR",           S, xcaaadr      }, /*  59 */
  108. {   "CAADAR",           S, xcaadar      }, /*  60 */
  109. {   "CAADDR",           S, xcaaddr      }, /*  61 */
  110. {   "CADAAR",           S, xcadaar      }, /*  62 */
  111. {   "CADADR",           S, xcadadr      }, /*  63 */
  112. {   "CADDAR",           S, xcaddar      }, /*  64 */
  113. {   "CADDDR",           S, xcadddr      }, /*  65 */
  114. {   "CDAAAR",           S, xcdaaar      }, /*  66 */
  115. {   "CDAADR",           S, xcdaadr      }, /*  67 */
  116. {   "CDADAR",           S, xcdadar      }, /*  68 */
  117. {   "CDADDR",           S, xcdaddr      }, /*  69 */
  118. {   "CDDAAR",           S, xcddaar      }, /*  70 */
  119. {   "CDDADR",           S, xcddadr      }, /*  71 */
  120. {   "CDDDAR",           S, xcdddar      }, /*  72 */
  121. {   "CDDDDR",           S, xcddddr      }, /*  73 */
  122.  
  123. {   "CONS",             S, xcons        }, /*  74 */
  124. {   "LIST",             S, xlist        }, /*  75 */
  125. {   "APPEND",           S, xappend      }, /*  76 */
  126. {   "REVERSE",          S, xreverse     }, /*  77 */
  127. {   "LAST",             S, xlast        }, /*  78 */
  128. {   "NTH",              S, xnth         }, /*  79 */
  129. {   "NTHCDR",           S, xnthcdr      }, /*  80 */
  130. {   "MEMBER",           S, xmember      }, /*  81 */
  131. {   "ASSOC",            S, xassoc       }, /*  82 */
  132. {   "SUBST",            S, xsubst       }, /*  83 */
  133. {   "SUBLIS",           S, xsublis      }, /*  84 */
  134. {   "REMOVE",           S, xremove      }, /*  85 */
  135. {   "LENGTH",           S, xlength      }, /*  86 */
  136. {   "MAPC",             S, xmapc        }, /*  87 */
  137. {   "MAPCAR",           S, xmapcar      }, /*  88 */
  138. {   "MAPL",             S, xmapl        }, /*  89 */
  139. {   "MAPLIST",          S, xmaplist     }, /*  90 */
  140.             
  141.     /* destructive list functions */
  142. {   "RPLACA",           S, xrplca       }, /*  91 */
  143. {   "RPLACD",           S, xrplcd       }, /*  92 */
  144. {   "NCONC",            S, xnconc       }, /*  93 */
  145. {   "DELETE",           S, xdelete      }, /*  94 */
  146.  
  147.     /* predicate functions */
  148. {   "ATOM",             S, xatom        }, /*  95 */
  149. {   "SYMBOLP",          S, xsymbolp     }, /*  96 */
  150. {   "NUMBERP",          S, xnumberp     }, /*  97 */
  151. {   "BOUNDP",           S, xboundp      }, /*  98 */
  152. {   "NULL",             S, xnull        }, /*  99 */
  153. {   "LISTP",            S, xlistp       }, /* 100 */
  154. {   "CONSP",            S, xconsp       }, /* 101 */
  155. {   "MINUSP",           S, xminusp      }, /* 102 */
  156. {   "ZEROP",            S, xzerop       }, /* 103 */
  157. {   "PLUSP",            S, xplusp       }, /* 104 */
  158. {   "EVENP",            S, xevenp       }, /* 105 */
  159. {   "ODDP",             S, xoddp        }, /* 106 */
  160. {   "EQ",               S, xeq          }, /* 107 */
  161. {   "EQL",              S, xeql         }, /* 108 */
  162. {   "EQUAL",            S, xequal       }, /* 109 */
  163.  
  164.     /* special forms */
  165. {   "COND",             F, xcond        }, /* 110 */
  166. {   "CASE",             F, xcase        }, /* 111 */
  167. {   "AND",              F, xand         }, /* 112 */
  168. {   "OR",               F, xor          }, /* 113 */
  169. {   "LET",              F, xlet         }, /* 114 */
  170. {   "LET*",             F, xletstar     }, /* 115 */
  171. {   "IF",               F, xif          }, /* 116 */
  172. {   "PROG",             F, xprog        }, /* 117 */
  173. {   "PROG*",            F, xprogstar    }, /* 118 */
  174. {   "PROG1",            F, xprog1       }, /* 119 */
  175. {   "PROG2",            F, xprog2       }, /* 120 */
  176. {   "PROGN",            F, xprogn       }, /* 121 */
  177. {   "GO",               F, xgo          }, /* 122 */
  178. {   "RETURN",           F, xreturn      }, /* 123 */
  179. {   "DO",               F, xdo          }, /* 124 */
  180. {   "DO*",              F, xdostar      }, /* 125 */
  181. {   "DOLIST",           F, xdolist      }, /* 126 */
  182. {   "DOTIMES",          F, xdotimes     }, /* 127 */
  183. {   "CATCH",            F, xcatch       }, /* 128 */
  184. {   "THROW",            F, xthrow       }, /* 129 */
  185.     
  186.     /* debugging and error handling functions */
  187. {   "ERROR",            S, xerror       }, /* 130 */
  188. {   "CERROR",           S, xcerror          }, /* 131 */
  189. {   "BREAK",            S, xbreak       }, /* 132 */
  190. {   "CLEAN-UP",         S, xcleanup     }, /* 133 */
  191. {   "TOP-LEVEL",            S, xtoplevel        }, /* 134 */
  192. {   "CONTINUE",         S, xcontinue        }, /* 135 */
  193. {   "ERRSET",           F, xerrset          }, /* 136 */
  194. {   "BAKTRACE",         S, xbaktrace        }, /* 137 */
  195. {   "EVALHOOK",         S, xevalhook        }, /* 138 */
  196.  
  197.     /* arithmetic functions */
  198. {   "TRUNCATE",         S, xfix         }, /* 139 */
  199. {   "FLOAT",            S, xfloat       }, /* 140 */
  200. {   "+",                S, xadd         }, /* 141 */
  201. {   "-",                S, xsub         }, /* 142 */
  202. {   "*",                S, xmul         }, /* 143 */
  203. {   "/",                S, xdiv         }, /* 144 */
  204. {   "1+",               S, xadd1        }, /* 145 */
  205. {   "1-",               S, xsub1        }, /* 146 */
  206. {   "REM",              S, xrem         }, /* 147 */
  207. {   "MIN",              S, xmin         }, /* 148 */
  208. {   "MAX",              S, xmax         }, /* 149 */
  209. {   "ABS",              S, xabs         }, /* 150 */
  210. {   "SIN",              S, xsin         }, /* 151 */
  211. {   "COS",              S, xcos         }, /* 152 */
  212. {   "TAN",              S, xtan         }, /* 153 */
  213. {   "EXPT",             S, xexpt        }, /* 154 */
  214. {   "EXP",              S, xexp         }, /* 155 */
  215. {   "SQRT",             S, xsqrt        }, /* 156 */
  216. {   "RANDOM",           S, xrand        }, /* 157 */
  217.             
  218.     /* bitwise logical functions */
  219. {   "LOGAND",           S, xlogand          }, /* 158 */
  220. {   "LOGIOR",           S, xlogior          }, /* 159 */
  221. {   "LOGXOR",           S, xlogxor          }, /* 160 */
  222. {   "LOGNOT",           S, xlognot          }, /* 161 */
  223.  
  224.     /* numeric comparison functions */
  225. {   "<",                S, xlss         }, /* 162 */
  226. {   "<=",               S, xleq         }, /* 163 */
  227. {   "=",                S, xequ         }, /* 164 */
  228. {   "/=",               S, xneq         }, /* 165 */
  229. {   ">=",               S, xgeq         }, /* 166 */
  230. {   ">",                S, xgtr         }, /* 167 */
  231.             
  232.     /* string functions */
  233. {   "STRCAT",           S, xstrcat          }, /* 168 */
  234. {   "SUBSEQ",           S, xsubseq          }, /* 169 */
  235. {   "STRING",           S, xstring          }, /* 170 */
  236. {   "CHAR",             S, xchar        }, /* 171 */
  237.  
  238.     /* I/O functions */
  239. {   "READ",             S, xread        }, /* 172 */
  240. {   "PRINT",            S, xprint       }, /* 173 */
  241. {   "PRIN1",            S, xprin1       }, /* 174 */
  242. {   "PRINC",            S, xprinc       }, /* 175 */
  243. {   "TERPRI",           S, xterpri          }, /* 176 */
  244. {   "FLATSIZE",         S, xflatsize        }, /* 177 */
  245. {   "FLATC",            S, xflatc       }, /* 178 */
  246.             
  247.     /* file I/O functions */
  248. {   "OPEN",             S, xopen        }, /* 179 */
  249. {   "FORMAT",           S, xformat      }, /* 180 */
  250. {   "CLOSE",            S, xclose       }, /* 181 */
  251. {   "READ-CHAR",        S, xrdchar      }, /* 182 */
  252. {   "PEEK-CHAR",        S, xpkchar      }, /* 183 */
  253. {   "WRITE-CHAR",       S, xwrchar      }, /* 184 */
  254. {   "READ-LINE",        S, xreadline    }, /* 185 */
  255.  
  256.     /* system functions */
  257. {   "LOAD",             S, xload        }, /* 186 */
  258. {   "DRIBBLE",          S, xtranscript  }, /* 187 */
  259.  
  260. /* functions specific to xldmem.c */
  261. {   "GC",               S, xgc          }, /* 188 */
  262. {   "EXPAND",           S, xexpand      }, /* 189 */
  263. {   "ALLOC",            S, xalloc       }, /* 190 */
  264. {   "ROOM",             S, xmem         }, /* 191 */
  265. #ifdef SAVERESTORE
  266. {   "SAVE",             S, xsave        }, /* 192 */
  267. {   "RESTORE",          S, xrestore     }, /* 193 */
  268. #else
  269. {   NULL,               S, xnotimp      }, /* 192 */
  270. {   NULL,               S, xnotimp      }, /* 193 */
  271. #endif
  272. /* end of functions specific to xldmem.c */
  273.  
  274. {   "TYPE-OF",          S, xtype        }, /* 194 */
  275. {   "EXIT",             S, xexit        }, /* 195 */
  276. {   "PEEK",             S, xpeek        }, /* 196 */
  277. {   "POKE",             S, xpoke        }, /* 197 */
  278. {   "ADDRESS-OF",       S, xaddrs       }, /* 198 */
  279.  
  280.     /* new functions and special forms */
  281. {   "VECTOR",           S, xvector      }, /* 199 */
  282. {   "BLOCK",            F, xblock       }, /* 200 */
  283. {   "RETURN-FROM",      F, xrtnfrom     }, /* 201 */
  284. {   "TAGBODY",          F, xtagbody     }, /* 202 */
  285. {   "PSETQ",            F, xpsetq       }, /* 203 */
  286. {   "FLET",             F, xflet        }, /* 204 */
  287. {   "LABELS",           F, xlabels      }, /* 205 */
  288. {   "MACROLET",         F, xmacrolet    }, /* 206 */
  289. {   "UNWIND-PROTECT",   F, xunwindprotect   }, /* 207 */
  290. {   "PPRINT",           S, xpp          }, /* 208 */
  291. {   "STRING<",          S, xstrlss      }, /* 209 */
  292. {   "STRING<=",         S, xstrleq      }, /* 210 */
  293. {   "STRING=",          S, xstreql      }, /* 211 */
  294. {   "STRING/=",         S, xstrneq      }, /* 212 */
  295. {   "STRING>=",         S, xstrgeq      }, /* 213 */
  296. {   "STRING>",          S, xstrgtr      }, /* 214 */
  297. {   "STRING-LESSP",     S, xstrilss     }, /* 215 */
  298. {   "STRING-NOT-GREATERP",  S, xstrileq }, /* 216 */
  299. {   "STRING-EQUAL",     S, xstrieql     }, /* 217 */
  300. {   "STRING-NOT-EQUAL", S, xstrineq     }, /* 218 */
  301. {   "STRING-NOT-LESSP", S, xstrigeq     }, /* 219 */
  302. {   "STRING-GREATERP",  S, xstrigtr     }, /* 220 */
  303. {   "INTEGERP",         S, xintegerp    }, /* 221 */
  304. {   "FLOATP",           S, xfloatp      }, /* 222 */
  305. {   "STRINGP",          S, xstringp     }, /* 223 */
  306. {   "ARRAYP",           S, xarrayp      }, /* 224 */
  307. {   "STREAMP",          S, xstreamp     }, /* 225 */
  308. {   "OBJECTP",          S, xobjectp     }, /* 226 */
  309. {   "STRING-UPCASE",    S, xupcase      }, /* 227 */
  310. {   "STRING-DOWNCASE",  S, xdowncase    }, /* 228 */
  311. {   "NSTRING-UPCASE",   S, xnupcase     }, /* 229 */
  312. {   "NSTRING-DOWNCASE", S, xndowncase   }, /* 230 */
  313. {   "STRING-TRIM",      S, xtrim        }, /* 231 */
  314. {   "STRING-LEFT-TRIM", S, xlefttrim    }, /* 232 */
  315. {   "STRING-RIGHT-TRIM",S, xrighttrim   }, /* 233 */
  316. {   "WHEN",             F, xwhen        }, /* 234 */
  317. {   "UNLESS",           F, xunless      }, /* 235 */
  318. {   "LOOP",             F, xloop        }, /* 236 */
  319. {   "SYMBOL-FUNCTION",  S, xsymfunction }, /* 237 */
  320. {   "FBOUNDP",          S, xfboundp     }, /* 238 */
  321. {   "SEND",             S, xsend        }, /* 239 */
  322. {   "SEND-SUPER",       S, xsendsuper   }, /* 240 */
  323. {   "PROGV",            F, xprogv       }, /* 241 */
  324. {   "CHARACTERP",       S, xcharp       }, /* 242 */
  325. {   "CHAR-INT",         S, xcharint     }, /* 243 */
  326. {   "INT-CHAR",         S, xintchar     }, /* 244 */
  327. {   "READ-BYTE",        S, xrdbyte      }, /* 245 */
  328. {   "WRITE-BYTE",       S, xwrbyte      }, /* 246 */
  329. {   "MAKE-STRING-INPUT-STREAM", S, xmkstrinput  }, /* 247 */
  330. {   "MAKE-STRING-OUTPUT-STREAM",S, xmkstroutput }, /* 248 */
  331. {   "GET-OUTPUT-STREAM-STRING", S, xgetstroutput}, /* 249 */
  332. {   "GET-OUTPUT-STREAM-LIST",   S, xgetlstoutput}, /* 250 */
  333. {   "GCD",              S, xgcd         }, /* 251 */
  334. {   "GET-LAMBDA-EXPRESSION",    S, xgetlambda       }, /* 252 */
  335. {   "MACROEXPAND",      S, xmacroexpand }, /* 253 */
  336. {   "MACROEXPAND-1",    S, x1macroexpand}, /* 254 */
  337. {   "CHAR<",            S, xchrlss      }, /* 255 */
  338. {   "CHAR<=",           S, xchrleq      }, /* 256 */
  339. {   "CHAR=",            S, xchreql      }, /* 257 */
  340. {   "CHAR/=",           S, xchrneq      }, /* 258 */
  341. {   "CHAR>=",           S, xchrgeq      }, /* 259 */
  342. {   "CHAR>",            S, xchrgtr      }, /* 260 */
  343. {   "CHAR-LESSP",       S, xchrilss     }, /* 261 */
  344. {   "CHAR-NOT-GREATERP",S, xchrileq     }, /* 262 */
  345. {   "CHAR-EQUAL",       S, xchrieql     }, /* 263 */
  346. {   "CHAR-NOT-EQUAL",   S, xchrineq     }, /* 264 */
  347. {   "CHAR-NOT-LESSP",   S, xchrigeq     }, /* 265 */
  348. {   "CHAR-GREATERP",    S, xchrigtr     }, /* 266 */
  349. {   "UPPER-CASE-P",     S, xuppercasep  }, /* 267 */
  350. {   "LOWER-CASE-P",     S, xlowercasep  }, /* 268 */
  351. {   "BOTH-CASE-P",      S, xbothcasep   }, /* 269 */
  352. {   "DIGIT-CHAR-P",     S, xdigitp      }, /* 270 */
  353. {   "ALPHANUMERICP",    S, xalphanumericp   }, /* 271 */
  354. {   "CHAR-UPCASE",      S, xchupcase    }, /* 272 */
  355. {   "CHAR-DOWNCASE",    S, xchdowncase  }, /* 273 */
  356. {   "DIGIT-CHAR",       S, xdigitchar   }, /* 274 */
  357. {   "CHAR-CODE",        S, xcharcode    }, /* 275 */
  358. {   "CODE-CHAR",        S, xcodechar    }, /* 276 */
  359. {   "ENDP",             S, xendp        }, /* 277 */
  360. {   "REMOVE-IF",        S, xremif       }, /* 278 */
  361. {   "REMOVE-IF-NOT",    S, xremifnot    }, /* 279 */
  362. {   "DELETE-IF",        S, xdelif       }, /* 280 */
  363. {   "DELETE-IF-NOT",    S, xdelifnot    }, /* 281 */
  364. {   "TRACE",            F, xtrace       }, /* 282 */
  365. {   "UNTRACE",          F, xuntrace     }, /* 283 */
  366. {   "SORT",             S, xsort        }, /* 284 */
  367.  
  368.     /* extra table entries */
  369. {   NULL,               S, xnotimp      }, /* 285 */
  370. {   NULL,               S, xnotimp      }, /* 286 */
  371. {   NULL,               S, xnotimp      }, /* 287 */
  372. {   NULL,               S, xnotimp      }, /* 288 */
  373. {   NULL,               S, xnotimp      }, /* 289 */
  374. {   NULL,               S, xnotimp      }, /* 290 */
  375. {   NULL,               S, xnotimp      }, /* 291 */
  376. {   NULL,               S, xnotimp      }, /* 292 */
  377. {   NULL,               S, xnotimp      }, /* 293 */
  378. {   NULL,               S, xnotimp      }, /* 294 */
  379. {   NULL,               S, xnotimp      }, /* 295 */
  380. {   NULL,               S, xnotimp      }, /* 296 */
  381. {   NULL,               S, xnotimp      }, /* 297 */
  382. {   NULL,               S, xnotimp      }, /* 298 */
  383. {   NULL,               S, xnotimp      }, /* 299 */
  384.  
  385.     /* include system dependant function pointers */
  386. #include "osptrs.h"
  387.  
  388. {0,0,0} /* end of table marker */
  389.  
  390. };          
  391.  
  392. /* xnotimp - function table entries that are currently not implemented */
  393. LOCAL LVAL xnotimp()
  394. {
  395.     xlfail("function not implemented");
  396.     return(NIL);  /* to keep compilers happy - L. Tierney */
  397. }
  398.  
  399.