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

1.1     ! root        1: /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter.
        !             2:    Copyright (C) 1985, 1986 Free Software Foundation, Inc.
        !             3: 
        !             4: This file is part of GNU Emacs.
        !             5: 
        !             6: GNU Emacs is free software; you can redistribute it and/or modify
        !             7: it under the terms of the GNU General Public License as published by
        !             8: the Free Software Foundation; either version 1, or (at your option)
        !             9: any later version.
        !            10: 
        !            11: GNU Emacs is distributed in the hope that it will be useful,
        !            12: but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            14: GNU General Public License for more details.
        !            15: 
        !            16: You should have received a copy of the GNU General Public License
        !            17: along with GNU Emacs; see the file COPYING.  If not, write to
        !            18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
        !            19: 
        !            20: 
        !            21: /* This must precede sys/signal.h on certain machines.  */
        !            22: #include <sys/types.h>
        !            23: #include <signal.h>
        !            24: 
        !            25: #include "config.h"
        !            26: #include "lisp.h"
        !            27: 
        !            28: #ifndef standalone
        !            29: #include "buffer.h"
        !            30: #endif
        !            31: 
        !            32: #include "emacssignal.h"
        !            33: 
        !            34: Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound;
        !            35: Lisp_Object Qerror_conditions, Qerror_message, Qtop_level;
        !            36: Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range;
        !            37: Lisp_Object Qvoid_variable, Qvoid_function;
        !            38: Lisp_Object Qsetting_constant, Qinvalid_read_syntax;
        !            39: Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch;
        !            40: Lisp_Object Qend_of_file, Qarith_error;
        !            41: Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only;
        !            42: Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qlistp, Qconsp;
        !            43: Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp;
        !            44: Lisp_Object Qchar_or_string_p, Qmarkerp, Qinteger_or_marker_p, Qvectorp;
        !            45: Lisp_Object Qboundp, Qfboundp;
        !            46: Lisp_Object Qcdr;
        !            47: 
        !            48: Lisp_Object
        !            49: wrong_type_argument (predicate, value)
        !            50:      register Lisp_Object predicate, value;
        !            51: {
        !            52:   register Lisp_Object tem;
        !            53:   do
        !            54:     {
        !            55:       if (!EQ (Vmocklisp_arguments, Qt))
        !            56:        {
        !            57:         if (XTYPE (value) == Lisp_String &&
        !            58:             (EQ (predicate, Qintegerp) || EQ (predicate, Qinteger_or_marker_p)))
        !            59:           return Fstring_to_int (value, Qt);
        !            60:         if (XTYPE (value) == Lisp_Int && EQ (predicate, Qstringp))
        !            61:           return Fint_to_string (value);
        !            62:        }
        !            63:       value = Fsignal (Qwrong_type_argument, Fcons (predicate, Fcons (value, Qnil)));
        !            64:       tem = call1 (predicate, value);
        !            65:     }
        !            66:   while (NULL (tem));
        !            67:   return value;
        !            68: }
        !            69: 
        !            70: pure_write_error ()
        !            71: {
        !            72:   error ("Attempt to modify read-only object");
        !            73: }
        !            74: 
        !            75: void
        !            76: args_out_of_range (a1, a2)
        !            77:      Lisp_Object a1, a2;
        !            78: {
        !            79:   while (1)
        !            80:     Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Qnil)));
        !            81: }
        !            82: 
        !            83: void
        !            84: args_out_of_range_3 (a1, a2, a3)
        !            85:      Lisp_Object a1, a2, a3;
        !            86: {
        !            87:   while (1)
        !            88:     Fsignal (Qargs_out_of_range, Fcons (a1, Fcons (a2, Fcons (a3, Qnil))));
        !            89: }
        !            90: 
        !            91: Lisp_Object
        !            92: make_number (num)
        !            93:      int num;
        !            94: {
        !            95:   register Lisp_Object val;
        !            96:   XSET (val, Lisp_Int, num);
        !            97:   return val;
        !            98: }
        !            99: 
        !           100: /* On some machines, XINT needs a temporary location.
        !           101:    Here it is, in case it is needed.  */
        !           102: 
        !           103: int sign_extend_temp;
        !           104: 
        !           105: /* On a few machines, XINT can only be done by calling this.  */
        !           106: 
        !           107: int
        !           108: sign_extend_lisp_int (num)
        !           109:      int num;
        !           110: {
        !           111:   if (num & (1 << (VALBITS - 1)))
        !           112:     return num | ((-1) << VALBITS);
        !           113:   else
        !           114:     return num & ((1 << VALBITS) - 1);
        !           115: }
        !           116: 
        !           117: /* Data type predicates */
        !           118: 
        !           119: DEFUN ("eq", Feq, Seq, 2, 2, 0,
        !           120:   "T if the two args are the same Lisp object.")
        !           121:   (obj1, obj2)
        !           122:      Lisp_Object obj1, obj2;
        !           123: {
        !           124:   if (EQ (obj1, obj2))
        !           125:     return Qt;
        !           126:   return Qnil;
        !           127: }
        !           128: 
        !           129: DEFUN ("null", Fnull, Snull, 1, 1, 0, "T if OBJECT is nil.")
        !           130:   (obj)
        !           131:      Lisp_Object obj;
        !           132: {
        !           133:   if (NULL (obj))
        !           134:     return Qt;
        !           135:   return Qnil;
        !           136: }
        !           137: 
        !           138: DEFUN ("consp", Fconsp, Sconsp, 1, 1, 0, "T if OBJECT is a cons cell.")
        !           139:   (obj)
        !           140:      Lisp_Object obj;
        !           141: {
        !           142:   if (XTYPE (obj) == Lisp_Cons)
        !           143:     return Qt;
        !           144:   return Qnil;
        !           145: }
        !           146: 
        !           147: DEFUN ("atom", Fatom, Satom, 1, 1, 0, "T if OBJECT is not a cons cell.  This includes nil.")
        !           148:   (obj)
        !           149:      Lisp_Object obj;
        !           150: {
        !           151:   if (XTYPE (obj) == Lisp_Cons)
        !           152:     return Qnil;
        !           153:   return Qt;
        !           154: }
        !           155: 
        !           156: DEFUN ("listp", Flistp, Slistp, 1, 1, 0, "T if OBJECT is a list.  This includes nil.")
        !           157:   (obj)
        !           158:      Lisp_Object obj;
        !           159: {
        !           160:   if (XTYPE (obj) == Lisp_Cons || NULL (obj))
        !           161:     return Qt;
        !           162:   return Qnil;
        !           163: }
        !           164: 
        !           165: DEFUN ("nlistp", Fnlistp, Snlistp, 1, 1, 0, "T if OBJECT is not a list.  Lists include nil.")
        !           166:   (obj)
        !           167:      Lisp_Object obj;
        !           168: {
        !           169:   if (XTYPE (obj) == Lisp_Cons || NULL (obj))
        !           170:     return Qnil;
        !           171:   return Qt;
        !           172: }
        !           173: 
        !           174: DEFUN ("integerp", Fintegerp, Sintegerp, 1, 1, 0, "T if OBJECT is a number.")
        !           175:   (obj)
        !           176:      Lisp_Object obj;
        !           177: {
        !           178:   if (XTYPE (obj) == Lisp_Int)
        !           179:     return Qt;
        !           180:   return Qnil;
        !           181: }
        !           182: 
        !           183: DEFUN ("natnump", Fnatnump, Snatnump, 1, 1, 0, "T if OBJECT is a nonnegative number.")
        !           184:   (obj)
        !           185:      Lisp_Object obj;
        !           186: {
        !           187:   if (XTYPE (obj) == Lisp_Int && XINT (obj) >= 0)
        !           188:     return Qt;
        !           189:   return Qnil;
        !           190: }
        !           191: 
        !           192: DEFUN ("symbolp", Fsymbolp, Ssymbolp, 1, 1, 0, "T if OBJECT is a symbol.")
        !           193:   (obj)
        !           194:      Lisp_Object obj;
        !           195: {
        !           196:   if (XTYPE (obj) == Lisp_Symbol)
        !           197:     return Qt;
        !           198:   return Qnil;
        !           199: }
        !           200: 
        !           201: DEFUN ("vectorp", Fvectorp, Svectorp, 1, 1, 0, "T if OBJECT is a vector.")
        !           202:   (obj)
        !           203:      Lisp_Object obj;
        !           204: {
        !           205:   if (XTYPE (obj) == Lisp_Vector)
        !           206:     return Qt;
        !           207:   return Qnil;
        !           208: }
        !           209: 
        !           210: DEFUN ("stringp", Fstringp, Sstringp, 1, 1, 0, "T if OBJECT is a string.")
        !           211:   (obj)
        !           212:      Lisp_Object obj;
        !           213: {
        !           214:   if (XTYPE (obj) == Lisp_String)
        !           215:     return Qt;
        !           216:   return Qnil;
        !           217: }
        !           218: 
        !           219: DEFUN ("arrayp", Farrayp, Sarrayp, 1, 1, 0, "T if OBJECT is an array (string or vector).")
        !           220:   (obj)
        !           221:      Lisp_Object obj;
        !           222: {
        !           223:   if (XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String)
        !           224:     return Qt;
        !           225:   return Qnil;
        !           226: }
        !           227: 
        !           228: DEFUN ("sequencep", Fsequencep, Ssequencep, 1, 1, 0,
        !           229:   "T if OBJECT is a sequence (list or array).")
        !           230:   (obj)
        !           231:      register Lisp_Object obj;
        !           232: {
        !           233:   if (CONSP (obj) || NULL (obj) ||
        !           234:       XTYPE (obj) == Lisp_Vector || XTYPE (obj) == Lisp_String)
        !           235:     return Qt;
        !           236:   return Qnil;
        !           237: }
        !           238: 
        !           239: DEFUN ("bufferp", Fbufferp, Sbufferp, 1, 1, 0, "T if OBJECT is an editor buffer.")
        !           240:   (obj)
        !           241:      Lisp_Object obj;
        !           242: {
        !           243:   if (XTYPE (obj) == Lisp_Buffer)
        !           244:     return Qt;
        !           245:   return Qnil;
        !           246: }
        !           247: 
        !           248: DEFUN ("markerp", Fmarkerp, Smarkerp, 1, 1, 0, "T if OBJECT is a marker (editor pointer).")
        !           249:   (obj)
        !           250:      Lisp_Object obj;
        !           251: {
        !           252:   if (XTYPE (obj) == Lisp_Marker)
        !           253:     return Qt;
        !           254:   return Qnil;
        !           255: }
        !           256: 
        !           257: DEFUN ("integer-or-marker-p", Finteger_or_marker_p, Sinteger_or_marker_p, 1, 1, 0,
        !           258:   "T if OBJECT is an integer or a marker (editor pointer).")
        !           259:   (obj)
        !           260:      register Lisp_Object obj;
        !           261: {
        !           262:   if (XTYPE (obj) == Lisp_Marker || XTYPE (obj) == Lisp_Int)
        !           263:     return Qt;
        !           264:   return Qnil;
        !           265: }
        !           266: 
        !           267: DEFUN ("subrp", Fsubrp, Ssubrp, 1, 1, 0, "T if OBJECT is a built-in function.")
        !           268:   (obj)
        !           269:      Lisp_Object obj;
        !           270: {
        !           271:   if (XTYPE (obj) == Lisp_Subr)
        !           272:     return Qt;
        !           273:   return Qnil;
        !           274: }
        !           275: 
        !           276: DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0, "T if OBJECT is a character (a number) or a string.")
        !           277:   (obj)
        !           278:      register Lisp_Object obj;
        !           279: {
        !           280:   if (XTYPE (obj) == Lisp_Int || XTYPE (obj) == Lisp_String)
        !           281:     return Qt;
        !           282:   return Qnil;
        !           283: }
        !           284: 
        !           285: /* Extract and set components of lists */
        !           286: 
        !           287: DEFUN ("car", Fcar, Scar, 1, 1, 0,
        !           288:   "Return the car of CONSCELL.  If arg is nil, return nil.")
        !           289:   (list)
        !           290:      register Lisp_Object list;
        !           291: {
        !           292:   while (1)
        !           293:     {
        !           294:       if (XTYPE (list) == Lisp_Cons)
        !           295:        return XCONS (list)->car;
        !           296:       else if (EQ (list, Qnil))
        !           297:        return Qnil;
        !           298:       else
        !           299:        list = wrong_type_argument (Qlistp, list);
        !           300:     }
        !           301: }
        !           302: 
        !           303: DEFUN ("car-safe", Fcar_safe, Scar_safe, 1, 1, 0,
        !           304:   "Return the car of OBJECT if it is a cons cell, or else  nil.")
        !           305:   (object)
        !           306:      Lisp_Object object;
        !           307: {
        !           308:   if (XTYPE (object) == Lisp_Cons)
        !           309:     return XCONS (object)->car;
        !           310:   else
        !           311:     return Qnil;
        !           312: }
        !           313: 
        !           314: DEFUN ("cdr", Fcdr, Scdr, 1, 1, 0,
        !           315:   "Return the cdr of CONSCELL.  If arg is nil, return nil.")
        !           316:   (list)
        !           317:      register Lisp_Object list;
        !           318: {
        !           319:   while (1)
        !           320:     {
        !           321:       if (XTYPE (list) == Lisp_Cons)
        !           322:        return XCONS (list)->cdr;
        !           323:       else if (EQ (list, Qnil))
        !           324:        return Qnil;
        !           325:       else
        !           326:        list = wrong_type_argument (Qlistp, list);
        !           327:     }
        !           328: }
        !           329: 
        !           330: DEFUN ("cdr-safe", Fcdr_safe, Scdr_safe, 1, 1, 0,
        !           331:   "Return the cdr of OBJECT if it is a cons cell, or else  nil.")
        !           332:   (object)
        !           333:      Lisp_Object object;
        !           334: {
        !           335:   if (XTYPE (object) == Lisp_Cons)
        !           336:     return XCONS (object)->cdr;
        !           337:   else
        !           338:     return Qnil;
        !           339: }
        !           340: 
        !           341: DEFUN ("setcar", Fsetcar, Ssetcar, 2, 2, 0,
        !           342:   "Set the car of CONSCELL to be NEWCAR.  Returns NEWCAR.")
        !           343:   (cell, newcar)
        !           344:      register Lisp_Object cell, newcar;
        !           345: {
        !           346:   if (XTYPE (cell) != Lisp_Cons)
        !           347:     cell = wrong_type_argument (Qconsp, cell);
        !           348: 
        !           349:   CHECK_IMPURE (cell);
        !           350:   XCONS (cell)->car = newcar;
        !           351:   return newcar;
        !           352: }
        !           353: 
        !           354: DEFUN ("setcdr", Fsetcdr, Ssetcdr, 2, 2, 0,
        !           355:   "Set the cdr of CONSCELL to be NEWCDR.  Returns NEWCDR.")
        !           356:   (cell, newcdr)
        !           357:      register Lisp_Object cell, newcdr;
        !           358: {
        !           359:   if (XTYPE (cell) != Lisp_Cons)
        !           360:     cell = wrong_type_argument (Qconsp, cell);
        !           361: 
        !           362:   CHECK_IMPURE (cell);
        !           363:   XCONS (cell)->cdr = newcdr;
        !           364:   return newcdr;
        !           365: }
        !           366: 
        !           367: /* Extract and set components of symbols */
        !           368: 
        !           369: DEFUN ("boundp", Fboundp, Sboundp, 1, 1, 0, "T if SYMBOL's value is not void.")
        !           370:   (sym)
        !           371:      register Lisp_Object sym;
        !           372: {
        !           373:   CHECK_SYMBOL (sym, 0);
        !           374:   return (XTYPE (XSYMBOL (sym)->value) == Lisp_Void
        !           375:          || EQ (XSYMBOL (sym)->value, Qunbound))
        !           376:         ? Qnil : Qt;
        !           377: }
        !           378: 
        !           379: DEFUN ("fboundp", Ffboundp, Sfboundp, 1, 1, 0, "T if SYMBOL's function definition is not void.")
        !           380:   (sym)
        !           381:      register Lisp_Object sym;
        !           382: {
        !           383:   CHECK_SYMBOL (sym, 0);
        !           384:   return (XTYPE (XSYMBOL (sym)->function) == Lisp_Void
        !           385:          || EQ (XSYMBOL (sym)->function, Qunbound))
        !           386:         ? Qnil : Qt;
        !           387: }
        !           388: 
        !           389: DEFUN ("makunbound", Fmakunbound, Smakunbound, 1, 1, 0, "Make SYMBOL's value be void.")
        !           390:   (sym)
        !           391:      register Lisp_Object sym;
        !           392: {
        !           393:   CHECK_SYMBOL (sym, 0);
        !           394:   XSYMBOL (sym)->value = Qunbound;
        !           395:   return sym;
        !           396: }
        !           397: 
        !           398: DEFUN ("fmakunbound", Ffmakunbound, Sfmakunbound, 1, 1, 0, "Make SYMBOL's function definition be void.")
        !           399:   (sym)
        !           400:      register Lisp_Object sym;
        !           401: {
        !           402:   CHECK_SYMBOL (sym, 0);
        !           403:   XSYMBOL (sym)->function = Qunbound;
        !           404:   return sym;
        !           405: }
        !           406: 
        !           407: DEFUN ("symbol-function", Fsymbol_function, Ssymbol_function, 1, 1, 0,
        !           408:   "Return SYMBOL's function definition.")
        !           409:   (sym)
        !           410:      register Lisp_Object sym;
        !           411: {
        !           412:   CHECK_SYMBOL (sym, 0);
        !           413:   if (EQ (XSYMBOL (sym)->function, Qunbound))
        !           414:     return Fsignal (Qvoid_function, Fcons (sym, Qnil));
        !           415:   return XSYMBOL (sym)->function;
        !           416: }
        !           417: 
        !           418: DEFUN ("symbol-plist", Fsymbol_plist, Ssymbol_plist, 1, 1, 0, "Return SYMBOL's property list.")
        !           419:   (sym)
        !           420:      register Lisp_Object sym;
        !           421: {
        !           422:   CHECK_SYMBOL (sym, 0);
        !           423:   return XSYMBOL (sym)->plist;
        !           424: }
        !           425: 
        !           426: DEFUN ("symbol-name", Fsymbol_name, Ssymbol_name, 1, 1, 0, "Return SYMBOL's name, a string.")
        !           427:   (sym)
        !           428:      register Lisp_Object sym;
        !           429: {
        !           430:   register Lisp_Object name;
        !           431: 
        !           432:   CHECK_SYMBOL (sym, 0);
        !           433:   XSET (name, Lisp_String, XSYMBOL (sym)->name);
        !           434:   return name;
        !           435: }
        !           436: 
        !           437: DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
        !           438:   "Set SYMBOL's function definition to NEWVAL, and return NEWVAL.")
        !           439:   (sym, newdef)
        !           440:      register Lisp_Object sym, newdef;
        !           441: {
        !           442:   CHECK_SYMBOL (sym, 0);
        !           443:   if (!NULL (Vautoload_queue) && !EQ (XSYMBOL (sym)->function, Qunbound))
        !           444:     Vautoload_queue = Fcons (Fcons (sym, XSYMBOL (sym)->function),
        !           445:                             Vautoload_queue);
        !           446:   XSYMBOL (sym)->function = newdef;
        !           447:   return newdef;
        !           448: }
        !           449: 
        !           450: DEFUN ("setplist", Fsetplist, Ssetplist, 2, 2, 0,
        !           451:   "Set SYMBOL's property list to NEWVAL, and return NEWVAL.")
        !           452:   (sym, newplist)
        !           453:      register Lisp_Object sym, newplist;
        !           454: {
        !           455:   CHECK_SYMBOL (sym, 0);
        !           456:   XSYMBOL (sym)->plist = newplist;
        !           457:   return newplist;
        !           458: }
        !           459: 
        !           460: /* Getting and setting values of symbols */
        !           461: 
        !           462: /* Given the raw contents of a symbol value cell,
        !           463:  return the Lisp value of the symbol. */
        !           464: 
        !           465: Lisp_Object
        !           466: do_symval_forwarding (valcontents)
        !           467:      register Lisp_Object valcontents;
        !           468: {
        !           469:   register Lisp_Object val;
        !           470: #ifdef SWITCH_ENUM_BUG
        !           471:   switch ((int) XTYPE (valcontents))
        !           472: #else
        !           473:   switch (XTYPE (valcontents))
        !           474: #endif
        !           475:     {
        !           476:     case Lisp_Intfwd:
        !           477:       XSET (val, Lisp_Int, *XINTPTR (valcontents));
        !           478:       return val;
        !           479: 
        !           480:     case Lisp_Boolfwd:
        !           481:       if (*XINTPTR (valcontents))
        !           482:        return Qt;
        !           483:       return Qnil;
        !           484: 
        !           485:     case Lisp_Objfwd:
        !           486:       return *XOBJFWD (valcontents);
        !           487: 
        !           488:     case Lisp_Buffer_Objfwd:
        !           489:       return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer);
        !           490:     }
        !           491:   return valcontents;
        !           492: }
        !           493: 
        !           494: void
        !           495: store_symval_forwarding (sym, valcontents, newval)
        !           496:      Lisp_Object sym;
        !           497:      register Lisp_Object valcontents, newval;
        !           498: {
        !           499: #ifdef SWITCH_ENUM_BUG
        !           500:   switch ((int) XTYPE (valcontents))
        !           501: #else
        !           502:   switch (XTYPE (valcontents))
        !           503: #endif
        !           504:     {
        !           505:     case Lisp_Intfwd:
        !           506:       CHECK_NUMBER (newval, 1);
        !           507:       *XINTPTR (valcontents) = XINT (newval);
        !           508:       break;
        !           509: 
        !           510:     case Lisp_Boolfwd:
        !           511:       *XINTPTR (valcontents) = NULL(newval) ? 0 : 1;
        !           512:       break;
        !           513: 
        !           514:     case Lisp_Objfwd:
        !           515:       *XOBJFWD (valcontents) = newval;
        !           516:       break;
        !           517: 
        !           518:     case Lisp_Buffer_Objfwd:
        !           519:       *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer) = newval;
        !           520:       break;
        !           521: 
        !           522:     default:
        !           523:       valcontents = XSYMBOL (sym)->value;
        !           524:       if (XTYPE (valcontents) == Lisp_Buffer_Local_Value ||
        !           525:          XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
        !           526:        XCONS (XSYMBOL (sym)->value)->car = newval;
        !           527:       else
        !           528:        XSYMBOL (sym)->value = newval;
        !           529:     }
        !           530: }
        !           531: 
        !           532: /* Note that it must not be possible to quit within this function.
        !           533:    Great care is required for this.  */
        !           534: 
        !           535: DEFUN ("symbol-value", Fsymbol_value, Ssymbol_value, 1, 1, 0, "Return SYMBOL's value.")
        !           536:   (sym)
        !           537:      Lisp_Object sym;
        !           538: {
        !           539:   register Lisp_Object valcontents, tem1;
        !           540:   register Lisp_Object val;
        !           541:   CHECK_SYMBOL (sym, 0);
        !           542:   valcontents = XSYMBOL (sym)->value;
        !           543: 
        !           544:  retry:
        !           545: #ifdef SWITCH_ENUM_BUG
        !           546:   switch ((int) XTYPE (valcontents))
        !           547: #else
        !           548:   switch (XTYPE (valcontents))
        !           549: #endif
        !           550:     {
        !           551:     case Lisp_Buffer_Local_Value:
        !           552:     case Lisp_Some_Buffer_Local_Value:
        !           553:       /* valcontents is a list
        !           554:         (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
        !           555: 
        !           556:         CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
        !           557:        local_var_alist, that being the element whose car is this variable.
        !           558:         Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER
        !           559:        does not have an element in its alist for this variable.
        !           560: 
        !           561:        If the current buffer is not BUFFER, we store the current REALVALUE value into
        !           562:        CURRENT-ALIST-ELEMENT, then find the appropriate alist element for
        !           563:        the buffer now current and set up CURRENT-ALIST-ELEMENT.
        !           564:        Then we set REALVALUE out of that element, and store into BUFFER.
        !           565:        Note that REALVALUE can be a forwarding pointer. */
        !           566: 
        !           567:       tem1 = XCONS (XCONS (valcontents)->cdr)->car;
        !           568:       if (NULL (tem1) || current_buffer != XBUFFER (tem1))
        !           569:        {
        !           570:          tem1 = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
        !           571:           Fsetcdr (tem1, do_symval_forwarding (XCONS (valcontents)->car));
        !           572:          tem1 = assq_no_quit (sym, current_buffer->local_var_alist);
        !           573:          if (NULL (tem1))
        !           574:            tem1 = XCONS (XCONS (valcontents)->cdr)->cdr;
        !           575:          XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car = tem1;
        !           576:          XSET (XCONS (XCONS (valcontents)->cdr)->car, Lisp_Buffer, current_buffer);
        !           577:          store_symval_forwarding (sym, XCONS (valcontents)->car, Fcdr (tem1));
        !           578:        }
        !           579:       valcontents = XCONS (valcontents)->car;
        !           580:       goto retry;
        !           581: 
        !           582:     case Lisp_Intfwd:
        !           583:       XSET (val, Lisp_Int, *XINTPTR (valcontents));
        !           584:       return val;
        !           585: 
        !           586:     case Lisp_Boolfwd:
        !           587:       if (*XINTPTR (valcontents))
        !           588:        return Qt;
        !           589:       return Qnil;
        !           590: 
        !           591:     case Lisp_Objfwd:
        !           592:       return *XOBJFWD (valcontents);
        !           593: 
        !           594:     case Lisp_Buffer_Objfwd:
        !           595:       return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer);
        !           596: 
        !           597:     case Lisp_Symbol:
        !           598:       /* For a symbol, check whether it is 'unbound. */
        !           599:       if (!EQ (valcontents, Qunbound))
        !           600:        break;
        !           601:       /* drops through! */
        !           602:     case Lisp_Void:
        !           603:       return Fsignal (Qvoid_variable, Fcons (sym, Qnil));
        !           604:     }
        !           605:   return valcontents;
        !           606: }
        !           607: 
        !           608: DEFUN ("default-value", Fdefault_value, Sdefault_value, 1, 1, 0,
        !           609:   "Return SYMBOL's default value.\n\
        !           610: This is the value that is seen in buffers that do not have their own values\n\
        !           611: for this variable.")
        !           612:   (sym)
        !           613:      Lisp_Object sym;
        !           614: {
        !           615:   register Lisp_Object valcontents;
        !           616: 
        !           617:   CHECK_SYMBOL (sym, 0);
        !           618:   valcontents = XSYMBOL (sym)->value;
        !           619:   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
        !           620:     {
        !           621:       register int idx = XUINT (valcontents);
        !           622: 
        !           623:       if (*(int *) (idx + (char *) &buffer_local_flags) != 0)
        !           624:        return *(Lisp_Object *)(idx + (char *) &buffer_defaults);
        !           625:     }
        !           626: 
        !           627:   if (XTYPE (valcontents) == Lisp_Buffer_Local_Value ||
        !           628:       XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
        !           629:     return XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->cdr;
        !           630:   return Fsymbol_value (sym);
        !           631: }
        !           632: 
        !           633: DEFUN ("set", Fset, Sset, 2, 2, 0,
        !           634:   "Set SYMBOL's value to NEWVAL, and return NEWVAL.")
        !           635:   (sym, newval)
        !           636:      register Lisp_Object sym, newval;
        !           637: {
        !           638: #ifndef RTPC_REGISTER_BUG
        !           639:   register Lisp_Object valcontents, tem1, current_alist_element;
        !           640: #else /* RTPC_REGISTER_BUG */
        !           641:   register Lisp_Object tem1;
        !           642:   Lisp_Object valcontents, current_alist_element;
        !           643: #endif /* RTPC_REGISTER_BUG */
        !           644: 
        !           645:   CHECK_SYMBOL (sym, 0);
        !           646:   if (NULL (sym) || EQ (sym, Qt))
        !           647:     return Fsignal (Qsetting_constant, Fcons (sym, Qnil));
        !           648:   valcontents = XSYMBOL (sym)->value;
        !           649: 
        !           650:   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
        !           651:     {
        !           652:       register int idx = XUINT (valcontents);
        !           653:       register int mask = *(int *)(idx + (char *) &buffer_local_flags);
        !           654:       if (mask > 0)
        !           655:        current_buffer->local_var_flags |= mask;
        !           656:     }
        !           657: 
        !           658:   if (XTYPE (valcontents) == Lisp_Buffer_Local_Value
        !           659:       || XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
        !           660:     {
        !           661:       /* valcontents is a list
        !           662:         (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
        !           663: 
        !           664:         CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
        !           665:        local_var_alist, that being the element whose car is this variable.
        !           666:         Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE),
        !           667:        if BUFFER does not have an element in its alist for this variable.
        !           668: 
        !           669:        If the current buffer is not BUFFER, we store the current REALVALUE value into
        !           670:        CURRENT-ALIST-ELEMENT, then find the appropriate alist element for
        !           671:        the buffer now current and set up CURRENT-ALIST-ELEMENT.
        !           672:        Then we set REALVALUE out of that element, and store into BUFFER.
        !           673:        Note that REALVALUE can be a forwarding pointer. */
        !           674: 
        !           675:       current_alist_element = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
        !           676:       if (current_buffer
        !           677:          != ((XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
        !           678:              /* If the current buffer is already cached,
        !           679:                 we don't need to change that fact.  */
        !           680:              ? XBUFFER (XCONS (XCONS (valcontents)->cdr)->car)
        !           681:              /* If setting the variable should make it local,
        !           682:                 it's not enough if the current buffer is already cached.
        !           683:                 We need to make sure it has a local value for the var.  */
        !           684:              : XBUFFER (XCONS (current_alist_element)->car)))
        !           685:        {
        !           686:          /* "Swap out" the buffer that was previously cached.  */
        !           687:           Fsetcdr (current_alist_element,
        !           688:                   do_symval_forwarding (XCONS (valcontents)->car));
        !           689: 
        !           690:          /* Encache the current buffer.  */
        !           691:          tem1 = Fassq (sym, current_buffer->local_var_alist);
        !           692:          if (NULL (tem1))
        !           693:            {
        !           694:              /* This buffer sees the default value still.
        !           695:                 If type is Lisp_Some_Buffer_Local_Value, set the default value.
        !           696:                 If type is Lisp_Buffer_Local_Value, give this buffer a local value
        !           697:                 and set that.  */
        !           698:              if (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
        !           699:                tem1 = XCONS (XCONS (valcontents)->cdr)->cdr;
        !           700:              else
        !           701:                {
        !           702:                  tem1 = Fcons (sym, Fcdr (current_alist_element));
        !           703:                  current_buffer->local_var_alist = Fcons (tem1, current_buffer->local_var_alist);
        !           704:                }
        !           705:            }
        !           706:          /* Set the CURRENT-ALIST-ELEMENT slot to fit this buffer.  */
        !           707:          current_alist_element = tem1;
        !           708:          XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car = tem1;
        !           709:          /* Record this buffer in the BUFFER slot.  */
        !           710:          XSET (XCONS (XCONS (valcontents)->cdr)->car,
        !           711:                Lisp_Buffer, current_buffer);
        !           712:          /* Now the CURRENT-ALIST-ELEMENT slot in VALCONTENTS
        !           713:             is correct for the current buffer.  */
        !           714:        }
        !           715:       /* If the current buffer sees the default value,
        !           716:         set the default value in the CURRENT-ALIST-ELEMENT right now.
        !           717:         Don't wait till some other buffer gets cached.  */
        !           718:       if (XCONS (XCONS (valcontents)->cdr)->cdr == current_alist_element)
        !           719:        XCONS (current_alist_element)->cdr = newval;
        !           720:       valcontents = XCONS (valcontents)->car;
        !           721:     }
        !           722:   store_symval_forwarding (sym, valcontents, newval);
        !           723:   return newval;
        !           724: }
        !           725: 
        !           726: DEFUN ("set-default", Fset_default, Sset_default, 2, 2, 0,
        !           727:   "Set SYMBOL's default value to VAL.  SYMBOL and VAL are evaluated.\n\
        !           728: The default value is seen in buffers that do not have their own values\n\
        !           729: for this variable.")
        !           730:   (sym, value)
        !           731:      Lisp_Object sym, value;
        !           732: {
        !           733:   register Lisp_Object valcontents, current_alist_element, alist_element_buffer;
        !           734: 
        !           735:   CHECK_SYMBOL (sym, 0);
        !           736:   valcontents = XSYMBOL (sym)->value;
        !           737: 
        !           738:   /* Handle variables like case-fold-search that have special slots
        !           739:      in the buffer.  Make them work apparently like Lisp_Buffer_Local_Value
        !           740:      variables.  */
        !           741:   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
        !           742:     {
        !           743:       register int idx = XUINT (valcontents);
        !           744: #ifndef RTPC_REGISTER_BUG
        !           745:       register struct buffer *b;
        !           746: #else
        !           747:       struct buffer *b;
        !           748: #endif
        !           749:       register int mask = *(int *) (idx + (char *) &buffer_local_flags);
        !           750: 
        !           751:       if (mask < 0)
        !           752:        /* -1 means the variable is always local in every buffer.
        !           753:           Set the default value, but not any of the local values.  */
        !           754:        *(Lisp_Object *)(idx + (char *) &buffer_defaults) = value;
        !           755: 
        !           756:       if (mask > 0)
        !           757:        {
        !           758:          /* Positive means a value that is local in some buffers.
        !           759:             Set the default value, and also the corresponding slot
        !           760:             in buffers where the variable is not local.  */
        !           761:          *(Lisp_Object *)(idx + (char *) &buffer_defaults) = value;
        !           762:          for (b = all_buffers; b; b = b->next)
        !           763:            if (!(b->local_var_flags & mask))
        !           764:              *(Lisp_Object *)(idx + (char *) b) = value;
        !           765:        }
        !           766:       return value;
        !           767:     }
        !           768: 
        !           769:   if (XTYPE (valcontents) != Lisp_Buffer_Local_Value &&
        !           770:       XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
        !           771:     return Fset (sym, value);
        !           772: 
        !           773:   /* Store new value into the DEFAULT-VALUE slot */
        !           774:   XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->cdr = value;
        !           775: 
        !           776:   /* If that slot is current, we must set the REALVALUE slot too */
        !           777:   current_alist_element = XCONS (XCONS (XCONS (valcontents)->cdr)->cdr)->car;
        !           778:   alist_element_buffer = Fcar (current_alist_element);
        !           779:   if (EQ (alist_element_buffer, current_alist_element))
        !           780:     store_symval_forwarding (sym, XCONS (valcontents)->car, value);
        !           781: 
        !           782:   return value;
        !           783: }
        !           784: 
        !           785: DEFUN ("setq-default", Fsetq_default, Ssetq_default, 2, UNEVALLED, 0,
        !           786:   "Set SYMBOL's default value to VAL.  VAL is evaluated; SYMBOL is not.\n\
        !           787: The default value is seen in buffers that do not have their own values\n\
        !           788: for this variable.")
        !           789:   (args)
        !           790:      Lisp_Object args;
        !           791: {
        !           792:   register Lisp_Object val;
        !           793:   struct gcpro gcpro1;
        !           794: 
        !           795:   GCPRO1 (args);
        !           796:   val = Feval (Fcar (Fcdr (args)));
        !           797:   UNGCPRO;
        !           798:   return Fset_default (Fcar (args), val);
        !           799: }
        !           800: 
        !           801: DEFUN ("make-variable-buffer-local", Fmake_variable_buffer_local, Smake_variable_buffer_local,
        !           802:   1, 1, "vMake Variable Buffer Local: ",
        !           803:   "Make VARIABLE have a separate value for each buffer.\n\
        !           804: At any time, the value for the current buffer is in effect.\n\
        !           805: There is also a default value which is seen in any buffer which has not yet\n\
        !           806: set its own value.\n\
        !           807: The function `default-value' gets the default value and `set-default' sets it.\n\
        !           808: Using `set' or `setq' to set the variable causes it to have a separate value\n\
        !           809: for the current buffer if it was previously using the default value.")
        !           810:   (sym)
        !           811:      register Lisp_Object sym;
        !           812: {
        !           813:   register Lisp_Object tem, valcontents;
        !           814: 
        !           815:   CHECK_SYMBOL (sym, 0);
        !           816: 
        !           817:   if (EQ (sym, Qnil) || EQ (sym, Qt))
        !           818:     error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
        !           819: 
        !           820:   valcontents = XSYMBOL (sym)->value;
        !           821:   if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value) ||
        !           822:       (XTYPE (valcontents) == Lisp_Buffer_Objfwd))
        !           823:     return sym;
        !           824:   if (XTYPE (valcontents) == Lisp_Some_Buffer_Local_Value)
        !           825:     {
        !           826:       XSETTYPE (XSYMBOL (sym)->value, Lisp_Buffer_Local_Value);
        !           827:       return sym;
        !           828:     }
        !           829:   if (EQ (valcontents, Qunbound))
        !           830:     XSYMBOL (sym)->value = Qnil;
        !           831:   tem = Fcons (Qnil, Fsymbol_value (sym));
        !           832:   XCONS (tem)->car = tem;
        !           833:   XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Fcurrent_buffer (), tem));
        !           834:   XSETTYPE (XSYMBOL (sym)->value, Lisp_Buffer_Local_Value);
        !           835:   return sym;
        !           836: }
        !           837: 
        !           838: DEFUN ("make-local-variable", Fmake_local_variable, Smake_local_variable,
        !           839:   1, 1, "vMake Local Variable: ",
        !           840:   "Make VARIABLE have a separate value in the current buffer.\n\
        !           841: Other buffers will continue to share a common default value.\n\
        !           842: See also `make-variable-buffer-local'.")
        !           843:   (sym)
        !           844:      register Lisp_Object sym;
        !           845: {
        !           846:   register Lisp_Object tem, valcontents;
        !           847: 
        !           848:   CHECK_SYMBOL (sym, 0);
        !           849: 
        !           850:   if (EQ (sym, Qnil) || EQ (sym, Qt))
        !           851:     error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
        !           852: 
        !           853:   valcontents = XSYMBOL (sym)->value;
        !           854:   if ((XTYPE (valcontents) == Lisp_Buffer_Local_Value) ||
        !           855:       (XTYPE (valcontents) == Lisp_Buffer_Objfwd))
        !           856:     return sym;
        !           857:   /* Make sure sym is set up to hold per-buffer values */
        !           858:   if (XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
        !           859:     {
        !           860:       if (EQ (valcontents, Qunbound))
        !           861:        XSYMBOL (sym)->value = Qnil;
        !           862:       tem = Fcons (Qnil, Fsymbol_value (sym));
        !           863:       XCONS (tem)->car = tem;
        !           864:       XSYMBOL (sym)->value = Fcons (XSYMBOL (sym)->value, Fcons (Qnil, tem));
        !           865:       XSETTYPE (XSYMBOL (sym)->value, Lisp_Some_Buffer_Local_Value);
        !           866:     }
        !           867:   /* Make sure this buffer has its own value of sym */
        !           868:   tem = Fassq (sym, current_buffer->local_var_alist);
        !           869:   if (NULL (tem))
        !           870:     {
        !           871:       current_buffer->local_var_alist
        !           872:         = Fcons (Fcons (sym, XCONS (XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->cdr)->cdr),
        !           873:                 current_buffer->local_var_alist);
        !           874: 
        !           875:       /* Make sure symbol does not think it is set up for this buffer;
        !           876:         force it to look once again for this buffer's value */
        !           877:       {
        !           878:        /* This local variable avoids "expression to complex" on IBM RT.  */
        !           879:        Lisp_Object xs;
        !           880:     
        !           881:        xs = XSYMBOL (sym)->value;
        !           882:        if (current_buffer == XBUFFER (XCONS (XCONS (xs)->cdr)->car))
        !           883:          XCONS (XCONS (XSYMBOL (sym)->value)->cdr)->car = Qnil; 
        !           884:       }
        !           885:     }
        !           886:   return sym;
        !           887: }
        !           888: 
        !           889: DEFUN ("kill-local-variable", Fkill_local_variable, Skill_local_variable,
        !           890:   1, 1, "vKill Local Variable: ",
        !           891:   "Make VARIABLE no longer have a separate value in the current buffer.\n\
        !           892: From now on the default value will apply in this buffer.")
        !           893:   (sym)
        !           894:      register Lisp_Object sym;
        !           895: {
        !           896:   register Lisp_Object tem, valcontents;
        !           897: 
        !           898:   CHECK_SYMBOL (sym, 0);
        !           899: 
        !           900:   valcontents = XSYMBOL (sym)->value;
        !           901: 
        !           902:   if (XTYPE (valcontents) == Lisp_Buffer_Objfwd)
        !           903:     {
        !           904:       register int idx = XUINT (valcontents);
        !           905:       register int mask = *(int *) (idx + (char *) &buffer_local_flags);
        !           906: 
        !           907:       if (mask > 0)
        !           908:        {
        !           909:          *(Lisp_Object *)(idx + (char *) current_buffer)
        !           910:            = *(Lisp_Object *)(idx + (char *) &buffer_defaults);
        !           911:          current_buffer->local_var_flags &= ~mask;
        !           912:        }
        !           913:       return sym;
        !           914:     }
        !           915: 
        !           916:   if (XTYPE (valcontents) != Lisp_Buffer_Local_Value &&
        !           917:       XTYPE (valcontents) != Lisp_Some_Buffer_Local_Value)
        !           918:     return sym;
        !           919: 
        !           920:   /* Get rid of this buffer's alist element, if any */
        !           921: 
        !           922:   tem = Fassq (sym, current_buffer->local_var_alist);
        !           923:   if (!NULL (tem))
        !           924:     current_buffer->local_var_alist = Fdelq (tem, current_buffer->local_var_alist);
        !           925: 
        !           926:   /* Make sure symbol does not think it is set up for this buffer;
        !           927:      force it to look once again for this buffer's value */
        !           928:   {
        !           929:     Lisp_Object sv;
        !           930:     sv = XSYMBOL (sym)->value;
        !           931:     if (current_buffer == XBUFFER (XCONS (XCONS (sv)->cdr)->car))
        !           932:       XCONS (XCONS (sv)->cdr)->car = Qnil;
        !           933:   }
        !           934: 
        !           935:   return sym;
        !           936: }
        !           937: 
        !           938: /* Extract and set vector and string elements */
        !           939: 
        !           940: DEFUN ("aref", Faref, Saref, 2, 2, 0,
        !           941:   "Return the element of ARRAY at index INDEX.\n\
        !           942: ARRAY may be a vector or a string.  INDEX starts at 0.")
        !           943:   (vector, idx)
        !           944:      register Lisp_Object vector;
        !           945:      Lisp_Object idx;
        !           946: {
        !           947:   register int idxval;
        !           948: 
        !           949:   CHECK_NUMBER (idx, 1);
        !           950:   idxval = XINT (idx);
        !           951:   if (XTYPE (vector) != Lisp_Vector && XTYPE (vector) != Lisp_String)
        !           952:     vector = wrong_type_argument (Qarrayp, vector);
        !           953:   if (idxval < 0 || idxval >= XVECTOR (vector)->size)
        !           954:     args_out_of_range (vector, idx);
        !           955:   if (XTYPE (vector) == Lisp_Vector)
        !           956:     return XVECTOR (vector)->contents[idxval];
        !           957:   else
        !           958:     {
        !           959:       Lisp_Object val;
        !           960:       XFASTINT (val) = (unsigned char) XSTRING (vector)->data[idxval];
        !           961:       return val;
        !           962:     }
        !           963: }
        !           964: 
        !           965: DEFUN ("aset", Faset, Saset, 3, 3, 0,
        !           966:   "Store into the element of ARRAY at index INDEX the value NEWVAL.\n\
        !           967: ARRAY may be a vector or a string.  INDEX starts at 0.")
        !           968:   (vector, idx, newelt)
        !           969:      register Lisp_Object vector;
        !           970:      Lisp_Object idx, newelt;
        !           971: {
        !           972:   register int idxval;
        !           973: 
        !           974:   CHECK_NUMBER (idx, 1);
        !           975:   idxval = XINT (idx);
        !           976:   if (XTYPE (vector) != Lisp_Vector && XTYPE (vector) != Lisp_String)
        !           977:     vector = wrong_type_argument (Qarrayp, vector);
        !           978:   if (idxval < 0 || idxval >= XVECTOR (vector)->size)
        !           979:     args_out_of_range (vector, idx);
        !           980:   CHECK_IMPURE (vector);
        !           981: 
        !           982:   if (XTYPE (vector) == Lisp_Vector)
        !           983:     XVECTOR (vector)->contents[idxval] = newelt;
        !           984:   else
        !           985:     XSTRING (vector)->data[idxval] = XINT (newelt);
        !           986: 
        !           987:   return newelt;
        !           988: }
        !           989: 
        !           990: Lisp_Object
        !           991: Farray_length (vector)
        !           992:      register Lisp_Object vector;
        !           993: {
        !           994:   register Lisp_Object size;
        !           995:   if (XTYPE (vector) != Lisp_Vector && XTYPE (vector) != Lisp_String)
        !           996:     vector = wrong_type_argument (Qarrayp, vector);
        !           997:   XFASTINT (size) = XVECTOR (vector)->size;
        !           998:   return size;
        !           999: }
        !          1000: 
        !          1001: /* Arithmetic functions */
        !          1002: 
        !          1003: DEFUN ("=", Feqlsign, Seqlsign, 2, 2, 0,
        !          1004:   "T if two args, both numbers, are equal.")
        !          1005:   (num1, num2)
        !          1006:      register Lisp_Object num1, num2;
        !          1007: {
        !          1008:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
        !          1009:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
        !          1010: 
        !          1011:   if (XINT (num1) == XINT (num2))
        !          1012:     return Qt;
        !          1013:   return Qnil;
        !          1014: }
        !          1015: 
        !          1016: DEFUN ("<", Flss, Slss, 2, 2, 0,
        !          1017:   "T if first arg is less than second arg.  Both must be numbers.")
        !          1018:   (num1, num2)
        !          1019:      register Lisp_Object num1, num2;
        !          1020: {
        !          1021:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
        !          1022:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
        !          1023: 
        !          1024:   if (XINT (num1) < XINT (num2))
        !          1025:     return Qt;
        !          1026:   return Qnil;
        !          1027: }
        !          1028: 
        !          1029: DEFUN (">", Fgtr, Sgtr, 2, 2, 0,
        !          1030:   "T if first arg is greater than second arg.  Both must be numbers.")
        !          1031:   (num1, num2)
        !          1032:      register Lisp_Object num1, num2;
        !          1033: {
        !          1034:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
        !          1035:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
        !          1036: 
        !          1037:   if (XINT (num1) > XINT (num2))
        !          1038:     return Qt;
        !          1039:   return Qnil;
        !          1040: }
        !          1041: 
        !          1042: DEFUN ("<=", Fleq, Sleq, 2, 2, 0,
        !          1043:   "T if first arg is less than or equal to second arg.  Both must be numbers.")
        !          1044:   (num1, num2)
        !          1045:      register Lisp_Object num1, num2;
        !          1046: {
        !          1047:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
        !          1048:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
        !          1049: 
        !          1050:   if (XINT (num1) <= XINT (num2))
        !          1051:     return Qt;
        !          1052:   return Qnil;
        !          1053: }
        !          1054: 
        !          1055: DEFUN (">=", Fgeq, Sgeq, 2, 2, 0,
        !          1056:   "T if first arg is greater than or equal to second arg.  Both must be numbers.")
        !          1057:   (num1, num2)
        !          1058:      register Lisp_Object num1, num2;
        !          1059: {
        !          1060:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
        !          1061:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
        !          1062: 
        !          1063:   if (XINT (num1) >= XINT (num2))
        !          1064:     return Qt;
        !          1065:   return Qnil;
        !          1066: }
        !          1067: 
        !          1068: DEFUN ("/=", Fneq, Sneq, 2, 2, 0,
        !          1069:   "T if first arg is not equal to second arg.  Both must be numbers.")
        !          1070:   (num1, num2)
        !          1071:      register Lisp_Object num1, num2;
        !          1072: {
        !          1073:   CHECK_NUMBER_COERCE_MARKER (num1, 0);
        !          1074:   CHECK_NUMBER_COERCE_MARKER (num2, 0);
        !          1075: 
        !          1076:   if (XINT (num1) != XINT (num2))
        !          1077:     return Qt;
        !          1078:   return Qnil;
        !          1079: }
        !          1080: 
        !          1081: DEFUN ("zerop", Fzerop, Szerop, 1, 1, 0, "T if NUMBER is zero.")
        !          1082:   (num)
        !          1083:      register Lisp_Object num;
        !          1084: {
        !          1085:   CHECK_NUMBER (num, 0);
        !          1086: 
        !          1087:   if (!XINT (num))
        !          1088:     return Qt;
        !          1089:   return Qnil;
        !          1090: }
        !          1091: 
        !          1092: DEFUN ("int-to-string", Fint_to_string, Sint_to_string, 1, 1, 0,
        !          1093:   "Convert INT to a string by printing it in decimal, with minus sign if negative.")
        !          1094:   (num)
        !          1095:      Lisp_Object num;
        !          1096: {
        !          1097:   char buffer[20];
        !          1098: 
        !          1099:   CHECK_NUMBER (num, 0);
        !          1100:   sprintf (buffer, "%d", XINT (num));
        !          1101:   return build_string (buffer);
        !          1102: }
        !          1103: 
        !          1104: DEFUN ("string-to-int", Fstring_to_int, Sstring_to_int, 1, 1, 0,
        !          1105:   "Convert STRING to an integer by parsing it as a decimal number.")
        !          1106:   (str)
        !          1107:      register Lisp_Object str;
        !          1108: {
        !          1109:   CHECK_STRING (str, 0);
        !          1110:   return make_number (atoi (XSTRING (str)->data));
        !          1111: }
        !          1112:   
        !          1113: enum arithop
        !          1114:   { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };
        !          1115: 
        !          1116: Lisp_Object
        !          1117: arith_driver
        !          1118:   (code, nargs, args)
        !          1119:      enum arithop code;
        !          1120:      int nargs;
        !          1121:      register Lisp_Object *args;
        !          1122: {
        !          1123:   register Lisp_Object val;
        !          1124:   register int argnum;
        !          1125:   register int accum;
        !          1126:   register int next;
        !          1127: 
        !          1128: #ifdef SWITCH_ENUM_BUG
        !          1129:   switch ((int) code)
        !          1130: #else
        !          1131:   switch (code)
        !          1132: #endif
        !          1133:     {
        !          1134:     case Alogior:
        !          1135:     case Alogxor:
        !          1136:     case Aadd:
        !          1137:     case Asub:
        !          1138:       accum = 0; break;
        !          1139:     case Amult:
        !          1140:       accum = 1; break;
        !          1141:     case Alogand:
        !          1142:       accum = -1; break;
        !          1143:     }
        !          1144: 
        !          1145:   for (argnum = 0; argnum < nargs; argnum++)
        !          1146:     {
        !          1147:       val = args[argnum];    /* using args[argnum] as argument to CHECK_NUMBER_... */
        !          1148:       CHECK_NUMBER_COERCE_MARKER (val, argnum);
        !          1149:       args[argnum] = val;    /* runs into a compiler bug. */
        !          1150:       next = XINT (args[argnum]);
        !          1151: #ifdef SWITCH_ENUM_BUG
        !          1152:       switch ((int) code)
        !          1153: #else
        !          1154:       switch (code)
        !          1155: #endif
        !          1156:        {
        !          1157:        case Aadd: accum += next; break;
        !          1158:        case Asub:
        !          1159:          if (!argnum && nargs != 1)
        !          1160:            next = - next;
        !          1161:          accum -= next;
        !          1162:          break;
        !          1163:        case Amult: accum *= next; break;
        !          1164:        case Adiv:
        !          1165:          if (!argnum) accum = next;
        !          1166:          else
        !          1167:            {
        !          1168:              /* Some systems fail to trap this right.  */
        !          1169:              if (!XINT (next))
        !          1170:                while (1)
        !          1171:                  Fsignal (Qarith_error, Qnil);
        !          1172: 
        !          1173:              accum /= next;
        !          1174:            }
        !          1175:          break;
        !          1176:        case Alogand: accum &= next; break;
        !          1177:        case Alogior: accum |= next; break;
        !          1178:        case Alogxor: accum ^= next; break;
        !          1179:        case Amax: if (!argnum || next > accum) accum = next; break;
        !          1180:        case Amin: if (!argnum || next < accum) accum = next; break;
        !          1181:        }
        !          1182:     }
        !          1183: 
        !          1184:   XSET (val, Lisp_Int, accum);
        !          1185:   return val;
        !          1186: }
        !          1187: 
        !          1188: DEFUN ("+", Fplus, Splus, 0, MANY, 0,
        !          1189:   "Return sum of any number of numbers.")
        !          1190:   (nargs, args)
        !          1191:      int nargs;
        !          1192:      Lisp_Object *args;
        !          1193: {
        !          1194:   return arith_driver (Aadd, nargs, args);
        !          1195: }
        !          1196: 
        !          1197: DEFUN ("-", Fminus, Sminus, 0, MANY, 0,
        !          1198:   "Negate number or subtract numbers.\n\
        !          1199: With one arg, negates it.  With more than one arg,\n\
        !          1200: subtracts all but the first from the first.")
        !          1201:   (nargs, args)
        !          1202:      int nargs;
        !          1203:      Lisp_Object *args;
        !          1204: {
        !          1205:   return arith_driver (Asub, nargs, args);
        !          1206: }
        !          1207: 
        !          1208: DEFUN ("*", Ftimes, Stimes, 0, MANY, 0,
        !          1209:   "Returns product of any number of numbers.")
        !          1210:   (nargs, args)
        !          1211:      int nargs;
        !          1212:      Lisp_Object *args;
        !          1213: {
        !          1214:   return arith_driver (Amult, nargs, args);
        !          1215: }
        !          1216: 
        !          1217: DEFUN ("/", Fquo, Squo, 2, MANY, 0,
        !          1218:   "Returns first argument divided by rest of arguments.")
        !          1219:   (nargs, args)
        !          1220:      int nargs;
        !          1221:      Lisp_Object *args;
        !          1222: {
        !          1223:   return arith_driver (Adiv, nargs, args);
        !          1224: }
        !          1225: 
        !          1226: DEFUN ("%", Frem, Srem, 2, 2, 0,
        !          1227:   "Returns remainder of first arg divided by second.")
        !          1228:   (num1, num2)
        !          1229:      register Lisp_Object num1, num2;
        !          1230: {
        !          1231:   Lisp_Object val;
        !          1232: 
        !          1233:   CHECK_NUMBER (num1, 0);
        !          1234:   CHECK_NUMBER (num2, 1);
        !          1235: 
        !          1236:   /* Some systems fail to trap this right.  */
        !          1237:   if (!XINT (num2))
        !          1238:     while (1)
        !          1239:       Fsignal (Qarith_error, Qnil);
        !          1240: 
        !          1241:   XSET (val, Lisp_Int, XINT (num1) % XINT (num2));
        !          1242:   return val;
        !          1243: }
        !          1244: 
        !          1245: DEFUN ("max", Fmax, Smax, 1, MANY, 0,
        !          1246:   "Return largest of all the arguments (which must be numbers.)")
        !          1247:   (nargs, args)
        !          1248:      int nargs;
        !          1249:      Lisp_Object *args;
        !          1250: {
        !          1251:   return arith_driver (Amax, nargs, args);
        !          1252: }
        !          1253: 
        !          1254: DEFUN ("min", Fmin, Smin, 1, MANY, 0,
        !          1255:   "Return smallest of all the arguments (which must be numbers.)")
        !          1256:   (nargs, args)
        !          1257:      int nargs;
        !          1258:      Lisp_Object *args;
        !          1259: {
        !          1260:   return arith_driver (Amin, nargs, args);
        !          1261: }
        !          1262: 
        !          1263: DEFUN ("logand", Flogand, Slogand, 0, MANY, 0,
        !          1264:   "Return bitwise and of all the arguments (numbers).")
        !          1265:   (nargs, args)
        !          1266:      int nargs;
        !          1267:      Lisp_Object *args;
        !          1268: {
        !          1269:   return arith_driver (Alogand, nargs, args);
        !          1270: }
        !          1271: 
        !          1272: DEFUN ("logior", Flogior, Slogior, 0, MANY, 0,
        !          1273:   "Return bitwise or of all the arguments (numbers).")
        !          1274:   (nargs, args)
        !          1275:      int nargs;
        !          1276:      Lisp_Object *args;
        !          1277: {
        !          1278:   return arith_driver (Alogior, nargs, args);
        !          1279: }
        !          1280: 
        !          1281: DEFUN ("logxor", Flogxor, Slogxor, 0, MANY, 0,
        !          1282:   "Return bitwise exclusive-or of all the arguments (numbers).")
        !          1283:   (nargs, args)
        !          1284:      int nargs;
        !          1285:      Lisp_Object *args;
        !          1286: {
        !          1287:   return arith_driver (Alogxor, nargs, args);
        !          1288: }
        !          1289: 
        !          1290: DEFUN ("ash", Fash, Sash, 2, 2, 0,
        !          1291:   "Return VALUE with its bits shifted left by COUNT.\n\
        !          1292: If COUNT is negative, shifting is actually to the right.\n\
        !          1293: In this case, the sign bit is duplicated.")
        !          1294:   (num1, num2)
        !          1295:      register Lisp_Object num1, num2;
        !          1296: {
        !          1297:   register Lisp_Object val;
        !          1298: 
        !          1299:   CHECK_NUMBER (num1, 0);
        !          1300:   CHECK_NUMBER (num2, 1);
        !          1301: 
        !          1302:   if (XINT (num2) > 0)
        !          1303:     XSET (val, Lisp_Int, XINT (num1) << XFASTINT (num2));
        !          1304:   else
        !          1305:     XSET (val, Lisp_Int, XINT (num1) >> -XINT (num2));
        !          1306:   return val;
        !          1307: }
        !          1308: 
        !          1309: DEFUN ("lsh", Flsh, Slsh, 2, 2, 0,
        !          1310:   "Return VALUE with its bits shifted left by COUNT.\n\
        !          1311: If COUNT is negative, shifting is actually to the right.\n\
        !          1312: In this case,  zeros are shifted in on the left.")
        !          1313:   (num1, num2)
        !          1314:      register Lisp_Object num1, num2;
        !          1315: {
        !          1316:   register Lisp_Object val;
        !          1317: 
        !          1318:   CHECK_NUMBER (num1, 0);
        !          1319:   CHECK_NUMBER (num2, 1);
        !          1320: 
        !          1321:   if (XINT (num2) > 0)
        !          1322:     XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) << XFASTINT (num2));
        !          1323:   else
        !          1324:     XSET (val, Lisp_Int, (unsigned) XFASTINT (num1) >> -XINT (num2));
        !          1325:   return val;
        !          1326: }
        !          1327: 
        !          1328: DEFUN ("1+", Fadd1, Sadd1, 1, 1, 0,
        !          1329:   "Return NUMBER plus one.")
        !          1330:   (num)
        !          1331:      register Lisp_Object num;
        !          1332: {
        !          1333:   CHECK_NUMBER_COERCE_MARKER (num, 0);
        !          1334:   XSETINT (num, XFASTINT (num) + 1);
        !          1335:   return num;
        !          1336: }
        !          1337: 
        !          1338: DEFUN ("1-", Fsub1, Ssub1, 1, 1, 0,
        !          1339:   "Return NUMBER minus one.")
        !          1340:   (num)
        !          1341:      register Lisp_Object num;
        !          1342: {
        !          1343:   CHECK_NUMBER_COERCE_MARKER (num, 0);
        !          1344:   XSETINT (num, XFASTINT (num) - 1);
        !          1345:   return num;
        !          1346: }
        !          1347: 
        !          1348: DEFUN ("lognot", Flognot, Slognot, 1, 1, 0,
        !          1349:   "Return the bitwise complement of ARG.")
        !          1350:   (num)
        !          1351:      register Lisp_Object num;
        !          1352: {
        !          1353:   CHECK_NUMBER (num, 0);
        !          1354:   XSETINT (num, ~XFASTINT (num));
        !          1355:   return num;
        !          1356: }
        !          1357: 
        !          1358: void
        !          1359: syms_of_data ()
        !          1360: {
        !          1361:   Qquote = intern ("quote");
        !          1362:   Qlambda = intern ("lambda");
        !          1363:   Qsubr = intern ("subr");
        !          1364:   Qerror_conditions = intern ("error-conditions");
        !          1365:   Qerror_message = intern ("error-message");
        !          1366:   Qtop_level = intern ("top-level");
        !          1367: 
        !          1368:   Qerror = intern ("error");
        !          1369:   Qquit = intern ("quit");
        !          1370:   Qwrong_type_argument = intern ("wrong-type-argument");
        !          1371:   Qargs_out_of_range = intern ("args-out-of-range");
        !          1372:   Qvoid_function = intern ("void-function");
        !          1373:   Qvoid_variable = intern ("void-variable");
        !          1374:   Qsetting_constant = intern ("setting-constant");
        !          1375:   Qinvalid_read_syntax = intern ("invalid-read-syntax");
        !          1376: 
        !          1377:   Qinvalid_function = intern ("invalid-function");
        !          1378:   Qwrong_number_of_arguments = intern ("wrong-number-of-arguments");
        !          1379:   Qno_catch = intern ("no-catch");
        !          1380:   Qend_of_file = intern ("end-of-file");
        !          1381:   Qarith_error = intern ("arith-error");
        !          1382:   Qbeginning_of_buffer = intern ("beginning-of-buffer");
        !          1383:   Qend_of_buffer = intern ("end-of-buffer");
        !          1384:   Qbuffer_read_only = intern ("buffer-read-only");
        !          1385: 
        !          1386:   Qlistp = intern ("listp");
        !          1387:   Qconsp = intern ("consp");
        !          1388:   Qsymbolp = intern ("symbolp");
        !          1389:   Qintegerp = intern ("integerp");
        !          1390:   Qnatnump = intern ("natnump");
        !          1391:   Qstringp = intern ("stringp");
        !          1392:   Qarrayp = intern ("arrayp");
        !          1393:   Qsequencep = intern ("sequencep");
        !          1394:   Qbufferp = intern ("bufferp");
        !          1395:   Qvectorp = intern ("vectorp");
        !          1396:   Qchar_or_string_p = intern ("char-or-string-p");
        !          1397:   Qmarkerp = intern ("markerp");
        !          1398:   Qinteger_or_marker_p = intern ("integer-or-marker-p");
        !          1399:   Qboundp = intern ("boundp");
        !          1400:   Qfboundp = intern ("fboundp");
        !          1401: 
        !          1402:   Qcdr = intern ("cdr");
        !          1403: 
        !          1404:   /* ERROR is used as a signaler for random errors for which nothing else is right */
        !          1405: 
        !          1406:   Fput (Qerror, Qerror_conditions,
        !          1407:        Fcons (Qerror, Qnil));
        !          1408:   Fput (Qerror, Qerror_message,
        !          1409:        build_string ("error"));
        !          1410: 
        !          1411:   Fput (Qquit, Qerror_conditions,
        !          1412:        Fcons (Qquit, Qnil));
        !          1413:   Fput (Qquit, Qerror_message,
        !          1414:        build_string ("Quit"));
        !          1415: 
        !          1416:   Fput (Qwrong_type_argument, Qerror_conditions,
        !          1417:        Fcons (Qwrong_type_argument, Fcons (Qerror, Qnil)));
        !          1418:   Fput (Qwrong_type_argument, Qerror_message,
        !          1419:        build_string ("Wrong type argument"));
        !          1420: 
        !          1421:   Fput (Qargs_out_of_range, Qerror_conditions,
        !          1422:        Fcons (Qargs_out_of_range, Fcons (Qerror, Qnil)));
        !          1423:   Fput (Qargs_out_of_range, Qerror_message,
        !          1424:        build_string ("Args out of range"));
        !          1425: 
        !          1426:   Fput (Qvoid_function, Qerror_conditions,
        !          1427:        Fcons (Qvoid_function, Fcons (Qerror, Qnil)));
        !          1428:   Fput (Qvoid_function, Qerror_message,
        !          1429:        build_string ("Symbol's function definition is void"));
        !          1430: 
        !          1431:   Fput (Qvoid_variable, Qerror_conditions,
        !          1432:        Fcons (Qvoid_variable, Fcons (Qerror, Qnil)));
        !          1433:   Fput (Qvoid_variable, Qerror_message,
        !          1434:        build_string ("Symbol's value as variable is void"));
        !          1435: 
        !          1436:   Fput (Qsetting_constant, Qerror_conditions,
        !          1437:        Fcons (Qsetting_constant, Fcons (Qerror, Qnil)));
        !          1438:   Fput (Qsetting_constant, Qerror_message,
        !          1439:        build_string ("Attempt to set a constant symbol"));
        !          1440: 
        !          1441:   Fput (Qinvalid_read_syntax, Qerror_conditions,
        !          1442:        Fcons (Qinvalid_read_syntax, Fcons (Qerror, Qnil)));
        !          1443:   Fput (Qinvalid_read_syntax, Qerror_message,
        !          1444:        build_string ("Invalid read syntax"));
        !          1445: 
        !          1446:   Fput (Qinvalid_function, Qerror_conditions,
        !          1447:        Fcons (Qinvalid_function, Fcons (Qerror, Qnil)));
        !          1448:   Fput (Qinvalid_function, Qerror_message,
        !          1449:        build_string ("Invalid function"));
        !          1450: 
        !          1451:   Fput (Qwrong_number_of_arguments, Qerror_conditions,
        !          1452:        Fcons (Qwrong_number_of_arguments, Fcons (Qerror, Qnil)));
        !          1453:   Fput (Qwrong_number_of_arguments, Qerror_message,
        !          1454:        build_string ("Wrong number of arguments"));
        !          1455: 
        !          1456:   Fput (Qno_catch, Qerror_conditions,
        !          1457:        Fcons (Qno_catch, Fcons (Qerror, Qnil)));
        !          1458:   Fput (Qno_catch, Qerror_message,
        !          1459:        build_string ("No catch for tag"));
        !          1460: 
        !          1461:   Fput (Qend_of_file, Qerror_conditions,
        !          1462:        Fcons (Qend_of_file, Fcons (Qerror, Qnil)));
        !          1463:   Fput (Qend_of_file, Qerror_message,
        !          1464:        build_string ("End of file during parsing"));
        !          1465: 
        !          1466:   Fput (Qarith_error, Qerror_conditions,
        !          1467:        Fcons (Qarith_error, Fcons (Qerror, Qnil)));
        !          1468:   Fput (Qarith_error, Qerror_message,
        !          1469:        build_string ("Arithmetic error"));
        !          1470: 
        !          1471:   Fput (Qbeginning_of_buffer, Qerror_conditions,
        !          1472:        Fcons (Qbeginning_of_buffer, Fcons (Qerror, Qnil)));
        !          1473:   Fput (Qbeginning_of_buffer, Qerror_message,
        !          1474:        build_string ("Beginning of buffer"));
        !          1475: 
        !          1476:   Fput (Qend_of_buffer, Qerror_conditions,
        !          1477:        Fcons (Qend_of_buffer, Fcons (Qerror, Qnil)));
        !          1478:   Fput (Qend_of_buffer, Qerror_message,
        !          1479:        build_string ("End of buffer"));
        !          1480: 
        !          1481:   Fput (Qbuffer_read_only, Qerror_conditions,
        !          1482:        Fcons (Qbuffer_read_only, Fcons (Qerror, Qnil)));
        !          1483:   Fput (Qbuffer_read_only, Qerror_message,
        !          1484:        build_string ("Buffer is read-only"));
        !          1485: 
        !          1486:   staticpro (&Qnil);
        !          1487:   staticpro (&Qt);
        !          1488:   staticpro (&Qquote);
        !          1489:   staticpro (&Qlambda);
        !          1490:   staticpro (&Qsubr);
        !          1491:   staticpro (&Qunbound);
        !          1492:   staticpro (&Qerror_conditions);
        !          1493:   staticpro (&Qerror_message);
        !          1494:   staticpro (&Qtop_level);
        !          1495: 
        !          1496:   staticpro (&Qerror);
        !          1497:   staticpro (&Qquit);
        !          1498:   staticpro (&Qwrong_type_argument);
        !          1499:   staticpro (&Qargs_out_of_range);
        !          1500:   staticpro (&Qvoid_function);
        !          1501:   staticpro (&Qvoid_variable);
        !          1502:   staticpro (&Qsetting_constant);
        !          1503:   staticpro (&Qinvalid_read_syntax);
        !          1504:   staticpro (&Qwrong_number_of_arguments);
        !          1505:   staticpro (&Qinvalid_function);
        !          1506:   staticpro (&Qno_catch);
        !          1507:   staticpro (&Qend_of_file);
        !          1508:   staticpro (&Qarith_error);
        !          1509:   staticpro (&Qbeginning_of_buffer);
        !          1510:   staticpro (&Qend_of_buffer);
        !          1511:   staticpro (&Qbuffer_read_only);
        !          1512: 
        !          1513:   staticpro (&Qlistp);
        !          1514:   staticpro (&Qconsp);
        !          1515:   staticpro (&Qsymbolp);
        !          1516:   staticpro (&Qintegerp);
        !          1517:   staticpro (&Qnatnump);
        !          1518:   staticpro (&Qstringp);
        !          1519:   staticpro (&Qarrayp);
        !          1520:   staticpro (&Qsequencep);
        !          1521:   staticpro (&Qbufferp);
        !          1522:   staticpro (&Qvectorp);
        !          1523:   staticpro (&Qchar_or_string_p);
        !          1524:   staticpro (&Qmarkerp);
        !          1525:   staticpro (&Qinteger_or_marker_p);
        !          1526:   staticpro (&Qboundp);
        !          1527:   staticpro (&Qfboundp);
        !          1528:   staticpro (&Qcdr);
        !          1529: 
        !          1530:   defsubr (&Seq);
        !          1531:   defsubr (&Snull);
        !          1532:   defsubr (&Slistp);
        !          1533:   defsubr (&Snlistp);
        !          1534:   defsubr (&Sconsp);
        !          1535:   defsubr (&Satom);
        !          1536:   defsubr (&Sintegerp);
        !          1537:   defsubr (&Snatnump);
        !          1538:   defsubr (&Ssymbolp);
        !          1539:   defsubr (&Sstringp);
        !          1540:   defsubr (&Svectorp);
        !          1541:   defsubr (&Sarrayp);
        !          1542:   defsubr (&Ssequencep);
        !          1543:   defsubr (&Sbufferp);
        !          1544:   defsubr (&Smarkerp);
        !          1545:   defsubr (&Sinteger_or_marker_p);
        !          1546:   defsubr (&Ssubrp);
        !          1547:   defsubr (&Schar_or_string_p);
        !          1548:   defsubr (&Scar);
        !          1549:   defsubr (&Scdr);
        !          1550:   defsubr (&Scar_safe);
        !          1551:   defsubr (&Scdr_safe);
        !          1552:   defsubr (&Ssetcar);
        !          1553:   defsubr (&Ssetcdr);
        !          1554:   defsubr (&Ssymbol_function);
        !          1555:   defsubr (&Ssymbol_plist);
        !          1556:   defsubr (&Ssymbol_name);
        !          1557:   defsubr (&Smakunbound);
        !          1558:   defsubr (&Sfmakunbound);
        !          1559:   defsubr (&Sboundp);
        !          1560:   defsubr (&Sfboundp);
        !          1561:   defsubr (&Sfset);
        !          1562:   defsubr (&Ssetplist);
        !          1563:   defsubr (&Ssymbol_value);
        !          1564:   defsubr (&Sset);
        !          1565:   defsubr (&Sdefault_value);
        !          1566:   defsubr (&Sset_default);
        !          1567:   defsubr (&Ssetq_default);
        !          1568:   defsubr (&Smake_variable_buffer_local);
        !          1569:   defsubr (&Smake_local_variable);
        !          1570:   defsubr (&Skill_local_variable);
        !          1571:   defsubr (&Saref);
        !          1572:   defsubr (&Saset);
        !          1573:   defsubr (&Sint_to_string);
        !          1574:   defsubr (&Sstring_to_int);
        !          1575:   defsubr (&Seqlsign);
        !          1576:   defsubr (&Slss);
        !          1577:   defsubr (&Sgtr);
        !          1578:   defsubr (&Sleq);
        !          1579:   defsubr (&Sgeq);
        !          1580:   defsubr (&Sneq);
        !          1581:   defsubr (&Szerop);
        !          1582:   defsubr (&Splus);
        !          1583:   defsubr (&Sminus);
        !          1584:   defsubr (&Stimes);
        !          1585:   defsubr (&Squo);
        !          1586:   defsubr (&Srem);
        !          1587:   defsubr (&Smax);
        !          1588:   defsubr (&Smin);
        !          1589:   defsubr (&Slogand);
        !          1590:   defsubr (&Slogior);
        !          1591:   defsubr (&Slogxor);
        !          1592:   defsubr (&Slsh);
        !          1593:   defsubr (&Sash);
        !          1594:   defsubr (&Sadd1);
        !          1595:   defsubr (&Ssub1);
        !          1596:   defsubr (&Slognot);
        !          1597: }
        !          1598: 
        !          1599: arith_error (signo)
        !          1600:      int signo;
        !          1601: {
        !          1602: #ifdef USG
        !          1603:   /* USG systems forget handlers when they are used;
        !          1604:      must reestablish each time */
        !          1605:   signal (signo, arith_error);
        !          1606: #endif /* USG */
        !          1607: #ifdef VMS
        !          1608:   /* VMS systems are like USG.  */
        !          1609:   signal (signo, arith_error);
        !          1610: #endif /* VMS */
        !          1611: #ifdef BSD4_1
        !          1612:   sigrelse (SIGFPE);
        !          1613: #else /* not BSD4_1 */
        !          1614:   sigsetmask (SIGEMPTYMASK);
        !          1615: #endif /* not BSD4_1 */
        !          1616: 
        !          1617:   while (1)
        !          1618:     Fsignal (Qarith_error, Qnil);
        !          1619: }
        !          1620: 
        !          1621: init_data ()
        !          1622: {
        !          1623:   /* Don't do this if just dumping out.
        !          1624:      We don't want to call `signal' in this case
        !          1625:      so that we don't have trouble with dumping
        !          1626:      signal-delivering routines in an inconsistent state.  */
        !          1627: #ifndef CANNOT_DUMP
        !          1628:   if (!initialized)
        !          1629:     return;
        !          1630: #endif /* CANNOT_DUMP */
        !          1631:   signal (SIGFPE, arith_error);
        !          1632: #ifdef uts
        !          1633:   signal (SIGEMT, arith_error);
        !          1634: #endif /* uts */
        !          1635: }

unix.superglobalmegacorp.com

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