1 /* xlisp - a small subset of lisp */ 2 /* Copyright (c) 1985, by David Michael Betz 3 All Rights Reserved 4 Permission is granted for unrestricted non-commercial use 5 6 HISTORY 7 28-Apr-03 Mazzoni 8 Added declarations for path.c (new file) 9 30-Mar-88 Dale Amon CMU-CSD 10 Set it up for unix. Picked _TURBOC_ because defs 11 are reasonable. 12 */ 13 14 /* system specific definitions */ 15 16 #ifndef __XLISP__ 17 #define __XLISP__ 18 19 #ifdef __cplusplus 20 extern "C" { 21 #endif 22 23 #include <stdlib.h> /* needed for getenv(); note that this was a problem 24 for PMAX implementation, but I assume PMAX is obsolete now. 25 - RBD 16apr04 */ 26 #include <stdio.h> 27 #include <ctype.h> 28 #include <setjmp.h> 29 30 /* NNODES number of nodes to allocate in each request (1000) */ 31 /* EDEPTH evaluation stack depth (2000) */ 32 /* ADEPTH argument stack depth (1000) */ 33 /* FORWARD type of a forward declaration () */ 34 /* LOCAL type of a local function (static) */ 35 /* AFMT printf format for addresses ("%x") */ 36 /* FIXTYPE data type for fixed point numbers (long) */ 37 /* ITYPE fixed point input conversion routine type (long atol()) */ 38 /* ICNV fixed point input conversion routine (atol) */ 39 /* IFMT printf format for fixed point numbers ("%ld") */ 40 /* FLOTYPE data type for floating point numbers (float) */ 41 /* OFFTYPE number the size of an address (int) */ 42 43 /* for the Win32 environment */ 44 #ifdef WIN32 45 #define NNODES 2000 46 #define AFMT "%p" 47 // TRY 64bit-ints throughout XLisp even on 32-bit Windows 48 // #ifdef _WIN64 49 #define OFFTYPE long long 50 #define FIXTYPE long long 51 #define IFMT "%lld" 52 #define ICNV(n) atoll(n) 53 // #else 54 // #define OFFTYPE long 55 // #define IFMT "%ld" 56 // #endif 57 /* #define SAVERESTORE */ 58 #define XL_LITTLE_ENDIAN 59 #define _longjmp longjmp 60 #define _setjmp setjmp 61 #endif 62 63 /* for the Turbo C compiler - MS-DOS, large model */ 64 #ifdef _TURBOC_ 65 #define NNODES 2000 66 #define AFMT "%lx" 67 #define OFFTYPE long 68 /* #define SAVERESTORE */ 69 #define XL_LITTLE_ENDIAN 70 #endif 71 72 /* for the AZTEC C compiler - MS-DOS, large model */ 73 #ifdef AZTEC_LM 74 #define NNODES 2000 75 #define AFMT "%lx" 76 #define OFFTYPE long 77 #define CVPTR(x) ptrtoabs(x) 78 #define NIL (void *)0 79 extern long ptrtoabs(); 80 /* #define SAVERESTORE */ 81 #define XL_LITTLE_ENDIAN 82 #endif 83 84 /* for the AZTEC C compiler - Macintosh */ 85 #ifdef AZTEC_MAC 86 #define NNODES 2000 87 #define AFMT "%lx" 88 #define OFFTYPE long 89 #define NIL (void *)0 90 #define SAVERESTORE 91 #define XL_BIG_ENDIAN 92 #endif 93 94 /* for the AZTEC C compiler - Amiga */ 95 #ifdef AZTEC_AMIGA 96 #define NNODES 2000 97 #define AFMT "%lx" 98 #define OFFTYPE long 99 #define NIL (void *)0 100 #define SAVERESTORE 101 #define XL_BIG_ENDIAN 102 #endif 103 104 /* for the Lightspeed C compiler - Macintosh */ 105 #ifdef LSC 106 #define NNODES 2000 107 #define AFMT "%lx" 108 #define OFFTYPE long 109 #define NIL (void *)0 110 #define SAVERESTORE 111 #define XL_BIG_ENDIAN 112 #endif 113 114 /* for the Microsoft C compiler - MS-DOS, large model */ 115 #ifdef MSC 116 #define NNODES 2000 117 #define AFMT "%lx" 118 #define OFFTYPE long 119 #define XL_LITTLE_ENDIAN 120 #endif 121 122 /* for the Mark Williams C compiler - Atari ST */ 123 #ifdef MWC 124 #define AFMT "%lx" 125 #define OFFTYPE long 126 #define XL_BIG_ENDIAN 127 #endif 128 129 /* for the Lattice C compiler - Atari ST */ 130 #ifdef LATTICE 131 #define FIXTYPE int 132 #define ITYPE int atoi() 133 #define ICNV(n) atoi(n) 134 #define IFMT "%d" 135 #define XL_BIG_ENDIAN 136 #endif 137 138 /* for the Digital Research C compiler - Atari ST */ 139 #ifdef DR 140 #define LOCAL 141 #define AFMT "%lx" 142 #define OFFTYPE long 143 #undef NULL 144 #define NULL 0L 145 #define XL_BIG_ENDIAN 146 #endif 147 148 /* Mac Metrowerks CW 6 */ 149 #ifdef __MWERKS__ 150 #define LSC 151 #undef PATHNAMES 152 #undef FILETABLE 153 #undef SAVERESTORE 154 #undef MEDMEM 155 #define EDEPTH 4000 156 #define ADEPTH 3000 157 #define OSAOPEN osaopen 158 #define OSBOPEN osbopen 159 #define NO_EXTENSIONS /* don't add ".lsp" onto filenames */ 160 #define XL_BIG_ENDIAN 161 #endif 162 163 /* Linux on Pentium */ 164 #if defined(__linux__) || defined(__GLIBC__) || defined(__CYGWIN__) 165 #define AFMT "%p" 166 #include <inttypes.h> 167 #include <endian.h> 168 #if __BYTE_ORDER == __LITTLE_ENDIAN 169 #define XL_LITTLE_ENDIAN 170 #else 171 #define XL_BIG_ENDIAN 172 #endif 173 #endif 174 175 /* FreeBSD */ 176 #ifdef __FreeBSD__ 177 #if __BYTE_ORDER == __LITTLE_ENDIAN 178 #define XL_LITTLE_ENDIAN 179 #else 180 #define XL_BIG_ENDIAN 181 #endif 182 #endif 183 184 /* DragonFly */ 185 #ifdef __DragonFly__ 186 #if defined(_BYTE_ORDER) 187 #if _BYTE_ORDER == _LITTLE_ENDIAN 188 #define XL_LITTLE_ENDIAN 189 #else 190 #define XL_BIG_ENDIAN 191 #endif 192 #else 193 #error "Byteorder undefined" 194 #endif 195 #endif 196 197 /* Apple CC (xcode, macOS, macintosh) */ 198 #ifdef __APPLE__ 199 #define NNODES 2000 200 #define AFMT "%p" 201 #define OFFTYPE long 202 #define NIL (void *)0 203 /* #define SAVERESTORE */ 204 #include <sys/types.h> 205 /* #if __BYTE_ORDER == __LITTLE_ENDIAN */ 206 #if defined(__LITTLE_ENDIAN__) 207 #define XL_LITTLE_ENDIAN 208 #else 209 #define XL_BIG_ENDIAN 210 #endif 211 #endif 212 213 /* default important definitions */ 214 #ifndef NNODES 215 #define NNODES 1000 216 #endif 217 #ifndef NTYPES 218 #define NTYPES 20 219 #endif 220 #ifndef EDEPTH 221 /* originally was 2000 */ 222 #define EDEPTH 4000 223 #endif 224 #ifndef ADEPTH 225 /* originally was 1000 */ 226 #define ADEPTH 2000 227 #endif 228 #ifndef FORWARD 229 #define FORWARD 230 #endif 231 #ifndef LOCAL 232 #define LOCAL static 233 #endif 234 #ifndef AFMT 235 #define AFMT "%lx" 236 #endif 237 #ifndef FIXTYPE 238 #define FIXTYPE long 239 #endif 240 #ifndef ITYPE 241 #ifndef atol /* if atol is a macro, this will mess things up */ 242 #define ITYPE long atol() 243 #endif 244 #endif 245 #ifndef ICNV 246 #define ICNV(n) atol(n) 247 #endif 248 #ifndef IFMT 249 #define IFMT "%ld" 250 #endif 251 #ifndef FLOTYPE 252 #define FLOTYPE double 253 #endif 254 #ifndef OFFTYPE 255 #define OFFTYPE int 256 #endif 257 #ifndef CVPTR 258 #define CVPTR(x) (x) 259 #endif 260 #ifndef UCHAR 261 #define UCHAR unsigned char 262 #endif 263 264 #ifndef STDERR 265 #define STDERR stderr 266 #endif 267 268 /* useful definitions */ 269 #ifndef TRUE 270 #define TRUE 1 271 #define FALSE 0 272 #endif 273 #define externp(x) ((x) && ntype(x) == EXTERN) 274 #ifndef NIL 275 #define NIL (LVAL )0 276 #endif 277 278 /* include the dynamic memory definitions */ 279 #include "xldmem.h" 280 281 /* program limits */ 282 #define STRMAX 250 /* maximum length of a string constant */ 283 /* this was 100 -- I had a perfectly good full path to init.lsp using 284 a directory structure created by Apple's Xcode that was about 108 285 characters, so I picked a bigger value. -RBD */ 286 287 #define HSIZE 1499 /* symbol hash table size */ 288 #define SAMPLE 50000 /* control character sample rate */ 289 /* Jul 2014: Under Xcode, debug, 2.4 GHz Intel Core i7: oscheck rate is 290 about 66Hz */ 291 292 /* function table offsets for the initialization functions */ 293 #define FT_RMHASH 0 294 #define FT_RMQUOTE 1 295 #define FT_RMDQUOTE 2 296 #define FT_RMBQUOTE 3 297 #define FT_RMCOMMA 4 298 #define FT_RMLPAR 5 299 #define FT_RMRPAR 6 300 #define FT_RMSEMI 7 301 #define FT_CLNEW 10 302 #define FT_CLISNEW 11 303 #define FT_CLANSWER 12 304 #define FT_OBISNEW 13 305 #define FT_OBCLASS 14 306 #define FT_OBSHOW 15 307 #define FT_OBISA 16 308 309 /* macro to push a value onto the argument stack */ 310 #define pusharg(x) {if (xlsp >= xlargstktop) xlargstkoverflow();\ 311 *xlsp++ = (x);} 312 313 /* #define DEBUG_GC */ 314 315 /* macros to protect pointers */ 316 #ifdef DEBUG_GC 317 void dbg_gc_xlsave(LVAL *n); 318 319 #define xlstkcheck(n) {if (xlstack - (n) < xlstkbase) xlstkoverflow();} 320 #define xlsave(n) {*--xlstack = &n; n = NIL; dbg_gc_xlsave(&n);} 321 #define xlprotect(n) {*--xlstack = &n; dbg_gc_xlsave(&n);} 322 323 /* check the stack and protect a single pointer */ 324 #define xlsave1(n) {if (xlstack <= xlstkbase) xlstkoverflow();\ 325 *--xlstack = &n; n = NIL; dbg_gc_xlsave(&n);} 326 #define xlprot1(n) {if (xlstack <= xlstkbase) xlstkoverflow();\ 327 *--xlstack = &n; dbg_gc_xlsave(&n);} 328 329 /* macros to pop pointers off the stack */ 330 #define xlpop() {++xlstack;} 331 #define xlpopn(n) {xlstack+=(n);} 332 333 #else 334 335 #define xlstkcheck(n) {if (xlstack - (n) < xlstkbase) xlstkoverflow();} 336 #define xlsave(n) {*--xlstack = &n; n = NIL;} 337 #define xlprotect(n) {*--xlstack = &n;} 338 339 /* check the stack and protect a single pointer */ 340 #define xlsave1(n) {if (xlstack <= xlstkbase) xlstkoverflow();\ 341 *--xlstack = &n; n = NIL;} 342 #define xlprot1(n) {if (xlstack <= xlstkbase) xlstkoverflow();\ 343 *--xlstack = &n;} 344 345 /* macros to pop pointers off the stack */ 346 #define xlpop() {++xlstack;} 347 #define xlpopn(n) {xlstack+=(n);} 348 #endif 349 350 /* macros to manipulate the lexical environment */ 351 #define xlframe(e) cons(NIL,e) 352 #define xlbind(s,v) xlpbind(s,v,xlenv) 353 #define xlfbind(s,v) xlpbind(s,v,xlfenv); 354 #define xlpbind(s,v,e) {rplaca(e,cons(cons(s,v),car(e)));} 355 356 /* macros to manipulate the dynamic environment */ 357 #define xldbind(s,v) {xldenv = cons(cons(s,getvalue(s)),xldenv);\ 358 setvalue(s,v);} 359 #define xlunbind(e) {for (; xldenv != (e); xldenv = cdr(xldenv))\ 360 setvalue(car(car(xldenv)),cdr(car(xldenv)));} 361 362 /* type predicates */ 363 #define atomp(x) ((x) == NIL || ntype(x) != CONS) 364 #define null(x) ((x) == NIL) 365 #define listp(x) ((x) == NIL || ntype(x) == CONS) 366 #define consp(x) ((x) && ntype(x) == CONS) 367 #define subrp(x) ((x) && ntype(x) == SUBR) 368 #define fsubrp(x) ((x) && ntype(x) == FSUBR) 369 #define stringp(x) ((x) && ntype(x) == STRING) 370 #define symbolp(x) ((x) && ntype(x) == SYMBOL) 371 #define streamp(x) ((x) && ntype(x) == STREAM) 372 #define objectp(x) ((x) && ntype(x) == OBJECT) 373 #define fixp(x) ((x) && ntype(x) == FIXNUM) 374 #define floatp(x) ((x) && ntype(x) == FLONUM) 375 #define vectorp(x) ((x) && ntype(x) == VECTOR) 376 #define closurep(x) ((x) && ntype(x) == CLOSURE) 377 #define charp(x) ((x) && ntype(x) == CHAR) 378 #define ustreamp(x) ((x) && ntype(x) == USTREAM) 379 #define boundp(x) (getvalue(x) != s_unbound) 380 #define fboundp(x) (getfunction(x) != s_unbound) 381 382 /* shorthand functions */ 383 #define consa(x) cons(x,NIL) 384 #define consd(x) cons(NIL,x) 385 386 /* argument list parsing macros */ 387 #define xlgetarg() (testarg(nextarg())) 388 #define xllastarg() {if (xlargc != 0) xltoomany();} 389 #define testarg(e) (moreargs() ? (e) : xltoofew()) 390 #define typearg(tp) (tp(*xlargv) ? nextarg() : xlbadtype(*xlargv)) 391 #define nextarg() (--xlargc, *xlargv++) 392 #define moreargs() (xlargc > 0) 393 394 /* macros to get arguments of a particular type */ 395 #define xlgacons() (testarg(typearg(consp))) 396 #define xlgalist() (testarg(typearg(listp))) 397 #define xlgasymbol() (testarg(typearg(symbolp))) 398 #define xlgastring() (testarg(typearg(stringp))) 399 #define xlgaobject() (testarg(typearg(objectp))) 400 #define xlgafixnum() (testarg(typearg(fixp))) 401 #define xlgaflonum() (testarg(typearg(floatp))) 402 #define xlgachar() (testarg(typearg(charp))) 403 #define xlgavector() (testarg(typearg(vectorp))) 404 #define xlgastream() (testarg(typearg(streamp))) 405 #define xlgaustream() (testarg(typearg(ustreamp))) 406 #define xlgaclosure() (testarg(typearg(closurep))) 407 408 /* function definition structure */ 409 typedef struct { 410 const char *fd_name; /* function name */ 411 int fd_type; /* function type */ 412 LVAL (*fd_subr)(void); /* function entry point */ 413 } FUNDEF; 414 415 /* execution context flags */ 416 #define CF_GO 0x0001 417 #define CF_RETURN 0x0002 418 #define CF_THROW 0x0004 419 #define CF_ERROR 0x0008 420 #define CF_CLEANUP 0x0010 421 #define CF_CONTINUE 0x0020 422 #define CF_TOPLEVEL 0x0040 423 #define CF_BRKLEVEL 0x0080 424 #define CF_UNWIND 0x0100 425 426 427 /* execution context */ 428 typedef struct context { 429 int c_flags; /* context type flags */ 430 LVAL c_expr; /* expression (type dependant) */ 431 jmp_buf c_jmpbuf; /* _longjmp context */ 432 struct context *c_xlcontext; /* old value of xlcontext */ 433 LVAL **c_xlstack; /* old value of xlstack */ 434 LVAL *c_xlargv; /* old value of xlargv */ 435 int c_xlargc; /* old value of xlargc */ 436 LVAL *c_xlfp; /* old value of xlfp */ 437 LVAL *c_xlsp; /* old value of xlsp */ 438 LVAL c_xlenv; /* old value of xlenv */ 439 LVAL c_xlfenv; /* old value of xlfenv */ 440 LVAL c_xldenv; /* old value of xldenv */ 441 } XLCONTEXT; 442 443 /* external variables */ 444 extern LVAL **xlstktop; /* top of the evaluation stack */ 445 extern LVAL **xlstkbase; /* base of the evaluation stack */ 446 extern LVAL **xlstack; /* evaluation stack pointer */ 447 extern LVAL *xlargstkbase; /* base of the argument stack */ 448 extern LVAL *xlargstktop; /* top of the argument stack */ 449 extern LVAL *xlfp; /* argument frame pointer */ 450 extern LVAL *xlsp; /* argument stack pointer */ 451 extern LVAL *xlargv; /* current argument vector */ 452 extern int xlargc; /* current argument count */ 453 454 /* more external variables */ 455 extern LVAL xlenv,xlfenv,xldenv,xlvalue,s_true; 456 extern LVAL lk_optional,lk_rest,lk_key,lk_aux,lk_allow_other_keys; 457 extern LVAL s_evalhook,s_applyhook,s_tracelist; 458 extern LVAL s_lambda,s_macro; 459 extern LVAL s_unbound; 460 extern int xlsample; 461 extern char buf[]; 462 extern LVAL obarray,s_gcflag,s_gchook; 463 extern int xldebug; 464 extern LVAL s_debugio; 465 extern LVAL s_tracenable,s_tlimit,s_breakenable; 466 extern LVAL s_loadingfiles; 467 extern LVAL k_direction,k_input,k_output; 468 extern LVAL s_stdin,s_stdout; 469 extern int xlfsize; 470 /* external variables */ 471 extern LVAL s_car,s_cdr,s_nth,s_get,s_svalue,s_splist,s_aref; 472 extern LVAL s_comma,s_comat; 473 extern char gsprefix[]; 474 extern int gsnumber; 475 476 477 /* additional prototypes */ 478 479 extern FILE *osaopen (const char *name, const char *mode); 480 extern FILE *osbopen (const char *name, const char *mode); 481 482 #ifdef __MWERKS__ 483 /* macfun.c */ 484 485 LVAL xptsize(void); 486 LVAL xhidepen(void); 487 LVAL xshowpen(void); 488 LVAL xgetpen(void); 489 LVAL xpenmode(void); 490 LVAL xpensize(void); 491 LVAL xpenpat(void); 492 LVAL xpennormal(void); 493 LVAL xmoveto(void); 494 LVAL xmove(void); 495 LVAL xdrawto(void); 496 LVAL xdraw(void); 497 LVAL xshowgraphics(void); 498 LVAL xhidegraphics(void); 499 LVAL xcleargraphics(void); 500 LVAL xtool(void); 501 LVAL xtool16(void); 502 LVAL xtool32(void); 503 LVAL xnewhandle(void); 504 LVAL xnewptr(void); 505 LVAL xhiword(void); 506 LVAL xloword(void); 507 LVAL xrdnohang(void); 508 /* #include "macstuff.h" */ 509 #endif 510 511 /* for extern.c */ 512 513 void inval_caches(void); 514 515 516 /* for xlbfun.c */ 517 518 LVAL xeval(void); 519 LVAL xapply(void); 520 LVAL xfuncall(void); 521 LVAL xmacroexpand(void); 522 LVAL x1macroexpand(void); 523 LVAL xatom(void); 524 LVAL xsymbolp(void); 525 LVAL xnumberp(void); 526 LVAL xintegerp(void); 527 LVAL xfloatp(void); 528 LVAL xcharp(void); 529 LVAL xstringp(void); 530 LVAL xarrayp(void); 531 LVAL xstreamp(void); 532 LVAL xobjectp(void); 533 LVAL xboundp(void); 534 LVAL xfboundp(void); 535 LVAL xnull(void); 536 LVAL xlistp(void); 537 LVAL xendp(void); 538 LVAL xconsp(void); 539 LVAL xeq(void); 540 LVAL xeql(void); 541 LVAL xequal(void); 542 LVAL xset(void); 543 LVAL xgensym(void); 544 LVAL xmakesymbol(void); 545 LVAL xintern(void); 546 LVAL xsymname(void); 547 LVAL xsymvalue(void); 548 LVAL xsymfunction(void); 549 LVAL xsymplist(void); 550 LVAL xget(void); 551 LVAL xputprop(void); 552 LVAL xremprop(void); 553 LVAL xhash(void); 554 LVAL xaref(void); 555 LVAL xmkarray(void); 556 LVAL xvector(void); 557 LVAL xerror(void); 558 LVAL xcerror(void); 559 LVAL xbreak(void); 560 LVAL xcleanup(void); 561 LVAL xtoplevel(void); 562 LVAL xcontinue(void); 563 LVAL xevalhook(void); 564 565 566 /* xlcont.c */ 567 568 LVAL xquote(void); 569 LVAL xfunction(void); 570 LVAL xbquote(void); 571 LVAL xlambda(void); 572 LVAL xgetlambda(void); 573 LVAL xsetq(void); 574 LVAL xpsetq(void); 575 LVAL xsetf(void); 576 LVAL xdefun(void); 577 LVAL xdefmacro(void); 578 LVAL xcond(void); 579 LVAL xwhen(void); 580 LVAL xunless(void); 581 LVAL xcase(void); 582 LVAL xand(void); 583 LVAL x_or(void); // xor causes problems for gcc, so I renamed it. -RBD 584 LVAL xif(void); 585 LVAL xlet(void); 586 LVAL xletstar(void); 587 LVAL xflet(void); 588 LVAL xlabels(void); 589 LVAL xmacrolet(void); 590 LVAL xprog(void); 591 LVAL xprogstar(void); 592 LVAL xgo(void); 593 LVAL xreturn(void); 594 LVAL xrtnfrom(void); 595 LVAL xprog1(void); 596 LVAL xprog2(void); 597 LVAL xprogn(void); 598 LVAL xprogv(void); 599 LVAL xloop(void); 600 LVAL xdo(void); 601 LVAL xdostar(void); 602 LVAL xdolist(void); 603 LVAL xdotimes(void); 604 LVAL xblock(void); 605 LVAL xtagbody(void); 606 LVAL xcatch(void); 607 LVAL xthrow(void); 608 LVAL xunwindprotect(void); 609 LVAL xerrset(void); 610 LVAL xtrace(void); 611 LVAL xuntrace(void); 612 613 614 /* xldbug.c */ 615 616 void xlabort(const char *emsg); 617 void xlbreak(const char *emsg, LVAL arg); 618 void xlfail(const char *emsg); 619 void xlerror(const char *emsg, LVAL arg); 620 void xlcerror(const char *cmsg, const char *emsg, LVAL arg); 621 void xlerrprint(const char *hdr, const char *cmsg, const char *emsg, LVAL arg); 622 void xlbaktrace(int n); 623 void xldinit(void); 624 void close_loadingfiles(void); 625 626 /* xldmem.c */ 627 extern long total; /* total bytes allocated by xlisp */ 628 629 LVAL cons(LVAL x, LVAL y); 630 LVAL cvstring(const char *str); 631 LVAL new_string(int size); 632 LVAL cvsymbol(const char *pname); 633 LVAL cvsubr(LVAL (*fcn)(void), int type, int offset); 634 LVAL cvfile(FILE *fp); 635 LVAL cvfixnum(FIXTYPE n); 636 LVAL cvflonum(FLOTYPE n); 637 LVAL cvchar(int n); 638 LVAL newustream(void); 639 LVAL newobject(LVAL cls, int size); 640 LVAL newclosure(LVAL name, LVAL type, LVAL env, LVAL fenv); 641 LVAL newvector(int size); 642 void gc(void); 643 SEGMENT *newsegment(int n); 644 LVAL xgc(void); 645 LVAL xexpand(void); 646 LVAL xalloc(void); 647 LVAL xmem(void); 648 LVAL xsave(void); 649 LVAL xrestore(void); 650 void xlminit(void); 651 LVAL cvextern(xtype_desc typeptr, unsigned char *instptr); /* convert an external type */ 652 LVAL newnode(int type); 653 void mark(LVAL ptr); 654 655 656 /* xleval.c */ 657 658 LVAL xleval(LVAL expr); 659 LVAL xlxeval(LVAL expr); 660 LVAL xlapply(int argc); 661 LVAL xlexpandmacros(LVAL form); 662 int macroexpand(LVAL fun, LVAL args, LVAL *pval); 663 int pushargs(LVAL fun, LVAL args); 664 LVAL makearglist(int argc, LVAL *argv); 665 LVAL xlclose(LVAL name, LVAL type, LVAL fargs, LVAL body, LVAL env, LVAL fenv); 666 void xlabind(LVAL fun, int argc, LVAL *argv); 667 void xlunbound(LVAL sym); 668 void xlfunbound(LVAL sym); 669 void xlstkoverflow(void); 670 void xlargstkoverflow(void); 671 672 673 /* xlfio.c */ 674 675 LVAL xread(void); 676 LVAL xprint(void); 677 LVAL xprin1(void); 678 LVAL xprinc(void); 679 LVAL xterpri(void); 680 LVAL xflatsize(void); 681 LVAL xflatc(void); 682 LVAL xopen(void); 683 LVAL xbopen(void); 684 LVAL xclose(void); 685 LVAL xrdchar(void); 686 LVAL xrdbyte(void); 687 LVAL xpkchar(void); 688 LVAL xwrchar(void); 689 LVAL xwrbyte(void); 690 LVAL xrdint(void); 691 LVAL xwrint(void); 692 LVAL xrdfloat(void); 693 LVAL xwrfloat(void); 694 LVAL xreadline(void); 695 LVAL xmkstrinput(void); 696 LVAL xmkstroutput(void); 697 LVAL xgetstroutput(void); 698 LVAL xgetlstoutput(void); 699 LVAL xformat(void); 700 LVAL xlistdir(void); 701 LVAL xbigendianp(void); 702 703 /* xlimage.c */ 704 705 int xlisave(const char *fname); 706 int xlirestore(const char *fname); 707 708 709 /* xlinit.c */ 710 711 void xlinit(void); 712 void xlsymbols(void); 713 714 715 /* xlftab.c */ 716 /* returns true on success, 717 false if table limits would be exceeded and the table remains unchanged 718 Call this, any number of times, before calling xlisp_main_init 719 */ 720 int xlbindfunctions(const FUNDEF *functions, size_t nfunctions); 721 722 /* xlio.c */ 723 724 int xlgetc(LVAL fptr); 725 void xlungetc(LVAL fptr, int ch); 726 int xlpeek(LVAL fptr); 727 void xlputc(LVAL fptr, int ch); 728 void xloutflush(LVAL fptr); 729 void xlflush(void); 730 void stdprint(LVAL expr); 731 void stdputstr(const char *str); 732 void stdflush(void); 733 void errprint(LVAL expr); 734 void errputstr(const char *str); 735 void dbgprint(LVAL expr); 736 void dbgputstr(const char *str); 737 void trcprin1(LVAL expr); 738 void trcputstr(const char *str); 739 740 741 /* xlisp.c */ 742 long xlsrand(long seed); 743 long xlrand(long range); 744 double xlrealrand(void); 745 void xlrdsave(LVAL expr); 746 void xlevsave(LVAL expr); 747 void xlfatal(const char *msg); 748 void xlisp_main_init(int, char **); 749 void xlisp_main(void); 750 void xlisp_wrapup(void); 751 752 753 /* xljump.c */ 754 755 void xlbegin(XLCONTEXT *cptr, int flags, LVAL expr); 756 void xlend(XLCONTEXT *cptr); 757 void xlgo(LVAL label); 758 void xlreturn(LVAL name, LVAL val); 759 void xlthrow(LVAL tag, LVAL val); 760 void xlsignal(const char *emsg, LVAL arg); 761 void xltoplevel(void); 762 void xlbrklevel(void); 763 void xlcleanup(void); 764 void xlcontinue(void); 765 void xljump(XLCONTEXT *target, int mask, LVAL val); 766 767 768 /* xllist.c */ 769 770 LVAL xcar(void); 771 LVAL xcdr(void); 772 LVAL xcaar(void); 773 LVAL xcadr(void); 774 LVAL xcdar(void); 775 LVAL xcddr(void); 776 LVAL xcaaar(void); 777 LVAL xcaadr(void); 778 LVAL xcadar(void); 779 LVAL xcaddr(void); 780 LVAL xcdaar(void); 781 LVAL xcdadr(void); 782 LVAL xcddar(void); 783 LVAL xcdddr(void); 784 785 /* cxxxxr functions */ 786 LVAL xcaaaar(void); 787 LVAL xcaaadr(void); 788 LVAL xcaadar(void); 789 LVAL xcaaddr(void); 790 LVAL xcadaar(void); 791 LVAL xcadadr(void); 792 LVAL xcaddar(void); 793 LVAL xcadddr(void); 794 LVAL xcdaaar(void); 795 LVAL xcdaadr(void); 796 LVAL xcdadar(void); 797 LVAL xcdaddr(void); 798 LVAL xcddaar(void); 799 LVAL xcddadr(void); 800 LVAL xcdddar(void); 801 LVAL xcddddr(void); 802 LVAL xcons(void); 803 LVAL xlist(void); 804 LVAL xappend(void); 805 LVAL xreverse(void); 806 LVAL xlast(void); 807 LVAL xmember(void); 808 LVAL xassoc(void); 809 LVAL xsubst(void); 810 LVAL xsublis(void); 811 LVAL xremove(void); 812 LVAL xremif(void); 813 LVAL xremifnot(void); 814 int dotest1(LVAL arg, LVAL fun); 815 int dotest2(LVAL arg1, LVAL arg2, LVAL fun); 816 LVAL xnth(void); 817 LVAL xnthcdr(void); 818 LVAL xlength(void); 819 LVAL xmapc(void); 820 LVAL xmapcar(void); 821 LVAL xmapl(void); 822 LVAL xmaplist(void); 823 LVAL xrplca(void); 824 LVAL xrplcd(void); 825 LVAL xnconc(void); 826 LVAL xdelete(void); 827 LVAL xdelif(void); 828 LVAL xdelifnot(void); 829 LVAL xsort(void); 830 831 832 /* xlmath.c */ 833 834 LVAL xadd(void); 835 LVAL xsub(void); 836 LVAL xmul(void); 837 LVAL xdiv(void); 838 LVAL xrem(void); 839 LVAL xmin(void); 840 LVAL xmax(void); 841 LVAL xexpt(void); 842 LVAL xlogand(void); 843 LVAL xlogior(void); 844 LVAL xlogxor(void); 845 LVAL xgcd(void); 846 void checkizero(FIXTYPE iarg); 847 void checkfzero(FLOTYPE farg); 848 void checkfneg(FLOTYPE farg); 849 LVAL xlognot(void); 850 LVAL xabs(void); 851 LVAL xadd1(void); 852 LVAL xsub1(void); 853 LVAL xsin(void); 854 LVAL xcos(void); 855 LVAL xtan(void); 856 LVAL xexp(void); 857 LVAL xsqrt(void); 858 LVAL xfix(void); 859 LVAL xfloat(void); 860 LVAL xrand(void); 861 LVAL xsrand(void); 862 LVAL xminusp(void); 863 LVAL xzerop(void); 864 LVAL xplusp(void); 865 LVAL xevenp(void); 866 LVAL xoddp(void); 867 LVAL xlss(void); 868 LVAL xleq(void); 869 LVAL xequ(void); 870 LVAL xneq(void); 871 LVAL xgeq(void); 872 LVAL xgtr(void); 873 LVAL xrealrand(void); 874 LVAL xtan(void); 875 LVAL xatan(void); 876 877 /* xlobj.c */ 878 879 LVAL xsend(void); 880 LVAL xsendsuper(void); 881 LVAL xlclass(const char *name, int vcnt); 882 void xladdivar(LVAL cls, const char *var); 883 void xladdmsg(LVAL cls, const char *msg, int offset); 884 int xlobgetvalue(LVAL pair, LVAL sym, LVAL *pval); 885 int xlobsetvalue(LVAL pair, LVAL sym, LVAL val); 886 LVAL obisnew(void); 887 LVAL obclass(void); 888 LVAL obshow(void); 889 LVAL obisa(void); 890 LVAL clnew(void); 891 LVAL clisnew(void); 892 LVAL clanswer(void); 893 void obsymbols(void); 894 void xloinit(void); 895 896 897 /* xlpp.c */ 898 899 LVAL xpp(void); 900 901 902 /* xlprin.c */ 903 904 void xlprint(LVAL fptr, LVAL vptr, int flag); 905 void xlterpri(LVAL fptr); 906 void xlputstr(LVAL fptr, const char *str); 907 void putatm(LVAL fptr, const char *tag, LVAL val); 908 909 910 /* xlread.c */ 911 912 int xlload(const char *fname, int vflag, int pflag); 913 int xlread(LVAL fptr, LVAL *pval, int rflag); 914 int readone(LVAL fptr, LVAL *pval); 915 LVAL rmhash(void); 916 LVAL rmquote(void); 917 LVAL rmdquote(void); 918 LVAL rmbquote(void); 919 LVAL rmcomma(void); 920 LVAL rmlpar(void); 921 LVAL rmrpar(void); 922 LVAL rmsemi(void); 923 LVAL tentry(int ch); 924 int xlisnumber(char *str, LVAL *pval); 925 void defmacro(int ch, LVAL type, int offset); 926 LVAL callmacro(LVAL fptr, int ch); 927 void xlrinit(void); 928 929 930 /* xlstr.c */ 931 932 LVAL xstrlss(void); 933 LVAL xstrleq(void); 934 LVAL xstreql(void); 935 LVAL xstrneq(void); 936 LVAL xstrgeq(void); 937 LVAL xstrgtr(void); 938 LVAL xstrilss(void); 939 LVAL xstrileq(void); 940 LVAL xstrieql(void); 941 LVAL xstrineq(void); 942 LVAL xstrigeq(void); 943 LVAL xstrigtr(void); 944 LVAL xupcase(void); 945 LVAL xdowncase(void); 946 LVAL xnupcase(void); 947 LVAL xndowncase(void); 948 LVAL xstrsearch(void); 949 LVAL xtrim(void); 950 LVAL xlefttrim(void); 951 LVAL xrighttrim(void); 952 LVAL xstrcat(void); 953 LVAL xsubseq(void); 954 LVAL xstring(void); 955 LVAL xchar(void); 956 LVAL xcharint(void); 957 LVAL xintchar(void); 958 LVAL xuppercasep(void); 959 LVAL xlowercasep(void); 960 LVAL xbothcasep(void); 961 LVAL xdigitp(void); 962 LVAL xcharcode(void); 963 LVAL xcodechar(void); 964 LVAL xchupcase(void); 965 LVAL xchdowncase(void); 966 LVAL xdigitchar(void); 967 LVAL xalphanumericp(void); 968 LVAL xchrlss(void); 969 LVAL xchrleq(void); 970 LVAL xchreql(void); 971 LVAL xchrneq(void); 972 LVAL xchrgeq(void); 973 LVAL xchrgtr(void); 974 LVAL xchrilss(void); 975 LVAL xchrileq(void); 976 LVAL xchrieql(void); 977 LVAL xchrineq(void); 978 LVAL xchrigeq(void); 979 LVAL xchrigtr(void); 980 LVAL xinfo(void); 981 982 /* xlsubr.c */ 983 984 LVAL xlsubr(const char *sname, int type, LVAL (*fcn)(void), int offset); 985 int xlgetkeyarg(LVAL key, LVAL *pval); 986 void xltest(LVAL *pfcn, int *ptresult); 987 int xlgkfixnum(LVAL key, LVAL *pval); 988 /* argument list parsing functions */ 989 extern LVAL xlgetfile(void); /* get a file/stream argument */ 990 extern LVAL xlgetfname(void); /* get a filename argument */ 991 int needsextension(const char *name); 992 /* error reporting functions (don't *really* return at all) */ 993 extern LVAL xlbadtype(LVAL arg); /* report "bad argument type" error */ 994 extern LVAL xltoofew(void); /* report "too few arguments" error */ 995 extern LVAL xltoomany(void); 996 int eq(LVAL arg1, LVAL arg2); 997 int eql(LVAL arg1, LVAL arg2); 998 int lval_equal(LVAL arg1, LVAL arg2); 999 1000 1001 /* xlsym.c */ 1002 1003 LVAL xlenter(const char *name); /* enter a symbol */ 1004 LVAL xlmakesym(const char *name); /* make an uninterned symbol */ 1005 LVAL xlgetvalue(LVAL sym); /* get value of a symbol (checked) */ 1006 LVAL xlxgetvalue(LVAL sym); /* get value of a symbol */ 1007 void xlsetvalue(LVAL sym, LVAL val); 1008 LVAL xlgetfunction(LVAL sym); /* get functional value of a symbol */ 1009 LVAL xlxgetfunction(LVAL sym); /* get functional value of a symbol (checked) */ 1010 void xlsetfunction(LVAL sym, LVAL val); 1011 LVAL xlgetprop(LVAL sym, LVAL prp); 1012 void xlputprop(LVAL sym, LVAL val, LVAL prp); 1013 void xlremprop(LVAL sym, LVAL prp); 1014 int hash(const char *str, int len); 1015 void xlsinit(void); 1016 LVAL findprop(LVAL sym, LVAL prp); 1017 1018 /* xlsys.c */ 1019 1020 LVAL xget_env(void); 1021 LVAL xload(void); 1022 LVAL xtranscript(void); 1023 LVAL xtype(void); 1024 LVAL xbaktrace(void); 1025 LVAL xexit(void); 1026 LVAL xpeek(void); 1027 LVAL xpoke(void); 1028 LVAL xaddrs(void); 1029 LVAL xgetruntime(void); 1030 LVAL xprofile(void); 1031 LVAL xquit(void); 1032 1033 /* macstuff, unixstuff, winstuff, osstuff */ 1034 1035 LVAL xgetrealtime(void); 1036 extern const char os_pathchar; 1037 extern const char os_sepchar; 1038 1039 void osinit(const char *banner); 1040 void oserror(const char *msg); 1041 void osfinish(void); 1042 int osclose(FILE *fp); 1043 void osflush(void); 1044 void oscheck(void); 1045 int osaputc(int ch, FILE *fp); 1046 void osoutflush(FILE *fp); 1047 int osbputc(int ch, FILE *fp); 1048 void ostputc(int ch); 1049 void ostoutflush(void); 1050 int osagetc(FILE *fp); 1051 int osbgetc(FILE *fp); 1052 int ostgetc(void); 1053 void ossymbols(void); 1054 LVAL xlinfo(void); 1055 LVAL xsetdir(void); 1056 int osdir_list_start(const char *path); 1057 const char *osdir_list_next(void); 1058 void osdir_list_finish(void); 1059 LVAL xosc_enable(void); 1060 LVAL xget_temp_path(void); 1061 LVAL xfind_in_xlisp_path(void); 1062 LVAL xsetupconsole(void); 1063 LVAL xechoenabled(void); 1064 LVAL xget_user(void); 1065 1066 /* security.c */ 1067 1068 extern char *secure_read_path; 1069 extern char *safe_write_path; 1070 extern int run_time_limit; 1071 extern int run_time; 1072 extern int memory_limit; 1073 #define SAFE_NYQUIST (safe_write_path != NULL) 1074 int ok_to_open(const char *filename, const char *mode); 1075 1076 /* These are now implemented in path.c -dmazzoni */ 1077 const char *return_xlisp_path(void); 1078 const char *find_in_xlisp_path(const char *fname); 1079 void set_xlisp_path(const char *p); 1080 1081 /* local.c - these procedures are specific to each implementation */ 1082 1083 void localinit(void); 1084 void localsymbols(void); 1085 void print_local_gc_info(void); 1086 void local_toplevel(void); 1087 1088 #ifdef __cplusplus 1089 } 1090 #endif 1091 1092 #endif 1093 1094