home *** CD-ROM | disk | FTP | other *** search
/ Stars of Shareware: Programmierung / SOURCE.mdf / programm / windows / c / xlisp21w / sources / xlftab.c < prev    next >
Encoding:
C/C++ Source or Header  |  1992-02-03  |  17.7 KB  |  481 lines
  1. /* xlftab.c - xlisp function table */
  2. /*  Copyright (c) 1985, by David Michael Betz
  3.     All Rights Reserved
  4.     Permission is granted for unrestricted non-commercial use   */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* include system dependant definitions */
  9. #include "osdefs.h"
  10.  
  11. /* SUBR/FSUBR indicator */
  12. #define S   SUBR
  13. #define F   FSUBR
  14.  
  15.  
  16. /* xnotimp - function table entries that are currently not implemented */
  17. LOCAL LVAL xnotimp()
  18. {
  19.     xlfail("function not implemented");
  20.     return NIL;
  21. }
  22.  
  23.  
  24. /* the function table */
  25. FUNDEF funtab[] = {
  26. /* DO NOT ALTER ENTRIES UNTIL AFTER OBPRIN1 */
  27.     /* read macro functions */
  28. {   NULL,               S, rmhash       },
  29. {   NULL,               S, rmquote      },
  30. {   NULL,               S, rmdquote     },
  31. {   NULL,               S, rmbquote     },
  32. {   NULL,               S, rmcomma      },
  33. {   NULL,               S, rmlpar       },
  34. {   NULL,               S, rmrpar       },
  35. {   NULL,               S, rmsemi       },
  36. {   NULL,               S, xnotimp      },
  37. {   NULL,               S, xnotimp      },
  38.  
  39.     /* methods */
  40. {   NULL,               S, clnew        },
  41. {   NULL,               S, clisnew      },
  42. {   NULL,               S, clanswer     },
  43. {   NULL,               S, obisnew      },
  44. {   NULL,               S, obclass      },
  45. {   NULL,               S, obshow       },
  46. {   NULL,               S, obprin1      },
  47.  
  48. /* Empty slots not needed beyond this point */
  49.  
  50.     /* evaluator functions */
  51. {   "EVAL",             S, xeval        },
  52. {   "APPLY",            S, xapply       },
  53. {   "FUNCALL",          S, xfuncall     },
  54. {   "QUOTE",            F, xquote       },
  55. {   "FUNCTION",         F, xfunction    },
  56. {   "BACKQUOTE",        F, xbquote      },
  57. {   "LAMBDA",           F, xlambda      },
  58.  
  59.     /* symbol functions */
  60. {   "SET",              S, xset         },
  61. {   "SETQ",             F, xsetq        },
  62. {   "SETF",             F, xsetf        },
  63. {   "DEFUN",            F, xdefun       },
  64. {   "DEFMACRO",         F, xdefmacro    },
  65. {   "GENSYM",           S, xgensym      },
  66. {   "MAKE-SYMBOL",      S, xmakesymbol  },
  67. {   "INTERN",           S, xintern      },
  68. {   "SYMBOL-NAME",      S, xsymname     },
  69. {   "SYMBOL-VALUE",     S, xsymvalue    },
  70. {   "SYMBOL-PLIST",     S, xsymplist    },
  71. {   "GET",              S, xget         },
  72. {   "PUTPROP",          S, xputprop     },
  73. {   "REMPROP",          S, xremprop     },
  74. {   "HASH",             S, xhash        },
  75.  
  76.     /* array functions */
  77. {   "MAKE-ARRAY",       S, xmkarray     },
  78. {   "AREF",             S, xaref        },
  79.             
  80.     /* list functions */
  81. {   "CAR",              S, xcar         },
  82. {   "CDR",              S, xcdr         },
  83.             
  84. {   "CAAR",             S, xcaar        },
  85. {   "CADR",             S, xcadr        },
  86. {   "CDAR",             S, xcdar        },
  87. {   "CDDR",             S, xcddr        },
  88.  
  89. {   "CAAAR",            S, xcaaar       },
  90. {   "CAADR",            S, xcaadr       },
  91. {   "CADAR",            S, xcadar       },
  92. {   "CADDR",            S, xcaddr       },
  93. {   "CDAAR",            S, xcdaar       },
  94. {   "CDADR",            S, xcdadr       },
  95. {   "CDDAR",            S, xcddar       },
  96. {   "CDDDR",            S, xcdddr       },
  97.  
  98. {   "CAAAAR",           S, xcaaaar      },
  99. {   "CAAADR",           S, xcaaadr      },
  100. {   "CAADAR",           S, xcaadar      },
  101. {   "CAADDR",           S, xcaaddr      },
  102. {   "CADAAR",           S, xcadaar      },
  103. {   "CADADR",           S, xcadadr      },
  104. {   "CADDAR",           S, xcaddar      },
  105. {   "CADDDR",           S, xcadddr      },
  106. {   "CDAAAR",           S, xcdaaar      },
  107. {   "CDAADR",           S, xcdaadr      },
  108. {   "CDADAR",           S, xcdadar      },
  109. {   "CDADDR",           S, xcdaddr      },
  110. {   "CDDAAR",           S, xcddaar      },
  111. {   "CDDADR",           S, xcddadr      },
  112. {   "CDDDAR",           S, xcdddar      },
  113. {   "CDDDDR",           S, xcddddr      },
  114.  
  115. {   "CONS",             S, xcons        },
  116. {   "LIST",             S, xlist        },
  117. {   "LIST*",            S, xliststar    },
  118. {   "APPEND",           S, xappend      },
  119. {   "REVERSE",          S, xreverse     },
  120. {   "LAST",             S, xlast        },
  121. {   "NTH",              S, xnth         },
  122. {   "NTHCDR",           S, xnthcdr      },
  123. {   "MEMBER",           S, xmember      },
  124. {   "ASSOC",            S, xassoc       },
  125. {   "SUBST",            S, xsubst       },
  126. {   "SUBLIS",           S, xsublis      },
  127. {   "REMOVE",           S, xremove      },
  128. {   "LENGTH",           S, xlength      },
  129. {   "MAPC",             S, xmapc        },
  130. {   "MAPCAR",           S, xmapcar      },
  131. {   "MAPL",             S, xmapl        },
  132. {   "MAPLIST",          S, xmaplist     },
  133. {   "MAPCAN",           S, xmapcan      },
  134. {   "MAPCON",           S, xmapcon      },
  135.  
  136.             
  137.     /* destructive list functions */
  138. {   "RPLACA",           S, xrplca       },
  139. {   "RPLACD",           S, xrplcd       },
  140. {   "NCONC",            S, xnconc       },
  141. {   "DELETE",           S, xdelete      },
  142.  
  143.     /* predicate functions */
  144. {   "ATOM",             S, xatom        },
  145. {   "SYMBOLP",          S, xsymbolp     },
  146. {   "NUMBERP",          S, xnumberp     },
  147. {   "BOUNDP",           S, xboundp      },
  148. {   "NULL",             S, xnull        },
  149. {   "LISTP",            S, xlistp       },
  150. {   "CONSP",            S, xconsp       },
  151. {   "MINUSP",           S, xminusp      },
  152. {   "ZEROP",            S, xzerop       },
  153. {   "PLUSP",            S, xplusp       },
  154. {   "EVENP",            S, xevenp       },
  155. {   "ODDP",             S, xoddp        },
  156. {   "EQ",               S, xeq          },
  157. {   "EQL",              S, xeql         },
  158. {   "EQUAL",            S, xequal       },
  159.  
  160.     /* special forms */
  161. {   "COND",             F, xcond        },
  162. {   "CASE",             F, xcase        },
  163. {   "AND",              F, xand         },
  164. {   "OR",               F, xor          },
  165. {   "LET",              F, xlet         },
  166. {   "LET*",             F, xletstar     },
  167. {   "IF",               F, xif          },
  168. {   "PROG",             F, xprog        },
  169. {   "PROG*",            F, xprogstar    },
  170. {   "PROG1",            F, xprog1       },
  171. {   "PROG2",            F, xprog2       },
  172. {   "PROGN",            F, xprogn       },
  173. {   "GO",               F, xgo          },
  174. {   "RETURN",           F, xreturn      },
  175. {   "DO",               F, xdo          },
  176. {   "DO*",              F, xdostar      },
  177. {   "DOLIST",           F, xdolist      },
  178. {   "DOTIMES",          F, xdotimes     },
  179. {   "CATCH",            F, xcatch       },
  180. {   "THROW",            F, xthrow       },
  181.     
  182.     /* debugging and error handling functions */
  183. {   "ERROR",            S, xerror       },
  184. {   "CERROR",           S, xcerror      },
  185. {   "BREAK",            S, xbreak       },
  186. {   "CLEAN-UP",         S, xcleanup     },
  187. {   "TOP-LEVEL",        S, xtoplevel    },
  188. {   "CONTINUE",         S, xcontinue    },
  189. {   "ERRSET",           F, xerrset      },
  190. {   "BAKTRACE",         S, xbaktrace    },
  191. {   "EVALHOOK",         S, xevalhook    },
  192.  
  193.     /* arithmetic functions */
  194. {   "TRUNCATE",         S, xfix         },
  195. {   "FLOAT",            S, xfloat       },
  196. {   "+",                S, xadd         },
  197. {   "-",                S, xsub         },
  198. {   "*",                S, xmul         },
  199. {   "/",                S, xdiv         },
  200. {   "1+",               S, xadd1        },
  201. {   "1-",               S, xsub1        },
  202. {   "REM",              S, xrem         },
  203. {   "MIN",              S, xmin         },
  204. {   "MAX",              S, xmax         },
  205. {   "ABS",              S, xabs         },
  206. {   "SIN",              S, xsin         },
  207. {   "COS",              S, xcos         },
  208. {   "TAN",              S, xtan         },
  209. {   "EXPT",             S, xexpt        },
  210. {   "EXP",              S, xexp         },
  211. {   "SQRT",             S, xsqrt        },
  212. {   "RANDOM",           S, xrand        },
  213.             
  214.     /* bitwise logical functions */
  215. {   "LOGAND",           S, xlogand      },
  216. {   "LOGIOR",           S, xlogior      },
  217. {   "LOGXOR",           S, xlogxor      },
  218. {   "LOGNOT",           S, xlognot      },
  219. #ifdef COMPLX
  220. {   "ASH",              S, xash         },
  221. #endif
  222.  
  223.     /* numeric comparison functions */
  224. {   "<",                S, xlss         },
  225. {   "<=",               S, xleq         },
  226. {   "=",                S, xequ         },
  227. {   "/=",               S, xneq         },
  228. {   ">=",               S, xgeq         },
  229. {   ">",                S, xgtr         },
  230.             
  231.     /* string functions */
  232.  
  233. {   "CONCATENATE",      S, xconcatenate },
  234. {   "SUBSEQ",           S, xsubseq      },
  235. {   "STRING",           S, xstring      },
  236. {   "CHAR",             S, xchar        },
  237.  
  238.     /* I/O functions */
  239. {   "READ",             S, xread        },
  240. {   "PRINT",            S, xprint       },
  241. {   "PRIN1",            S, xprin1       },
  242. {   "PRINC",            S, xprinc       },
  243. {   "TERPRI",           S, xterpri      },
  244. {   "FLATSIZE",         S, xflatsize    },
  245. {   "FLATC",            S, xflatc       },
  246.             
  247.     /* file I/O functions */
  248. {   "OPEN",             S, xopen        },
  249. {   "FORMAT",           S, xformat      },
  250. {   "CLOSE",            S, xclose       },
  251. {   "READ-CHAR",        S, xrdchar      },
  252. {   "PEEK-CHAR",        S, xpkchar      },
  253. {   "WRITE-CHAR",       S, xwrchar      },
  254. {   "READ-LINE",        S, xreadline    },
  255.  
  256.     /* system functions */
  257. {   "LOAD",             S, xload        },
  258. {   "DRIBBLE",          S, xtranscript  },
  259.  
  260. /* functions specific to xldmem.c */
  261. {   "GC",               S, xgc          },
  262. {   "EXPAND",           S, xexpand      },
  263. {   "ALLOC",            S, xalloc       },
  264. {   "ROOM",             S, xmem         },
  265. #ifdef SAVERESTORE
  266. {   "SAVE",             S, xsave        },
  267. {   "RESTORE",          S, xrestore     },
  268. #endif
  269. /* end of functions specific to xldmem.c */
  270.  
  271. {   "TYPE-OF",          S, xtype        },
  272. {   "EXIT",             S, xexit        },
  273. {   "PEEK",             S, xpeek        },
  274. {   "POKE",             S, xpoke        },
  275. {   "ADDRESS-OF",       S, xaddrs       },
  276.  
  277.     /* new functions and special forms */
  278. {   "VECTOR",           S, xvector      },
  279. {   "BLOCK",            F, xblock       },
  280. {   "RETURN-FROM",      F, xrtnfrom     },
  281. {   "TAGBODY",          F, xtagbody     },
  282. {   "PSETQ",            F, xpsetq       },
  283. {   "FLET",             F, xflet        },
  284. {   "LABELS",           F, xlabels      },
  285. {   "MACROLET",         F, xmacrolet    },
  286. {   "UNWIND-PROTECT",   F, xunwindprotect},
  287. {   "PPRINT",           S, xpp          },
  288. {   "STRING<",          S, xstrlss      },
  289. {   "STRING<=",         S, xstrleq      },
  290. {   "STRING=",          S, xstreql      },
  291. {   "STRING/=",         S, xstrneq      },
  292. {   "STRING>=",         S, xstrgeq      },
  293. {   "STRING>",          S, xstrgtr      },
  294. {   "STRING-LESSP",     S, xstrilss     },
  295. {   "STRING-NOT-GREATERP",S,xstrileq    },
  296. {   "STRING-EQUAL",     S, xstrieql     },
  297. {   "STRING-NOT-EQUAL", S, xstrineq     },
  298. {   "STRING-NOT-LESSP", S, xstrigeq     },
  299. {   "STRING-GREATERP",  S, xstrigtr     },
  300. {   "INTEGERP",         S, xintegerp    },
  301. {   "FLOATP",           S, xfloatp      },
  302. {   "STRINGP",          S, xstringp     },
  303. {   "ARRAYP",           S, xarrayp      },
  304. {   "STREAMP",          S, xstreamp     },
  305. {   "OBJECTP",          S, xobjectp     },
  306. {   "STRING-UPCASE",    S, xupcase      },
  307. {   "STRING-DOWNCASE",  S, xdowncase    },
  308. {   "NSTRING-UPCASE",   S, xnupcase     },
  309. {   "NSTRING-DOWNCASE", S, xndowncase   },
  310. {   "STRING-TRIM",      S, xtrim        },
  311. {   "STRING-LEFT-TRIM", S, xlefttrim    },
  312. {   "STRING-RIGHT-TRIM",S, xrighttrim   },
  313. {   "WHEN",             F, xwhen        },
  314. {   "UNLESS",           F, xunless      },
  315. {   "LOOP",             F, xloop        },
  316. {   "SYMBOL-FUNCTION",  S, xsymfunction },
  317. {   "FBOUNDP",          S, xfboundp     },
  318. {   "SEND",             S, xsend        },
  319. {   "SEND-SUPER",       S, xsendsuper   },
  320. {   "PROGV",            F, xprogv       },
  321. {   "CHARACTERP",       S, xcharp       },
  322. {   "CHAR-INT",         S, xcharint     },
  323. {   "INT-CHAR",         S, xintchar     },
  324. {   "READ-BYTE",        S, xrdbyte      },
  325. {   "WRITE-BYTE",       S, xwrbyte      },
  326. {   "MAKE-STRING-INPUT-STREAM", S, xmkstrinput      },
  327. {   "MAKE-STRING-OUTPUT-STREAM",S, xmkstroutput     },
  328. {   "GET-OUTPUT-STREAM-STRING", S, xgetstroutput    },
  329. {   "GET-OUTPUT-STREAM-LIST",   S, xgetlstoutput    },
  330. {   "GCD",              S, xgcd         },
  331. {   "GET-LAMBDA-EXPRESSION",    S, xgetlambda       },
  332. {   "MACROEXPAND",      S, xmacroexpand },
  333. {   "MACROEXPAND-1",    S, x1macroexpand},
  334. {   "CHAR<",            S, xchrlss      },
  335. {   "CHAR<=",           S, xchrleq      },
  336. {   "CHAR=",            S, xchreql      },
  337. {   "CHAR/=",           S, xchrneq      },
  338. {   "CHAR>=",           S, xchrgeq      },
  339. {   "CHAR>",            S, xchrgtr      },
  340. {   "CHAR-LESSP",       S, xchrilss     },
  341. {   "CHAR-NOT-GREATERP",S, xchrileq     },
  342. {   "CHAR-EQUAL",       S, xchrieql     },
  343. {   "CHAR-NOT-EQUAL",   S, xchrineq     },
  344. {   "CHAR-NOT-LESSP",   S, xchrigeq     },
  345. {   "CHAR-GREATERP",    S, xchrigtr     },
  346. {   "UPPER-CASE-P",     S, xuppercasep  },
  347. {   "LOWER-CASE-P",     S, xlowercasep  },
  348. {   "BOTH-CASE-P",      S, xbothcasep   },
  349. {   "DIGIT-CHAR-P",     S, xdigitp      },
  350. {   "ALPHANUMERICP",    S, xalphanumericp},
  351. {   "CHAR-UPCASE",      S, xchupcase    },
  352. {   "CHAR-DOWNCASE",    S, xchdowncase  },
  353. {   "DIGIT-CHAR",       S, xdigitchar   },
  354. {   "CHAR-CODE",        S, xcharcode    },
  355. {   "CODE-CHAR",        S, xcodechar    },
  356. {   "ENDP",             S, xendp        },
  357. {   "REMOVE-IF",        S, xremif       },
  358. {   "REMOVE-IF-NOT",    S, xremifnot    },
  359. {   "DELETE-IF",        S, xdelif       },
  360. {   "DELETE-IF-NOT",    S, xdelifnot    },
  361. {   "TRACE",            F, xtrace       },
  362. {   "UNTRACE",          F, xuntrace     },
  363. {   "SORT",             S, xsort        },
  364. #ifdef ADDEDTAA
  365. {   "GENERIC",          S, xgeneric     },
  366. #endif
  367. #ifdef TIMES
  368. {   "TIME",             F, xtime        },
  369. {   "GET-INTERNAL-RUN-TIME",    S, xruntime  },
  370. {   "GET-INTERNAL-REAL-TIME",   S, xrealtime },
  371. #endif
  372. /* extra table entries */
  373. #ifdef POSFCNS
  374. {   "COUNT-IF",         S, xcountif     },
  375. {   "FIND-IF",          S, xfindif      },
  376. {   "POSITION-IF",      S, xpositionif  },
  377. #endif
  378. {   "COERCE",           S, xcoerce      },
  379. {   "ELT",              S, xelt         },
  380. #ifdef SRCHFCN
  381. {   "SEARCH",           S, xsearch      },
  382. #endif
  383. #ifdef MAPFCNS
  384. {   "MAP",              S, xmap         },
  385. {   "SOME",             S, xsome        },
  386. {   "EVERY",            S, xevery       },
  387. {   "NOTANY",           S, xnotany      },
  388. {   "NOTEVERY",         S, xnotevery    },
  389. #endif
  390. {   "FILE-POSITION",    S, xfileposition},
  391. {   "FILE-LENGTH",      S, xfilelength  },
  392. {   "FRESH-LINE",       S, xfreshline   },
  393. {   "OPEN-STREAM-P",    S, xopenstreamp },
  394. {   "INPUT-STREAM-P",   S, xinputstreamp},
  395. {   "OUTPUT-STREAM-P",  S, xoutputstreamp},
  396. #ifdef FILETABLE
  397. {   "TRUENAME",         S, xtruename    },
  398. {   "DELETE-FILE",      S, xdeletefile  },
  399. #endif
  400. {   "DEFSTRUCT",        F, xdefstruct   },
  401. {   "%STRUCT-TYPE-P",   S, xstrtypep    },
  402. {   "%MAKE-STRUCT",     S, xmkstruct    },
  403. {   "%COPY-STRUCT",     S, xcpystruct   },
  404. {   "%STRUCT-REF",      S, xstrref      },
  405. {   "%STRUCT-SET",      S, xstrset      },
  406. {   "ASIN",             S, xasin        },
  407. {   "ACOS",             S, xacos        },
  408. {   "ATAN",             S, xatan        },
  409. #ifdef APPLYHOOK
  410. {   "APPLYHOOK",        S, xapplyhook   },
  411. #endif
  412. {   "NREVERSE",         S, xnreverse    },
  413. {   "BUTLAST",          S, xbutlast     },
  414. {   "TYPEP",            S, xtypep       },
  415. #ifdef REDUCE
  416. {   "REDUCE",           S, xreduce      },
  417. #endif
  418. #ifdef REMDUPS
  419. {   "REMOVE-DUPLICATES",S, xremove_duplicates },
  420. #endif
  421.  
  422. #ifdef SETS
  423. {   "ADJOIN",           S, xadjoin          },
  424. {   "UNION",            S, xunion           },
  425. {   "INTERSECTION",     S, xintersection    },
  426. {   "SET-DIFFERENCE",   S, xset_difference  },
  427. {   "SUBSETP",          S, xsubsetp         },
  428. #endif
  429.  
  430. #ifdef HASHFCNS
  431. {   "GETHASH",          S, xgethash         },
  432. {   "REMHASH",          S, xremhash         },
  433. {   "MAKE-HASH-TABLE",  S, xmakehash        },
  434. {   "CLRHASH",          S, xclrhash         },
  435. {   "MAPHASH",          S, xmaphash         },
  436. {   "HASH-TABLE-COUNT", S, xhashcount       },
  437. #endif
  438.  
  439. #ifdef COMPLX
  440. {   "COMPLEXP",         S, xcomplexp        },
  441. {   "COMPLEX",          S, xcomplex         },
  442. {   "CONJUGATE",        S, xconjugate       },
  443. {   "REALPART",         S, xrealpart        },
  444. {   "IMAGPART",         S, ximagpart        },
  445. {   "LOG",              S, xlog             },
  446. {   "FLOOR",            S, xfloor           },
  447. {   "CEILING",          S, xceil            },
  448. {   "ROUND",            S, xround           },
  449. {   "PHASE",            S, xphase           },
  450. {   "LCM",              S, xlcm             },
  451. {   "MOD",              S, xmod             },
  452. #endif
  453.  
  454. #ifdef RATIOS
  455. {   "RATIONALP",        S, xrationalp       },
  456. {   "NUMERATOR",        S, xnumerator       },
  457. {   "DENOMINATOR",      S, xdenominator     },
  458. #endif
  459.  
  460. {   "DEFCONSTANT",      F, xdefconstant     },
  461. {   "CONSTANTP",        S, xconstantp       },
  462. {   "DEFPARAMETER",     F, xdefparameter    },
  463. {   "DEFVAR",           F, xdefvar          },
  464. {   "MAKUNBOUND",       S, xmakunbound      },
  465.  
  466. #ifdef RANDOM
  467. {   "MAKE-RANDOM-STATE",S, xmakerandom      },
  468. #endif
  469.  
  470.     /* include system dependent function pointers */
  471. #include "osptrs.h"
  472.  
  473.     /* Two patches here to promote module portability to xscheme:*/
  474.     /* $putpatch.c$: "MODULE_XLFTAB_C_FUNTAB_S" */
  475.     /* $putpatch.c$: "MODULE_XLFTAB_C_FUNTAB_F" */
  476. {0,0,0} /* end of table marker */
  477.  
  478. };          
  479.  
  480. int ftabsize = sizeof(funtab); /* TAA MOD -- added validity check */
  481.