aboutsummaryrefslogtreecommitdiffstats
path: root/src/data.c
diff options
context:
space:
mode:
authorGerd Moellmann2001-03-15 09:44:10 +0000
committerGerd Moellmann2001-03-15 09:44:10 +0000
commit7a283f3621d1901aa66313973d67a868bc8f4404 (patch)
tree457e421579513366e7923cf04fd36f61fdea64d5 /src/data.c
parent9b3a7dad95f249e368deadec1504ebf92970c288 (diff)
downloademacs-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.c116
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
4This file is part of GNU Emacs. 5This file is part of GNU Emacs.
5 6
@@ -92,9 +93,7 @@ static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
92static Lisp_Object Qchar_table, Qbool_vector, Qhash_table; 93static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
93static Lisp_Object Qsubrp, Qmany, Qunevalled; 94static Lisp_Object Qsubrp, Qmany, Qunevalled;
94 95
95static Lisp_Object swap_in_symval_forwarding (); 96static Lisp_Object swap_in_symval_forwarding P_ ((Lisp_Object, Lisp_Object));
96
97Lisp_Object set_internal ();
98 97
99Lisp_Object 98Lisp_Object
100wrong_type_argument (predicate, value) 99wrong_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
778void 780void
779store_symval_forwarding (symbol, valcontents, newval) 781store_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
2276enum arithop 2284enum arithop
2277 { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin }; 2285 {
2278 2286 Aadd,
2279extern Lisp_Object float_arith_driver (); 2287 Asub,
2288 Amult,
2289 Adiv,
2290 Alogand,
2291 Alogior,
2292 Alogxor,
2293 Amax,
2294 Amin
2295 };
2296
2297static Lisp_Object float_arith_driver P_ ((double, int, enum arithop,
2298 int, Lisp_Object *));
2280extern Lisp_Object fmod_float (); 2299extern Lisp_Object fmod_float ();
2281 2300
2282Lisp_Object 2301Lisp_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
2347Lisp_Object 2389static Lisp_Object
2348float_arith_driver (accum, argnum, code, nargs, args) 2390float_arith_driver (accum, argnum, code, nargs, args)
2349 double accum; 2391 double accum;
2350 register int argnum; 2392 register int argnum;