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