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