diff options
| author | Gerd Moellmann | 2001-03-15 09:44:10 +0000 |
|---|---|---|
| committer | Gerd Moellmann | 2001-03-15 09:44:10 +0000 |
| commit | 7a283f3621d1901aa66313973d67a868bc8f4404 (patch) | |
| tree | 457e421579513366e7923cf04fd36f61fdea64d5 /src/data.c | |
| parent | 9b3a7dad95f249e368deadec1504ebf92970c288 (diff) | |
| download | emacs-7a283f3621d1901aa66313973d67a868bc8f4404.tar.gz emacs-7a283f3621d1901aa66313973d67a868bc8f4404.zip | |
(store_symval_forwarding): Add parameter BUF. If BUF is
non-null, set a per-buffer value in BUF instead of the current
buffer.
(swap_in_global_binding, swap_in_symval_forwarding, Fset_default):
Call store_symval_forwarding with BUF null.
(set_internal): Call store_symval_forwarding with the BUF
parameter passed to set_internal. Formerly, the value was always
set in the current buffer; the buffer recorded in specbind for
this case wasn't used.
(arith_driver): Reindent.
Diffstat (limited to 'src/data.c')
| -rw-r--r-- | src/data.c | 116 |
1 files changed, 79 insertions, 37 deletions
diff --git a/src/data.c b/src/data.c index a85c3c0179a..b635cb5619b 100644 --- a/src/data.c +++ b/src/data.c | |||
| @@ -1,5 +1,6 @@ | |||
| 1 | /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. | 1 | /* Primitive operations on Lisp data types for GNU Emacs Lisp interpreter. |
| 2 | Copyright (C) 1985,86,88,93,94,95,97,98,99,2000 Free Software Foundation, Inc. | 2 | Copyright (C) 1985,86,88,93,94,95,97,98,99, 2000, 2001 |
| 3 | Free Software Foundation, Inc. | ||
| 3 | 4 | ||
| 4 | This file is part of GNU Emacs. | 5 | This file is part of GNU Emacs. |
| 5 | 6 | ||
| @@ -92,9 +93,7 @@ static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector; | |||
| 92 | static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; | 93 | static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; |
| 93 | static Lisp_Object Qsubrp, Qmany, Qunevalled; | 94 | static Lisp_Object Qsubrp, Qmany, Qunevalled; |
| 94 | 95 | ||
| 95 | static Lisp_Object swap_in_symval_forwarding (); | 96 | static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object)); |
| 96 | |||
| 97 | Lisp_Object set_internal (); | ||
| 98 | 97 | ||
| 99 | Lisp_Object | 98 | Lisp_Object |
| 100 | wrong_type_argument (predicate, value) | 99 | wrong_type_argument (predicate, value) |
| @@ -773,12 +772,16 @@ do_symval_forwarding (valcontents) | |||
| 773 | /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell | 772 | /* Store NEWVAL into SYMBOL, where VALCONTENTS is found in the value cell |
| 774 | of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the | 773 | of SYMBOL. If SYMBOL is buffer-local, VALCONTENTS should be the |
| 775 | buffer-independent contents of the value cell: forwarded just one | 774 | buffer-independent contents of the value cell: forwarded just one |
| 776 | step past the buffer-localness. */ | 775 | step past the buffer-localness. |
| 776 | |||
| 777 | BUF non-zero means set the value in buffer BUF instead of the | ||
| 778 | current buffer. This only plays a role for per-buffer variables. */ | ||
| 777 | 779 | ||
| 778 | void | 780 | void |
| 779 | store_symval_forwarding (symbol, valcontents, newval) | 781 | store_symval_forwarding (symbol, valcontents, newval, buf) |
| 780 | Lisp_Object symbol; | 782 | Lisp_Object symbol; |
| 781 | register Lisp_Object valcontents, newval; | 783 | register Lisp_Object valcontents, newval; |
| 784 | struct buffer *buf; | ||
| 782 | { | 785 | { |
| 783 | switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) | 786 | switch (SWITCH_ENUM_CAST (XTYPE (valcontents))) |
| 784 | { | 787 | { |
| @@ -814,14 +817,18 @@ store_symval_forwarding (symbol, valcontents, newval) | |||
| 814 | && XTYPE (newval) != XINT (type)) | 817 | && XTYPE (newval) != XINT (type)) |
| 815 | buffer_slot_type_mismatch (offset); | 818 | buffer_slot_type_mismatch (offset); |
| 816 | 819 | ||
| 817 | PER_BUFFER_VALUE (current_buffer, offset) = newval; | 820 | if (buf == NULL) |
| 821 | buf = current_buffer; | ||
| 822 | PER_BUFFER_VALUE (buf, offset) = newval; | ||
| 818 | } | 823 | } |
| 819 | break; | 824 | break; |
| 820 | 825 | ||
| 821 | case Lisp_Misc_Kboard_Objfwd: | 826 | case Lisp_Misc_Kboard_Objfwd: |
| 822 | (*(Lisp_Object *)((char *)current_kboard | 827 | { |
| 823 | + XKBOARD_OBJFWD (valcontents)->offset)) | 828 | char *base = (char *) current_kboard; |
| 824 | = newval; | 829 | char *p = base + XKBOARD_OBJFWD (valcontents)->offset; |
| 830 | *(Lisp_Object *) p = newval; | ||
| 831 | } | ||
| 825 | break; | 832 | break; |
| 826 | 833 | ||
| 827 | default: | 834 | default: |
| @@ -861,7 +868,7 @@ swap_in_global_binding (symbol) | |||
| 861 | 868 | ||
| 862 | /* Select the global binding in the symbol. */ | 869 | /* Select the global binding in the symbol. */ |
| 863 | XCAR (cdr) = cdr; | 870 | XCAR (cdr) = cdr; |
| 864 | store_symval_forwarding (symbol, valcontents, XCDR (cdr)); | 871 | store_symval_forwarding (symbol, valcontents, XCDR (cdr), NULL); |
| 865 | 872 | ||
| 866 | /* Indicate that the global binding is set up now. */ | 873 | /* Indicate that the global binding is set up now. */ |
| 867 | XBUFFER_LOCAL_VALUE (valcontents)->frame = Qnil; | 874 | XBUFFER_LOCAL_VALUE (valcontents)->frame = Qnil; |
| @@ -915,7 +922,7 @@ swap_in_symval_forwarding (symbol, valcontents) | |||
| 915 | XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; | 922 | XBUFFER_LOCAL_VALUE (valcontents)->frame = selected_frame; |
| 916 | store_symval_forwarding (symbol, | 923 | store_symval_forwarding (symbol, |
| 917 | XBUFFER_LOCAL_VALUE (valcontents)->realvalue, | 924 | XBUFFER_LOCAL_VALUE (valcontents)->realvalue, |
| 918 | Fcdr (tem1)); | 925 | Fcdr (tem1), NULL); |
| 919 | } | 926 | } |
| 920 | return XBUFFER_LOCAL_VALUE (valcontents)->realvalue; | 927 | return XBUFFER_LOCAL_VALUE (valcontents)->realvalue; |
| 921 | } | 928 | } |
| @@ -1136,9 +1143,9 @@ set_internal (symbol, newval, buf, bindflag) | |||
| 1136 | /* If storing void (making the symbol void), forward only through | 1143 | /* If storing void (making the symbol void), forward only through |
| 1137 | buffer-local indicator, not through Lisp_Objfwd, etc. */ | 1144 | buffer-local indicator, not through Lisp_Objfwd, etc. */ |
| 1138 | if (voide) | 1145 | if (voide) |
| 1139 | store_symval_forwarding (symbol, Qnil, newval); | 1146 | store_symval_forwarding (symbol, Qnil, newval, buf); |
| 1140 | else | 1147 | else |
| 1141 | store_symval_forwarding (symbol, innercontents, newval); | 1148 | store_symval_forwarding (symbol, innercontents, newval, buf); |
| 1142 | 1149 | ||
| 1143 | /* If we just set a variable whose current binding is frame-local, | 1150 | /* If we just set a variable whose current binding is frame-local, |
| 1144 | store the new value in the frame parameter too. */ | 1151 | store the new value in the frame parameter too. */ |
| @@ -1282,8 +1289,9 @@ for this variable.") | |||
| 1282 | = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); | 1289 | = XCAR (XBUFFER_LOCAL_VALUE (valcontents)->cdr); |
| 1283 | alist_element_buffer = Fcar (current_alist_element); | 1290 | alist_element_buffer = Fcar (current_alist_element); |
| 1284 | if (EQ (alist_element_buffer, current_alist_element)) | 1291 | if (EQ (alist_element_buffer, current_alist_element)) |
| 1285 | store_symval_forwarding (symbol, XBUFFER_LOCAL_VALUE (valcontents)->realvalue, | 1292 | store_symval_forwarding (symbol, |
| 1286 | value); | 1293 | XBUFFER_LOCAL_VALUE (valcontents)->realvalue, |
| 1294 | value, NULL); | ||
| 1287 | 1295 | ||
| 1288 | return value; | 1296 | return value; |
| 1289 | } | 1297 | } |
| @@ -2274,9 +2282,20 @@ If the base used is not 10, floating point is not recognized.") | |||
| 2274 | 2282 | ||
| 2275 | 2283 | ||
| 2276 | enum arithop | 2284 | enum arithop |
| 2277 | { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin }; | 2285 | { |
| 2278 | 2286 | Aadd, | |
| 2279 | extern Lisp_Object float_arith_driver (); | 2287 | Asub, |
| 2288 | Amult, | ||
| 2289 | Adiv, | ||
| 2290 | Alogand, | ||
| 2291 | Alogior, | ||
| 2292 | Alogxor, | ||
| 2293 | Amax, | ||
| 2294 | Amin | ||
| 2295 | }; | ||
| 2296 | |||
| 2297 | static Lisp_Object float_arith_driver P_ ((double, int, enum arithop, | ||
| 2298 | int, Lisp_Object *)); | ||
| 2280 | extern Lisp_Object fmod_float (); | 2299 | extern Lisp_Object fmod_float (); |
| 2281 | 2300 | ||
| 2282 | Lisp_Object | 2301 | Lisp_Object |
| @@ -2287,7 +2306,7 @@ arith_driver (code, nargs, args) | |||
| 2287 | { | 2306 | { |
| 2288 | register Lisp_Object val; | 2307 | register Lisp_Object val; |
| 2289 | register int argnum; | 2308 | register int argnum; |
| 2290 | register EMACS_INT accum; | 2309 | register EMACS_INT accum = 0; |
| 2291 | register EMACS_INT next; | 2310 | register EMACS_INT next; |
| 2292 | 2311 | ||
| 2293 | switch (SWITCH_ENUM_CAST (code)) | 2312 | switch (SWITCH_ENUM_CAST (code)) |
| @@ -2296,32 +2315,43 @@ arith_driver (code, nargs, args) | |||
| 2296 | case Alogxor: | 2315 | case Alogxor: |
| 2297 | case Aadd: | 2316 | case Aadd: |
| 2298 | case Asub: | 2317 | case Asub: |
| 2299 | accum = 0; break; | 2318 | accum = 0; |
| 2319 | break; | ||
| 2300 | case Amult: | 2320 | case Amult: |
| 2301 | accum = 1; break; | 2321 | accum = 1; |
| 2322 | break; | ||
| 2302 | case Alogand: | 2323 | case Alogand: |
| 2303 | accum = -1; break; | 2324 | accum = -1; |
| 2325 | break; | ||
| 2326 | default: | ||
| 2327 | break; | ||
| 2304 | } | 2328 | } |
| 2305 | 2329 | ||
| 2306 | for (argnum = 0; argnum < nargs; argnum++) | 2330 | for (argnum = 0; argnum < nargs; argnum++) |
| 2307 | { | 2331 | { |
| 2308 | val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ | 2332 | /* Using args[argnum] as argument to CHECK_NUMBER_... */ |
| 2333 | val = args[argnum]; | ||
| 2309 | CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); | 2334 | CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); |
| 2310 | 2335 | ||
| 2311 | if (FLOATP (val)) /* time to do serious math */ | 2336 | if (FLOATP (val)) |
| 2312 | return (float_arith_driver ((double) accum, argnum, code, | 2337 | return float_arith_driver ((double) accum, argnum, code, |
| 2313 | nargs, args)); | 2338 | nargs, args); |
| 2314 | args[argnum] = val; /* runs into a compiler bug. */ | 2339 | args[argnum] = val; |
| 2315 | next = XINT (args[argnum]); | 2340 | next = XINT (args[argnum]); |
| 2316 | switch (SWITCH_ENUM_CAST (code)) | 2341 | switch (SWITCH_ENUM_CAST (code)) |
| 2317 | { | 2342 | { |
| 2318 | case Aadd: accum += next; break; | 2343 | case Aadd: |
| 2344 | accum += next; | ||
| 2345 | break; | ||
| 2319 | case Asub: | 2346 | case Asub: |
| 2320 | accum = argnum ? accum - next : nargs == 1 ? - next : next; | 2347 | accum = argnum ? accum - next : nargs == 1 ? - next : next; |
| 2321 | break; | 2348 | break; |
| 2322 | case Amult: accum *= next; break; | 2349 | case Amult: |
| 2350 | accum *= next; | ||
| 2351 | break; | ||
| 2323 | case Adiv: | 2352 | case Adiv: |
| 2324 | if (!argnum) accum = next; | 2353 | if (!argnum) |
| 2354 | accum = next; | ||
| 2325 | else | 2355 | else |
| 2326 | { | 2356 | { |
| 2327 | if (next == 0) | 2357 | if (next == 0) |
| @@ -2329,11 +2359,23 @@ arith_driver (code, nargs, args) | |||
| 2329 | accum /= next; | 2359 | accum /= next; |
| 2330 | } | 2360 | } |
| 2331 | break; | 2361 | break; |
| 2332 | case Alogand: accum &= next; break; | 2362 | case Alogand: |
| 2333 | case Alogior: accum |= next; break; | 2363 | accum &= next; |
| 2334 | case Alogxor: accum ^= next; break; | 2364 | break; |
| 2335 | case Amax: if (!argnum || next > accum) accum = next; break; | 2365 | case Alogior: |
| 2336 | case Amin: if (!argnum || next < accum) accum = next; break; | 2366 | accum |= next; |
| 2367 | break; | ||
| 2368 | case Alogxor: | ||
| 2369 | accum ^= next; | ||
| 2370 | break; | ||
| 2371 | case Amax: | ||
| 2372 | if (!argnum || next > accum) | ||
| 2373 | accum = next; | ||
| 2374 | break; | ||
| 2375 | case Amin: | ||
| 2376 | if (!argnum || next < accum) | ||
| 2377 | accum = next; | ||
| 2378 | break; | ||
| 2337 | } | 2379 | } |
| 2338 | } | 2380 | } |
| 2339 | 2381 | ||
| @@ -2344,7 +2386,7 @@ arith_driver (code, nargs, args) | |||
| 2344 | #undef isnan | 2386 | #undef isnan |
| 2345 | #define isnan(x) ((x) != (x)) | 2387 | #define isnan(x) ((x) != (x)) |
| 2346 | 2388 | ||
| 2347 | Lisp_Object | 2389 | static Lisp_Object |
| 2348 | float_arith_driver (accum, argnum, code, nargs, args) | 2390 | float_arith_driver (accum, argnum, code, nargs, args) |
| 2349 | double accum; | 2391 | double accum; |
| 2350 | register int argnum; | 2392 | register int argnum; |