home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / lisp / interpre / xlispplu / sources / xlisp.h < prev    next >
C/C++ Source or Header  |  1992-02-03  |  39KB  |  1,140 lines
  1. /* XLISP-PLUS is based on:
  2. */
  3.  
  4. /* xlisp - a small subset of lisp */
  5. /*      Copyright (c) 1985, by David Michael Betz
  6.         All Rights Reserved
  7.         Permission is granted for unrestricted non-commercial use       */
  8.  
  9. /* Public Domain contributors to this modified distribution:
  10.     Tom Almy, Mikael Pettersson, Neal Holtz, Johnny Greenblatt, 
  11.     Ken Whedbee, Blake McBride, Pete Yadlowsky, and Hume Smith */
  12.  
  13. /* Portions of this code from XLISP-STAT Copyright (c) 1988, Luke Tierney */
  14.  
  15. /* system specific definitions */
  16.  
  17. #include <stdio.h>
  18. #include <ctype.h>
  19. #include <setjmp.h>
  20. #include <string.h>
  21.  
  22. /************ Notice to anyone attempting modifications ****************/
  23. /* Compared to original XLISP, length of strings in an LVAL exclude the
  24.    terminating null. When appropriate, characters are consistantly treated
  25.    as unsigned, and the null, \0, character is allowed. Don't write any new
  26.    code that assumes NULL and/or NIL are zero */
  27.  
  28. /********************** PREFERENCE OPTIONS ****************/
  29.  
  30. /* There used to be many different preference options; if
  31.    you turned them all off you got "standard" xlisp 2.0. But because
  32.    of option proliferation, and the change of name, this is no longer
  33.    true: there are many fewer options, and most functions are now
  34.    standard. */
  35.  
  36. /* You can also use dynamic array allocation by substituting dldmem.c
  37.    and dlimage.c for xldmem.c and xlimage.c. Using this alternative
  38.    adds 1184 bytes of code */
  39.  
  40. /* Costs indicated for Borland Turbo C++ V1.0 (as a C compiler) */
  41.  
  42. /* Not all permutations of these choices have been tested, but luckily most
  43.    won't interract. */
  44.  
  45. /* This option modifies performance, but don't affect execution of
  46.    application programs (other than speed) */
  47. #define JMAC        /* performance enhancing macros, Johnny Greenblatt 
  48.                         (7.5K at full config). Don't bother for 16 bit
  49.                         MSDOS compilers. */
  50.  
  51. /* This option is necessary for Microsoft Windows 3.0, but can be used
  52.    under MS-DOS as well. Borland C++ and TopSpeed C provide adequate library
  53.    support for MS-DOS use. For other compilers, additional functions would
  54.    need to be written (not supplied). Windows provides the necessary
  55.    functions, so any Windows-compliant compiler should suffice.
  56.    When using this option, you must compile all modules with the medium
  57.    memory model, and you must also use the dldmem/dlimage pair of files
  58.    rather than the xldmem/xlimage pair of files.
  59.    This option is not enabled here; when desired it is enabled from the
  60.    compiler command line. */
  61. /*#define MEDMEM*/      /* Medium memory model */
  62.  
  63. /* This option is necessary for Microsoft Windows 3.0. It handles file
  64.    streams using a local table of file defining structures. For non-windows
  65.    use, the benefits are file streams can print their associated file names
  66.    and files streams are preserved across saves. It also allows the
  67.    functions TRUENAME and DELETE-FILE */
  68. #define FILETABLE
  69.  
  70. /* This option allows xlisp to be called as a server. There is no outer loop.
  71.    The STUFF file will have to modified appropriately, as well as xldbug. */
  72. /*#define SERVER*/  /* server version */
  73.  
  74. /* This option adds a *readtable-case* global variable that has the same
  75.    effect as the readtable-case function described in CLtL, 2nd Ed. 
  76.    It is contributed by Blake McBride, root@blakex.raindernet.com, who
  77.    places it in the public domain */
  78. #define READTABLECASE
  79.  
  80. /* This option adds the :KEY arguments to appropriate functions. It's
  81.    easy to work around when missing (adds about 2k bytes) */
  82. #define KEYARG
  83.  
  84. /* Use environmental variable of same name as a search
  85.     path for LOAD and RESTORE commands. Might not be
  86.     available on some systems */
  87. #define PATHNAMES "XLPATH"
  88.  
  89. /* The remainder of options solely add various functions. If you are
  90.    pressed for space, you might try eliminating some of these (particularly
  91.    TIMES, COMPLX, and RATIOS) */
  92.  
  93. #define SRCHFCN     /* SEARCH (1040 bytes)*/
  94.  
  95. #define MAPFCNS     /* SOME EVERY NOTANY NOTEVERY MAP (2352 bytes)*/
  96.  
  97. #define POSFCNS     /* POSITION-IF COUNT-IF FIND-IF (1504 bytes)*/
  98.  
  99. #define REMDUPS     /* REMOVE-DUPLICATES (1440 bytes)*/
  100.  
  101. #define REDUCE      /* REDUCE, by Luke Tierney (with modifications). 
  102.                        (1008 bytes)*/
  103.  
  104. #define ADDEDTAA    /* added function by TAA: GENERIC (336 bytes) */
  105.  
  106. #define TIMES       /* time functions TIME GET-INTERNAL-RUN-TIME
  107.                        GET-INTERNAL-REAL-TIME and constant
  108.                        INTERNAL-TIME-UNITS-PER-SECOND (5286 bytes)*/
  109.  
  110. #define RANDOM      /* Add RANDOM-NUMBER-STATE type, *RANDOM-STATE*, and
  111.                        function MAKE-RANDOM-STATE
  112.                        You must also define TIMES (736 bytes)*/
  113.  
  114. #define HASHFCNS    /* Hash table functions (Ken Whedbee):
  115.                        SETHASH (SETF (SETHASH..)), MAKE-HASH-TABLE, 
  116.                        TAA's REMHASH, MAPHASH, CLRHASH, HASH-TABLE-COUNT
  117.                        (2608 bytes)*/
  118.  
  119. #define SETS        /* Luke Tierney's set functions ADJOIN UNION INTERSECTION
  120.                         SET-DIFFERENCE SUBSETP (1328 bytes)*/
  121.  
  122. #define APPLYHOOK   /* adds applyhook support, strangely missing before 
  123.                        (1312 bytes)*/
  124.  
  125. #define COMPLX      /* complex numbers&more math from Luke Tierney:
  126.                         COMPLEX, COMPLEXP, IMAGPART, REALPART, CONJUGATE, 
  127.                         PHASE, LOG, FLOOR, CEILING, ROUND, and PI.
  128.                         Also LCM (by Ken Whedbee) and
  129.                         ASH (by Pete Yadlowsky) (15k bytes) */
  130.  
  131. #define RATIOS      /* rational numbers (by Pete Yadlowsky)
  132.                        requires COMPLX even though there is no
  133.                        support for complex rational numbers (4600 bytes)*/
  134.  
  135. #define SAVERESTORE
  136.                     /* SAVE and RESTORE commands (an original option!) 
  137.                         (3936 bytes) */
  138.  
  139. /* The following option only available for certain compilers noted
  140.    below */
  141.  
  142. #define GRAPHICS    /* add graphics commands 
  143.                         MODE COLOR MOVE DRAW MOVEREL DRAWREL
  144.                        and screen commands CLS CLEOL GOTO-XY
  145.                         (3k) */
  146.  
  147.  
  148.  
  149.  
  150. /************ END OF PREFERENCE OPTIONS **************/
  151.  
  152.  
  153. /* handle dependencies */
  154.  
  155.  
  156. #ifdef RANDOM
  157. #ifndef TIMES
  158. #define TIMES
  159. #endif
  160. #endif
  161.  
  162. #ifdef RATIOS
  163. #ifndef COMPLX
  164. #define COMPLX
  165. #endif
  166. #endif
  167.  
  168. /*************** COMPILER/ENVIRONMENT OPTIONS ****************/
  169.  
  170.  
  171.  
  172. /* Default compiler options: */
  173. /* NNODES       number of nodes to allocate in each request (2000) */
  174. /* VSSIZE       number of vector nodes to allocate in each request (6000) */
  175. /* EDEPTH       evaluation stack depth (650) */
  176. /* ADEPTH       argument stack depth (1000) */
  177. /* FORWARD      type of a forward declaration () */
  178. /* LOCAL        type of a local function (static) */
  179. /* NEAR         function is is same segment (8086 processors) () */
  180. /* AFMT         printf format for addresses ("%x") */
  181. /* FIXTYPE      data type for fixed point numbers (long) */
  182. /* MAXFIX       maximum positive value of an integer (0x7fffffffL) */
  183. /* MAXSLEN      maximum sequence length, <= maximum unsigned, on 16 bit
  184.                 systems should be the maximum string length that can be
  185.                 malloc'ed (1000000)*/
  186. /* MAXVLEN      maximum vector length, should normally be MAXSLEN, but on
  187.                 16 bit systems needs to be the maximum vector size that can
  188.                 be malloc'ed (MAXSLEN) */
  189. /* ITYPE        fixed point input conversion routine type (long atol()) */
  190. /* ICNV         fixed point input conversion routine (atol) */
  191. /* IFMT         printf format for fixed point numbers ("%ld") */
  192. /* RFMT         printf format for ratios ("%ld/%ld") */
  193. /* FLOTYPE      data type for floating point numbers (double) */
  194. /* OFFTYPE      number the size of an address (int) */
  195. /* CVPTR        macro to convert an address to an OFFTYPE. We have to go
  196.                 through hoops for some MS-DOS compilers that like to
  197.                 normalize pointers. In these days of Windows, compilers
  198.                 seem to be better behaved. Change to default definition
  199.                 only after extensive testing. This is no big deal as it
  200.                 only effects the SAVE command. (OFFTYPE)(x) */
  201. /* ALIGN32      Compiler has 32 bit ints and 32 bit alignment of struct
  202.                 elements */
  203. /* DOSINPUT     OS specific code can read using OS's line input functon */
  204. /* IEEEFP       IEEE FP -- proper printing of +-INF and NAN
  205.                        for compilers that can't hack it.
  206.                        Currently for little-endian systems. */
  207. /* CDECL        C style declaration, for compilers that can also generate
  208.                 Pascal style, to allow calling of main() ([nothing])*/
  209. /* ANSI         define for ANSI C compiler */
  210. /* FNAMEMAX     Maximum size of file name strings (63) */
  211.  
  212. /* STDIO and MEM and certain STRING calls can be overridden as needed
  213.    for various compilers or environments. By default, the standard
  214.    library functions are used. Any substitute function must mimic the
  215.    standard function in terms of arguments and return values */
  216.  
  217. /* OSAOPEN      Open ascii file (fopen) */
  218. /* OSBOPEN      Open binary file (fopen) */
  219. /* MODETYPE     Type of open mode (const char *) */
  220. /* OPEN_RO      Open mode for read only ("r") */
  221. /* OPEN_UPDATE  Open mode for update ("r+") */
  222. /* CREATE_WR    Open mode for create for writing ("w") */
  223. /* CREATE_UPDATE Open mode for create update ("w+") */
  224. /* CLOSED       Closed file, or return value when open fails (NULL) */
  225. /* OSGETC       Character read (fgetc) */
  226. /* OSPUTC       Character write (fputc) */
  227. /* OSREAD       Binary read of file (fread) */
  228. /* OSWRITE      Binary write of file (fwrite) */
  229. /* OSCLOSE      Close the file (fclose) */
  230. /* OSSEEK       Seek in file (fseek(fp,loc,SEEK_SET)) */
  231. /* OSSEEKCUR    Seek for changing direction (fseek(fp,loc,SEEK_CUR)) */
  232. /* OSSEEKEND    Seek to end  (fseek(fp,0L,SEEK_END)) */
  233. /* OSTELL       Tell file location (ftell) */
  234. /* FILEP        File pointer type (FILE *),
  235.                 used in all the above functions */
  236. /* STDIN        Standard input (a FILEP) (stdin) */
  237. /* STDOUT       Standard output (stdout) */
  238. /* CONSOLE      Console (stderr) */
  239.  
  240. /* MALLOC       Memory allocation (malloc) */
  241. /* CALLOC       Memory allocation (calloc) */
  242. /* MFREE        Memory allocation (free) */
  243.  
  244. /* These are needed in case far pointer override is necessary: */
  245.  
  246. /* STRCMP       String compare (strcmp) */
  247. /* STRCPY       String copy (strcpy) */
  248. /* STRNCPY      String copy (strncpy) */
  249. /* STRCAT       String concatenate (strcat) */
  250. /* STRLEN       String length (strlen) */
  251. /* MEMCPY       Memory copy (memcpy) */
  252.  
  253.  
  254. /* for Zortech C  -- Versions 2.0 and above, please */
  255. /* Works for Large Model, 268PM model (Z), and 386PM model (X) */
  256. /* GRAPHICS ok */
  257. /* EDEPTH should be stacksize/25 */
  258. #ifdef __ZTC__
  259. #ifdef DOS386   /* 80386 compiler */
  260. #define EDEPTH 4000 
  261. #define ADEPTH 6000
  262. #define VSSIZE 20000
  263. #define ALIGN32
  264. #define ANSI
  265. #if __ZTC__ < 0x300
  266. #define IEEEFP      /* they fixed this */
  267. #endif
  268. #define CDECL   _cdecl
  269. #define DOSINPUT
  270. #ifndef FILETABLE
  271. #define OSBOPEN osbopen /* special mode for binary files */
  272. extern FILE * _cdecl osbopen(const char *name, const char *mode);   /* open binary file */
  273. #endif
  274. #else           /* 80286PM or Real mode */
  275. #ifdef DOS16RM
  276. #define EDEPTH          2000
  277. #define ADEPTH          3000
  278. #endif
  279. #define MAXSLEN         (65519U)
  280. #define MAXVLEN         (16379U)
  281. #define ANSI
  282. #define AFMT            "%lx"
  283. #define OFFTYPE         unsigned long
  284. #if __ZTC__ < 0x300
  285. #define IEEEFP      /* they fixed this */
  286. #endif
  287. #define CDECL   _cdecl
  288. #define DOSINPUT
  289. #undef JMAC         /* not worth effort if cramped for space */
  290. #define NEAR _near
  291. #ifndef FILETABLE
  292. #define OSBOPEN osbopen /* special mode for binary files */
  293. extern FILE * _cdecl osbopen(const char *name, const char *mode);   /* open binary file */
  294. #endif
  295. #endif
  296. #undef MEDMEM       /* doesn't work, as of V2.1 */
  297. #endif
  298.  
  299. /* for the Turbo C compiler - MS-DOS, large or medium model */
  300. /* Version 1.5 and 2.0.  1.5 won't compile with TIMES */
  301. /* Also for Turbo/Borland C++, as a C compiler */
  302. /* GRAPHICS ok */
  303. /* EDEPTH should be stacksize/25 */
  304. #ifdef __TURBOC__
  305. #define MAXSLEN         (65519U)
  306. #define MAXVLEN         (16383U)
  307. #define ANSI
  308. #define AFMT            "%lx"
  309. #define OFFTYPE         unsigned long
  310. #ifdef MEDMEM
  311. #define CVPTR(x)        (unsigned long)(x)
  312. #else
  313. #define CVPTR(x)        ((((unsigned long)(x) >> 16) << 4) + ((unsigned) x))
  314. #endif
  315. #if __TURBOC__ < 0x297
  316. #define IEEEFP          /* Borland C++ V2.0 or later handles this */
  317. #endif
  318. #define CDECL _Cdecl
  319. #define DOSINPUT
  320. #undef JMAC         /* not worth effort if cramped for space */
  321. #define NEAR near
  322. #ifndef FILETABLE
  323. #define OSBOPEN osbopen /* special mode for binary files */
  324. extern FILE * _Cdecl osbopen(const char *name, const char *mode);   /* open binary file */
  325. #endif
  326. #endif
  327.  
  328. /* for the JPI TopSpeed C Compiler, Medium or Large memory model */
  329. /* GRAPHICS ok */
  330. /* EDEPTH should be stacksize/25 */
  331. #ifdef __TSC__
  332. #pragma data(heap_size=>4096,stack_size=>16384)
  333. #define IEEEFP
  334. #define MAXSLEN         (65519U)
  335. #define MAXVLEN         (16379U)
  336. #define ANSI
  337. #define AFMT            "%lx"
  338. #define OFFTYPE         unsigned long
  339. #ifdef MEDMEM
  340. #define CVPTR(x)        (unsigned long)(x)
  341. #else
  342. #define CVPTR(x)        ((((unsigned long)(x) >> 16) << 4) + ((unsigned) x))
  343. #endif
  344. #define CDECL           /* don't use CDECL with this compiler */
  345. #define DOSINPUT
  346. #undef JMAC         /* not worth effort if cramped for space */
  347. #define NEAR near
  348. #ifndef FILETABLE
  349. #define OSBOPEN osbopen /* special mode for binary files */
  350. extern FILE *osbopen(const char *name, const char *mode);   /* open binary file */
  351. #endif
  352. #endif
  353.  
  354. /* for the Microsoft C compiler - MS-DOS, large model */
  355. /* Version 5.0.  Avoid optimizations. Should work with earlier as well. */
  356. /* Version 6.0A. Most opts ok. Avoid those that conflict with longjump */
  357. /* GRAPHICS ok */
  358. /* EDEPTH should be stacksize/25 */
  359. #ifdef MSC
  360. #define MAXSLEN         (65519U)
  361. #define MAXVLEN         (16379U)
  362. #define ANSI
  363. #define AFMT            "%lx"
  364. #define OFFTYPE         long
  365. #define CVPTR(x)        ((((unsigned long)(x) >> 16) << 4) + ((unsigned) x))
  366. #define CDECL _cdecl
  367. #define DOSINPUT
  368. #undef JMAC         /* not worth effort if cramped for space */
  369. #define NEAR _near
  370. #ifndef FILETABLE
  371. #define OSBOPEN osbopen /* special mode for binary files */
  372. extern FILE * _cdecl osbopen(const char *name, const char *mode);   /* open binary file */
  373. #endif
  374. #undef MEDMEM       /* Except for Windows, in the future */
  375. #endif
  376.  
  377. /* for 80386, Metaware High-C386 */
  378. /* GRAPHICS ok -- Special fast graphics code, this
  379.    version works only for EGA/VGA/Enhanced EorVGA modes! */
  380. /* Tested with Versions 1.3, 1.4, and 1.5 */
  381. #ifdef __HIGHC__
  382. /* default EDEPTH=2000, at stacksize/34, requires stack of 68000 */
  383. #define EDEPTH 4000 
  384. #define ADEPTH 6000
  385. #define VSSIZE 20000
  386. #define ALIGN32
  387. #define ANSI
  388. #define DOSINPUT
  389. extern long myftell(FILE *fp);  /* ftell is broken at least through v1.62) */
  390. #ifdef FILETABLE
  391. #define OSTELL(f) myftell(filetab[f].fp)
  392. #else
  393. #define OSTELL myftell
  394. #define OSBOPEN osbopen /* special mode for binary files */
  395. extern FILE *osbopen(const char *name, const char *mode);   /* open binary file */
  396. #endif
  397. #undef MEDMEM
  398. #endif
  399.  
  400. /* For GCC on MSDOS (see GCCSTUFF.C) */
  401. /* for now graphics is pretty clunky, as well */
  402. #ifdef GCC
  403. #define EDEPTH 4000
  404. #define ADEPTH 6000
  405. #define VSSIZE 20000
  406. #define ALIGN32
  407. #define ANSI
  408. #define  SEEK_CUR 1
  409. #define  SEEK_END 2
  410. #define  SEEK_SET 0
  411. #define IEEEFP
  412. /* library improperly handles ASCII files re lseek() */
  413. #define OSGETC osgetc
  414. #define OSPUTC osputc
  415. #ifdef FILETABLE
  416. extern int osgetc(int), osputc(int,int);
  417. #else /* No FILETABLE */
  418. extern int osgetc(FILE*), osputc(int,FILE*);
  419. #define OSAOPEN osaopen /* special mode for ASCII files */
  420. extern FILE *osaopen(const char *name, const char *mode);
  421. #define OSBOPEN osbopen /* special mode for binary files */
  422. extern FILE *osbopen(const char *name, const char *mode);
  423. #endif
  424. #define DOSINPUT
  425. #undef MEDMEM
  426. #endif
  427.  
  428. /* for BSD & SYSV Unix. */
  429. /* Also define BSD in BSD or SUNOS systems */
  430. #ifdef UNIX
  431. #define VOID void
  432. #define EDEPTH 4000 
  433. #define ADEPTH 6000
  434. #define ALIGN32
  435. #define AFMT                    "%lx"
  436. #ifndef SEEK_SET
  437. #define SEEK_SET                0
  438. #endif
  439. #ifndef SEEK_CUR
  440. #define SEEK_CUR                1
  441. #endif
  442. #ifndef SEEK_END
  443. #define SEEK_END                2
  444. #endif
  445. #undef GRAPHICS
  446. #undef MEDMEM
  447. #define remove unlink   /* not all Unix systems have remove */
  448. #ifdef FILETABLE
  449. extern int osopen();
  450. #define OSAOPEN osopen
  451. #define OSBOPEN osopen
  452. /* use default FILETABLE declaration for OSCLOSE */
  453. #endif
  454. #endif
  455.  
  456. /* Amiga Lattice 5.04 (From Hume Smith) */
  457. #ifdef AMIGA
  458. #define EDEPTH 4000
  459. #define ADEPTH 6000
  460. #define ALIGN32
  461. #define AFMT         "%lx"
  462. #define SEEK_SET      0
  463. #define SEEK_CUR      1
  464. #define SEEK_END      2
  465. #undef GRAPHICS
  466. #undef MEDMEM
  467. #undef FILETABLE    /* not ported */
  468. #endif
  469.  
  470. /*>>>>>>> For other systems -- You are on your own! */
  471.  
  472. /* Take care of VOID default definition */
  473.  
  474. #ifndef VOID
  475. #define VOID void    
  476. #endif
  477.  
  478.  
  479. /* Handle the FILETABLE specification -- non-windows */
  480. #ifdef FILETABLE
  481. #define FTABSIZE 13
  482. #define FILEP int
  483. #define CLOSED (-1)     /* because FILEP is now table index */
  484. #define STDIN (0)
  485. #define STDOUT (1)
  486. #define CONSOLE (2)
  487. #ifndef OSAOPEN
  488. #define OSAOPEN osaopen
  489. extern FILEP osaopen(const char *name, const char *mode);
  490. #endif
  491. #ifndef OSBOPEN
  492. #define OSBOPEN osbopen
  493. extern FILEP osbopen(const char *name, const char *mode);
  494. #endif
  495. #ifndef OSGETC
  496. #define OSGETC(f) fgetc(filetab[f].fp)
  497. #endif
  498. #ifndef OSPUTC
  499. #define OSPUTC(i,f) fputc(i,filetab[f].fp)
  500. #endif
  501. #ifndef OSREAD
  502. #define OSREAD(x,y,z,f) fread(x,y,z,filetab[f].fp)
  503. #endif
  504. #ifndef OSWRITE
  505. #define OSWRITE(x,y,z,f) fwrite(x,y,z,filetab[f].fp)
  506. #endif
  507. #ifndef OSCLOSE
  508. #define OSCLOSE osclose
  509. #ifdef ANSI
  510. extern void osclose(int i); /* we must define this */
  511. #else
  512. extern VOID osclose();
  513. #endif
  514. #endif
  515. #ifndef OSSEEK
  516. #define OSSEEK(f,loc) fseek(filetab[f].fp,loc,SEEK_SET)
  517. #endif
  518. #ifndef OSSEEKEND
  519. #define OSSEEKEND(f) fseek(filetab[f].fp,0L,SEEK_END)
  520. #endif
  521. #ifndef OSSEEKCUR
  522. #define OSSEEKCUR(f,loc) fseek(filetab[f].fp,loc,SEEK_CUR)
  523. #endif
  524. #ifndef OSTELL
  525. #define OSTELL(f) ftell(filetab[f].fp)
  526. #endif
  527. #endif
  528.  
  529.  
  530. /* Handle the MEDMEM specification */
  531. #ifdef MEDMEM
  532. #ifdef __ZTC__
  533. #define FAR _far
  534. #else
  535. #include <alloc.h>
  536. #define FAR far
  537. #endif
  538. #define STRCMP _fstrcmp
  539. #define STRCPY _fstrcpy
  540. #define STRNCPY _fstrncpy
  541. #define STRCAT _fstrcat
  542. #define STRLEN _fstrlen
  543. #define MEMCPY _fmemcpy
  544. #ifdef __TSC__
  545. #define MALLOC _fmalloc
  546. #define CALLOC _fcalloc
  547. #define MFREE  _ffree
  548. #endif
  549. #ifdef __TURBOC__
  550. #define MALLOC farmalloc
  551. #define CALLOC farcalloc
  552. #define MFREE farfree
  553. #endif
  554. #endif
  555.  
  556. /************ DEFAULT DEFINITIONS  ******************/
  557. #ifndef NNODES
  558. #define NNODES          2000
  559. #endif
  560. #ifndef VSSIZE
  561. #define VSSIZE          6000
  562. #endif
  563. #ifndef EDEPTH
  564. #define EDEPTH          650
  565. #endif
  566. #ifndef ADEPTH
  567. #define ADEPTH          1000
  568. #endif
  569. #ifndef FORWARD
  570. #define FORWARD
  571. #endif
  572. #ifndef LOCAL
  573. #define LOCAL           static
  574. #endif
  575. #ifndef AFMT
  576. #define AFMT            "%x"
  577. #endif
  578. #ifndef FIXTYPE
  579. #define FIXTYPE         long
  580. #endif
  581. #ifdef ANSI /* ANSI C Compilers already define this! */
  582. #include <limits.h>
  583. #define MAXFIX  LONG_MAX
  584. #else
  585. #ifndef MAXFIX
  586. #define MAXFIX          (0x7fffffffL)
  587. #endif
  588. #endif
  589. #ifndef MAXSLEN
  590. #define MAXSLEN         (1000000)   /* no sequences longer than this */
  591. #endif
  592. #ifndef MAXVLEN
  593. #define MAXVLEN         MAXSLEN
  594. #endif
  595. #ifndef ITYPE
  596. #define ITYPE           long atol()
  597. #endif
  598. #ifndef ICNV
  599. #define ICNV(n)         atol(n)
  600. #endif
  601. #ifndef IFMT
  602. #define IFMT            "%ld"
  603. #endif
  604. #ifdef RATIOS
  605. #ifndef RFMT
  606. #define RFMT            "%ld/%ld"
  607. #endif
  608. #endif
  609. #ifndef FLOTYPE
  610. #define FLOTYPE         double
  611. #endif
  612. #ifndef OFFTYPE
  613. #define OFFTYPE         int
  614. #endif
  615. #ifndef CVPTR
  616. #define CVPTR(x)        ((OFFTYPE)(x))
  617. #endif
  618. #ifdef ANSI
  619. #define VOIDP   void
  620. #else
  621. #define VOIDP
  622. #endif
  623. #ifndef CDECL
  624. #define CDECL
  625. #endif
  626. #ifndef NEAR
  627. #define NEAR
  628. #endif
  629. #ifndef FAR
  630. #define FAR
  631. #endif
  632. #ifndef FNAMEMAX
  633. #define FNAMEMAX 63
  634. #endif
  635. #ifndef OSAOPEN
  636. #define OSAOPEN fopen
  637. #endif
  638. #ifndef OSBOPEN
  639. #define OSBOPEN fopen
  640. #endif
  641. #ifndef MODETYPE
  642. #define MODETYPE const char *
  643. #endif
  644. #ifndef OPEN_RO
  645. #define OPEN_RO "r"
  646. #endif
  647. #ifndef OPEN_UPDATE
  648. #define OPEN_UPDATE "r+"
  649. #endif
  650. #ifndef CREATE_WR
  651. #define CREATE_WR "w"
  652. #endif
  653. #ifndef CREATE_UPDATE
  654. #define CREATE_UPDATE "w+"
  655. #endif
  656. #ifndef CLOSED
  657. #define CLOSED NULL
  658. #endif
  659. #ifndef OSGETC
  660. #define OSGETC fgetc
  661. #endif
  662. #ifndef OSPUTC
  663. #define OSPUTC fputc
  664. #endif
  665. #ifndef OSREAD
  666. #define OSREAD fread
  667. #endif
  668. #ifndef OSWRITE
  669. #define OSWRITE fwrite
  670. #endif
  671. #ifndef OSCLOSE
  672. #define OSCLOSE fclose
  673. #endif
  674. #ifndef OSSEEK
  675. #define OSSEEK(fp,loc) fseek(fp,loc,SEEK_SET)
  676. #endif
  677. #ifndef OSSEEKEND
  678. #define OSSEEKEND(fp) fseek(fp,0L,SEEK_END)
  679. #endif
  680. #ifndef OSSEEKCUR
  681. #define OSSEEKCUR(fp,loc) fseek(fp,loc,SEEK_CUR)
  682. #endif
  683. #ifndef OSTELL
  684. #define OSTELL ftell
  685. #endif
  686. #ifndef FILEP
  687. #define FILEP FILE *
  688. #endif
  689. #ifndef STDIN
  690. #define STDIN stdin
  691. #endif
  692. #ifndef STDOUT
  693. #define STDOUT stdout
  694. #endif
  695. #ifndef CONSOLE
  696. #define CONSOLE stderr
  697. #endif
  698. #ifndef MALLOC
  699. #define MALLOC malloc
  700. #endif
  701. #ifndef CALLOC
  702. #define CALLOC calloc
  703. #endif
  704. #ifndef MFREE
  705. #define MFREE free
  706. #endif
  707. #ifndef STRCMP
  708. #define STRCMP strcmp
  709. #endif
  710. #ifndef STRCPY
  711. #define STRCPY strcpy
  712. #endif
  713. #ifndef STRNCPY
  714. #define STRNCPY strncpy
  715. #endif
  716. #ifndef STRCAT
  717. #define STRCAT strcat
  718. #endif
  719. #ifndef STRLEN
  720. #define STRLEN strlen
  721. #endif
  722. #ifndef MEMCPY
  723. #define MEMCPY memcpy
  724. #endif
  725.  
  726. /* useful definitions */
  727. #ifndef TRUE
  728. #define TRUE    1
  729. #endif
  730. #ifndef FALSE
  731. #define FALSE   0
  732. #endif
  733.  
  734. #ifdef COMPLX
  735. #define PI 3.14159265358979323846
  736. #endif
  737.  
  738. #ifdef ANSI
  739. #include <stdlib.h>
  740. #endif
  741.  
  742. /************* END OF COMPILER/ENVIRONMENT OPTIONS ************/
  743.  
  744.  
  745.  
  746. /* $putpatch.c$: "MODULE_XLISP_H_PROVIDES" */
  747.  
  748. /* include the dynamic memory definitions */
  749. #include "xldmem.h"
  750.  
  751. /* program limits */
  752. #define STRMAX          100             /* maximum length of a string constant */
  753. #define HSIZE           199             /* symbol hash table size */
  754. #define SAMPLE          100             /* control character sample rate */
  755.  
  756. /* function table offsets for the initialization functions */
  757. #define FT_RMHASH       0
  758. #define FT_RMQUOTE      1
  759. #define FT_RMDQUOTE     2
  760. #define FT_RMBQUOTE     3
  761. #define FT_RMCOMMA      4
  762. #define FT_RMLPAR       5
  763. #define FT_RMRPAR       6
  764. #define FT_RMSEMI       7
  765. #define FT_CLNEW        10
  766. #define FT_CLISNEW      11
  767. #define FT_CLANSWER     12
  768. #define FT_OBISNEW      13
  769. #define FT_OBCLASS      14
  770. #define FT_OBSHOW       15
  771. #define FT_OBPRIN1      16
  772.         
  773. /* macro to push a value onto the argument stack */
  774. #define pusharg(x)      {if (xlsp >= xlargstktop) xlargstkoverflow();\
  775.                          *xlsp++ = (x);}
  776.  
  777. /* macros to protect pointers */
  778. #define xlstkcheck(n)   {if (xlstack - (n) < xlstkbase) xlstkoverflow();}
  779. #define xlsave(n)       {*--xlstack = &n; n = NIL;}
  780. #define xlprotect(n)    {*--xlstack = &n;}
  781.  
  782. /* check the stack and protect a single pointer */
  783. #define xlsave1(n)      {if (xlstack <= xlstkbase) xlstkoverflow();\
  784.                          *--xlstack = &n; n = NIL;}
  785. #define xlprot1(n)      {if (xlstack <= xlstkbase) xlstkoverflow();\
  786.                          *--xlstack = &n;}
  787.  
  788. /* macros to pop pointers off the stack */
  789. #define xlpop()         {++xlstack;}
  790. #define xlpopn(n)       {xlstack+=(n);}
  791.  
  792. /* macros to manipulate the lexical environment */
  793. #define xlframe(e)      cons(NIL,e)
  794. #define xlfbind(s,v)    xlpbind(s,v,xlfenv);
  795. #define xlpbind(s,v,e)  {rplaca(e,cons(cons(s,v),car(e)));}
  796.  
  797. /* macros to manipulate the dynamic environment */
  798. #define xldbind(s,v)    {xldenv = cons(cons(s,getvalue(s)),xldenv);\
  799.                          setvalue(s,v);}
  800. #define xlunbind(e)     {for (; xldenv != (e); xldenv = cdr(xldenv))\
  801.                            setvalue(car(car(xldenv)),cdr(car(xldenv)));}
  802.  
  803. /* macro to manipulate dynamic and lexical environment */
  804.  
  805. #define xlbind(s,v) {if (specialp(s)) xldbind(s,v) else xlpbind(s,v,xlenv)}
  806. #define xlpdbind(s,v,e) {e = cons(cons(s,getvalue(s)),e);\
  807.                          setvalue(s,v);}
  808.  
  809. /* type predicates */                          
  810. #ifdef __BORLANDC__
  811. #define null(x)         (((unsigned)(void _seg *)(x)) == ((unsigned)(void _seg *) NIL))
  812. #else
  813. #ifdef MSC
  814. #define null(x)         (((unsigned)(_segment *)(x)) == ((unsigned)(_segment *) NIL))
  815. #else
  816. #define null(x)         ((x) == NIL)
  817. #endif
  818. #endif
  819. #define atom(x)         (null(x) || ntype(x) != CONS)
  820. #define listp(x)        (null(x) || ntype(x) == CONS)
  821.  
  822. #define consp(x)        (ntype(x) == CONS)
  823. #define subrp(x)        (ntype(x) == SUBR)
  824. #define fsubrp(x)       (ntype(x) == FSUBR)
  825. #define stringp(x)      (ntype(x) == STRING)
  826. #define symbolp(x)      (ntype(x) == SYMBOL)
  827. #define streamp(x)      (ntype(x) == STREAM)
  828. #define objectp(x)      (ntype(x) == OBJECT)
  829. #define fixp(x)         (ntype(x) == FIXNUM)
  830. #ifdef RATIOS
  831. #define ratiop(x)       (ntype(x) == RATIO)
  832. #endif
  833. #define floatp(x)       (ntype(x) == FLONUM)
  834. #ifdef COMPLX
  835. #define complexp(x)     (ntype(x) == COMPLEX)
  836. #endif
  837. #ifdef RATIOS
  838. #define numberp(x)      (ntype(x) == FIXNUM || ntype(x) == FLONUM || ntype(x) == RATIO)
  839. #else
  840. #define numberp(x)      (ntype(x) == FIXNUM || ntype(x) == FLONUM)
  841. #endif
  842. #define vectorp(x)      (ntype(x) == VECTOR)
  843. #define closurep(x)     (ntype(x) == CLOSURE)
  844. #define charp(x)        (ntype(x) == CHAR)
  845. #define ustreamp(x)     (ntype(x) == USTREAM)
  846. #define structp(x)      (ntype(x) == STRUCT)
  847.  
  848. #define boundp(x)       (getvalue(x) != s_unbound)
  849. #define fboundp(x)      (getfunction(x) != s_unbound)
  850.  
  851. /* shorthand functions */
  852. #define consa(x)        cons(x,NIL)
  853. #define consd(x)        cons(NIL,x)
  854.  
  855. /* argument list parsing macros */
  856. #define xlgetarg()      (testarg(nextarg()))
  857. #define xllastarg()     {if (xlargc != 0) xltoomany();}
  858. #define testarg(e)      (moreargs() ? (e) : xltoofew())
  859. #define typearg(tp)     (tp(*xlargv) ? nextarg() : xlbadtype(*xlargv))
  860. #define nextarg()       (--xlargc, *xlargv++)
  861. #define moreargs()      (xlargc > 0)
  862.  
  863. /* macros to get arguments of a particular type */
  864. #define xlgacons()      (testarg(typearg(consp)))
  865. #define xlgalist()      (testarg(typearg(listp)))
  866. #define xlgasymbol()    (testarg(typearg(symbolp)))
  867. #define xlgasymornil()  (testarg(typearg(symbolp)))
  868. #define xlgastring()    (testarg(typearg(stringp)))
  869. #define xlgastrorsym()  (testarg(symbolp(*xlargv) ? getpname(nextarg()) : typearg(stringp)))
  870. #define xlgaobject()    (testarg(typearg(objectp)))
  871. #define xlgafixnum()    (testarg(typearg(fixp)))
  872. #define xlgaflonum()    (testarg(typearg(floatp)))
  873. #define xlgachar()      (testarg(typearg(charp)))
  874. #define xlgavector()    (testarg(typearg(vectorp)))
  875. #define xlgastream()    (testarg(typearg(streamp)))
  876. #define xlgaustream()   (testarg(typearg(ustreamp)))
  877. #define xlgaclosure()   (testarg(typearg(closurep)))
  878. #define xlgastruct()    (testarg(typearg(structp)))
  879.  
  880.  
  881. /* FILETABLE specification -- non-windows */
  882. #ifdef FILETABLE
  883. typedef struct {
  884.     FILE *fp;
  885.     char *tname;    /* true file name */
  886. } FILETABLETYPE;
  887. extern FILETABLETYPE filetab[FTABSIZE];
  888. #endif
  889.  
  890. /* function definition structure */
  891. typedef struct {
  892.     char *fd_name;      /* function name */
  893.     int fd_type;        /* function type */
  894.     LVAL (*fd_subr)();  /* function entry point */
  895. } FUNDEF;
  896.  
  897. /* execution context flags */
  898. #define CF_GO           0x0001
  899. #define CF_RETURN       0x0002
  900. #define CF_THROW        0x0004
  901. #define CF_ERROR        0x0008
  902. #define CF_CLEANUP      0x0010
  903. #define CF_CONTINUE     0x0020
  904. #define CF_TOPLEVEL     0x0040
  905. #define CF_BRKLEVEL     0x0080
  906. #define CF_UNWIND       0x0100
  907.  
  908. /* execution context */
  909. typedef LVAL NEAR *FRAMEP;
  910. typedef struct context {
  911.     int c_flags;                        /* context type flags */
  912.     LVAL c_expr;                        /* expression (type dependent) */
  913.     jmp_buf c_jmpbuf;                   /* longjmp context */
  914.     struct context *c_xlcontext;        /* old value of xlcontext */
  915.     LVAL * NEAR *c_xlstack;             /* old value of xlstack */
  916.     LVAL NEAR *c_xlargv;                /* old value of xlargv */
  917.     int c_xlargc;                       /* old value of xlargc */
  918.     LVAL NEAR *c_xlfp;                  /* old value of xlfp */
  919.     LVAL NEAR *c_xlsp;                  /* old value of xlsp */
  920.     LVAL c_xlenv;                       /* old value of xlenv */
  921.     LVAL c_xlfenv;                      /* old value of xlfenv */
  922.     LVAL c_xldenv;                      /* old value of xldenv */
  923. } CONTEXT;
  924.  
  925.  
  926. /* external variables */
  927.  
  928. extern LVAL * NEAR xlstkbase[];     /* evaluation stack */
  929. extern LVAL * NEAR *xlstack;            /* evaluation stack pointer */
  930. #define xlstktop (&xlstkbase[EDEPTH])   /* top of the evaluation stack */
  931. extern LVAL NEAR xlargstkbase[];        /* base of the argument stack */
  932. #define xlargstktop (&xlargstkbase[ADEPTH]) /* top of the argument stack */
  933. extern LVAL NEAR *xlfp;             /* argument frame pointer */
  934. extern LVAL NEAR *xlsp;             /* argument stack pointer */
  935. extern LVAL NEAR *xlargv;           /* current argument vector */
  936. extern int xlargc;              /* current argument count */
  937.  
  938. #ifdef ANSI /* thanks for this trick go to Hume Smith */
  939. #define _(x) x
  940. #else
  941. #define _(x) ()
  942. #endif
  943.  
  944. /* OS system interface, *stuff file */
  945. extern VOID oscheck _((void));  /* check for control character during exec */
  946. extern VOID osinit _((char *banner)); /* initialize os interface */
  947. extern VOID osfinish _((void)); /* restore os interface */
  948. extern VOID osflush _((void));  /* flush terminal input buffer */
  949. extern long osrand _((long));   /* next random number in sequence */
  950. #ifdef PATHNAMES
  951. extern FILEP ospopen _((char *name, int ascii)); /* open file using path */
  952. #endif
  953. extern VOID xoserror _((char *msg));/* print an error message */
  954. extern int  ostgetc _((void));      /* get a character from the terminal */
  955. extern VOID ostputc _((int ch));    /* put a character to the terminal */
  956. #ifdef TIMES
  957. extern unsigned long ticks_per_second _((void));
  958. extern unsigned long run_tick_count _((void));
  959. extern unsigned long real_tick_count _((void));
  960. #endif
  961. extern int renamebackup _((char *filename));
  962. #ifdef FILETABLE
  963. extern int truename _((char *name, char *rname));
  964. #endif
  965.  
  966. /* for xlisp.c */
  967. extern VOID xlrdsave _((LVAL expr));
  968. extern VOID xlevsave _((LVAL expr));
  969. extern VOID xlfatal _((char *msg));
  970. extern VOID wrapup _((void));
  971.  
  972. /* for xleval */
  973. extern LVAL xlxeval _((LVAL expr));
  974. extern VOID xlabind _((LVAL fun, int argc, LVAL *argv));
  975. extern VOID xlfunbound _((LVAL sym));
  976. extern VOID xlargstkoverflow _((void));
  977. extern int  macroexpand _((LVAL fun, LVAL args, LVAL *pval));
  978. extern int  pushargs _((LVAL fun, LVAL args));
  979. extern LVAL makearglist _((int argc, LVAL *argv));
  980. extern VOID xlunbound _((LVAL sym));
  981. extern VOID xlstkoverflow _((void));
  982.  
  983. /* for xlio */
  984. extern int xlgetc _((LVAL fptr));
  985. extern VOID xlungetc _((LVAL fptr, int ch));
  986. extern int xlpeek _((LVAL fptr));
  987. extern VOID xlputc _((LVAL fptr, int ch));
  988. extern VOID xlflush _((void));
  989. extern VOID stdprint _((LVAL expr));
  990. extern VOID stdputstr _((char *str));
  991. extern VOID errprint _((LVAL expr));
  992. extern VOID errputstr _((char *str));
  993. extern VOID dbgprint _((LVAL expr));
  994. extern VOID dbgputstr _((char *str));
  995. extern VOID trcprin1 _((LVAL expr));
  996. extern VOID trcputstr _((char *str));
  997.  
  998. /* for xlprin */
  999. extern VOID xlputstr _((LVAL fptr, char *str));
  1000. extern VOID xlprint _((LVAL fptr, LVAL vptr, int flag));
  1001. extern VOID xlprintl _((LVAL fptr, LVAL vptr, int flag));
  1002. extern int  xlgetcolumn _((LVAL fptr));
  1003. extern int  xlfreshline _((LVAL fptr));
  1004. extern VOID xlterpri _((LVAL fptr));
  1005. extern VOID xlputstr _((LVAL fptr, char* str));
  1006.  
  1007. /* for xljump */
  1008. extern VOID xljump _((CONTEXT *target, int mask, LVAL val));
  1009. extern VOID xlbegin _((CONTEXT *cptr, int flags, LVAL expr));
  1010. extern VOID xlend _((CONTEXT *cptr));
  1011. extern VOID xlgo _((LVAL label));
  1012. extern VOID xlreturn _((LVAL name, LVAL val));
  1013. extern VOID xlthrow _((LVAL tag, LVAL val));
  1014. extern VOID xlsignal _((char FAR *emsg, LVAL arg));
  1015. extern VOID xltoplevel _((void));
  1016. extern VOID xlbrklevel _((void));
  1017. extern VOID xlcleanup _((void));
  1018. extern VOID xlcontinue _((void));
  1019.  
  1020. /* for xllist */
  1021. #ifdef HASHFCNS
  1022. extern VOID xlsetgethash _((LVAL key, LVAL table, LVAL value));
  1023. #endif
  1024.  
  1025. /* for xlsubr */
  1026. extern int xlgetkeyarg _((LVAL key, LVAL *pval));
  1027. extern int xlgkfixnum _((LVAL key, LVAL *pval));
  1028. extern VOID xltest _((LVAL *pfcn, int *ptresult));
  1029. extern int needsextension _((char *name));
  1030. extern int eql _((LVAL arg1, LVAL arg2));
  1031. extern int equal _((LVAL arg, LVAL arg2));
  1032. #ifdef KEYARG
  1033. extern LVAL xlkey _((void));
  1034. extern LVAL xlapp1 _((LVAL fun, LVAL arg));
  1035. extern int dotest1 _((LVAL arg1, LVAL fun, LVAL kfun));
  1036. extern int dotest2 _((LVAL arg1, LVAL arg2, LVAL fun, LVAL kfun));
  1037. extern int dotest2s _((LVAL arg1, LVAL arg2, LVAL fun, LVAL kfun));
  1038. #else
  1039. extern int dotest1 _((LVAL arg1, LVAL fun));
  1040. extern int dotest2 _((LVAL arg1, LVAL arg2, LVAL fun));
  1041. #endif
  1042. #ifdef COMPLX
  1043. extern FLOTYPE makefloat _((LVAL arg));
  1044. #endif
  1045.  
  1046. /* for xlobj */
  1047. extern int xlobsetvalue _((LVAL pair, LVAL sym, LVAL val));
  1048. extern int xlobgetvalue _((LVAL pair, LVAL sym, LVAL *pval));
  1049. extern VOID putobj _((LVAL fptr, LVAL obj));
  1050.  
  1051. /* for xlread */
  1052. extern LVAL tentry _((int ch));
  1053. extern int xlload _((char *fname, int vflag, int pflag));
  1054. extern int xlread _((LVAL fptr, LVAL *pval));
  1055. extern int isnumber _((char *str, LVAL *pval));
  1056.  
  1057. /* for xlstruct */
  1058. extern LVAL xlrdstruct _((LVAL list));
  1059. extern VOID xlprstruct _((LVAL fptr, LVAL vptr, int flag));
  1060.  
  1061. /* save/restore functions */
  1062. #ifdef SAVERESTORE
  1063. extern int xlirestore _((char *fname));
  1064. extern int xlisave _((char *fname));
  1065. #endif
  1066.  
  1067. /* external procedure declarations */
  1068. extern VOID obsymbols _((void));    /* initialize oop symbols */
  1069. extern VOID ossymbols _((void));    /* initialize os symbols */
  1070. extern VOID xlsymbols _((void));    /* initialize interpreter symbols */
  1071. extern VOID xloinit _((void));      /* initialize object functions */
  1072. extern VOID xlsinit _((void));      /* initialize xlsym.c */
  1073. extern VOID xlrinit _((void));      /* initialize xlread.c */
  1074. extern VOID xlminit _((void));      /* init xldmem */
  1075. extern VOID xldinit _((void));      /* initilaixe debugger */
  1076. extern  int xlinit _((char *resfile));  /* xlisp initialization routine */
  1077. extern LVAL xleval _((LVAL expr));  /* evaluate an expression */
  1078. extern LVAL xlapply _((int argc));  /* apply a function to arguments */
  1079. extern LVAL xlsubr _((char *sname, int type, LVAL (*fcn)(void),int offset));
  1080.                                 /* enter a subr/fsubr */
  1081. extern LVAL xlenter _((char *name));/* enter a symbol */
  1082. extern LVAL xlmakesym _((char *name));  /* make an uninterned symbol */
  1083. extern LVAL xlgetvalue _((LVAL sym));   /* get value of a symbol (checked) */
  1084. extern VOID xlsetvalue _((LVAL sym, LVAL val)); /* set the value of symbol */
  1085. extern LVAL xlxgetvalue _((LVAL sym));  /* get value of a symbol */
  1086. extern LVAL xlgetfunction _((LVAL sym));/* get functional value of a symbol */
  1087. extern LVAL xlxgetfunction _((LVAL sym));
  1088.                             /* get functional value of a symbol (checked) */
  1089. extern VOID xlsetfunction _((LVAL sym, LVAL val));  /* set the functional value */
  1090. extern LVAL xlexpandmacros _((LVAL form));      /* expand macros in a form */
  1091. extern LVAL xlgetprop _((LVAL sym, LVAL prp));  /* get the value of a property */
  1092. extern VOID xlputprop _((LVAL sym, LVAL val, LVAL prp)); /*set value of property*/
  1093. extern VOID xlremprop _((LVAL sym, LVAL prp));  /* remove a property */
  1094. extern LVAL xlclose _((LVAL name, LVAL type, LVAL fargs, LVAL body, LVAL env, LVAL fenv));
  1095.                                 /* create a function closure */
  1096. extern int hash _((char FAR *str, int len));    /* Hash the string */
  1097. extern int xlhash _((LVAL obj, int len));   /* Hash anything */
  1098.  
  1099. #ifdef RANDOM
  1100. extern LVAL newrandom _((long));            /* create a random-state */
  1101. #endif
  1102.  
  1103. /* argument list parsing functions */
  1104. extern LVAL xlgetfile _((int outflag));     /* get a file/stream argument */
  1105. extern LVAL xlgetfname _((void));   /* get a filename argument */
  1106.  
  1107. /* error reporting functions  (don't *really* return at all) */
  1108. extern LVAL xltoofew _((void));     /* report "too few arguments" error */
  1109. extern VOID xltoomany _((void));    /* report "too many arguments" error */
  1110. extern VOID xltoolong _((void));    /* too long to process error */
  1111. extern LVAL xlbadtype _((LVAL arg));/* report "bad argument type" error */
  1112. extern LVAL xlerror _((char FAR *emsg, LVAL arg));  /* report arbitrary error */
  1113. extern VOID xlcerror _((char FAR *cmsg, char FAR *emsg, LVAL arg)); /*recoverable error*/
  1114. extern VOID xlerrprint _((char *hdr,char FAR *cmsg, char FAR *emsg, LVAL arg));
  1115. extern VOID xlbaktrace _((int n));  /* do a backtrace */
  1116. extern VOID xlabort _((char *emsg));    /* serious error handler */
  1117. extern VOID xlfail _((char *emsg));     /* xlisp error handler */
  1118. extern VOID xlbreak _((char FAR *emsg, LVAL arg));  /* enter break look */
  1119. extern VOID xlnoassign _((LVAL arg));   /* report assignment to constant error */
  1120. extern int xlcvttype _((LVAL arg));
  1121.  
  1122. #ifdef SERVER
  1123. extern int initXlisp _((char *resfile));    /* Initialize, return error code */
  1124. extern int execXlisp _((char *cmd, int restype, 
  1125.         char FAR * FAR *resstr, LVAL * resval)); /* execute expression */
  1126. extern VOID wrapupXlisp _((void));          /* relinquish memory, quit */
  1127. #endif
  1128.  
  1129.  
  1130. extern int redirectin, redirectout; /* input/output redirection */
  1131. extern char buf[];              /* temporary character buffer */
  1132.  
  1133. extern struct node isnil;
  1134. #define NIL (&isnil)
  1135.  
  1136. #include "xlftab.h"
  1137.  
  1138. /* Should be last in file: */
  1139. /* $putpatch.c$: "MODULE_XLISP_H_GLOBALS" */
  1140.