Return to eval.c CVS log

Up to [Apple XNU] / GNUtools / emacs / src

Annotation of GNUtools/emacs/src/eval.c, revision 1.1

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

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