Return to eval.c CVS log

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

Annotation of 43BSD/contrib/emacs/src/eval.c, revision 1.1

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

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