|
|
1.1 ! root 1: /* Fundamental definitions for GNU Emacs Lisp interpreter. ! 2: Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. ! 3: ! 4: This file is part of GNU Emacs. ! 5: ! 6: GNU Emacs is free software; you can redistribute it and/or modify ! 7: it under the terms of the GNU General Public License as published by ! 8: the Free Software Foundation; either version 1, or (at your option) ! 9: any later version. ! 10: ! 11: GNU Emacs is distributed in the hope that it will be useful, ! 12: but WITHOUT ANY WARRANTY; without even the implied warranty of ! 13: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ! 14: GNU General Public License for more details. ! 15: ! 16: You should have received a copy of the GNU General Public License ! 17: along with GNU Emacs; see the file COPYING. If not, write to ! 18: the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. */ ! 19: ! 20: ! 21: /* Define the fundamental Lisp data structures */ ! 22: ! 23: /* This is the set of Lisp data types */ ! 24: ! 25: enum Lisp_Type ! 26: { ! 27: /* Integer. object.v.integer is the integer value. */ ! 28: Lisp_Int, ! 29: ! 30: /* Symbol. object.v.symbol points to a struct Lisp_Symbol. */ ! 31: Lisp_Symbol, ! 32: ! 33: /* Marker (editor pointer). object.v.marker points to a struct Lisp_Marker. */ ! 34: Lisp_Marker, ! 35: ! 36: /* String. object.v.string points to a struct Lisp_String. ! 37: The length of the string, and its contents, are stored therein. */ ! 38: Lisp_String, ! 39: ! 40: /* Vector of Lisp objects. object.v.vector points to a struct Lisp_Vector. ! 41: The length of the vector, and its contents, are stored therein. */ ! 42: Lisp_Vector, ! 43: ! 44: /* Cons. object.v.cons points to a struct Lisp_Cons. */ ! 45: Lisp_Cons, ! 46: ! 47: /* >>> No longer used */ ! 48: Lisp_Object_Unused_1, ! 49: #if 0 ! 50: was... ! 51: /* Treated like vector in GC, except do not set its mark bit. ! 52: Used for internal data blocks that will be explicitly freed ! 53: but which, while active, are reached by GC mark exactly once ! 54: and should be marked through like a vector. */ ! 55: Lisp_Temp_Vector, ! 56: #endif /* 0 */ ! 57: ! 58: /* Editor buffer. obj.v.buffer points to a struct buffer. ! 59: No buffer is ever truly freed; they can be "killed", but this ! 60: just marks them as dead. */ ! 61: Lisp_Buffer, ! 62: ! 63: /* Built-in function. obj.v.subr points to a struct Lisp_Subr ! 64: which describes how to call the function, and its documentation, ! 65: as well as pointing to the code. */ ! 66: Lisp_Subr, ! 67: ! 68: /* Internal value return by subroutines of read. ! 69: The user never sees this data type. ! 70: Its value is just a number. */ ! 71: Lisp_Internal, ! 72: ! 73: /* Forwarding pointer to an int variable. ! 74: This is allowed only in the value cell of a symbol, ! 75: and it means that the symbol's value really lives in the ! 76: specified int variable. ! 77: obj.v.intptr points to the int variable. */ ! 78: Lisp_Intfwd, ! 79: ! 80: /* Boolean forwarding pointer to an int variable. ! 81: This is like Lisp_Intfwd except that the ostensible "value" of the symbol ! 82: is t if the int variable is nonzero, nil if it is zero. ! 83: obj.v.intptr points to the int variable. */ ! 84: Lisp_Boolfwd, ! 85: ! 86: /* Object describing a connection to a subprocess. ! 87: It points to storage of type struct Lisp_Process */ ! 88: Lisp_Process, ! 89: ! 90: /* Forwarding pointer to a Lisp_Object variable. ! 91: This is allowed only in the value cell of a symbol, ! 92: and it means that the symbol's value really lives in the ! 93: specified variable. ! 94: obj.v.objfwd points to the Lisp_Object variable. */ ! 95: Lisp_Objfwd, ! 96: ! 97: /* was Lisp_Internal */ ! 98: Lisp_Object_Unused_2, ! 99: ! 100: /* Used when a FILE * value needs to be passed ! 101: in an argument of type Lisp_Object. ! 102: You must do (FILE *) obj.v.integer to get the value. ! 103: The user will never see this data type. */ ! 104: Lisp_Internal_Stream, ! 105: ! 106: /* Used in a symbol value cell when the symbol's value is per-buffer. ! 107: The actual contents are a cons cell which starts a list like this: ! 108: (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)). ! 109: ! 110: BUFFER is the last buffer for which this symbol's value was ! 111: made up to date. ! 112: ! 113: CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's ! 114: b_local_var_alist, that being the element whose car is this variable. ! 115: Or it can be a pointer to the (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER ! 116: does not have an element in its alist for this variable ! 117: (that is, if BUFFER sees the default value of this variable). ! 118: ! 119: If we want to examine or set the value and BUFFER is current, ! 120: we just examine or set REALVALUE. ! 121: If BUFFER is not current, we store the current REALVALUE value into ! 122: CURRENT-ALIST-ELEMENT, then find the appropriate alist element for ! 123: the buffer now current and set up CURRENT-ALIST-ELEMENT. ! 124: Then we set REALVALUE out of that element, and store into BUFFER. ! 125: ! 126: If we are setting the variable and the current buffer does not have ! 127: an alist entry for this variable, an alist entry is created. ! 128: ! 129: Note that REALVALUE can be a forwarding pointer. ! 130: Each time it is examined or set, forwarding must be done. */ ! 131: Lisp_Buffer_Local_Value, ! 132: ! 133: /* Like Lisp_Buffer_Local_Value with one difference: ! 134: merely setting the variable while some buffer is current ! 135: does not cause that buffer to have its own local value of this variable. ! 136: Only make-local-variable does that. */ ! 137: Lisp_Some_Buffer_Local_Value, ! 138: ! 139: ! 140: /* Like Lisp_Objfwd except that value lives in a slot ! 141: in the current buffer. Value is byte index of slot within buffer */ ! 142: Lisp_Buffer_Objfwd, ! 143: ! 144: /* In symbol value cell, means var is unbound. ! 145: In symbol function cell, means function name is undefined. */ ! 146: Lisp_Void, ! 147: ! 148: /* Window used for Emacs display. ! 149: Data inside looks like a Lisp_Vector. */ ! 150: Lisp_Window, ! 151: ! 152: /* Used by save,set,restore-window-configuration */ ! 153: Lisp_Window_Configuration ! 154: }; ! 155: ! 156: #ifndef NO_UNION_TYPE ! 157: ! 158: #ifndef BIG_ENDIAN ! 159: ! 160: /* Definition of Lisp_Object for little-endian machines. */ ! 161: ! 162: typedef ! 163: union Lisp_Object ! 164: { ! 165: /* Used for comparing two Lisp_Objects; ! 166: also, positive integers can be accessed fast this way. */ ! 167: int i; ! 168: ! 169: struct ! 170: { ! 171: int val: 24; ! 172: char type; ! 173: } s; ! 174: struct ! 175: { ! 176: unsigned int val: 24; ! 177: char type; ! 178: } u; ! 179: struct ! 180: { ! 181: unsigned int val: 24; ! 182: enum Lisp_Type type: 7; ! 183: /* The markbit is not really part of the value of a Lisp_Object, ! 184: and is always zero except during garbage collection. */ ! 185: unsigned int markbit: 1; ! 186: } gu; ! 187: } ! 188: Lisp_Object; ! 189: ! 190: #else /* If BIG_ENDIAN */ ! 191: ! 192: typedef ! 193: union Lisp_Object ! 194: { ! 195: /* Used for comparing two Lisp_Objects; ! 196: also, positive integers can be accessed fast this way. */ ! 197: int i; ! 198: ! 199: struct ! 200: { ! 201: char type; ! 202: int val: 24; ! 203: } s; ! 204: struct ! 205: { ! 206: char type; ! 207: unsigned int val: 24; ! 208: } u; ! 209: struct ! 210: { ! 211: /* The markbit is not really part of the value of a Lisp_Object, ! 212: and is always zero except during garbage collection. */ ! 213: unsigned int markbit: 1; ! 214: enum Lisp_Type type: 7; ! 215: unsigned int val: 24; ! 216: } gu; ! 217: } ! 218: Lisp_Object; ! 219: ! 220: #endif /* BIG_ENDIAN */ ! 221: ! 222: #endif /* NO_UNION_TYPE */ ! 223: ! 224: ! 225: /* If union type is not wanted, define Lisp_Object as just a number ! 226: and define the macros below to extract fields by shifting */ ! 227: ! 228: #ifdef NO_UNION_TYPE ! 229: ! 230: #define Lisp_Object int ! 231: ! 232: /* These values are overridden by the m- file on some machines. */ ! 233: #ifndef VALBITS ! 234: #define VALBITS 24 ! 235: #endif ! 236: ! 237: #ifndef GCTYPEBITS ! 238: #define GCTYPEBITS 7 ! 239: #endif ! 240: ! 241: #ifndef VALMASK ! 242: #define VALMASK ((1<<VALBITS) - 1) ! 243: #endif ! 244: #define GCTYPEMASK ((1<<GCTYPEBITS) - 1) ! 245: #define MARKBIT (1 << (VALBITS + GCTYPEBITS)) ! 246: ! 247: #endif /* NO_UNION_TYPE */ ! 248: ! 249: /* These macros extract various sorts of values from a Lisp_Object. ! 250: For example, if tem is a Lisp_Object whose type is Lisp_Cons, ! 251: XCONS (tem) is the struct Lisp_Cons * pointing to the memory for that cons. */ ! 252: ! 253: #ifdef NO_UNION_TYPE ! 254: ! 255: /* One need to override this if there must be high bits set in data space ! 256: (doing the result of the below & ((1 << (GCTYPE + 1)) - 1) would work ! 257: on all machines, but would penalise machines which don't need it) ! 258: */ ! 259: #ifndef XTYPE ! 260: #define XTYPE(a) ((enum Lisp_Type) ((a) >> VALBITS)) ! 261: #endif ! 262: ! 263: #ifndef XSETTYPE ! 264: #define XSETTYPE(a, b) ((a) = XUINT (a) | ((int)(b) << VALBITS)) ! 265: #endif ! 266: ! 267: /* Use XFASTINT for fast retrieval and storage of integers known ! 268: to be positive. This takes advantage of the fact that Lisp_Int is 0. */ ! 269: #define XFASTINT(a) (a) ! 270: ! 271: /* Extract the value of a Lisp_Object as a signed integer. */ ! 272: ! 273: #ifndef XINT /* Some machines need to do this differently. */ ! 274: #define XINT(a) (((a) << (INTBITS-VALBITS)) >> (INTBITS-VALBITS)) ! 275: #endif ! 276: ! 277: /* Extract the value as an unsigned integer. This is a basis ! 278: for exctacting it as a pointer to a structure in storage. */ ! 279: ! 280: #ifndef XUINT ! 281: #define XUINT(a) ((a) & VALMASK) ! 282: #endif ! 283: ! 284: #ifdef HAVE_SHM ! 285: /* In this representation, data is found in two widely separated segments. */ ! 286: #define XPNTR(a) \ ! 287: (XUINT (a) | (XUINT (a) > PURESIZE ? DATA_SEG_BITS : PURE_SEG_BITS)) ! 288: #else /* not HAVE_SHM */ ! 289: #ifdef DATA_SEG_BITS ! 290: /* This case is used for the rt-pc. ! 291: In the diffs I was given, it checked for ptr = 0 ! 292: and did not adjust it in that case. ! 293: But I don't think that zero should ever be found ! 294: in a Lisp object whose data type says it points to something. */ ! 295: #define XPNTR(a) (XUINT (a) | DATA_SEG_BITS) ! 296: #else /* not DATA_SEG_BITS */ ! 297: #define XPNTR(a) XUINT (a) ! 298: #endif ! 299: #endif /* not HAVE_SHM */ ! 300: ! 301: #ifndef XSETINT ! 302: #define XSETINT(a, b) ((a) = ((a) & ~VALMASK) | ((b) & VALMASK)) ! 303: #endif ! 304: ! 305: #ifndef XSETUINT ! 306: #define XSETUINT(a, b) XSETINT (a, b) ! 307: #endif ! 308: ! 309: #ifndef XSETPNTR ! 310: #define XSETPNTR(a, b) XSETINT (a, b) ! 311: #endif ! 312: ! 313: #ifndef XSET ! 314: #define XSET(var, type, ptr) \ ! 315: ((var) = ((int)(type) << VALBITS) + ((int) (ptr) & VALMASK)) ! 316: #endif ! 317: ! 318: /* During garbage collection, XGCTYPE must be used for extracting types ! 319: so that the mark bit is ignored. XMARKBIT access the markbit. ! 320: Markbits are used only in particular slots of particular structure types. ! 321: Other markbits are always zero. ! 322: Outside of garbage collection, all mark bits are always zero. */ ! 323: ! 324: #ifndef XGCTYPE ! 325: #define XGCTYPE(a) ((enum Lisp_Type) (((a) >> VALBITS) & GCTYPEMASK)) ! 326: #endif ! 327: ! 328: /* In version 19, try ! 329: #if VALBITS + GCTYPEBITS == INTBITS - 1 ! 330: #define XMARKBIT(a) ((a) < 0) ! 331: #define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | ((b) ? MARKBIT : 0)) ! 332: */ ! 333: ! 334: #ifndef XMARKBIT ! 335: #define XMARKBIT(a) ((a) & MARKBIT) ! 336: #endif ! 337: ! 338: #ifndef XSETMARKBIT ! 339: #define XSETMARKBIT(a,b) ((a) = ((a) & ~MARKBIT) | (b)) ! 340: #endif ! 341: ! 342: #ifndef XMARK ! 343: #define XMARK(a) ((a) |= MARKBIT) ! 344: #endif ! 345: ! 346: #ifndef XUNMARK ! 347: #define XUNMARK(a) ((a) &= ~MARKBIT) ! 348: #endif ! 349: ! 350: #endif /* NO_UNION_TYPE */ ! 351: ! 352: #ifndef NO_UNION_TYPE ! 353: ! 354: #define XTYPE(a) ((enum Lisp_Type) (a).u.type) ! 355: #define XSETTYPE(a, b) ((a).u.type = (char) (b)) ! 356: ! 357: /* Use XFASTINT for fast retrieval and storage of integers known ! 358: to be positive. This takes advantage of the fact that Lisp_Int is 0. */ ! 359: #define XFASTINT(a) ((a).i) ! 360: ! 361: #ifdef EXPLICIT_SIGN_EXTEND ! 362: /* Make sure we sign-extend; compilers have been known to fail to do so. */ ! 363: #define XINT(a) (((a).i << 8) >> 8) ! 364: #else ! 365: #define XINT(a) ((a).s.val) ! 366: #endif /* EXPLICIT_SIGN_EXTEND */ ! 367: ! 368: #define XUINT(a) ((a).u.val) ! 369: #define XPNTR(a) ((a).u.val) ! 370: #define XSETINT(a, b) ((a).s.val = (int) (b)) ! 371: #define XSETUINT(a, b) ((a).s.val = (int) (b)) ! 372: #define XSETPNTR(a, b) ((a).s.val = (int) (b)) ! 373: ! 374: #define XSET(var, vartype, ptr) \ ! 375: (((var).s.type = ((char) (vartype))), ((var).s.val = ((int) (ptr)))) ! 376: ! 377: /* During garbage collection, XGCTYPE must be used for extracting types ! 378: so that the mark bit is ignored. XMARKBIT access the markbit. ! 379: Markbits are used only in particular slots of particular structure types. ! 380: Other markbits are always zero. ! 381: Outside of garbage collection, all mark bits are always zero. */ ! 382: ! 383: #define XGCTYPE(a) ((a).gu.type) ! 384: #define XMARKBIT(a) ((a).gu.markbit) ! 385: #define XSETMARKBIT(a,b) (XMARKBIT(a) = (b)) ! 386: #define XMARK(a) (XMARKBIT(a) = 1) ! 387: #define XUNMARK(a) (XMARKBIT(a) = 0) ! 388: ! 389: #endif /* NO_UNION_TYPE */ ! 390: ! 391: ! 392: #define XCONS(a) ((struct Lisp_Cons *) XPNTR(a)) ! 393: #define XBUFFER(a) ((struct buffer *) XPNTR(a)) ! 394: #define XVECTOR(a) ((struct Lisp_Vector *) XPNTR(a)) ! 395: #define XSUBR(a) ((struct Lisp_Subr *) XPNTR(a)) ! 396: #define XSTRING(a) ((struct Lisp_String *) XPNTR(a)) ! 397: #define XSYMBOL(a) ((struct Lisp_Symbol *) XPNTR(a)) ! 398: #define XFUNCTION(a) ((Lisp_Object (*)()) XPNTR(a)) ! 399: #define XMARKER(a) ((struct Lisp_Marker *) XPNTR(a)) ! 400: #define XOBJFWD(a) ((Lisp_Object *) XPNTR(a)) ! 401: #define XINTPTR(a) ((int *) XPNTR(a)) ! 402: #define XWINDOW(a) ((struct window *) XPNTR(a)) ! 403: #define XPROCESS(a) ((struct Lisp_Process *) XPNTR(a)) ! 404: ! 405: #define XSETCONS(a, b) XSETPNTR(a, (int) (b)) ! 406: #define XSETBUFFER(a, b) XSETPNTR(a, (int) (b)) ! 407: #define XSETVECTOR(a, b) XSETPNTR(a, (int) (b)) ! 408: #define XSETSUBR(a, b) XSETPNTR(a, (int) (b)) ! 409: #define XSETSTRING(a, b) XSETPNTR(a, (int) (b)) ! 410: #define XSETSYMBOL(a, b) XSETPNTR(a, (int) (b)) ! 411: #define XSETFUNCTION(a, b) XSETPNTR(a, (int) (b)) ! 412: #define XSETMARKER(a, b) XSETPNTR(a, (int) (b)) ! 413: #define XSETOBJFWD(a, b) XSETPNTR(a, (int) (b)) ! 414: #define XSETINTPTR(a, b) XSETPNTR(a, (int) (b)) ! 415: #define XSETWINDOW(a, b) XSETPNTR(a, (int) (b)) ! 416: #define XSETPROCESS(a, b) XSETPNTR(a, (int) (b)) ! 417: ! 418: /* In a cons, the markbit of the car is the gc mark bit */ ! 419: ! 420: struct Lisp_Cons ! 421: { ! 422: Lisp_Object car, cdr; ! 423: }; ! 424: ! 425: /* Like a cons, but records info on where the text lives that it was read from */ ! 426: /* This is not really in use now */ ! 427: ! 428: struct Lisp_Buffer_Cons ! 429: { ! 430: Lisp_Object car, cdr; ! 431: struct buffer *buffer; ! 432: int bufpos; ! 433: }; ! 434: ! 435: /* In a string or vector, the sign bit of the `size' is the gc mark bit */ ! 436: ! 437: struct Lisp_String ! 438: { ! 439: int size; ! 440: unsigned char data[1]; ! 441: }; ! 442: ! 443: struct Lisp_Vector ! 444: { ! 445: int size; ! 446: struct Lisp_Vector *next; ! 447: Lisp_Object contents[1]; ! 448: }; ! 449: ! 450: /* In a symbol, the markbit of the plist is used as the gc mark bit */ ! 451: ! 452: struct Lisp_Symbol ! 453: { ! 454: struct Lisp_String *name; ! 455: Lisp_Object value; ! 456: Lisp_Object function; ! 457: Lisp_Object plist; ! 458: struct Lisp_Symbol *next; /* -> next symbol in this obarray bucket */ ! 459: }; ! 460: ! 461: struct Lisp_Subr ! 462: { ! 463: Lisp_Object (*function) (); ! 464: short min_args, max_args; ! 465: char *symbol_name; ! 466: char *prompt; ! 467: char *doc; ! 468: }; ! 469: ! 470: /* In a marker, the markbit of the chain field is used as the gc mark bit */ ! 471: ! 472: struct Lisp_Marker ! 473: { ! 474: struct buffer *buffer; ! 475: Lisp_Object chain; ! 476: int bufpos; ! 477: }; ! 478: ! 479: /* Data type checking */ ! 480: ! 481: #ifdef NULL ! 482: #undef NULL ! 483: #endif ! 484: #define NULL(x) (XFASTINT (x) == XFASTINT (Qnil)) ! 485: /* #define LISTP(x) (XTYPE ((x)) == Lisp_Cons)*/ ! 486: #define CONSP(x) (XTYPE ((x)) == Lisp_Cons) ! 487: #define EQ(x, y) (XFASTINT (x) == XFASTINT (y)) ! 488: ! 489: #define CHECK_LIST(x, i) \ ! 490: { if ((XTYPE ((x)) != Lisp_Cons) && !NULL (x)) x = wrong_type_argument (Qlistp, (x)); } ! 491: ! 492: #define CHECK_STRING(x, i) \ ! 493: { if (XTYPE ((x)) != Lisp_String) x = wrong_type_argument (Qstringp, (x)); } ! 494: ! 495: #define CHECK_CONS(x, i) \ ! 496: { if (XTYPE ((x)) != Lisp_Cons) x = wrong_type_argument (Qconsp, (x)); } ! 497: ! 498: #define CHECK_SYMBOL(x, i) \ ! 499: { if (XTYPE ((x)) != Lisp_Symbol) x = wrong_type_argument (Qsymbolp, (x)); } ! 500: ! 501: #define CHECK_VECTOR(x, i) \ ! 502: { if (XTYPE ((x)) != Lisp_Vector) x = wrong_type_argument (Qvectorp, (x)); } ! 503: ! 504: #define CHECK_BUFFER(x, i) \ ! 505: { if (XTYPE ((x)) != Lisp_Buffer) x = wrong_type_argument (Qbufferp, (x)); } ! 506: ! 507: #define CHECK_WINDOW(x, i) \ ! 508: { if (XTYPE ((x)) != Lisp_Window) x = wrong_type_argument (Qwindowp, (x)); } ! 509: ! 510: #define CHECK_PROCESS(x, i) \ ! 511: { if (XTYPE ((x)) != Lisp_Process) x = wrong_type_argument (Qprocessp, (x)); } ! 512: ! 513: #define CHECK_NUMBER(x, i) \ ! 514: { if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qintegerp, (x)); } ! 515: ! 516: #define CHECK_MARKER(x, i) \ ! 517: { if (XTYPE ((x)) != Lisp_Marker) x = wrong_type_argument (Qmarkerp, (x)); } ! 518: ! 519: #define CHECK_NUMBER_COERCE_MARKER(x, i) \ ! 520: { if (XTYPE ((x)) == Lisp_Marker) XFASTINT (x) = marker_position (x); \ ! 521: else if (XTYPE ((x)) != Lisp_Int) x = wrong_type_argument (Qinteger_or_marker_p, (x)); } ! 522: ! 523: #ifdef VIRT_ADDR_VARIES ! 524: ! 525: /* For machines like APOLLO where text and data can go anywhere ! 526: in virtual memory. */ ! 527: #define CHECK_IMPURE(obj) \ ! 528: { extern int pure[]; \ ! 529: if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) ((char *) pure + PURESIZE) \ ! 530: && (PNTR_COMPARISON_TYPE) XPNTR (obj) >= (PNTR_COMPARISON_TYPE) pure) \ ! 531: pure_write_error (); } ! 532: ! 533: #else /* not VIRT_ADDR_VARIES */ ! 534: #ifdef PNTR_COMPARISON_TYPE ! 535: ! 536: /* when PNTR_COMPARISON_TYPE is not the default (unsigned int) */ ! 537: #define CHECK_IMPURE(obj) \ ! 538: { extern int my_edata; \ ! 539: if ((PNTR_COMPARISON_TYPE) XPNTR (obj) < (PNTR_COMPARISON_TYPE) &my_edata) \ ! 540: pure_write_error (); } ! 541: ! 542: #else /* not VIRT_ADDRESS_VARIES, not PNTR_COMPARISON_TYPE */ ! 543: ! 544: #define CHECK_IMPURE(obj) \ ! 545: { extern int my_edata; \ ! 546: if (XPNTR (obj) < (unsigned int) &my_edata) \ ! 547: pure_write_error (); } ! 548: ! 549: #endif /* PNTR_COMPARISON_TYPE */ ! 550: #endif /* VIRT_ADDRESS_VARIES */ ! 551: ! 552: /* Cast pointers to this type to compare them. Some machines want int. */ ! 553: #ifndef PNTR_COMPARISON_TYPE ! 554: #define PNTR_COMPARISON_TYPE unsigned int ! 555: #endif ! 556: ! 557: /* Define a built-in function for calling from Lisp. ! 558: `lname' should be the name to give the function in Lisp, ! 559: as a null-terminated C string. ! 560: `fnname' should be the name of the function in C. ! 561: By convention, it starts with F. ! 562: `sname' should be the name for the C constant structure ! 563: that records information on this function for internal use. ! 564: By convention, it should be the same as `fnname' but with S instead of F. ! 565: It's too bad that C macros can't compute this from `fnname'. ! 566: `minargs' should be a number, the minimum number of arguments allowed. ! 567: `maxargs' should be a number, the maximum number of arguments allowed, ! 568: or else MANY or UNEVALLED. ! 569: MANY means pass a vector of evaluated arguments, ! 570: in the form of an integer number-of-arguments ! 571: followed by the address of a vector of Lisp_Objects ! 572: which contains the argument values. ! 573: UNEVALLED means pass the list of unevaluated arguments ! 574: `prompt' says how to read arguments for an interactive call. ! 575: This can be zero or a C string. ! 576: Zero means that interactive calls are not allowed. ! 577: A string is interpreted in a hairy way: ! 578: it should contain one line for each argument to be read, terminated by \n. ! 579: The first character of the line controls the type of parsing: ! 580: s -- read a string. ! 581: S -- read a symbol. ! 582: k -- read a key sequence and return it as a string. ! 583: a -- read a function name (symbol) with completion. ! 584: C -- read a command name (symbol) with completion. ! 585: v -- read a variable name (symbol) with completion. ! 586: b -- read a buffer name (a string) with completion. ! 587: B -- buffer name, may be existing buffer or may not be. ! 588: f -- read a file name, file must exist. ! 589: F -- read a file name, file need not exist. ! 590: n -- read a number. ! 591: c -- read a character and return it as a number. ! 592: p -- use the numeric value of the prefix argument. ! 593: P -- use raw value of prefix - can be nil, -, (NUMBER) or NUMBER. ! 594: x -- read a Lisp object from the minibuffer. ! 595: X -- read a Lisp form from the minibuffer and use its value. ! 596: A null string means call interactively with no arguments. ! 597: `doc' is documentation for the user. ! 598: */ ! 599: ! 600: #define DEFUN(lname, fnname, sname, minargs, maxargs, prompt, doc) \ ! 601: Lisp_Object fnname (); \ ! 602: struct Lisp_Subr sname = {fnname, minargs, maxargs, lname, prompt, 0}; \ ! 603: Lisp_Object fnname ! 604: ! 605: /* defsubr (Sname); ! 606: is how we define the symbol for function `name' at start-up time. */ ! 607: extern void defsubr (); ! 608: ! 609: #define MANY -2 ! 610: #define UNEVALLED -1 ! 611: ! 612: /* Macros we use to define forwarded Lisp variables. ! 613: These are used in the syms_of_FILENAME functions. */ ! 614: ! 615: #define DEFVARLISP(lname, vname, doc) defvar_lisp (lname, vname) ! 616: #define DEFVARBOOL(lname, vname, doc) defvar_bool (lname, vname) ! 617: #define DEFVARINT(lname, vname, doc) defvar_int (lname, vname) ! 618: #define DEFVARPERBUFFER(lname, vname, doc) \ ! 619: defvar_per_buffer (lname, vname, 0) ! 620: ! 621: #define DEFVAR_LISP(lname, vname, doc) defvar_lisp (lname, vname) ! 622: #define DEFVAR_LISP_NOPRO(lname, vname, doc) defvar_lisp_nopro (lname, vname) ! 623: #define DEFVAR_BOOL(lname, vname, doc) defvar_bool (lname, vname) ! 624: #define DEFVAR_INT(lname, vname, doc) defvar_int (lname, vname) ! 625: #define DEFVAR_PER_BUFFER(lname, vname, doc) \ ! 626: defvar_per_buffer (lname, vname, 0) ! 627: ! 628: /* Structure for recording Lisp call stack for backtrace purposes */ ! 629: ! 630: struct specbinding ! 631: { ! 632: Lisp_Object symbol, old_value; ! 633: Lisp_Object (*func) (); ! 634: Lisp_Object unused; /* Dividing by 16 is faster than by 12 */ ! 635: }; ! 636: ! 637: extern struct specbinding *specpdl; ! 638: extern struct specbinding *specpdl_ptr; ! 639: extern int specpdl_size; ! 640: ! 641: struct handler ! 642: { ! 643: Lisp_Object handler; ! 644: Lisp_Object var; ! 645: int poll_suppress_count; /* No error should exit a piece of code ! 646: in which polling is suppressed. */ ! 647: struct catchtag *tag; ! 648: struct handler *next; ! 649: }; ! 650: ! 651: extern struct handler *handlerlist; ! 652: ! 653: /* Check quit-flag and quit if it is non-nil. */ ! 654: ! 655: #define QUIT \ ! 656: if (!NULL (Vquit_flag) && NULL (Vinhibit_quit)) \ ! 657: { Vquit_flag = Qnil; Fsignal (Qquit, Qnil); } ! 658: ! 659: /* Nonzero if ought to quit now. */ ! 660: ! 661: #define QUITP (!NULL (Vquit_flag) && NULL (Vinhibit_quit)) ! 662: ! 663: /* 1 if CH is upper case. */ ! 664: ! 665: #define UPPERCASEP(CH) (downcase_table[CH] != (CH)) ! 666: ! 667: /* 1 if CH is lower case. */ ! 668: ! 669: #define LOWERCASEP(CH) \ ! 670: (downcase_table[CH] == (CH) && downcase_table[0400 + (CH)] != (CH)) ! 671: ! 672: /* 1 if CH is neither upper nor lower case. */ ! 673: ! 674: #define NOCASEP(CH) (downcase_table[0400 + (CH)] == (CH)) ! 675: ! 676: /* Upcase a character, or make no change if that cannot be done. */ ! 677: ! 678: #define UPCASE(CH) (downcase_table[CH] == (CH) ? UPCASE1 (CH) : (CH)) ! 679: ! 680: /* Upcase a character known to be not upper case. */ ! 681: ! 682: #define UPCASE1(CH) downcase_table[0400 + (CH)] ! 683: ! 684: /* Downcase a character, or make no change if that cannot be done. */ ! 685: ! 686: #define DOWNCASE(CH) downcase_table[CH] ! 687: ! 688: /* number of bytes of structure consed since last GC */ ! 689: ! 690: extern int consing_since_gc; ! 691: ! 692: /* threshold for doing another gc */ ! 693: ! 694: extern int gc_cons_threshold; ! 695: ! 696: /* value of consing_since_gc when undos were last truncated. */ ! 697: ! 698: extern int consing_at_last_truncate; ! 699: ! 700: /* Structure for recording stack slots that need marking */ ! 701: ! 702: /* This is a chain of structures, each of which points at a Lisp_Object variable ! 703: whose value should be marked in garbage collection. ! 704: Normally every link of the chain is an automatic variable of a function, ! 705: and its `val' points to some argument or local variable of the function. ! 706: On exit to the function, the chain is set back to the value it had on entry. ! 707: This way, no link remains in the chain when the stack frame containing the link disappears. ! 708: ! 709: Every function that can call Feval must protect in this fashion all ! 710: Lisp_Object variables whose contents will be used again. */ ! 711: ! 712: extern struct gcpro *gcprolist; ! 713: ! 714: struct gcpro ! 715: { ! 716: struct gcpro *next; ! 717: Lisp_Object *var; /* Address of first protected variable */ ! 718: int nvars; /* Number of consecutive protected variables */ ! 719: }; ! 720: ! 721: #define GCPRO1(varname) \ ! 722: {gcpro1.next = gcprolist; gcpro1.var = &varname; gcpro1.nvars = 1; \ ! 723: gcprolist = &gcpro1; } ! 724: ! 725: #define GCPRO2(varname1, varname2) \ ! 726: {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ ! 727: gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ ! 728: gcprolist = &gcpro2; } ! 729: ! 730: #define GCPRO3(varname1, varname2, varname3) \ ! 731: {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ ! 732: gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ ! 733: gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ ! 734: gcprolist = &gcpro3; } ! 735: ! 736: #define GCPRO4(varname1, varname2, varname3, varname4) \ ! 737: {gcpro1.next = gcprolist; gcpro1.var = &varname1; gcpro1.nvars = 1; \ ! 738: gcpro2.next = &gcpro1; gcpro2.var = &varname2; gcpro2.nvars = 1; \ ! 739: gcpro3.next = &gcpro2; gcpro3.var = &varname3; gcpro3.nvars = 1; \ ! 740: gcpro4.next = &gcpro3; gcpro4.var = &varname4; gcpro4.nvars = 1; \ ! 741: gcprolist = &gcpro4; } ! 742: ! 743: /* Call staticpro (&var) to protect static variable `var'. */ ! 744: ! 745: void staticpro(); ! 746: ! 747: #define UNGCPRO (gcprolist = gcpro1.next) ! 748: ! 749: /* Defined in data.c */ ! 750: extern Lisp_Object Qnil, Qt, Qquote, Qlambda, Qsubr, Qunbound; ! 751: extern Lisp_Object Qerror_conditions, Qerror_message, Qtop_level; ! 752: extern Lisp_Object Qerror, Qquit, Qwrong_type_argument, Qargs_out_of_range; ! 753: extern Lisp_Object Qvoid_variable, Qvoid_function; ! 754: extern Lisp_Object Qsetting_constant, Qinvalid_read_syntax; ! 755: extern Lisp_Object Qinvalid_function, Qwrong_number_of_arguments, Qno_catch; ! 756: extern Lisp_Object Qend_of_file, Qarith_error; ! 757: extern Lisp_Object Qbeginning_of_buffer, Qend_of_buffer, Qbuffer_read_only; ! 758: ! 759: extern Lisp_Object Qintegerp, Qnatnump, Qsymbolp, Qlistp, Qconsp; ! 760: extern Lisp_Object Qstringp, Qarrayp, Qsequencep, Qbufferp; ! 761: extern Lisp_Object Qchar_or_string_p, Qmarkerp, Qvectorp; ! 762: extern Lisp_Object Qinteger_or_marker_p, Qboundp, Qfboundp; ! 763: extern Lisp_Object Qcdr; ! 764: ! 765: extern Lisp_Object Feq (), Fnull (), Flistp (), Fconsp (), Fatom (), Fnlistp (); ! 766: extern Lisp_Object Fintegerp (), Fnatnump (), Fsymbolp (); ! 767: extern Lisp_Object Fvectorp (), Fstringp (), Farrayp (), Fsequencep (); ! 768: extern Lisp_Object Fbufferp (), Fmarkerp (), Fsubrp (), Fchar_or_string_p (); ! 769: extern Lisp_Object Finteger_or_marker_p (); ! 770: ! 771: extern Lisp_Object Fcar (), Fcar_safe(), Fcdr (), Fcdr_safe(); ! 772: extern Lisp_Object Fsetcar (), Fsetcdr (); ! 773: extern Lisp_Object Fboundp (), Ffboundp (), Fmakunbound (), Ffmakunbound (); ! 774: extern Lisp_Object Fsymbol_function (), Fsymbol_plist (), Fsymbol_name (); ! 775: extern Lisp_Object Ffset (), Fsetplist (); ! 776: extern Lisp_Object Fsymbol_value (), Fset (); ! 777: extern Lisp_Object Fdefault_value (), Fset_default (); ! 778: ! 779: extern Lisp_Object Faref (), Faset (), Farray_length (); ! 780: ! 781: extern Lisp_Object Fstring_to_int (), Fint_to_string (); ! 782: extern Lisp_Object Feqlsign (), Fgtr (), Flss (), Fgeq (), Fleq (), Fneq (), Fzerop (); ! 783: extern Lisp_Object Fplus (), Fminus (), Ftimes (), Fquo (), Frem (), Fmax (), Fmin (); ! 784: extern Lisp_Object Flogand (), Flogior (), Flogxor (), Flognot (), Flsh (), Fash (); ! 785: extern Lisp_Object Fadd1 (), Fsub1 (); ! 786: ! 787: extern Lisp_Object make_number (); ! 788: extern void args_out_of_range (); ! 789: extern void args_out_of_range_3 (); ! 790: extern Lisp_Object wrong_type_argument (); ! 791: ! 792: /* Defined in fns.c */ ! 793: extern Lisp_Object Qstring_lessp; ! 794: extern Lisp_Object Vfeatures; ! 795: extern Lisp_Object Fidentity (), Frandom (); ! 796: extern Lisp_Object Flength (); ! 797: extern Lisp_Object Fappend (), Fconcat (), Fvconcat (), Fcopy_sequence (); ! 798: extern Lisp_Object Fsubstring (); ! 799: extern Lisp_Object Fnthcdr (), Fmemq (), Fassq (), Fassoc (); ! 800: extern Lisp_Object Frassq (), Fdelq (), Fsort (); ! 801: extern Lisp_Object Freverse (), Fnreverse (), Fget (), Fput (), Fequal (); ! 802: extern Lisp_Object Ffillarray (), Fnconc (), Fmapcar (), Fmapconcat (); ! 803: extern Lisp_Object Fy_or_n_p (), Fyes_or_no_p (); ! 804: extern Lisp_Object Ffeaturep (), Frequire () , Fprovide (); ! 805: extern Lisp_Object concat2 (), nconc2 (); ! 806: extern Lisp_Object assq_no_quit (); ! 807: ! 808: /* Defined in alloc.c */ ! 809: extern Lisp_Object Vpurify_flag; ! 810: extern Lisp_Object Fcons (), Flist(), Fmake_list (); ! 811: extern Lisp_Object Fmake_vector (), Fvector (), Fmake_symbol (), Fmake_marker (); ! 812: extern Lisp_Object Fmake_string (), build_string (), make_string(); ! 813: extern Lisp_Object Fpurecopy (), make_pure_string (); ! 814: extern Lisp_Object pure_cons (), make_pure_vector (); ! 815: extern Lisp_Object Fgarbage_collect (); ! 816: ! 817: /* Defined in print.c */ ! 818: extern Lisp_Object Vprin1_to_string_buffer; ! 819: extern Lisp_Object Fprin1 (), Fprin1_to_string (), Fprinc (); ! 820: extern Lisp_Object Fterpri (), Fprint (); ! 821: extern Lisp_Object Vstandard_output, Qstandard_output; ! 822: extern temp_output_buffer_setup (), temp_output_buffer_show (); ! 823: ! 824: /* Defined in lread.c */ ! 825: extern Lisp_Object Qvariable_documentation, Qstandard_input; ! 826: extern Lisp_Object Vobarray, Vstandard_input; ! 827: extern Lisp_Object Fread (), Fread_from_string (); ! 828: extern Lisp_Object Fintern (), Fintern_soft (), Fload (); ! 829: extern Lisp_Object Fget_file_char (), Fread_char (); ! 830: extern Lisp_Object Feval_current_buffer (), Feval_region (); ! 831: extern Lisp_Object intern (), oblookup (); ! 832: ! 833: /* Defined in eval.c */ ! 834: extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; ! 835: extern Lisp_Object Vinhibit_quit, Vquit_flag, Qinhibit_quit; ! 836: extern Lisp_Object Vmocklisp_arguments, Qmocklisp, Qmocklisp_arguments; ! 837: extern Lisp_Object Vautoload_queue; ! 838: extern Lisp_Object Fand (), For (), Fif (), Fprogn (), Fprog1 (), Fprog2 (); ! 839: extern Lisp_Object Fsetq (), Fquote (); ! 840: extern Lisp_Object Fuser_variable_p (), Finteractive_p (); ! 841: extern Lisp_Object Fdefun (), Flet (), FletX (), Fwhile (); ! 842: extern Lisp_Object Fcatch (), Fthrow (), Funwind_protect (); ! 843: extern Lisp_Object Fcondition_case (), Fsignal (); ! 844: extern Lisp_Object Ffunction_type (), Fautoload (), Fcommandp (); ! 845: extern Lisp_Object Feval (), Fapply (), Ffuncall (); ! 846: extern Lisp_Object Fglobal_set (), Fglobal_value (), Fbacktrace (); ! 847: extern Lisp_Object apply1 (), call0 (), call1 (), call2 (), call3 (); ! 848: extern Lisp_Object apply_lambda (); ! 849: extern Lisp_Object internal_catch (); ! 850: extern Lisp_Object internal_condition_case (); ! 851: extern void unbind_to (); ! 852: extern void error (); ! 853: extern Lisp_Object un_autoload (); ! 854: ! 855: /* Defined in editfns.c */ ! 856: extern Lisp_Object Vprefix_arg, Qminus, Vcurrent_prefix_arg; ! 857: extern Lisp_Object Fgoto_char (); ! 858: extern Lisp_Object Fpoint_min_marker (), Fpoint_max_marker (); ! 859: extern Lisp_Object Fpoint_min (), Fpoint_max (); ! 860: extern Lisp_Object Fpoint (), Fpoint_marker (), Fmark_marker (); ! 861: extern Lisp_Object Ffollchar (), Fprevchar (), Fchar_after (), Finsert (); ! 862: extern Lisp_Object Feolp (), Feobp (), Fbolp (), Fbobp (); ! 863: extern Lisp_Object Fformat (), format1 (); ! 864: extern Lisp_Object Fbuffer_substring (), Fbuffer_string (); ! 865: extern Lisp_Object Fstring_equal (), Fstring_lessp (), Fbuffer_substring_lessp (); ! 866: extern Lisp_Object save_excursion_save (), save_restriction_save (); ! 867: extern Lisp_Object save_excursion_restore (), save_restriction_restore (); ! 868: extern Lisp_Object Fchar_to_string (); ! 869: ! 870: /* defined in buffer.c */ ! 871: extern Lisp_Object Vbuffer_alist; ! 872: extern Lisp_Object Fget_buffer (), Fget_buffer_create (), Fset_buffer (); ! 873: extern Lisp_Object Fbarf_if_buffer_read_only (); ! 874: extern Lisp_Object Fcurrent_buffer (), Fswitch_to_buffer (), Fpop_to_buffer (); ! 875: extern Lisp_Object Fother_buffer (); ! 876: extern struct buffer *all_buffers; ! 877: ! 878: /* defined in marker.c */ ! 879: ! 880: extern Lisp_Object Fmarker_position (), Fmarker_buffer (); ! 881: extern Lisp_Object Fcopy_marker (); ! 882: ! 883: /* Defined in fileio.c */ ! 884: ! 885: extern Lisp_Object Qfile_error; ! 886: extern Lisp_Object Ffile_name_as_directory (); ! 887: extern Lisp_Object Fexpand_file_name (), Ffile_name_nondirectory (); ! 888: extern Lisp_Object Fsubstitute_in_file_name (); ! 889: extern Lisp_Object Ffile_symlink_p (); ! 890: ! 891: /* Defined in abbrev.c */ ! 892: ! 893: extern Lisp_Object Vfundamental_mode_abbrev_table; ! 894: ! 895: /* defined in search.c */ ! 896: extern unsigned char downcase_table[]; ! 897: extern Lisp_Object Fstring_match (); ! 898: extern Lisp_Object Fscan_buffer (); ! 899: ! 900: /* defined in minibuf.c */ ! 901: ! 902: extern Lisp_Object last_minibuf_string, Vminibuffer_list; ! 903: extern Lisp_Object read_minibuf (), Fcompleting_read (); ! 904: extern Lisp_Object Fread_from_minibuffer (); ! 905: extern Lisp_Object Fread_variable (); ! 906: extern Lisp_Object Fread_minibuffer (), Feval_minibuffer (); ! 907: extern Lisp_Object Fread_string (), Fread_file_name (); ! 908: extern Lisp_Object Fread_no_blanks_input (); ! 909: ! 910: /* Defined in callint.c */ ! 911: ! 912: extern Lisp_Object Vcommand_history; ! 913: extern Lisp_Object Qcall_interactively; ! 914: extern Lisp_Object Fcall_interactively (); ! 915: extern Lisp_Object Fprefix_numeric_value (); ! 916: ! 917: /* defined in casefiddle.c */ ! 918: ! 919: extern Lisp_Object Fdowncase (), Fupcase (), Fcapitalize (); ! 920: ! 921: /* defined in keyboard.c */ ! 922: ! 923: extern Lisp_Object Vhelp_form, Vtop_level; ! 924: extern Lisp_Object Fdiscard_input (), Frecursive_edit (); ! 925: extern Lisp_Object Fcommand_execute (), Finput_pending_p (); ! 926: extern int poll_suppress_count; ! 927: ! 928: /* defined in keymap.c */ ! 929: ! 930: extern Lisp_Object Qkeymap; ! 931: extern Lisp_Object Fkey_description (), Fsingle_key_description (); ! 932: extern Lisp_Object Fwhere_is_internal (); ! 933: extern Lisp_Object access_keymap (), store_in_keymap (); ! 934: extern Lisp_Object get_keyelt (), get_keymap(); ! 935: ! 936: /* defined in indent.c */ ! 937: extern Lisp_Object Fvertical_motion (), Findent_to (), Fcurrent_column (); ! 938: ! 939: /* defined in window.c */ ! 940: extern Lisp_Object Qwindowp; ! 941: extern Lisp_Object Fget_buffer_window (); ! 942: extern Lisp_Object Fsave_window_excursion (); ! 943: extern Lisp_Object Fset_window_configuration (), Fcurrent_window_configuration (); ! 944: ! 945: /* defined in emacs.c */ ! 946: extern Lisp_Object decode_env_path (); ! 947: /* Nonzero means don't do interactive redisplay and don't change tty modes */ ! 948: extern int noninteractive; ! 949: /* Nonzero means don't do use window-system-specific display code */ ! 950: extern int inhibit_window_system; ! 951: ! 952: /* defined in process.c */ ! 953: extern Lisp_Object Fget_process (), Fget_buffer_process (), Fprocessp (); ! 954: extern Lisp_Object Fprocess_status (), Fkill_process (); ! 955: ! 956: /* defined in callproc.c */ ! 957: extern Lisp_Object Vexec_path, Vexec_directory; ! 958: ! 959: #ifdef MAINTAIN_ENVIRONMENT ! 960: /* defined in environ.c */ ! 961: extern int size_of_current_environ (); ! 962: extern void get_current_environ (); ! 963: /* extern void current_environ (); */ ! 964: extern Lisp_Object Fgetenv (); ! 965: #endif /* MAINTAIN_ENVIRONMENT */ ! 966: ! 967: /* defined in doc.c */ ! 968: extern Lisp_Object Vdoc_file_name; ! 969: extern Lisp_Object Fsubstitute_command_keys (); ! 970: extern Lisp_Object Fdocumentation (), Fdocumentation_property (); ! 971: ! 972: /* defined in bytecode.c */ ! 973: extern Lisp_Object Qbytecode; ! 974: ! 975: /* defined in macros.c */ ! 976: extern Lisp_Object Fexecute_kbd_macro (); ! 977: ! 978: /* Nonzero means Emacs has already been initialized. ! 979: Used during startup to detect startup of dumped Emacs. */ ! 980: extern int initialized; ! 981: ! 982: extern int immediate_quit; /* Nonzero means ^G can quit instantly */ ! 983: ! 984: extern void debugger (); ! 985: ! 986: extern char *malloc (), *realloc (), *getenv (), *ctime (), *getwd (); ! 987: extern long *xmalloc (), *xrealloc (); ! 988: ! 989: #ifdef MAINTAIN_ENVIRONMENT ! 990: extern unsigned char *egetenv (); ! 991: #else ! 992: #define egetenv getenv ! 993: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.