Return to eval.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / src

Annotation of 43BSDReno/contrib/emacs-18.55/src/eval.c, revision 1.1

1.1     ! root        1: /* Evaluator for GNU Emacs Lisp interpreter.
        !             2:    Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is distributed in the hope that it will be useful,
        !             7: but WITHOUT ANY WARRANTY.  No author or distributor
        !             8: accepts responsibility to anyone for the consequences of using it
        !             9: or for whether it serves any particular purpose or works at all,
        !            10: unless he says so in writing.  Refer to the GNU Emacs General Public
        !            11: License for full details.
        !            12: 
        !            13: Everyone is granted permission to copy, modify and redistribute
        !            14: GNU Emacs, but only under the conditions described in the
        !            15: GNU Emacs General Public License.   A copy of this license is
        !            16: supposed to have been given to you along with GNU Emacs so you
        !            17: can know your rights and responsibilities.  It should be in a
        !            18: file named COPYING.  Among other things, the copyright notice
        !            19: and this notice must be preserved on all copies.  */
        !            20: 
        !            21: 
        !            22: #include "config.h"
        !            23: #include "lisp.h"
        !            24: 
        !            25: #ifndef standalone
        !            26: #include "commands.h"
        !            27: #else
        !            28: #define INTERACTIVE 1
        !            29: #endif
        !            30: 
        !            31: #include <setjmp.h>
        !            32: 
        !            33: /* This definition is duplicated in alloc.c and keyboard.c */
        !            34: /* Putting it in lisp.h makes cc bomb out! */
        !            35: 
        !            36: struct backtrace
        !            37:   {
        !            38:     struct backtrace *next;
        !            39:     Lisp_Object *function;
        !            40:     Lisp_Object *args; /* Points to vector of args. */
        !            41:     int nargs;         /* length of vector */
        !            42:               /* if nargs is UNEVALLED, args points to slot holding list of unevalled args */
        !            43:     char evalargs;
        !            44:     /* Nonzero means call value of debugger when done with this operation. */
        !            45:     char debug_on_exit;
        !            46:   };
        !            47: 
        !            48: struct backtrace *backtrace_list;
        !            49: 
        !            50: struct catchtag
        !            51:   {
        !            52:     Lisp_Object tag;
        !            53:     Lisp_Object val;
        !            54:     struct catchtag *next;
        !            55:     struct gcpro *gcpro;
        !            56:     jmp_buf jmp;
        !            57:     struct backtrace *backlist;
        !            58:     int lisp_eval_depth;
        !            59:     int pdlcount;
        !            60:   };
        !            61: 
        !            62: struct catchtag *catchlist;
        !            63: 
        !            64: Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
        !            65: Lisp_Object Vquit_flag, Vinhibit_quit;
        !            66: Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp;
        !            67: Lisp_Object Qand_rest, Qand_optional;
        !            68: 
        !            69: /* Non-nil means record all fset's and provide's, to be undone
        !            70:    if the file being autoloaded is not fully loaded.
        !            71:    They are recorded by being consed onto the front of Vautoload_queue:
        !            72:    (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide.  */
        !            73: 
        !            74: Lisp_Object Vautoload_queue;
        !            75: 
        !            76: /* Current number of specbindings allocated in specpdl.  */
        !            77: 
        !            78: int specpdl_size;
        !            79: 
        !            80: /* Pointer to beginning of specpdl.  */
        !            81: 
        !            82: struct specbinding *specpdl;
        !            83: 
        !            84: /* Pointer to first unused element in specpdl.  */
        !            85: 
        !            86: struct specbinding *specpdl_ptr;
        !            87: 
        !            88: /* Maximum size allowed for specpdl allocation */
        !            89: 
        !            90: int max_specpdl_size;
        !            91: 
        !            92: /* Depth in Lisp evaluations and function calls.  */
        !            93: 
        !            94: int lisp_eval_depth;
        !            95: 
        !            96: /* Maximum allowed depth in Lisp evaluations and function calls.  */
        !            97: 
        !            98: int max_lisp_eval_depth;
        !            99: 
        !           100: /* Nonzero means enter debugger before next function call */
        !           101: int debug_on_next_call;
        !           102: 
        !           103: /* Nonzero means display a backtrace if an error
        !           104:  is handled by the command loop's error handler. */
        !           105: int stack_trace_on_error;
        !           106: 
        !           107: /* Nonzero means enter debugger if an error
        !           108:  is handled by the command loop's error handler. */
        !           109: int debug_on_error;
        !           110: 
        !           111: /* Nonzero means enter debugger if a quit signal
        !           112:  is handled by the command loop's error handler. */
        !           113: int debug_on_quit;
        !           114: 
        !           115: Lisp_Object Vdebugger;
        !           116: 
        !           117: void specbind (), unbind_to (), record_unwind_protect ();
        !           118: 
        !           119: Lisp_Object funcall_lambda ();
        !           120: extern Lisp_Object ml_apply (); /* Apply a mocklisp function to unevaluated argument list */
        !           121: 
        !           122: init_eval_once ()
        !           123: {
        !           124:   specpdl_size = 50;
        !           125:   specpdl = (struct specbinding *) malloc (specpdl_size * sizeof (struct specbinding));
        !           126:   max_specpdl_size = 600;
        !           127:   max_lisp_eval_depth = 200;
        !           128: }
        !           129: 
        !           130: init_eval ()
        !           131: {
        !           132:   specpdl_ptr = specpdl;
        !           133:   catchlist = 0;
        !           134:   handlerlist = 0;
        !           135:   backtrace_list = 0;
        !           136:   Vquit_flag = Qnil;
        !           137:   debug_on_next_call = 0;
        !           138:   lisp_eval_depth = 0;
        !           139: }
        !           140: 
        !           141: Lisp_Object
        !           142: call_debugger (arg)
        !           143:      Lisp_Object arg;
        !           144: {
        !           145:   if (lisp_eval_depth + 20 > max_lisp_eval_depth)
        !           146:     max_lisp_eval_depth = lisp_eval_depth + 20;
        !           147:   if (specpdl_size + 40 > max_specpdl_size)
        !           148:     max_specpdl_size = specpdl_size + 40;
        !           149:   debug_on_next_call = 0;
        !           150:   return apply1 (Vdebugger, arg);
        !           151: }
        !           152: 
        !           153: do_debug_on_call (code)
        !           154:      Lisp_Object code;
        !           155: {
        !           156:   debug_on_next_call = 0;
        !           157:   backtrace_list->debug_on_exit = 1;
        !           158:   call_debugger (Fcons (code, Qnil));
        !           159: }
        !           160: 
        !           161: /* NOTE!!! Every function that can call EVAL must protect its args
        !           162:  and temporaries from garbage collection while it needs them.
        !           163:  The definition of `For' shows what you have to do.  */
        !           164: 
        !           165: DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
        !           166:   "Eval args until one of them yields non-NIL, then return that value.\n\
        !           167: The remaining args are not evalled at all.\n\
        !           168: If all args return NIL, return NIL.")
        !           169:   (args)
        !           170:      Lisp_Object args;
        !           171: {
        !           172:   register Lisp_Object val;
        !           173:   Lisp_Object args_left;
        !           174:   struct gcpro gcpro1;
        !           175: 
        !           176:   if (NULL(args))
        !           177:     return Qnil;
        !           178: 
        !           179:   args_left = args;
        !           180:   GCPRO1 (args_left);
        !           181: 
        !           182:   do
        !           183:     {
        !           184:       val = Feval (Fcar (args_left));
        !           185:       if (!NULL (val))
        !           186:        break;
        !           187:       args_left = Fcdr (args_left);
        !           188:     }
        !           189:   while (!NULL(args_left));
        !           190: 
        !           191:   UNGCPRO;
        !           192:   return val;
        !           193: }
        !           194: 
        !           195: DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
        !           196:   "Eval args until one of them yields NIL, then return NIL.\n\
        !           197: The remaining args are not evalled at all.\n\
        !           198: If no arg yields NIL, return the last arg's value.")
        !           199:   (args)
        !           200:      Lisp_Object args;
        !           201: {
        !           202:   register Lisp_Object val;
        !           203:   Lisp_Object args_left;
        !           204:   struct gcpro gcpro1;
        !           205: 
        !           206:   if (NULL(args))
        !           207:     return Qt;
        !           208: 
        !           209:   args_left = args;
        !           210:   GCPRO1 (args_left);
        !           211: 
        !           212:   do
        !           213:     {
        !           214:       val = Feval (Fcar (args_left));
        !           215:       if (NULL (val))
        !           216:        break;
        !           217:       args_left = Fcdr (args_left);
        !           218:     }
        !           219:   while (!NULL(args_left));
        !           220: 
        !           221:   UNGCPRO;
        !           222:   return val;
        !           223: }
        !           224: 
        !           225: DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
        !           226:   "(if C T E...) if C yields non-NIL do T, else do E...\n\
        !           227: Returns the value of T or the value of the last of the E's.\n\
        !           228: There may be no E's; then if C yields NIL, the value is NIL.")
        !           229:   (args)
        !           230:      Lisp_Object args;
        !           231: {
        !           232:   register Lisp_Object cond;
        !           233:   struct gcpro gcpro1;
        !           234: 
        !           235:   GCPRO1 (args);
        !           236:   cond = Feval (Fcar (args));
        !           237:   UNGCPRO;
        !           238: 
        !           239:   if (!NULL (cond))
        !           240:     return Feval (Fcar (Fcdr (args)));
        !           241:   return Fprogn (Fcdr (Fcdr (args)));
        !           242: }
        !           243: 
        !           244: DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
        !           245:   "(cond CLAUSES...) tries each clause until one succeeds.\n\
        !           246: Each clause looks like (C BODY...).  C is evaluated\n\
        !           247: and, if the value is non-nil, this clause succeeds:\n\
        !           248: then the expressions in BODY are evaluated and the last one's\n\
        !           249: value is the value of the cond expression.\n\
        !           250: If a clause looks like (C), C's value if non-nil is returned from cond.\n\
        !           251: If no clause succeeds, cond returns nil.")
        !           252:   (args)
        !           253:      Lisp_Object args;
        !           254: {
        !           255:   register Lisp_Object clause, val;
        !           256:   struct gcpro gcpro1;
        !           257: 
        !           258:   GCPRO1 (args);
        !           259:   while (!NULL (args))
        !           260:     {
        !           261:       clause = Fcar (args);
        !           262:       val = Feval (Fcar (clause));
        !           263:       if (!NULL (val))
        !           264:        {
        !           265:          if (!EQ (XCONS (clause)->cdr, Qnil))
        !           266:            val = Fprogn (XCONS (clause)->cdr);
        !           267:          break;
        !           268:        }
        !           269:       args = XCONS (args)->cdr;
        !           270:     }
        !           271:   UNGCPRO;
        !           272: 
        !           273:   return val;
        !           274: }
        !           275: 
        !           276: DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
        !           277:   "Eval arguments in sequence, and return the value of the last one.")
        !           278:   (args)
        !           279:      Lisp_Object args;
        !           280: {
        !           281:   register Lisp_Object val, tem;
        !           282:   Lisp_Object args_left;
        !           283:   struct gcpro gcpro1;
        !           284: 
        !           285:   /* In Mocklisp code, symbols at the front of the progn arglist
        !           286:    are to be bound to zero. */
        !           287:   if (!EQ (Vmocklisp_arguments, Qt))
        !           288:     {
        !           289:       val = make_number (0);
        !           290:       while (!NULL (args) && (tem = Fcar (args), XTYPE (tem) == Lisp_Symbol))
        !           291:        {
        !           292:          QUIT;
        !           293:          specbind (tem, val), args = Fcdr (args);
        !           294:        }
        !           295:     }
        !           296: 
        !           297:   if (NULL(args))
        !           298:     return Qnil;
        !           299: 
        !           300:   args_left = args;
        !           301:   GCPRO1 (args_left);
        !           302: 
        !           303:   do
        !           304:     {
        !           305:       val = Feval (Fcar (args_left));
        !           306:       args_left = Fcdr (args_left);
        !           307:     }
        !           308:   while (!NULL(args_left));
        !           309: 
        !           310:   UNGCPRO;
        !           311:   return val;
        !           312: }
        !           313: 
        !           314: DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
        !           315:   "Eval arguments in sequence, then return the FIRST arg's value.\n\
        !           316: This value is saved during the evaluation of the remaining args,\n\
        !           317: whose values are discarded.")
        !           318:   (args)
        !           319:      Lisp_Object args;
        !           320: {
        !           321:   Lisp_Object val;
        !           322:   register Lisp_Object args_left;
        !           323:   struct gcpro gcpro1, gcpro2;
        !           324:   register int argnum = 0;
        !           325: 
        !           326:   if (NULL(args))
        !           327:     return Qnil;
        !           328: 
        !           329:   args_left = args;
        !           330:   val = Qnil;
        !           331:   GCPRO2 (args, val);
        !           332: 
        !           333:   do
        !           334:     {
        !           335:       if (!(argnum++))
        !           336:         val = Feval (Fcar (args_left));
        !           337:       else
        !           338:        Feval (Fcar (args_left));
        !           339:       args_left = Fcdr (args_left);
        !           340:     }
        !           341:   while (!NULL(args_left));
        !           342: 
        !           343:   UNGCPRO;
        !           344:   return val;
        !           345: }
        !           346: 
        !           347: DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
        !           348:   "Eval arguments in sequence, then return the SECOND arg's value.\n\
        !           349: This value is saved during the evaluation of the remaining args,\n\
        !           350: whose values are discarded.")
        !           351:   (args)
        !           352:      Lisp_Object args;
        !           353: {
        !           354:   Lisp_Object val;
        !           355:   register Lisp_Object args_left;
        !           356:   struct gcpro gcpro1, gcpro2;
        !           357:   register int argnum = -1;
        !           358: 
        !           359:   val = Qnil;
        !           360: 
        !           361:   if (NULL(args))
        !           362:     return Qnil;
        !           363: 
        !           364:   args_left = args;
        !           365:   val = Qnil;
        !           366:   GCPRO2 (args, val);
        !           367: 
        !           368:   do
        !           369:     {
        !           370:       if (!(argnum++))
        !           371:         val = Feval (Fcar (args_left));
        !           372:       else
        !           373:        Feval (Fcar (args_left));
        !           374:       args_left = Fcdr (args_left);
        !           375:     }
        !           376:   while (!NULL(args_left));
        !           377: 
        !           378:   UNGCPRO;
        !           379:   return val;
        !           380: }
        !           381: 
        !           382: DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
        !           383:   "(setq SYM VAL SYM VAL ...) sets each SYM to the value of its VAL.\n\
        !           384: The SYMs are not evaluated.  Thus (setq x y) sets x to the value of y.\n\
        !           385: Each SYM is set before the next VAL is computed.")
        !           386:   (args)
        !           387:      Lisp_Object args;
        !           388: {
        !           389:   register Lisp_Object args_left;
        !           390:   register Lisp_Object val, sym;
        !           391:   struct gcpro gcpro1;
        !           392: 
        !           393:   if (NULL(args))
        !           394:     return Qnil;
        !           395: 
        !           396:   args_left = args;
        !           397:   GCPRO1 (args);
        !           398: 
        !           399:   do
        !           400:     {
        !           401:       val = Feval (Fcar (Fcdr (args_left)));
        !           402:       sym = Fcar (args_left);
        !           403:       Fset (sym, val);
        !           404:       args_left = Fcdr (Fcdr (args_left));
        !           405:     }
        !           406:   while (!NULL(args_left));
        !           407: 
        !           408:   UNGCPRO;
        !           409:   return val;
        !           410: }
        !           411:      
        !           412: DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
        !           413:   "Return the argument, without evaluating it.  (quote x)  yields  x.")
        !           414:   (args)
        !           415:      Lisp_Object args;
        !           416: {
        !           417:   return Fcar (args);
        !           418: }
        !           419:      
        !           420: DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
        !           421:   "Quote a function object.\n\
        !           422: Equivalent to the quote function in the interpreter,\n\
        !           423: but causes the compiler to compile the argument as a function\n\
        !           424: if it is not a symbol.")
        !           425:   (args)
        !           426:      Lisp_Object args;
        !           427: {
        !           428:   return Fcar (args);
        !           429: }
        !           430: 
        !           431: DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
        !           432:   "Return t if function in which this appears was called interactively.\n\
        !           433: This means that the function was called with call-interactively (which\n\
        !           434: includes being called as the binding of a key)\n\
        !           435: and input is currently coming from the keyboard (not in keyboard macro).")
        !           436:   ()
        !           437: {
        !           438:   register struct backtrace *btp;
        !           439:   register Lisp_Object fun;
        !           440: 
        !           441:   if (!INTERACTIVE)
        !           442:     return Qnil;
        !           443:   /* Skip the frame of interactive-p itself (if interpreted)
        !           444:      or the frame of byte-code (if called from compiled function).  */
        !           445:   for (btp = backtrace_list->next;
        !           446:        btp && (btp->nargs == UNEVALLED
        !           447:               || EQ (*btp->function, Qbytecode));
        !           448:        btp = btp->next)
        !           449:     {}
        !           450:   /* btp now points at the frame of the innermost function
        !           451:      that DOES eval its args.
        !           452:      If it is a built-in function (such as load or eval-region)
        !           453:      return nil.  */
        !           454:   fun = *btp->function;
        !           455:   while (XTYPE (fun) == Lisp_Symbol)
        !           456:     {
        !           457:       QUIT;
        !           458:       fun = Fsymbol_function (fun);
        !           459:     }
        !           460:   if (XTYPE (fun) == Lisp_Subr)
        !           461:     return Qnil;
        !           462:   /* btp points to the frame of a Lisp function that called interactive-p.
        !           463:      Return t if that function was called interactively.  */
        !           464:   if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
        !           465:     return Qt;
        !           466:   return Qnil;
        !           467: }
        !           468: 
        !           469: DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
        !           470:   "(defun NAME ARGLIST [DOCSTRING] BODY...) defines NAME as a function.\n\
        !           471: The definition is (lambda ARGLIST [DOCSTRING] BODY...).\n\
        !           472: See also the function  interactive .")
        !           473:   (args)
        !           474:      Lisp_Object args;
        !           475: {
        !           476:   register Lisp_Object fn_name;
        !           477:   register Lisp_Object defn;
        !           478: 
        !           479:   fn_name = Fcar (args);
        !           480:   defn = Fcons (Qlambda, Fcdr (args));
        !           481:   if (!NULL (Vpurify_flag))
        !           482:     defn = Fpurecopy (defn);
        !           483:   Ffset (fn_name, defn);
        !           484:   return fn_name;
        !           485: }
        !           486: 
        !           487: DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
        !           488:   "(defmacro NAME ARGLIST [DOCSTRING] BODY...) defines NAME as a macro.\n\
        !           489: The definition is (macro lambda ARGLIST [DOCSTRING] BODY...).\n\
        !           490: When the macro is called, as in (NAME ARGS...),\n\
        !           491: the function (lambda ARGLIST BODY...) is applied to\n\
        !           492: the list ARGS... as it appears in the expression,\n\
        !           493: and the result should be a form to be evaluated instead of the original.")
        !           494:   (args)
        !           495:      Lisp_Object args;
        !           496: {
        !           497:   register Lisp_Object fn_name;
        !           498:   register Lisp_Object defn;
        !           499: 
        !           500:   fn_name = Fcar (args);
        !           501:   defn = Fcons (Qmacro, Fcons (Qlambda, Fcdr (args)));
        !           502:   if (!NULL (Vpurify_flag))
        !           503:     defn = Fpurecopy (defn);
        !           504:   Ffset (fn_name, defn);
        !           505:   return fn_name;
        !           506: }
        !           507: 
        !           508: DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
        !           509:   "(defvar SYMBOL INITVALUE DOCSTRING) defines SYMBOL as an advertised variable.\n\
        !           510: INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\
        !           511: INITVALUE and DOCSTRING are optional.\n\
        !           512: If DOCSTRING starts with *, this variable is identified as a user option.\n\
        !           513:  This means that M-x set-variable and M-x edit-options recognize it.\n\
        !           514: If INITVALUE is missing, SYMBOL's value is not set.")
        !           515:   (args)
        !           516:      Lisp_Object args;
        !           517: {
        !           518:   register Lisp_Object sym, tem;
        !           519: 
        !           520:   sym = Fcar (args);
        !           521:   tem = Fcdr (args);
        !           522:   if (!NULL (tem))
        !           523:     {
        !           524:       tem = Fboundp (sym);
        !           525:       if (NULL (tem))
        !           526:        Fset (sym, Feval (Fcar (Fcdr (args))));
        !           527:     }
        !           528:   tem = Fcar (Fcdr (Fcdr (args)));
        !           529:   if (!NULL (tem))
        !           530:     {
        !           531:       if (!NULL (Vpurify_flag))
        !           532:        tem = Fpurecopy (tem);
        !           533:       Fput (sym, Qvariable_documentation, tem);
        !           534:     }
        !           535:   return sym;
        !           536: }
        !           537: 
        !           538: DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
        !           539:   "(defconst SYMBOL INITVALUE DOCSTRING) defines SYMBOL as a constant variable.\n\
        !           540: The intent is that programs do not change this value (but users may).\n\
        !           541: Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
        !           542: DOCSTRING is optional.\n\
        !           543: If DOCSTRING starts with *, this variable is identified as a user option.\n\
        !           544:  This means that M-x set-variable and M-x edit-options recognize it.")
        !           545:   (args)
        !           546:      Lisp_Object args;
        !           547: {
        !           548:   register Lisp_Object sym, tem;
        !           549: 
        !           550:   sym = Fcar (args);
        !           551:   Fset (sym, Feval (Fcar (Fcdr (args))));
        !           552:   tem = Fcar (Fcdr (Fcdr (args)));
        !           553:   if (!NULL (tem))
        !           554:     {
        !           555:       if (!NULL (Vpurify_flag))
        !           556:        tem = Fpurecopy (tem);
        !           557:       Fput (sym, Qvariable_documentation, tem);
        !           558:     }
        !           559:   return sym;
        !           560: }
        !           561: 
        !           562: DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
        !           563:   "Returns t if VARIABLE is intended to be set and modified by users,\n\
        !           564: as opposed to by programs.\n\
        !           565: Determined by whether the first character of the documentation\n\
        !           566: for the variable is \"*\"")
        !           567:   (variable)
        !           568:      Lisp_Object variable;
        !           569: {
        !           570:   Lisp_Object documentation;
        !           571:   
        !           572:   documentation = Fget (variable, Qvariable_documentation);
        !           573:   if (XTYPE (documentation) == Lisp_Int && XINT (documentation) < 0)
        !           574:     return Qt;
        !           575:   if ((XTYPE (documentation) == Lisp_String) &&
        !           576:       ((unsigned char) XSTRING (documentation)->data[0] == '*'))
        !           577:     return Qt;
        !           578:   return Qnil;
        !           579: }  
        !           580: 
        !           581: DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
        !           582:   "(let* VARLIST BODY...) binds variables according to VARLIST then executes BODY.\n\
        !           583: The value of the last form in BODY is returned.\n\
        !           584: Each element of VARLIST is a symbol (which is bound to NIL)\n\
        !           585: or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
        !           586: Each VALUEFORM can refer to the symbols already bound by this VARLIST.")
        !           587:   (args)
        !           588:      Lisp_Object args;
        !           589: {
        !           590:   Lisp_Object varlist, val, elt;
        !           591:   int count = specpdl_ptr - specpdl;
        !           592:   struct gcpro gcpro1, gcpro2, gcpro3;
        !           593: 
        !           594:   GCPRO3 (args, elt, varlist);
        !           595: 
        !           596:   varlist = Fcar (args);
        !           597:   while (!NULL (varlist))
        !           598:     {
        !           599:       QUIT;
        !           600:       elt = Fcar (varlist);
        !           601:       if (XTYPE (elt) == Lisp_Symbol)
        !           602:        specbind (elt, Qnil);
        !           603:       else
        !           604:        {
        !           605:          val = Feval (Fcar (Fcdr (elt)));
        !           606:          specbind (Fcar (elt), val);
        !           607:        }
        !           608:       varlist = Fcdr (varlist);
        !           609:     }
        !           610:   UNGCPRO;
        !           611:   val = Fprogn (Fcdr (args));
        !           612:   unbind_to (count);
        !           613:   return val;
        !           614: }
        !           615: 
        !           616: DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
        !           617:   "(let VARLIST BODY...) binds variables according to VARLIST then executes BODY.\n\
        !           618: The value of the last form in BODY is returned.\n\
        !           619: Each element of VARLIST is a symbol (which is bound to NIL)\n\
        !           620: or a list (SYMBOL VALUEFORM) (which binds SYMBOL to the value of VALUEFORM).\n\
        !           621: All the VALUEFORMs are evalled before any symbols are bound.")
        !           622:   (args)
        !           623:      Lisp_Object args;
        !           624: {
        !           625:   Lisp_Object *temps, tem;
        !           626:   register Lisp_Object elt, varlist;
        !           627:   int count = specpdl_ptr - specpdl;
        !           628:   register int argnum;
        !           629:   struct gcpro gcpro1, gcpro2;
        !           630: 
        !           631:   varlist = Fcar (args);
        !           632: 
        !           633:   /* Make space to hold the values to give the bound variables */
        !           634:   elt = Flength (varlist);
        !           635:   temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object));
        !           636: 
        !           637:   /* Compute the values and store them in `temps' */
        !           638: 
        !           639:   GCPRO2 (args, *temps);
        !           640:   gcpro2.nvars = 0;
        !           641: 
        !           642:   for (argnum = 0; !NULL (varlist); varlist = Fcdr (varlist))
        !           643:     {
        !           644:       QUIT;
        !           645:       elt = Fcar (varlist);
        !           646:       if (XTYPE (elt) == Lisp_Symbol)
        !           647:        temps [argnum++] = Qnil;
        !           648:       else
        !           649:        temps [argnum++] = Feval (Fcar (Fcdr (elt)));
        !           650:       gcpro2.nvars = argnum;
        !           651:     }
        !           652:   UNGCPRO;
        !           653: 
        !           654:   varlist = Fcar (args);
        !           655:   for (argnum = 0; !NULL (varlist); varlist = Fcdr (varlist))
        !           656:     {
        !           657:       elt = Fcar (varlist);
        !           658:       tem = temps[argnum++];
        !           659:       if (XTYPE (elt) == Lisp_Symbol)
        !           660:        specbind (elt, tem);
        !           661:       else
        !           662:        specbind (Fcar (elt), tem);
        !           663:     }
        !           664: 
        !           665:   elt = Fprogn (Fcdr (args));
        !           666:   unbind_to (count);
        !           667:   return elt;
        !           668: }
        !           669: 
        !           670: DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
        !           671:   "(while TEST BODY...) if TEST yields non-NIL, execute the BODY forms and repeat.")
        !           672:   (args)
        !           673:      Lisp_Object args;
        !           674: {
        !           675:   Lisp_Object test, body, tem;
        !           676:   struct gcpro gcpro1, gcpro2;
        !           677: 
        !           678:   GCPRO2 (test, body);
        !           679: 
        !           680:   test = Fcar (args);
        !           681:   body = Fcdr (args);
        !           682:   while (tem = Feval (test), !NULL (tem))
        !           683:     {
        !           684:       QUIT;
        !           685:       Fprogn (body);
        !           686:     }
        !           687: 
        !           688:   UNGCPRO;
        !           689:   return Qnil;
        !           690: }
        !           691: 
        !           692: DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
        !           693:   "If FORM is a macro call, expand it.\n\
        !           694: If the result of expansion is another macro call, expand it, etc.\n\
        !           695: Return the ultimate expansion.\n\
        !           696: The second optional arg ENVIRONMENT species an environment of macro\n\
        !           697: definitions to shadow the loaded ones for use in file byte-compilation.")
        !           698:   (form, env)
        !           699:      register Lisp_Object form;
        !           700:      Lisp_Object env;
        !           701: {
        !           702:   register Lisp_Object expander, sym, def, tem;
        !           703: 
        !           704:   while (1)
        !           705:     {
        !           706:       /* Come back here each time we expand a macro call,
        !           707:         in case it expands into another macro call.  */
        !           708:       if (XTYPE (form) != Lisp_Cons)
        !           709:        break;
        !           710:       sym = XCONS (form)->car;
        !           711:       if (XTYPE (sym) != Lisp_Symbol)
        !           712:        break;
        !           713:       /* Trace symbols aliases to other symbols
        !           714:         until we get a symbol that is not an alias.  */
        !           715:       while (1)
        !           716:        {
        !           717:          QUIT;
        !           718:          tem = Fassq (sym, env);
        !           719:          if (NULL (tem))
        !           720:            {
        !           721:              def = XSYMBOL (sym)->function;
        !           722:              if (XTYPE (def) == Lisp_Symbol && !EQ (def, Qunbound))
        !           723:                sym = def;
        !           724:              else
        !           725:                break;
        !           726:            }
        !           727:          else
        !           728:            {
        !           729:              if (XTYPE (tem) == Lisp_Cons
        !           730:                  && XTYPE (XCONS (tem)->cdr) == Lisp_Symbol)
        !           731:                sym = XCONS (tem)->cdr;
        !           732:              else
        !           733:                break;
        !           734:            }
        !           735:        }
        !           736:       /* Right now TEM is the result from SYM in ENV,
        !           737:         and if TEM is nil then DEF is SYM's function definition.  */
        !           738:       if (NULL (tem))
        !           739:        {
        !           740:          /* SYM is not mentioned in ENV.
        !           741:             Look at its function definition.  */
        !           742:          if (EQ (def, Qunbound)
        !           743:              || XTYPE (def) != Lisp_Cons)
        !           744:            /* Not defined or definition not suitable */
        !           745:            break;
        !           746:          if (EQ (XCONS (def)->car, Qautoload))
        !           747:            {
        !           748:              /* Autoloading function: will it be a macro when loaded?  */
        !           749:              tem = Fcar (Fnthcdr (make_number (4), def));
        !           750:              if (NULL (tem))
        !           751:                break;
        !           752:              /* Yes, load it and try again.  */
        !           753:              do_autoload (def, sym);
        !           754:              continue;
        !           755:            }
        !           756:          else if (!EQ (XCONS (def)->car, Qmacro))
        !           757:            break;
        !           758:          else expander = XCONS (def)->cdr;
        !           759:        }
        !           760:       else
        !           761:        {
        !           762:          expander = XCONS (tem)->cdr;
        !           763:          if (NULL (expander))
        !           764:            break;
        !           765:        }
        !           766:       form = apply1 (expander, XCONS (form)->cdr);
        !           767:     }
        !           768:   return form;
        !           769: }
        !           770: 
        !           771: DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
        !           772:   "(catch TAG BODY...) perform BODY allowing nonlocal exits using (throw TAG).\n\
        !           773: TAG is evalled to get the tag to use.  throw  to that tag exits this catch.\n\
        !           774: Then the BODY is executed.  If no  throw  happens, the value of the last BODY\n\
        !           775: form is returned from  catch.  If a  throw  happens, it specifies the value to\n\
        !           776: return from  catch.")
        !           777:   (args)
        !           778:      Lisp_Object args;
        !           779: {
        !           780:   register Lisp_Object tag;
        !           781:   struct gcpro gcpro1;
        !           782: 
        !           783:   GCPRO1 (args);
        !           784:   tag = Feval (Fcar (args));
        !           785:   UNGCPRO;
        !           786:   return internal_catch (tag, Fprogn, Fcdr (args));
        !           787: }
        !           788: 
        !           789: /* Set up a catch, then call C function FUNC on argument ARG.
        !           790:    FUNC should return a Lisp_Object.
        !           791:    This is how catches are done from within C code. */
        !           792: 
        !           793: Lisp_Object
        !           794: internal_catch (tag, func, arg)
        !           795:      Lisp_Object tag;
        !           796:      Lisp_Object (*func) ();
        !           797:      Lisp_Object arg;
        !           798: {
        !           799:   /* This structure is made part of the chain `catchlist'.  */
        !           800:   struct catchtag c;
        !           801: 
        !           802:   /* Fill in the components of c, and put it on the list.  */
        !           803:   c.next = catchlist;
        !           804:   c.tag = tag;
        !           805:   c.val = Qnil;
        !           806:   c.backlist = backtrace_list;
        !           807:   c.lisp_eval_depth = lisp_eval_depth;
        !           808:   c.pdlcount = specpdl_ptr - specpdl;
        !           809:   c.gcpro = gcprolist;
        !           810:   catchlist = &c;
        !           811: 
        !           812:   /* Call FUNC.  */
        !           813:   if (! _setjmp (c.jmp))
        !           814:     c.val = (*func) (arg);
        !           815: 
        !           816:   /* Throw works by a longjmp that comes right here.  */
        !           817:   catchlist = c.next;
        !           818:   return c.val;
        !           819: }
        !           820: 
        !           821: /* Discard from the catchlist all catch tags back through CATCH.
        !           822:    Before each catch is discarded, unbind all special bindings
        !           823:    made within that catch.  Also, when discarding a catch that
        !           824:    corresponds to a condition handler, discard that handler.
        !           825: 
        !           826:    At the end, restore some static info saved in CATCH.
        !           827: 
        !           828:    This is used for correct unwinding in Fthrow and Fsignal,
        !           829:    before doing the longjmp that actually destroys the stack frames
        !           830:    in which these handlers and catches reside.  */
        !           831: 
        !           832: static void
        !           833: unbind_catch (catch)
        !           834:      struct catchtag *catch;
        !           835: {
        !           836:   register int last_time;
        !           837: 
        !           838:   do
        !           839:     {
        !           840:       last_time = catchlist == catch;
        !           841:       unbind_to (catchlist->pdlcount);
        !           842:       if (handlerlist != 0 && handlerlist->tag == catchlist)
        !           843:        handlerlist = handlerlist->next;
        !           844:       catchlist = catchlist->next;
        !           845:     }
        !           846:   while (! last_time);
        !           847: 
        !           848:   gcprolist = catch->gcpro;
        !           849:   backtrace_list = catch->backlist;
        !           850:   lisp_eval_depth = catch->lisp_eval_depth;
        !           851: }
        !           852: 
        !           853: DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
        !           854:   "(throw TAG VALUE): throw to the catch for TAG and return VALUE from it.\n\
        !           855: Both TAG and VALUE are evalled.")
        !           856:   (tag, val)
        !           857:      register Lisp_Object tag, val;
        !           858: {
        !           859:   register struct catchtag *c;
        !           860: 
        !           861:   while (1)
        !           862:     {
        !           863:       if (!NULL (tag))
        !           864:        for (c = catchlist; c; c = c->next)
        !           865:          {
        !           866:            if (EQ (c->tag, tag))
        !           867:              {
        !           868:                c->val = val;
        !           869:                unbind_catch (c);
        !           870:                _longjmp (c->jmp, 1);
        !           871:              }
        !           872:          }
        !           873:       tag = Fsignal (Qno_catch, Fcons (tag, Fcons (val, Qnil)));
        !           874:     }
        !           875: }
        !           876: 
        !           877: 
        !           878: DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
        !           879:   "Do BODYFORM, protecting with UNWINDFORMS.\n\
        !           880: Usage looks like (unwind-protect BODYFORM UNWINDFORMS...) \n\
        !           881: If BODYFORM completes normally, its value is returned\n\
        !           882: after executing the UNWINDFORMS.\n\
        !           883: If BODYFORM exits nonlocally, the UNWINDFORMS are executed anyway.")
        !           884:   (args)
        !           885:      Lisp_Object args;
        !           886: {
        !           887:   Lisp_Object val;
        !           888:   int count = specpdl_ptr - specpdl;
        !           889:   struct gcpro gcpro1;
        !           890: 
        !           891:   record_unwind_protect (0, Fcdr (args));
        !           892:   val = Feval (Fcar (args));
        !           893:   GCPRO1 (val);
        !           894:   unbind_to (count);  
        !           895:   UNGCPRO;
        !           896:   return val;
        !           897: }
        !           898: 
        !           899: /* Chain of condition handlers currently in effect.
        !           900:    The elements of this chain are contained in the stack frames
        !           901:    of Fcondition_case and internal_condition_case.
        !           902:    When an error is signaled (by calling Fsignal, below),
        !           903:    this chain is searched for an element that applies.  */
        !           904: 
        !           905: struct handler *handlerlist;
        !           906: 
        !           907: DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
        !           908:   "Regain control when an error is signaled.\n\
        !           909:  (condition-case VAR BODYFORM HANDLERS...)\n\
        !           910: executes BODYFORM and returns its value if no error happens.\n\
        !           911: Each element of HANDLERS looks like (CONDITION-NAME BODY...)\n\
        !           912: where the BODY is made of Lisp expressions.\n\
        !           913: The handler is applicable to an error\n\
        !           914: if CONDITION-NAME is one of the error's condition names.\n\
        !           915: When a handler handles an error,\n\
        !           916: control returns to the condition-case and the handler BODY... is executed\n\
        !           917: with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
        !           918: The value of the last BODY form is returned from the condition-case.\n\
        !           919: See SIGNAL for more info.")
        !           920:   (args)
        !           921:      Lisp_Object args;
        !           922: {
        !           923:   Lisp_Object val;
        !           924:   struct catchtag c;
        !           925:   struct handler h;
        !           926:   register Lisp_Object tem;
        !           927: 
        !           928:   tem = Fcar (args);
        !           929:   CHECK_SYMBOL (tem, 0);
        !           930: 
        !           931:   c.tag = Qnil;
        !           932:   c.val = Qnil;
        !           933:   c.backlist = backtrace_list;
        !           934:   c.lisp_eval_depth = lisp_eval_depth;
        !           935:   c.pdlcount = specpdl_ptr - specpdl;
        !           936:   c.gcpro = gcprolist;
        !           937:   if (_setjmp (c.jmp))
        !           938:     {
        !           939:       if (!NULL (h.var))
        !           940:         specbind (h.var, Fcdr (c.val));
        !           941:       val = Fprogn (Fcdr (Fcar (c.val)));
        !           942:       unbind_to (c.pdlcount);
        !           943:       return val;
        !           944:     }
        !           945:   c.next = catchlist;
        !           946:   catchlist = &c;
        !           947:   h.var = Fcar (args);
        !           948:   h.handler = Fcdr (Fcdr (args));
        !           949:   
        !           950:   for (val = h.handler; ! NULL (val); val = Fcdr (val))
        !           951:     {
        !           952:       tem = Fcar (val);
        !           953:       if ((!NULL (tem)) &&
        !           954:          (!CONSP (tem) || (XTYPE (XCONS (tem)->car) != Lisp_Symbol)))
        !           955:        error ("Invalid condition handler", tem);
        !           956:     }
        !           957:   
        !           958:   h.next = handlerlist;
        !           959:   h.tag = &c;
        !           960:   handlerlist = &h;
        !           961: 
        !           962:   val = Feval (Fcar (Fcdr (args)));
        !           963:   catchlist = c.next;
        !           964:   handlerlist = h.next;
        !           965:   return val;
        !           966: }
        !           967: 
        !           968: Lisp_Object
        !           969: internal_condition_case (bfun, handlers, hfun)
        !           970:      Lisp_Object (*bfun) ();
        !           971:      Lisp_Object handlers;
        !           972:      Lisp_Object (*hfun) ();
        !           973: {
        !           974:   Lisp_Object val;
        !           975:   struct catchtag c;
        !           976:   struct handler h;
        !           977: 
        !           978:   c.tag = Qnil;
        !           979:   c.val = Qnil;
        !           980:   c.backlist = backtrace_list;
        !           981:   c.lisp_eval_depth = lisp_eval_depth;
        !           982:   c.pdlcount = specpdl_ptr - specpdl;
        !           983:   c.gcpro = gcprolist;
        !           984:   if (_setjmp (c.jmp))
        !           985:     {
        !           986:       return (*hfun) (Fcdr (c.val));
        !           987:     }
        !           988:   c.next = catchlist;
        !           989:   catchlist = &c;
        !           990:   h.handler = handlers;
        !           991:   h.var = Qnil;
        !           992:   h.next = handlerlist;
        !           993:   h.tag = &c;
        !           994:   handlerlist = &h;
        !           995: 
        !           996:   val = (*bfun) ();
        !           997:   catchlist = c.next;
        !           998:   handlerlist = h.next;
        !           999:   return val;
        !          1000: }
        !          1001: 
        !          1002: static Lisp_Object find_handler_clause ();
        !          1003: 
        !          1004: DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
        !          1005:   "Signal an error.  Args are SIGNAL-NAME, and associated DATA.\n\
        !          1006: A signal name is a symbol with an  error-conditions  property\n\
        !          1007: that is a list of condition names.\n\
        !          1008: A handler for any of those names will get to handle this signal.\n\
        !          1009: The symbol  error  should always be one of them.\n\
        !          1010: \n\
        !          1011: DATA should be a list.  Its elements are printed as part of the error message.\n\
        !          1012: If the signal is handled, DATA is made available to the handler.\n\
        !          1013: See  condition-case.")
        !          1014:   (sig, data)
        !          1015:      Lisp_Object sig, data;
        !          1016: {
        !          1017:   register struct handler *allhandlers = handlerlist;
        !          1018:   Lisp_Object conditions;
        !          1019:   extern int gc_in_progress;
        !          1020:   extern int waiting_for_input;
        !          1021:   Lisp_Object debugger_value;
        !          1022: 
        !          1023:   quit_error_check ();
        !          1024:   immediate_quit = 0;
        !          1025:   if (gc_in_progress || waiting_for_input)
        !          1026:     abort ();
        !          1027: 
        !          1028:   conditions = Fget (sig, Qerror_conditions);
        !          1029: 
        !          1030:   for (; handlerlist; handlerlist = handlerlist->next)
        !          1031:     {
        !          1032:       register Lisp_Object clause;
        !          1033:       clause = find_handler_clause (handlerlist->handler, conditions,
        !          1034:                                    sig, data, &debugger_value);
        !          1035: 
        !          1036:       /* If have called debugger and user wants to continue,
        !          1037:         just return nil.  */
        !          1038:       if (EQ (clause, Qlambda))
        !          1039:        return debugger_value;
        !          1040: 
        !          1041:       if (!NULL (clause))
        !          1042:        {
        !          1043:          struct handler *h = handlerlist;
        !          1044:          handlerlist = allhandlers;
        !          1045:          unbind_catch (h->tag);
        !          1046:          h->tag->val = Fcons (clause, Fcons (sig, data));
        !          1047:          _longjmp (h->tag->jmp, 1);
        !          1048:        }
        !          1049:     }
        !          1050: 
        !          1051:   handlerlist = allhandlers;
        !          1052:   /* If no handler is present now, try to run the debugger,
        !          1053:      and if that fails, throw to top level.  */
        !          1054:   find_handler_clause (Qerror, conditions, sig, data, &debugger_value);
        !          1055:   Fthrow (Qtop_level, Qt);
        !          1056: }
        !          1057: 
        !          1058: /* Value of Qlambda means we have called debugger and
        !          1059:    user has continued.  Store value returned fromdebugger
        !          1060:    into *debugger_value_ptr */
        !          1061: 
        !          1062: static Lisp_Object
        !          1063: find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
        !          1064:      Lisp_Object handlers, conditions, sig, data;
        !          1065:      Lisp_Object *debugger_value_ptr;
        !          1066: {
        !          1067:   register Lisp_Object h;
        !          1068:   register Lisp_Object tem;
        !          1069:   register Lisp_Object tem1;
        !          1070: 
        !          1071:   if (EQ (handlers, Qt))  /* t is used by handlers for all conditions, set up by C code.  */
        !          1072:     return Qt;
        !          1073:   if (EQ (handlers, Qerror))  /* error is used similarly, but means display a backtrace too */
        !          1074:     {
        !          1075:       if (stack_trace_on_error)
        !          1076:        internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil);
        !          1077:       if (EQ (sig, Qquit) ? debug_on_quit : debug_on_error)
        !          1078:        {
        !          1079:          *debugger_value_ptr =
        !          1080:            call_debugger (Fcons (Qerror,
        !          1081:                                  Fcons (Fcons (sig, data),
        !          1082:                                         Qnil)));
        !          1083:          return Qlambda;
        !          1084:        }
        !          1085:       return Qt;
        !          1086:     }
        !          1087:   for (h = handlers; CONSP (h); h = Fcdr (h))
        !          1088:     {
        !          1089:       tem1 = Fcar (h);
        !          1090:       if (!CONSP (tem1))
        !          1091:        continue;
        !          1092:       tem = Fmemq (Fcar (tem1), conditions);
        !          1093:       if (!NULL (tem))
        !          1094:         return tem1;
        !          1095:     }
        !          1096:   return Qnil;
        !          1097: }
        !          1098: 
        !          1099: /* dump an error message; called like printf */
        !          1100: 
        !          1101: /* VARARGS 1 */
        !          1102: void
        !          1103: error (m, a1, a2, a3)
        !          1104:      char *m;
        !          1105: {
        !          1106:   char buf[200];
        !          1107:   sprintf (buf, m, a1, a2, a3);
        !          1108:   while (1)
        !          1109:     Fsignal (Qerror, Fcons (build_string (buf), Qnil));
        !          1110: }
        !          1111: 
        !          1112: DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0,
        !          1113:   "T if FUNCTION makes provisions for interactive calling.\n\
        !          1114: This means it contains a description for how to read arguments to give it.\n\
        !          1115: The value is nil for an invalid function or a symbol with no function definition.\n\
        !          1116: \n\
        !          1117: Interactively callable functions include strings (treated as keyboard macros),\n\
        !          1118: lambda-expressions that contain a top-level call to  interactive ,\n\
        !          1119: autoload definitions made by  autoload  with non-nil fourth argument,\n\
        !          1120: and some of the built-in functions of Lisp.\n\
        !          1121: \n\
        !          1122: Also, a symbol is commandp if its function definition is commandp.")
        !          1123:   (function)
        !          1124:      Lisp_Object function;
        !          1125: {
        !          1126:   register Lisp_Object fun;
        !          1127:   register Lisp_Object funcar;
        !          1128:   register Lisp_Object tem;
        !          1129:   register int i = 0;
        !          1130: 
        !          1131:   fun = function;
        !          1132:   while (XTYPE (fun) == Lisp_Symbol)
        !          1133:     {
        !          1134:       if (++i > 10) return Qnil;
        !          1135:       tem = Ffboundp (fun);
        !          1136:       if (NULL (tem)) return Qnil;
        !          1137:       fun = Fsymbol_function (fun);
        !          1138:     }
        !          1139:   if (XTYPE (fun) == Lisp_Subr)
        !          1140:     if (XSUBR (fun)->prompt)
        !          1141:       return Qt;
        !          1142:     else
        !          1143:       return Qnil;
        !          1144:   if (XTYPE (fun) == Lisp_Vector || XTYPE (fun) == Lisp_String)
        !          1145:     return Qt;
        !          1146:   if (!CONSP (fun))
        !          1147:     return Qnil;
        !          1148:   funcar = Fcar (fun);
        !          1149:   if (XTYPE (funcar) != Lisp_Symbol)
        !          1150:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1151:   if (EQ (funcar, Qlambda))
        !          1152:     return Fassq (Qinteractive, Fcdr (Fcdr (fun)));
        !          1153:   if (EQ (funcar, Qmocklisp))
        !          1154:     return Qt;  /* All mocklisp functions can be called interactively */
        !          1155:   if (EQ (funcar, Qautoload))
        !          1156:     return Fcar (Fcdr (Fcdr (Fcdr (fun))));
        !          1157:   else
        !          1158:     return Qnil;
        !          1159: }
        !          1160: 
        !          1161: /* ARGSUSED */
        !          1162: DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
        !          1163:   "Define FUNCTION to autoload from FILE.\n\
        !          1164: FUNCTION is a symbol; FILE is a file name string to pass to  load.\n\
        !          1165: Third arg DOCSTRING is documentation for the function.\n\
        !          1166: Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
        !          1167: Fifth arg MACRO if non-nil says the function is really a macro.\n\
        !          1168: Third through fifth args give info about the real definition.\n\
        !          1169: They default to nil.\n\
        !          1170: If FUNCTION is already defined other than as an autoload,\n\
        !          1171: this does nothing and returns nil.")
        !          1172:   (function, file, docstring, interactive, macro)
        !          1173:      Lisp_Object function, file, docstring, interactive, macro;
        !          1174: {
        !          1175: #ifdef NO_ARG_ARRAY
        !          1176:   Lisp_Object args[4];
        !          1177: #endif
        !          1178: 
        !          1179:   CHECK_SYMBOL (function, 0);
        !          1180:   CHECK_STRING (file, 1);
        !          1181: 
        !          1182:   /* If function is defined and not as an autoload, don't override */
        !          1183:   if (!EQ (XSYMBOL (function)->function, Qunbound)
        !          1184:       && !(XTYPE (XSYMBOL (function)->function) == Lisp_Cons
        !          1185:           && EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload)))
        !          1186:     return Qnil;
        !          1187: 
        !          1188: #ifdef NO_ARG_ARRAY
        !          1189:   args[0] = file;
        !          1190:   args[1] = docstring;
        !          1191:   args[2] = interactive;
        !          1192:   args[3] = macro;
        !          1193: 
        !          1194:   return Ffset (function, Fcons (Qautoload, Flist (4, &args[0])));
        !          1195: #else /* NO_ARG_ARRAY */
        !          1196:   return Ffset (function, Fcons (Qautoload, Flist (4, &file)));
        !          1197: #endif /* not NO_ARG_ARRAY */
        !          1198: }
        !          1199: 
        !          1200: Lisp_Object
        !          1201: un_autoload (oldqueue)
        !          1202:      Lisp_Object oldqueue;
        !          1203: {
        !          1204:   register Lisp_Object queue, first, second;
        !          1205: 
        !          1206:   /* Queue to unwind is current value of Vautoload_queue.
        !          1207:      oldqueue is the shadowed value to leave in Vautoload_queue.  */
        !          1208:   queue = Vautoload_queue;
        !          1209:   Vautoload_queue = oldqueue;
        !          1210:   while (CONSP (queue))
        !          1211:     {
        !          1212:       first = Fcar (queue);
        !          1213:       second = Fcdr (first);
        !          1214:       first = Fcar (first);
        !          1215:       if (EQ (second, Qnil))
        !          1216:        Vfeatures = first;
        !          1217:       else
        !          1218:        Ffset (first, second);
        !          1219:       queue = Fcdr (queue);
        !          1220:     }
        !          1221:   return Qnil;
        !          1222: }
        !          1223: 
        !          1224: do_autoload (fundef, funname)
        !          1225:      Lisp_Object fundef, funname;
        !          1226: {
        !          1227:   int count = specpdl_ptr - specpdl;
        !          1228:   Lisp_Object fun, val;
        !          1229: 
        !          1230:   fun = funname;
        !          1231: 
        !          1232:   /* Value saved here is to be restored into Vautoload_queue */
        !          1233:   record_unwind_protect (un_autoload, Vautoload_queue);
        !          1234:   Vautoload_queue = Qt;
        !          1235:   Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
        !          1236:   /* Once loading finishes, don't undo it.  */
        !          1237:   Vautoload_queue = Qt;
        !          1238:   unbind_to (count);
        !          1239: 
        !          1240:   while (XTYPE (fun) == Lisp_Symbol)
        !          1241:     {
        !          1242:       QUIT;
        !          1243:       val = XSYMBOL (fun)->function;
        !          1244:       if (EQ (val, Qunbound))
        !          1245:        Fsymbol_function (fun); /* Get the right kind of error! */
        !          1246:       fun = val;
        !          1247:     }
        !          1248:   if (XTYPE (fun) == Lisp_Cons
        !          1249:       && EQ (XCONS (fun)->car, Qautoload))
        !          1250:     error ("Autoloading failed to define function %s",
        !          1251:           XSYMBOL (funname)->name->data);
        !          1252: }
        !          1253: 
        !          1254: DEFUN ("eval", Feval, Seval, 1, 1, 0,
        !          1255:   "Evaluate FORM and return its value.")
        !          1256:   (form)
        !          1257:      Lisp_Object form;
        !          1258: {
        !          1259:   Lisp_Object fun, val, original_fun, original_args;
        !          1260:   Lisp_Object funcar;
        !          1261:   struct backtrace backtrace;
        !          1262:   struct gcpro gcpro1, gcpro2, gcpro3;
        !          1263: 
        !          1264:   if (XTYPE (form) == Lisp_Symbol)
        !          1265:     {
        !          1266:       if (EQ (Vmocklisp_arguments, Qt))
        !          1267:         return Fsymbol_value (form);
        !          1268:       val = Fsymbol_value (form);
        !          1269:       if (NULL (val))
        !          1270:        XFASTINT (val) = 0;
        !          1271:       else if (EQ (val, Qt))
        !          1272:        XFASTINT (val) = 1;
        !          1273:       return val;
        !          1274:     }
        !          1275:   if (!CONSP (form))
        !          1276:     return form;
        !          1277: 
        !          1278:   QUIT;
        !          1279:   if (consing_since_gc > gc_cons_threshold)
        !          1280:     {
        !          1281:       GCPRO1 (form);
        !          1282:       Fgarbage_collect ();
        !          1283:       UNGCPRO;
        !          1284:     }
        !          1285: 
        !          1286:   if (++lisp_eval_depth > max_lisp_eval_depth)
        !          1287:     {
        !          1288:       if (max_lisp_eval_depth < 100)
        !          1289:        max_lisp_eval_depth = 100;
        !          1290:       if (lisp_eval_depth > max_lisp_eval_depth)
        !          1291:        error ("Lisp nesting exceeds max-lisp-eval-depth");
        !          1292:     }
        !          1293: 
        !          1294:   original_fun = Fcar (form);
        !          1295:   original_args = Fcdr (form);
        !          1296: 
        !          1297:   backtrace.next = backtrace_list;
        !          1298:   backtrace_list = &backtrace;
        !          1299:   backtrace.function = &original_fun; /* This also protects them from gc */
        !          1300:   backtrace.args = &original_args;
        !          1301:   backtrace.nargs = UNEVALLED;
        !          1302:   backtrace.evalargs = 1;
        !          1303:   backtrace.debug_on_exit = 0;
        !          1304: 
        !          1305:   if (debug_on_next_call)
        !          1306:     do_debug_on_call (Qt);
        !          1307: 
        !          1308:   /* At this point, only original_fun and original_args
        !          1309:      have values that will be used below */
        !          1310:  retry:
        !          1311:   fun = original_fun;
        !          1312:   while (XTYPE (fun) == Lisp_Symbol)
        !          1313:     {
        !          1314:       QUIT;
        !          1315:       val = XSYMBOL (fun)->function;
        !          1316:       if (EQ (val, Qunbound))
        !          1317:        Fsymbol_function (fun); /* Get the right kind of error! */
        !          1318:       fun = val;
        !          1319:     }
        !          1320: 
        !          1321:   if (XTYPE (fun) == Lisp_Subr)
        !          1322:     {
        !          1323:       Lisp_Object numargs;
        !          1324:       Lisp_Object argvals[5];
        !          1325:       Lisp_Object args_left;
        !          1326:       register int i, maxargs;
        !          1327: 
        !          1328:       args_left = original_args;
        !          1329:       numargs = Flength (args_left);
        !          1330: 
        !          1331:       if (XINT (numargs) < XSUBR (fun)->min_args ||
        !          1332:          (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
        !          1333:        return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));
        !          1334: 
        !          1335:       if (XSUBR (fun)->max_args == UNEVALLED)
        !          1336:        {
        !          1337:          backtrace.evalargs = 0;
        !          1338:          val = (*XSUBR (fun)->function) (args_left);
        !          1339:          goto done;
        !          1340:        }
        !          1341: 
        !          1342:       if (XSUBR (fun)->max_args == MANY)
        !          1343:        {
        !          1344:          /* Pass a vector of evaluated arguments */
        !          1345:          Lisp_Object *vals;
        !          1346:          register int argnum = 0;
        !          1347: 
        !          1348:          vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
        !          1349: 
        !          1350:          GCPRO3 (args_left, fun, fun);
        !          1351:          gcpro3.var = vals;
        !          1352:          gcpro3.nvars = 0;
        !          1353: 
        !          1354:          while (!NULL (args_left))
        !          1355:            {
        !          1356:              vals[argnum++] = Feval (Fcar (args_left));
        !          1357:              args_left = Fcdr (args_left);
        !          1358:              gcpro3.nvars = argnum;
        !          1359:            }
        !          1360:          UNGCPRO;
        !          1361: 
        !          1362:          backtrace.args = vals;
        !          1363:          backtrace.nargs = XINT (numargs);
        !          1364: 
        !          1365:          val = (*XSUBR (fun)->function) (XINT (numargs), vals);
        !          1366:          goto done;
        !          1367:        }
        !          1368: 
        !          1369:       GCPRO3 (args_left, fun, fun);
        !          1370:       gcpro3.var = argvals;
        !          1371:       gcpro3.nvars = 0;
        !          1372: 
        !          1373:       maxargs = XSUBR (fun)->max_args;
        !          1374:       for (i = 0; i < maxargs; args_left = Fcdr (args_left))
        !          1375:        {
        !          1376:          argvals[i] = Feval (Fcar (args_left));
        !          1377:          gcpro3.nvars = ++i;
        !          1378:        }
        !          1379: 
        !          1380:       UNGCPRO;
        !          1381: 
        !          1382:       backtrace.args = argvals;
        !          1383:       backtrace.nargs = XINT (numargs);
        !          1384: 
        !          1385:       switch (i)
        !          1386:        {
        !          1387:        case 0:
        !          1388:          val = (*XSUBR (fun)->function) ();
        !          1389:          goto done;
        !          1390:        case 1:
        !          1391:          val = (*XSUBR (fun)->function) (argvals[0]);
        !          1392:          goto done;
        !          1393:        case 2:
        !          1394:          val = (*XSUBR (fun)->function) (argvals[0], argvals[1]);
        !          1395:          goto done;
        !          1396:        case 3:
        !          1397:          val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
        !          1398:                                          argvals[2]);
        !          1399:          goto done;
        !          1400:        case 4:
        !          1401:          val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
        !          1402:                                          argvals[2], argvals[3]);
        !          1403:          goto done;
        !          1404:        case 5:
        !          1405:          val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
        !          1406:                                          argvals[3], argvals[4]);
        !          1407:          goto done;
        !          1408:        }
        !          1409:     }
        !          1410:   if (!CONSP (fun))
        !          1411:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1412:   funcar = Fcar (fun);
        !          1413:   if (XTYPE (funcar) != Lisp_Symbol)
        !          1414:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1415:   if (EQ (funcar, Qautoload))
        !          1416:     {
        !          1417:       do_autoload (fun, original_fun);
        !          1418:       goto retry;
        !          1419:     }
        !          1420:   if (EQ (funcar, Qmacro))
        !          1421:     val = Feval (apply1 (Fcdr (fun), original_args));
        !          1422:   else if (EQ (funcar, Qlambda))
        !          1423:     val = apply_lambda (fun, original_args, 1);
        !          1424:   else if (EQ (funcar, Qmocklisp))
        !          1425:     val = ml_apply (fun, original_args);
        !          1426:   else
        !          1427:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1428: 
        !          1429:  done:
        !          1430:   if (!EQ (Vmocklisp_arguments, Qt))
        !          1431:     {
        !          1432:       if (NULL (val))
        !          1433:        XFASTINT (val) = 0;
        !          1434:       else if (EQ (val, Qt))
        !          1435:        XFASTINT (val) = 1;
        !          1436:     }
        !          1437:   lisp_eval_depth--;
        !          1438:   if (backtrace.debug_on_exit)
        !          1439:     val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
        !          1440:   backtrace_list = backtrace.next;
        !          1441:   return val;
        !          1442: }
        !          1443: 
        !          1444: DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
        !          1445:   "Call FUNCTION, passing remaining arguments to it.  The last argument\n\
        !          1446: is a list of arguments to pass.\n\
        !          1447: Thus, (apply '+ 1 2 '(3 4)) returns 10.")
        !          1448:   (nargs, args)
        !          1449:      int nargs;
        !          1450:      Lisp_Object *args;
        !          1451: {
        !          1452:   register int i, numargs;
        !          1453:   register Lisp_Object spread_arg;
        !          1454:   register Lisp_Object *funcall_args ;
        !          1455:   Lisp_Object fun;
        !          1456: 
        !          1457:   fun = args [0];
        !          1458:   funcall_args = 0;
        !          1459:   spread_arg = args [nargs - 1];
        !          1460:   CHECK_LIST (spread_arg, nargs);
        !          1461:   
        !          1462:   numargs = XINT (Flength (spread_arg));
        !          1463: 
        !          1464:   if (numargs == 0)
        !          1465:     return Ffuncall (nargs - 1, args);
        !          1466:   else if (numargs == 1)
        !          1467:     {
        !          1468:       args [nargs - 1] = XCONS (spread_arg)->car;
        !          1469:       return Ffuncall (nargs, args);
        !          1470:     }
        !          1471: 
        !          1472:   numargs = nargs - 2 + numargs;
        !          1473: 
        !          1474:   while (XTYPE (fun) == Lisp_Symbol)
        !          1475:     {
        !          1476:       QUIT;
        !          1477:       fun = XSYMBOL (fun)->function;
        !          1478:       if (EQ (fun, Qunbound))
        !          1479:        {
        !          1480:          /* Let funcall get the error */
        !          1481:          fun = args[0];
        !          1482:          goto funcall;
        !          1483:        }
        !          1484:     }
        !          1485: 
        !          1486:   if (XTYPE (fun) == Lisp_Subr)
        !          1487:     if (numargs < XSUBR (fun)->min_args ||
        !          1488:        (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
        !          1489:       goto funcall;            /* Let funcall get the error */
        !          1490:     else if (XSUBR (fun)->max_args > numargs)
        !          1491:       {
        !          1492:         /* Avoid making funcall cons up a yet another new vector of arguments
        !          1493:           by explicitly supplying nil's for optional values */
        !          1494:        funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args)
        !          1495:                                               * sizeof (Lisp_Object));
        !          1496:        for (i = numargs; i < XSUBR (fun)->max_args;)
        !          1497:          funcall_args[++i] = Qnil;
        !          1498:       }
        !          1499:  funcall:
        !          1500:   /* We add 1 to numargs because funcall_args includes the
        !          1501:      function itself as well as its arguments.  */
        !          1502:   if (!funcall_args)
        !          1503:     funcall_args = (Lisp_Object *) alloca ((1 + numargs)
        !          1504:                                           * sizeof (Lisp_Object));
        !          1505:   bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
        !          1506:   /* Spread the last arg we got.  Its first element goes in
        !          1507:      the slot that it used to occupy, hence this value of I.  */
        !          1508:   i = nargs - 1;
        !          1509:   while (!NULL (spread_arg))
        !          1510:     {
        !          1511:       funcall_args [i++] = XCONS (spread_arg)->car;
        !          1512:       spread_arg = XCONS (spread_arg)->cdr;
        !          1513:     }
        !          1514:   return Ffuncall (numargs + 1, funcall_args);
        !          1515: }
        !          1516: 
        !          1517: /* Apply fn to arg */
        !          1518: Lisp_Object
        !          1519: apply1 (fn, arg)
        !          1520:      Lisp_Object fn, arg;
        !          1521: {
        !          1522:   if (NULL (arg))
        !          1523:     return Ffuncall (1, &fn);
        !          1524: #ifdef NO_ARG_ARRAY
        !          1525:   {
        !          1526:     Lisp_Object args[2];
        !          1527:     args[0] = fn;
        !          1528:     args[1] = arg;
        !          1529:     return Fapply (2, args);
        !          1530:   }
        !          1531: #else /* not NO_ARG_ARRAY */
        !          1532:   return Fapply (2, &fn);
        !          1533: #endif /* not NO_ARG_ARRAY */
        !          1534: }
        !          1535: 
        !          1536: /* Call function fn on no arguments */
        !          1537: Lisp_Object
        !          1538: call0 (fn)
        !          1539:      Lisp_Object fn;
        !          1540: {
        !          1541:   return Ffuncall (1, &fn);
        !          1542: }
        !          1543: 
        !          1544: /* Call function fn with argument arg */
        !          1545: /* ARGSUSED */
        !          1546: Lisp_Object
        !          1547: call1 (fn, arg)
        !          1548:      Lisp_Object fn, arg;
        !          1549: {
        !          1550: #ifdef NO_ARG_ARRAY
        !          1551:   Lisp_Object args[2];
        !          1552:   args[0] = fn;
        !          1553:   args[1] = arg;
        !          1554:   return Ffuncall (2, args);
        !          1555: #else /* not NO_ARG_ARRAY */
        !          1556:   return Ffuncall (2, &fn);
        !          1557: #endif /* not NO_ARG_ARRAY */
        !          1558: }
        !          1559: 
        !          1560: /* Call function fn with arguments arg, arg1 */
        !          1561: /* ARGSUSED */
        !          1562: Lisp_Object
        !          1563: call2 (fn, arg, arg1)
        !          1564:      Lisp_Object fn, arg, arg1;
        !          1565: {
        !          1566: #ifdef NO_ARG_ARRAY
        !          1567:   Lisp_Object args[3];
        !          1568:   args[0] = fn;
        !          1569:   args[1] = arg;
        !          1570:   args[2] = arg1;
        !          1571:   return Ffuncall (3, args);
        !          1572: #else /* not NO_ARG_ARRAY */
        !          1573:   return Ffuncall (3, &fn);
        !          1574: #endif /* not NO_ARG_ARRAY */
        !          1575: }
        !          1576: 
        !          1577: /* Call function fn with arguments arg, arg1, arg2 */
        !          1578: /* ARGSUSED */
        !          1579: Lisp_Object
        !          1580: call3 (fn, arg, arg1, arg2)
        !          1581:      Lisp_Object fn, arg, arg1, arg2;
        !          1582: {
        !          1583: #ifdef NO_ARG_ARRAY
        !          1584:   Lisp_Object args[4];
        !          1585:   args[0] = fn;
        !          1586:   args[1] = arg;
        !          1587:   args[2] = arg1;
        !          1588:   args[3] = arg2;
        !          1589:   return Ffuncall (4, args);
        !          1590: #else /* not NO_ARG_ARRAY */
        !          1591:   return Ffuncall (4, &fn);
        !          1592: #endif /* not NO_ARG_ARRAY */
        !          1593: }
        !          1594: 
        !          1595: DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
        !          1596:   "Call first argument as a function, passing remaining arguments to it.\n\
        !          1597: Thus,  (funcall 'cons 'x 'y)  returns  (x . y).")
        !          1598:   (nargs, args)
        !          1599:      int nargs;
        !          1600:      Lisp_Object *args;
        !          1601: {
        !          1602:   Lisp_Object fun;
        !          1603:   Lisp_Object funcar;
        !          1604:   int numargs = nargs - 1;
        !          1605:   Lisp_Object lisp_numargs;
        !          1606:   Lisp_Object val;
        !          1607:   struct backtrace backtrace;
        !          1608:   struct gcpro gcpro1;
        !          1609:   register Lisp_Object *internal_args;
        !          1610:   register int i;
        !          1611: 
        !          1612:   QUIT;
        !          1613:   if (consing_since_gc > gc_cons_threshold)
        !          1614:     {
        !          1615:       GCPRO1 (*args);
        !          1616:       gcpro1.nvars = nargs;
        !          1617:       Fgarbage_collect ();
        !          1618:       UNGCPRO;
        !          1619:     }
        !          1620: 
        !          1621:   if (++lisp_eval_depth > max_lisp_eval_depth)
        !          1622:     {
        !          1623:       if (max_lisp_eval_depth < 100)
        !          1624:        max_lisp_eval_depth = 100;
        !          1625:       if (lisp_eval_depth > max_lisp_eval_depth)
        !          1626:        error ("Lisp nesting exceeds max-lisp-eval-depth");
        !          1627:     }
        !          1628: 
        !          1629:   backtrace.next = backtrace_list;
        !          1630:   backtrace_list = &backtrace;
        !          1631:   backtrace.function = &args[0];
        !          1632:   backtrace.args = &args[1];
        !          1633:   backtrace.nargs = nargs - 1;
        !          1634:   backtrace.evalargs = 0;
        !          1635:   backtrace.debug_on_exit = 0;
        !          1636: 
        !          1637:   if (debug_on_next_call)
        !          1638:     do_debug_on_call (Qlambda);
        !          1639: 
        !          1640:  retry:
        !          1641: 
        !          1642:   fun = args[0];
        !          1643:   while (XTYPE (fun) == Lisp_Symbol)
        !          1644:     {
        !          1645:       QUIT;
        !          1646:       val = XSYMBOL (fun)->function;
        !          1647:       if (EQ (val, Qunbound))
        !          1648:        Fsymbol_function (fun); /* Get the right kind of error! */
        !          1649:       fun = val;
        !          1650:     }
        !          1651: 
        !          1652:   if (XTYPE (fun) == Lisp_Subr)
        !          1653:     {
        !          1654:       if (numargs < XSUBR (fun)->min_args ||
        !          1655:          (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
        !          1656:        {
        !          1657:          XFASTINT (lisp_numargs) = numargs;
        !          1658:          return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (lisp_numargs, Qnil)));
        !          1659:        }
        !          1660: 
        !          1661:       if (XSUBR (fun)->max_args == UNEVALLED)
        !          1662:        return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1663: 
        !          1664:       if (XSUBR (fun)->max_args == MANY)
        !          1665:        {
        !          1666:          val = (*XSUBR (fun)->function) (numargs, args + 1);
        !          1667:          goto done;
        !          1668:        }
        !          1669: 
        !          1670:       if (XSUBR (fun)->max_args > numargs)
        !          1671:        {
        !          1672:          internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
        !          1673:          bcopy (args + 1, internal_args, numargs * sizeof (Lisp_Object));
        !          1674:          for (i = numargs; i < XSUBR (fun)->max_args; i++)
        !          1675:            internal_args[i] = Qnil;
        !          1676:        }
        !          1677:       else
        !          1678:        internal_args = args + 1;
        !          1679:       switch (XSUBR (fun)->max_args)
        !          1680:        {
        !          1681:        case 0:
        !          1682:          val = (*XSUBR (fun)->function) ();
        !          1683:          goto done;
        !          1684:        case 1:
        !          1685:          val = (*XSUBR (fun)->function) (internal_args[0]);
        !          1686:          goto done;
        !          1687:        case 2:
        !          1688:          val = (*XSUBR (fun)->function) (internal_args[0],
        !          1689:                                          internal_args[1]);
        !          1690:          goto done;
        !          1691:        case 3:
        !          1692:          val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
        !          1693:                                          internal_args[2]);
        !          1694:          goto done;
        !          1695:        case 4:
        !          1696:          val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
        !          1697:                                          internal_args[2],
        !          1698:                                          internal_args[3]);
        !          1699:          goto done;
        !          1700:        case 5:
        !          1701:          val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
        !          1702:                                          internal_args[2], internal_args[3],
        !          1703:                                          internal_args[4]);
        !          1704:          goto done;
        !          1705:        }
        !          1706:     }
        !          1707:   if (!CONSP (fun))
        !          1708:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1709:   funcar = Fcar (fun);
        !          1710:   if (XTYPE (funcar) != Lisp_Symbol)
        !          1711:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1712:   if (EQ (funcar, Qlambda))
        !          1713:     val = funcall_lambda (fun, numargs, args + 1);
        !          1714:   else if (EQ (funcar, Qmocklisp))
        !          1715:     val = ml_apply (fun, Flist (numargs, args + 1));
        !          1716:   else if (EQ (funcar, Qautoload))
        !          1717:     {
        !          1718:       do_autoload (fun, args[0]);
        !          1719:       goto retry;
        !          1720:     }
        !          1721:   else
        !          1722:     return Fsignal (Qinvalid_function, Fcons (fun, Qnil));
        !          1723: 
        !          1724:  done:
        !          1725:   lisp_eval_depth--;
        !          1726:   if (backtrace.debug_on_exit)
        !          1727:     val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
        !          1728:   backtrace_list = backtrace.next;
        !          1729:   return val;
        !          1730: }
        !          1731: 
        !          1732: Lisp_Object
        !          1733: apply_lambda (fun, args, eval_flag)
        !          1734:      Lisp_Object fun, args;
        !          1735:      int eval_flag;
        !          1736: {
        !          1737:   Lisp_Object args_left;
        !          1738:   Lisp_Object numargs;
        !          1739:   register Lisp_Object *arg_vector;
        !          1740:   struct gcpro gcpro1, gcpro2, gcpro3;
        !          1741:   register int i;
        !          1742:   register Lisp_Object tem;
        !          1743: 
        !          1744:   numargs = Flength (args);
        !          1745:   arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
        !          1746:   args_left = args;
        !          1747: 
        !          1748:   GCPRO3 (*arg_vector, args_left, fun);
        !          1749:   gcpro1.nvars = 0;
        !          1750: 
        !          1751:   for (i = 0; i < XINT (numargs);)
        !          1752:     {
        !          1753:       tem = Fcar (args_left), args_left = Fcdr (args_left);
        !          1754:       if (eval_flag) tem = Feval (tem);
        !          1755:       arg_vector[i++] = tem;
        !          1756:       gcpro1.nvars = i;
        !          1757:     }
        !          1758: 
        !          1759:   UNGCPRO;
        !          1760: 
        !          1761:   if (eval_flag)
        !          1762:     {
        !          1763:       backtrace_list->args = arg_vector;
        !          1764:       backtrace_list->nargs = i;
        !          1765:     }
        !          1766:   backtrace_list->evalargs = 0;
        !          1767:   tem = funcall_lambda (fun, XINT (numargs), arg_vector);
        !          1768: 
        !          1769:   /* Do the debug-on-exit now, while arg_vector still exists.  */
        !          1770:   if (backtrace_list->debug_on_exit)
        !          1771:     tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
        !          1772:   /* Don't do it again when we return to eval.  */
        !          1773:   backtrace_list->debug_on_exit = 0;
        !          1774:   return tem;
        !          1775: }
        !          1776: 
        !          1777: Lisp_Object
        !          1778: funcall_lambda (fun, nargs, arg_vector)
        !          1779:      Lisp_Object fun;
        !          1780:      int nargs;
        !          1781:      register Lisp_Object *arg_vector;
        !          1782: {
        !          1783:   Lisp_Object val, tem;
        !          1784:   register Lisp_Object syms_left;
        !          1785:   Lisp_Object numargs;
        !          1786:   register Lisp_Object next;
        !          1787:   int count = specpdl_ptr - specpdl;
        !          1788:   register int i;
        !          1789:   int optional = 0, rest = 0;
        !          1790: 
        !          1791:   specbind (Qmocklisp_arguments, Qt);   /* t means NOT mocklisp! */
        !          1792: 
        !          1793:   XFASTINT (numargs) = nargs;
        !          1794: 
        !          1795:   i = 0;
        !          1796:   for (syms_left = Fcar (Fcdr (fun)); !NULL (syms_left); syms_left = Fcdr (syms_left))
        !          1797:     {
        !          1798:       QUIT;
        !          1799:       next = Fcar (syms_left);
        !          1800:       if (EQ (next, Qand_rest))
        !          1801:        rest = 1;
        !          1802:       else if (EQ (next, Qand_optional))
        !          1803:        optional = 1;
        !          1804:       else if (rest)
        !          1805:        {
        !          1806:          specbind (Fcar (syms_left), Flist (nargs - i, &arg_vector[i]));
        !          1807:          i = nargs;
        !          1808:        }
        !          1809:       else if (i < nargs)
        !          1810:        {
        !          1811:          tem = arg_vector[i++];
        !          1812:          specbind (next, tem);
        !          1813:        }
        !          1814:       else if (!optional)
        !          1815:        return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));
        !          1816:       else
        !          1817:        specbind (next, Qnil);
        !          1818:     }
        !          1819: 
        !          1820:   if (i < nargs)
        !          1821:     return Fsignal (Qwrong_number_of_arguments, Fcons (fun, Fcons (numargs, Qnil)));
        !          1822: 
        !          1823:   val = Fprogn (Fcdr (Fcdr (fun)));
        !          1824:   unbind_to (count);
        !          1825:   return val;
        !          1826: }
        !          1827: 
        !          1828: void
        !          1829: grow_specpdl ()
        !          1830: {
        !          1831:   register int count = specpdl_ptr - specpdl;
        !          1832:   if (specpdl_size >= max_specpdl_size)
        !          1833:     {
        !          1834:       if (max_specpdl_size < 400)
        !          1835:        max_specpdl_size = 400;
        !          1836:       if (specpdl_size >= max_specpdl_size)
        !          1837:        {
        !          1838:          Fsignal (Qerror,
        !          1839:                   Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
        !          1840:          max_specpdl_size *= 2;
        !          1841:        }
        !          1842:     }
        !          1843:   specpdl_size *= 2;
        !          1844:   if (specpdl_size > max_specpdl_size)
        !          1845:     specpdl_size = max_specpdl_size;
        !          1846:   specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));
        !          1847:   specpdl_ptr = specpdl + count;
        !          1848: }
        !          1849: 
        !          1850: void
        !          1851: specbind (symbol, value)
        !          1852:      Lisp_Object symbol, value;
        !          1853: {
        !          1854:   extern void store_symval_forwarding (); /* in eval.c */
        !          1855:   Lisp_Object ovalue;
        !          1856: 
        !          1857:   if (specpdl_ptr == specpdl + specpdl_size)
        !          1858:     grow_specpdl ();
        !          1859:   specpdl_ptr->symbol = symbol;
        !          1860:   specpdl_ptr->func = 0;
        !          1861:   ovalue = XSYMBOL (symbol)->value;
        !          1862:   specpdl_ptr->old_value = EQ (ovalue, Qunbound) ? Qunbound : Fsymbol_value (symbol);
        !          1863:   specpdl_ptr++;
        !          1864:   if (XTYPE (ovalue) == Lisp_Buffer_Objfwd)
        !          1865:     store_symval_forwarding (symbol, ovalue, value);
        !          1866:   else
        !          1867:     Fset (symbol, value);
        !          1868: }
        !          1869: 
        !          1870: void
        !          1871: record_unwind_protect (function, arg)
        !          1872:      Lisp_Object (*function)();
        !          1873:      Lisp_Object arg;
        !          1874: {
        !          1875:   if (specpdl_ptr == specpdl + specpdl_size)
        !          1876:     grow_specpdl ();
        !          1877:   specpdl_ptr->func = function;
        !          1878:   specpdl_ptr->symbol = Qnil;
        !          1879:   specpdl_ptr->old_value = arg;
        !          1880:   specpdl_ptr++;
        !          1881: }
        !          1882: 
        !          1883: void
        !          1884: unbind_to (count)
        !          1885:      int count;
        !          1886: {
        !          1887:   int quitf = !NULL (Vquit_flag);
        !          1888: 
        !          1889:   Vquit_flag = Qnil;
        !          1890: 
        !          1891:   while (specpdl_ptr != specpdl + count)
        !          1892:     {
        !          1893:       --specpdl_ptr;
        !          1894:       if (specpdl_ptr->func != 0)
        !          1895:        (*specpdl_ptr->func) (specpdl_ptr->old_value);
        !          1896:       /* Note that a "binding" of nil is really an unwind protect,
        !          1897:        so in that case the "old value" is a list of forms to evaluate.  */
        !          1898:       else if (NULL (specpdl_ptr->symbol))
        !          1899:        Fprogn (specpdl_ptr->old_value);
        !          1900:       else
        !          1901:         Fset (specpdl_ptr->symbol, specpdl_ptr->old_value);
        !          1902:     }
        !          1903:   if (NULL (Vquit_flag) && quitf) Vquit_flag = Qt;
        !          1904: }
        !          1905: 
        !          1906: #if 0
        !          1907: 
        !          1908: /* Get the value of symbol's global binding, even if that binding
        !          1909:  is not now dynamically visible.  */
        !          1910: 
        !          1911: Lisp_Object
        !          1912: top_level_value (symbol)
        !          1913:      Lisp_Object symbol;
        !          1914: {
        !          1915:   register struct specbinding *ptr = specpdl;
        !          1916: 
        !          1917:   CHECK_SYMBOL (symbol, 0);
        !          1918:   for (; ptr != specpdl_ptr; ptr++)
        !          1919:     {
        !          1920:       if (EQ (ptr->symbol, symbol))
        !          1921:        return ptr->old_value;
        !          1922:     }
        !          1923:   return Fsymbol_value (symbol);
        !          1924: }
        !          1925: 
        !          1926: Lisp_Object
        !          1927: top_level_set (symbol, newval)
        !          1928:      Lisp_Object symbol, newval;
        !          1929: {
        !          1930:   register struct specbinding *ptr = specpdl;
        !          1931: 
        !          1932:   CHECK_SYMBOL (symbol, 0);
        !          1933:   for (; ptr != specpdl_ptr; ptr++)
        !          1934:     {
        !          1935:       if (EQ (ptr->symbol, symbol))
        !          1936:        {
        !          1937:          ptr->old_value = newval;
        !          1938:          return newval;
        !          1939:        }
        !          1940:     }
        !          1941:   return Fset (symbol, newval);
        !          1942: }  
        !          1943: 
        !          1944: #endif /* 0 */
        !          1945: 
        !          1946: DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
        !          1947:   "Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.\n\
        !          1948: The debugger is entered when that frame exits, if the flag is non-nil.")
        !          1949:   (level, flag)
        !          1950:      Lisp_Object level, flag;
        !          1951: {
        !          1952:   register struct backtrace *backlist = backtrace_list;
        !          1953:   register int i;
        !          1954: 
        !          1955:   CHECK_NUMBER (level, 0);
        !          1956: 
        !          1957:   for (i = 0; backlist && i < XINT (level); i++)
        !          1958:     {
        !          1959:       backlist = backlist->next;
        !          1960:     }
        !          1961: 
        !          1962:   if (backlist)
        !          1963:     backlist->debug_on_exit = !NULL (flag);
        !          1964: 
        !          1965:   return flag;
        !          1966: }
        !          1967: 
        !          1968: DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
        !          1969:   "Print a trace of Lisp function calls currently active.\n\
        !          1970: Output stream used is value of standard-output.")
        !          1971:   ()
        !          1972: {
        !          1973:   register struct backtrace *backlist = backtrace_list;
        !          1974:   register int i;
        !          1975:   register Lisp_Object tail;
        !          1976:   Lisp_Object tem;
        !          1977: 
        !          1978:   while (backlist)
        !          1979:     {
        !          1980:       write_string (backlist->debug_on_exit ? "* " : "  ", 2);
        !          1981:       if (backlist->nargs == UNEVALLED)
        !          1982:         write_string ("(", -1);
        !          1983:       tem = *backlist->function;
        !          1984:       Fprin1 (tem, Qnil);      /* This can QUIT */
        !          1985:       if (backlist->nargs == UNEVALLED)
        !          1986:        {
        !          1987:          if (backlist->evalargs)
        !          1988:            write_string (" ...computing arguments...", -1);
        !          1989:          else
        !          1990:            write_string (" ...", -1);
        !          1991:        }
        !          1992:       else if (backlist->nargs == MANY)
        !          1993:        {
        !          1994:          write_string ("(", -1);
        !          1995:          for (tail = *backlist->args, i = 0; !NULL (tail); tail = Fcdr (tail), i++)
        !          1996:            {
        !          1997:              if (i) write_string (" ", -1);
        !          1998:              Fprin1 (Fcar (tail), Qnil);
        !          1999:            }
        !          2000:        }
        !          2001:       else
        !          2002:        {
        !          2003:          write_string ("(", -1);
        !          2004:          for (i = 0; i < backlist->nargs; i++)
        !          2005:            {
        !          2006:              if (i) write_string (" ", -1);
        !          2007:              Fprin1 (backlist->args[i], Qnil);
        !          2008:            }
        !          2009:        }
        !          2010:       write_string (")\n", -1);
        !          2011:       backlist = backlist->next;
        !          2012:     }
        !          2013:   return Qnil;
        !          2014: }
        !          2015: 
        !          2016: syms_of_eval ()
        !          2017: {
        !          2018:   DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
        !          2019:     "Limit on number of Lisp variable bindings & unwind-protects before error.");
        !          2020: 
        !          2021:   DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
        !          2022:     "Limit on depth in eval, apply and funcall before error.");
        !          2023: 
        !          2024:   DEFVAR_LISP ("quit-flag", &Vquit_flag,
        !          2025:     "Non-nil causes  eval  to abort, unless  inhibit-quit  is non-nil.\n\
        !          2026: Typing C-G sets  quit-flag  non-nil, regardless of  inhibit-quit.");
        !          2027:   Vquit_flag = Qnil;
        !          2028: 
        !          2029:   DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
        !          2030:     "Non-nil inhibits C-g quitting from happening immediately.\n\
        !          2031: Note that  quit-flag  will still be set by typing C-g,\n\
        !          2032: so a quit will be signalled as soon as  inhibit-quit  is nil.\n\
        !          2033: To prevent this happening, set  quit-flag  to nil\n\
        !          2034: before making  inhibit-quit  nil.");
        !          2035:   Vinhibit_quit = Qnil;
        !          2036: 
        !          2037:   Qautoload = intern ("autoload");
        !          2038:   staticpro (&Qautoload);
        !          2039: 
        !          2040:   Qmacro = intern ("macro");
        !          2041:   staticpro (&Qmacro);
        !          2042: 
        !          2043:   Qexit = intern ("exit");
        !          2044:   staticpro (&Qexit);
        !          2045: 
        !          2046:   Qinteractive = intern ("interactive");
        !          2047:   staticpro (&Qinteractive);
        !          2048: 
        !          2049:   Qcommandp = intern ("commandp");
        !          2050:   staticpro (&Qcommandp);
        !          2051: 
        !          2052:   Qdefun = intern ("defun");
        !          2053:   staticpro (&Qdefun);
        !          2054: 
        !          2055:   Qand_rest = intern ("&rest");
        !          2056:   staticpro (&Qand_rest);
        !          2057: 
        !          2058:   Qand_optional = intern ("&optional");
        !          2059:   staticpro (&Qand_optional);
        !          2060: 
        !          2061:   DEFVAR_BOOL ("stack-trace-on-error", &stack_trace_on_error,
        !          2062:     "*Non-nil means automatically display a backtrace buffer\n\
        !          2063: after any error that is handled by the editor command loop.");
        !          2064:   stack_trace_on_error = 0;
        !          2065: 
        !          2066:   DEFVAR_BOOL ("debug-on-error", &debug_on_error,
        !          2067:     "*Non-nil means enter debugger if an error is signaled.\n\
        !          2068: Does not apply to errors handled by condition-case.\n\
        !          2069: See also variable debug-on-quit.");
        !          2070:   debug_on_error = 0;
        !          2071: 
        !          2072:   DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
        !          2073:     "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\
        !          2074: Does not apply if quit is handled by a condition-case.");
        !          2075:   debug_on_quit = 0;
        !          2076: 
        !          2077:   DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
        !          2078:     "Non-nil means enter debugger before next eval, apply or funcall.");
        !          2079: 
        !          2080:   DEFVAR_LISP ("debugger", &Vdebugger,
        !          2081:     "Function to call to invoke debugger.\n\
        !          2082: If due to frame exit, args are 'exit and value being returned;\n\
        !          2083:  this function's value will be returned instead of that.\n\
        !          2084: If due to error, args are 'error and list of signal's args.\n\
        !          2085: If due to apply or funcall entry, one arg, 'lambda.\n\
        !          2086: If due to eval entry, one arg, 't.");
        !          2087:   Vdebugger = Qnil;
        !          2088: 
        !          2089:   Qmocklisp_arguments = intern ("mocklisp-arguments");
        !          2090:   staticpro (&Qmocklisp_arguments);
        !          2091:   DEFVAR_LISP ("mocklisp-arguments", &Vmocklisp_arguments,
        !          2092:     "While in a mocklisp function, the list of its unevaluated args.");
        !          2093:   Vmocklisp_arguments = Qt;
        !          2094: 
        !          2095:   staticpro (&Vautoload_queue);
        !          2096:   Vautoload_queue = Qnil;
        !          2097: 
        !          2098:   defsubr (&Sor);
        !          2099:   defsubr (&Sand);
        !          2100:   defsubr (&Sif);
        !          2101:   defsubr (&Scond);
        !          2102:   defsubr (&Sprogn);
        !          2103:   defsubr (&Sprog1);
        !          2104:   defsubr (&Sprog2);
        !          2105:   defsubr (&Ssetq);
        !          2106:   defsubr (&Squote);
        !          2107:   defsubr (&Sfunction);
        !          2108:   defsubr (&Sdefun);
        !          2109:   defsubr (&Sdefmacro);
        !          2110:   defsubr (&Sdefvar);
        !          2111:   defsubr (&Sdefconst);
        !          2112:   defsubr (&Suser_variable_p);
        !          2113:   defsubr (&Slet);
        !          2114:   defsubr (&SletX);
        !          2115:   defsubr (&Swhile);
        !          2116:   defsubr (&Smacroexpand);
        !          2117:   defsubr (&Scatch);
        !          2118:   defsubr (&Sthrow);
        !          2119:   defsubr (&Sunwind_protect);
        !          2120:   defsubr (&Scondition_case);
        !          2121:   defsubr (&Ssignal);
        !          2122:   defsubr (&Sinteractive_p);
        !          2123:   defsubr (&Scommandp);
        !          2124:   defsubr (&Sautoload);
        !          2125:   defsubr (&Seval);
        !          2126:   defsubr (&Sapply);
        !          2127:   defsubr (&Sfuncall);
        !          2128:   defsubr (&Sbacktrace_debug);
        !          2129:   defsubr (&Sbacktrace);
        !          2130: }

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.