comparison src/data.c @ 9465:ea2ee8bd3c63

(do_symval_forwarding, store_symval_forwarding, find_symbol_value, Fset, default_value, Fset_default, Fkill_local_variable): Use the new substructure. (store_symval_forwarding): Change args to buffer_slot_type_mismatch.
author Karl Heuer <kwzh@gnu.org>
date Wed, 12 Oct 1994 05:15:21 +0000
parents 379c7b900689
children 8a68b5794c91
comparison
equal deleted inserted replaced
9464:4bb620c9a075 9465:ea2ee8bd3c63
624 Lisp_Object 624 Lisp_Object
625 do_symval_forwarding (valcontents) 625 do_symval_forwarding (valcontents)
626 register Lisp_Object valcontents; 626 register Lisp_Object valcontents;
627 { 627 {
628 register Lisp_Object val; 628 register Lisp_Object val;
629 int offset;
630 if (MISCP (valcontents))
631 switch (XMISC (valcontents)->type)
632 {
633 case Lisp_Misc_Intfwd:
634 XSETINT (val, *XINTFWD (valcontents)->intvar);
635 return val;
636
637 case Lisp_Misc_Boolfwd:
638 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
639
640 case Lisp_Misc_Objfwd:
641 return *XOBJFWD (valcontents)->objvar;
642
643 case Lisp_Misc_Buffer_Objfwd:
644 offset = XBUFFER_OBJFWD (valcontents)->offset;
645 return *(Lisp_Object *)(offset + (char *)current_buffer);
646 }
647 return valcontents;
648 }
649
650 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell
651 of SYM. If SYM is buffer-local, VALCONTENTS should be the
652 buffer-independent contents of the value cell: forwarded just one
653 step past the buffer-localness. */
654
655 void
656 store_symval_forwarding (sym, valcontents, newval)
657 Lisp_Object sym;
658 register Lisp_Object valcontents, newval;
659 {
629 #ifdef SWITCH_ENUM_BUG 660 #ifdef SWITCH_ENUM_BUG
630 switch ((int) XTYPE (valcontents)) 661 switch ((int) XTYPE (valcontents))
631 #else 662 #else
632 switch (XTYPE (valcontents)) 663 switch (XTYPE (valcontents))
633 #endif 664 #endif
634 { 665 {
635 case Lisp_Intfwd: 666 case Lisp_Misc:
636 XSETINT (val, *XINTPTR (valcontents)); 667 switch (XMISC (valcontents)->type)
637 return val; 668 {
638 669 case Lisp_Misc_Intfwd:
639 case Lisp_Boolfwd: 670 CHECK_NUMBER (newval, 1);
640 if (*XINTPTR (valcontents)) 671 *XINTFWD (valcontents)->intvar = XINT (newval);
641 return Qt; 672 break;
642 return Qnil; 673
643 674 case Lisp_Misc_Boolfwd:
644 case Lisp_Objfwd: 675 *XBOOLFWD (valcontents)->boolvar = NILP (newval) ? 0 : 1;
645 return *XOBJFWD (valcontents); 676 break;
646 677
647 case Lisp_Buffer_Objfwd: 678 case Lisp_Misc_Objfwd:
648 return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer); 679 *XOBJFWD (valcontents)->objvar = newval;
649 } 680 break;
650 return valcontents; 681
651 } 682 case Lisp_Misc_Buffer_Objfwd:
652 683 {
653 /* Store NEWVAL into SYM, where VALCONTENTS is found in the value cell 684 int offset = XBUFFER_OBJFWD (valcontents)->offset;
654 of SYM. If SYM is buffer-local, VALCONTENTS should be the 685 Lisp_Object type;
655 buffer-independent contents of the value cell: forwarded just one 686
656 step past the buffer-localness. */ 687 type = *(Lisp_Object *)(offset + (char *)&buffer_local_types);
657 688 if (! NILP (type) && ! NILP (newval)
658 void 689 && XTYPE (newval) != XINT (type))
659 store_symval_forwarding (sym, valcontents, newval) 690 buffer_slot_type_mismatch (offset);
660 Lisp_Object sym; 691
661 register Lisp_Object valcontents, newval; 692 *(Lisp_Object *)(offset + (char *)current_buffer) = newval;
662 { 693 break;
663 #ifdef SWITCH_ENUM_BUG 694 }
664 switch ((int) XTYPE (valcontents)) 695 default:
665 #else 696 goto def;
666 switch (XTYPE (valcontents)) 697 }
667 #endif
668 {
669 case Lisp_Intfwd:
670 CHECK_NUMBER (newval, 1);
671 *XINTPTR (valcontents) = XINT (newval);
672 break; 698 break;
673 699
674 case Lisp_Boolfwd:
675 *XINTPTR (valcontents) = NILP(newval) ? 0 : 1;
676 break;
677
678 case Lisp_Objfwd:
679 *XOBJFWD (valcontents) = newval;
680 break;
681
682 case Lisp_Buffer_Objfwd:
683 {
684 unsigned int offset = XUINT (valcontents);
685 Lisp_Object type;
686
687 type = *(Lisp_Object *)(offset + (char *)&buffer_local_types);
688 if (! NILP (type) && ! NILP (newval)
689 && XTYPE (newval) != XINT (type))
690 buffer_slot_type_mismatch (valcontents, newval);
691
692 *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer)
693 = newval;
694 break;
695 }
696
697 default: 700 default:
701 def:
698 valcontents = XSYMBOL (sym)->value; 702 valcontents = XSYMBOL (sym)->value;
699 if (BUFFER_LOCAL_VALUEP (valcontents) 703 if (BUFFER_LOCAL_VALUEP (valcontents)
700 || SOME_BUFFER_LOCAL_VALUEP (valcontents)) 704 || SOME_BUFFER_LOCAL_VALUEP (valcontents))
701 XCONS (XSYMBOL (sym)->value)->car = newval; 705 XCONS (XSYMBOL (sym)->value)->car = newval;
702 else 706 else
771 case Lisp_Buffer_Local_Value: 775 case Lisp_Buffer_Local_Value:
772 case Lisp_Some_Buffer_Local_Value: 776 case Lisp_Some_Buffer_Local_Value:
773 valcontents = swap_in_symval_forwarding (sym, valcontents); 777 valcontents = swap_in_symval_forwarding (sym, valcontents);
774 goto retry; 778 goto retry;
775 779
776 case Lisp_Intfwd: 780 case Lisp_Misc:
777 XSETINT (val, *XINTPTR (valcontents)); 781 switch (XMISC (valcontents)->type)
778 return val; 782 {
779 783 case Lisp_Misc_Intfwd:
780 case Lisp_Boolfwd: 784 XSETINT (val, *XINTFWD (valcontents)->intvar);
781 if (*XINTPTR (valcontents)) 785 return val;
782 return Qt; 786
783 return Qnil; 787 case Lisp_Misc_Boolfwd:
784 788 return (*XBOOLFWD (valcontents)->boolvar ? Qt : Qnil);
785 case Lisp_Objfwd: 789
786 return *XOBJFWD (valcontents); 790 case Lisp_Misc_Objfwd:
787 791 return *XOBJFWD (valcontents)->objvar;
788 case Lisp_Buffer_Objfwd: 792
789 return *(Lisp_Object *)(XUINT (valcontents) + (char *)current_buffer); 793 case Lisp_Misc_Buffer_Objfwd:
794 return *(Lisp_Object *)(XBUFFER_OBJFWD (valcontents)->offset
795 + (char *)current_buffer);
796 }
790 } 797 }
791 798
792 return valcontents; 799 return valcontents;
793 } 800 }
794 801
820 return Fsignal (Qsetting_constant, Fcons (sym, Qnil)); 827 return Fsignal (Qsetting_constant, Fcons (sym, Qnil));
821 valcontents = XSYMBOL (sym)->value; 828 valcontents = XSYMBOL (sym)->value;
822 829
823 if (BUFFER_OBJFWDP (valcontents)) 830 if (BUFFER_OBJFWDP (valcontents))
824 { 831 {
825 register int idx = XUINT (valcontents); 832 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
826 register int mask = XINT (*((Lisp_Object *) 833 register int mask = XINT (*((Lisp_Object *)
827 (idx + (char *)&buffer_local_flags))); 834 (idx + (char *)&buffer_local_flags)));
828 if (mask > 0) 835 if (mask > 0)
829 current_buffer->local_var_flags |= mask; 836 current_buffer->local_var_flags |= mask;
830 } 837 }
936 943
937 /* For a built-in buffer-local variable, get the default value 944 /* For a built-in buffer-local variable, get the default value
938 rather than letting do_symval_forwarding get the current value. */ 945 rather than letting do_symval_forwarding get the current value. */
939 if (BUFFER_OBJFWDP (valcontents)) 946 if (BUFFER_OBJFWDP (valcontents))
940 { 947 {
941 register int idx = XUINT (valcontents); 948 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
942 949
943 if (XINT (*(Lisp_Object *) (idx + (char *) &buffer_local_flags)) != 0) 950 if (XINT (*(Lisp_Object *) (idx + (char *) &buffer_local_flags)) != 0)
944 return *(Lisp_Object *)(idx + (char *) &buffer_defaults); 951 return *(Lisp_Object *)(idx + (char *) &buffer_defaults);
945 } 952 }
946 953
1009 /* Handle variables like case-fold-search that have special slots 1016 /* Handle variables like case-fold-search that have special slots
1010 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value 1017 in the buffer. Make them work apparently like Lisp_Buffer_Local_Value
1011 variables. */ 1018 variables. */
1012 if (BUFFER_OBJFWDP (valcontents)) 1019 if (BUFFER_OBJFWDP (valcontents))
1013 { 1020 {
1014 register int idx = XUINT (valcontents); 1021 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
1015 register struct buffer *b; 1022 register struct buffer *b;
1016 register int mask = XINT (*((Lisp_Object *) 1023 register int mask = XINT (*((Lisp_Object *)
1017 (idx + (char *)&buffer_local_flags))); 1024 (idx + (char *)&buffer_local_flags)));
1018 1025
1019 if (mask > 0) 1026 if (mask > 0)
1203 1210
1204 valcontents = XSYMBOL (sym)->value; 1211 valcontents = XSYMBOL (sym)->value;
1205 1212
1206 if (BUFFER_OBJFWDP (valcontents)) 1213 if (BUFFER_OBJFWDP (valcontents))
1207 { 1214 {
1208 register int idx = XUINT (valcontents); 1215 register int idx = XBUFFER_OBJFWD (valcontents)->offset;
1209 register int mask = XINT (*((Lisp_Object*) 1216 register int mask = XINT (*((Lisp_Object*)
1210 (idx + (char *)&buffer_local_flags))); 1217 (idx + (char *)&buffer_local_flags)));
1211 1218
1212 if (mask > 0) 1219 if (mask > 0)
1213 { 1220 {