comparison src/data.c @ 10605:bc37b55fcbb9

(do_symval_forwarding): Handle display-local vars. (store_symval_forwarding, find_symbol_value): Likewise. (Fmake_variable_buffer_local): Disallow display-local vars here. (Fmake_local_variable): Likewise.
author Karl Heuer <kwzh@gnu.org>
date Tue, 31 Jan 1995 00:52:50 +0000
parents 2ab3bd0288a9
children 4eeb2d49d841
comparison
equal deleted inserted replaced
10604:c954d143db84 10605:bc37b55fcbb9
640 return *XOBJFWD (valcontents)->objvar; 640 return *XOBJFWD (valcontents)->objvar;
641 641
642 case Lisp_Misc_Buffer_Objfwd: 642 case Lisp_Misc_Buffer_Objfwd:
643 offset = XBUFFER_OBJFWD (valcontents)->offset; 643 offset = XBUFFER_OBJFWD (valcontents)->offset;
644 return *(Lisp_Object *)(offset + (char *)current_buffer); 644 return *(Lisp_Object *)(offset + (char *)current_buffer);
645
646 case Lisp_Misc_Display_Objfwd:
647 offset = XDISPLAY_OBJFWD (valcontents)->offset;
648 return *(Lisp_Object *)(offset
649 + (char *)get_perdisplay (selected_frame));
645 } 650 }
646 return valcontents; 651 return valcontents;
647 } 652 }
648 653
649 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell 654 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell
683 if (! NILP (type) && ! NILP (newval) 688 if (! NILP (type) && ! NILP (newval)
684 && XTYPE (newval) != XINT (type)) 689 && XTYPE (newval) != XINT (type))
685 buffer_slot_type_mismatch (offset); 690 buffer_slot_type_mismatch (offset);
686 691
687 *(Lisp_Object *)(offset + (char *)current_buffer) = newval; 692 *(Lisp_Object *)(offset + (char *)current_buffer) = newval;
688 break;
689 } 693 }
694 break;
695
696 case Lisp_Misc_Display_Objfwd:
697 (*(Lisp_Object *)((char *)get_perdisplay (selected_frame)
698 + XDISPLAY_OBJFWD (valcontents)->offset))
699 = newval;
700 break;
701
690 default: 702 default:
691 goto def; 703 goto def;
692 } 704 }
693 break; 705 break;
694 706
709 721
710 static Lisp_Object 722 static Lisp_Object
711 swap_in_symval_forwarding (sym, valcontents) 723 swap_in_symval_forwarding (sym, valcontents)
712 Lisp_Object sym, valcontents; 724 Lisp_Object sym, valcontents;
713 { 725 {
714 /* valcontents is a list 726 /* valcontents is a pointer to a struct resembling the cons
715 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)). 727 (REALVALUE BUFFER CURRENT-ALIST-ELEMENT . DEFAULT-VALUE)).
716 728
717 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's 729 CURRENT-ALIST-ELEMENT is a pointer to an element of BUFFER's
718 local_var_alist, that being the element whose car is this 730 local_var_alist, that being the element whose car is this
719 variable. Or it can be a pointer to the 731 variable. Or it can be a pointer to the
720 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have 732 (CURRENT-ALIST-ELEMENT . DEFAULT-VALUE), if BUFFER does not have
721 an element in its alist for this variable. 733 an element in its alist for this variable.
782 return *XOBJFWD (valcontents)->objvar; 794 return *XOBJFWD (valcontents)->objvar;
783 795
784 case Lisp_Misc_Buffer_Objfwd: 796 case Lisp_Misc_Buffer_Objfwd:
785 return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset 797 return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset
786 + (char *)current_buffer); 798 + (char *)current_buffer);
799
800 case Lisp_Misc_Display_Objfwd:
801 return *(Lisp_Object *)(XDISPLAY_OBJFWD (valcontents)->offset
802 + (char *)get_perdisplay (selected_frame));
787 } 803 }
788 } 804 }
789 805
790 return valcontents; 806 return valcontents;
791 } 807 }
1099 { 1115 {
1100 register Lisp_Object tem, valcontents, newval; 1116 register Lisp_Object tem, valcontents, newval;
1101 1117
1102 CHECK_SYMBOL (sym, 0); 1118 CHECK_SYMBOL (sym, 0);
1103 1119
1104 if (EQ (sym, Qnil) || EQ (sym, Qt)) 1120 valcontents = XSYMBOL (sym)->value;
1121 if (EQ (sym, Qnil) || EQ (sym, Qt) || DISPLAY_OBJFWDP (valcontents))
1105 error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data); 1122 error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
1106 1123
1107 valcontents = XSYMBOL (sym)->value;
1108 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) 1124 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
1109 return sym; 1125 return sym;
1110 if (SOME_BUFFER_LOCAL_VALUEP (valcontents)) 1126 if (SOME_BUFFER_LOCAL_VALUEP (valcontents))
1111 { 1127 {
1112 XMISC (XSYMBOL (sym)->value)->type = Lisp_Misc_Buffer_Local_Value; 1128 XMISC (XSYMBOL (sym)->value)->type = Lisp_Misc_Buffer_Local_Value;
1142 { 1158 {
1143 register Lisp_Object tem, valcontents; 1159 register Lisp_Object tem, valcontents;
1144 1160
1145 CHECK_SYMBOL (sym, 0); 1161 CHECK_SYMBOL (sym, 0);
1146 1162
1147 if (EQ (sym, Qnil) || EQ (sym, Qt)) 1163 valcontents = XSYMBOL (sym)->value;
1164 if (EQ (sym, Qnil) || EQ (sym, Qt) || DISPLAY_OBJFWDP (valcontents))
1148 error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data); 1165 error ("Symbol %s may not be buffer-local", XSYMBOL (sym)->name->data);
1149 1166
1150 valcontents = XSYMBOL (sym)->value;
1151 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents)) 1167 if (BUFFER_LOCAL_VALUEP (valcontents) || BUFFER_OBJFWDP (valcontents))
1152 { 1168 {
1153 tem = Fboundp (sym); 1169 tem = Fboundp (sym);
1154 1170
1155 /* Make sure the symbol has a local value in this particular buffer, 1171 /* Make sure the symbol has a local value in this particular buffer,
1156 by setting it to the same value it already has. */ 1172 by setting it to the same value it already has. */
1157 Fset (sym, (EQ (tem, Qt) ? Fsymbol_value (sym) : Qunbound)); 1173 Fset (sym, (EQ (tem, Qt) ? Fsymbol_value (sym) : Qunbound));
1158 return sym; 1174 return sym;
1159 } 1175 }
1574 if (FLOATP (num)) 1590 if (FLOATP (num))
1575 { 1591 {
1576 char pigbuf[350]; /* see comments in float_to_string */ 1592 char pigbuf[350]; /* see comments in float_to_string */
1577 1593
1578 float_to_string (pigbuf, XFLOAT(num)->data); 1594 float_to_string (pigbuf, XFLOAT(num)->data);
1579 return build_string (pigbuf); 1595 return build_string (pigbuf);
1580 } 1596 }
1581 #endif /* LISP_FLOAT_TYPE */ 1597 #endif /* LISP_FLOAT_TYPE */
1582 1598
1583 sprintf (buffer, "%d", XINT (num)); 1599 sprintf (buffer, "%d", XINT (num));
1584 return build_string (buffer); 1600 return build_string (buffer);
1607 return make_float (atof (p)); 1623 return make_float (atof (p));
1608 #endif /* LISP_FLOAT_TYPE */ 1624 #endif /* LISP_FLOAT_TYPE */
1609 1625
1610 return make_number (atoi (p)); 1626 return make_number (atoi (p));
1611 } 1627 }
1612 1628
1613 enum arithop 1629 enum arithop
1614 { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin }; 1630 { Aadd, Asub, Amult, Adiv, Alogand, Alogior, Alogxor, Amax, Amin };
1615 1631
1616 extern Lisp_Object float_arith_driver (); 1632 extern Lisp_Object float_arith_driver ();
1617 1633
1696 int nargs; 1712 int nargs;
1697 register Lisp_Object *args; 1713 register Lisp_Object *args;
1698 { 1714 {
1699 register Lisp_Object val; 1715 register Lisp_Object val;
1700 double next; 1716 double next;
1701 1717
1702 for (; argnum < nargs; argnum++) 1718 for (; argnum < nargs; argnum++)
1703 { 1719 {
1704 val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */ 1720 val = args[argnum]; /* using args[argnum] as argument to CHECK_NUMBER_... */
1705 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum); 1721 CHECK_NUMBER_OR_FLOAT_COERCE_MARKER (val, argnum);
1706 1722
1862 i1 = XINT (num1); 1878 i1 = XINT (num1);
1863 i2 = XINT (num2); 1879 i2 = XINT (num2);
1864 1880
1865 if (i2 == 0) 1881 if (i2 == 0)
1866 Fsignal (Qarith_error, Qnil); 1882 Fsignal (Qarith_error, Qnil);
1867 1883
1868 i1 %= i2; 1884 i1 %= i2;
1869 1885
1870 /* If the "remainder" comes out with the wrong sign, fix it. */ 1886 /* If the "remainder" comes out with the wrong sign, fix it. */
1871 if ((i1 < 0) != (i2 < 0)) 1887 if ((i1 < 0) != (i2 < 0))
1872 i1 += i2; 1888 i1 += i2;
2372 #ifndef CANNOT_DUMP 2388 #ifndef CANNOT_DUMP
2373 if (!initialized) 2389 if (!initialized)
2374 return; 2390 return;
2375 #endif /* CANNOT_DUMP */ 2391 #endif /* CANNOT_DUMP */
2376 signal (SIGFPE, arith_error); 2392 signal (SIGFPE, arith_error);
2377 2393
2378 #ifdef uts 2394 #ifdef uts
2379 signal (SIGEMT, arith_error); 2395 signal (SIGEMT, arith_error);
2380 #endif /* uts */ 2396 #endif /* uts */
2381 } 2397 }