Return to data.c CVS log

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

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

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