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