ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/microscheme/scheme.c
(Generate patch)

Comparing microscheme/scheme.c (file contents):
Revision 1.12 by root, Thu Nov 26 07:30:25 2015 UTC vs.
Revision 1.13 by root, Thu Nov 26 07:59:42 2015 UTC

… …
208#define T_SYNTAX 0x0010 208#define T_SYNTAX 0x0010
209#define T_IMMUTABLE 0x0020 209#define T_IMMUTABLE 0x0020
210#define T_ATOM 0x0040 /* only for gc */ 210#define T_ATOM 0x0040 /* only for gc */
211#define T_MARK 0x0080 /* only for gc */ 211#define T_MARK 0x0080 /* only for gc */
212 212
213static num num_add (num a, num b);
214static num num_mul (num a, num b); 213static num num_op (char op, num a, num b);
215static num num_div (num a, num b);
216static num num_intdiv (num a, num b); 214static num num_intdiv (num a, num b);
217static num num_sub (num a, num b);
218static num num_rem (num a, num b); 215static num num_rem (num a, num b);
219static num num_mod (num a, num b); 216static num num_mod (num a, num b);
220static int num_eq (num a, num b); 217static int num_eq (num a, num b);
221static int num_gt (num a, num b); 218static int num_gt (num a, num b);
222static int num_ge (num a, num b); 219static int num_ge (num a, num b);
… …
681static void assign_syntax (SCHEME_P_ const char *name); 678static void assign_syntax (SCHEME_P_ const char *name);
682static int syntaxnum (pointer p); 679static int syntaxnum (pointer p);
683static void assign_proc (SCHEME_P_ enum scheme_opcodes, const char *name); 680static void assign_proc (SCHEME_P_ enum scheme_opcodes, const char *name);
684 681
685static num 682static num
686num_add (num a, num b) 683num_op (char op, num a, num b)
687{ 684{
688 num ret; 685 num ret;
689 686
690 num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b)); 687 num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));
691 688
692 if (num_is_fixnum (ret)) 689 if (num_is_fixnum (ret))
693 num_set_ivalue (ret, num_get_ivalue (a) + num_get_ivalue (b)); 690 {
691 IVALUE av = num_get_ivalue (a);
692 IVALUE bv = num_get_ivalue (b);
693
694 switch (op)
695 {
696 case '+': av += bv; break;
697 case '-': av -= bv; break;
698 case '*': av *= bv; break;
699 case '/': av /= bv; break;
700 }
701
702 num_set_ivalue (ret, av);
703 }
694 else 704 else
695 num_set_rvalue (ret, num_get_rvalue (a) + num_get_rvalue (b)); 705 {
706 RVALUE av = num_get_rvalue (a);
707 RVALUE bv = num_get_rvalue (b);
696 708
697 return ret; 709 switch (op)
698} 710 {
711 case '+': av += bv; break;
712 case '-': av -= bv; break;
713 case '*': av *= bv; break;
714 case '/': av /= bv; break;
715 }
699 716
700static num 717 num_set_rvalue (ret, av);
701num_mul (num a, num b) 718 }
702{
703 num ret;
704
705 num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));
706
707 if (num_is_fixnum (ret))
708 num_set_ivalue (ret, num_get_ivalue (a) * num_get_ivalue (b));
709 else
710 num_set_rvalue (ret, num_get_rvalue (a) * num_get_rvalue (b));
711 719
712 return ret; 720 return ret;
713} 721}
714 722
715static num 723static num
… …
721 729
722 if (num_is_fixnum (ret)) 730 if (num_is_fixnum (ret))
723 num_set_ivalue (ret, num_get_ivalue (a) / num_get_ivalue (b)); 731 num_set_ivalue (ret, num_get_ivalue (a) / num_get_ivalue (b));
724 else 732 else
725 num_set_rvalue (ret, num_get_rvalue (a) / num_get_rvalue (b)); 733 num_set_rvalue (ret, num_get_rvalue (a) / num_get_rvalue (b));
726
727 return ret;
728}
729
730static num
731num_intdiv (num a, num b)
732{
733 num ret;
734
735 num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));
736
737 if (num_is_fixnum (ret))
738 num_set_ivalue (ret, num_get_ivalue (a) / num_get_ivalue (b));
739 else
740 num_set_rvalue (ret, num_get_rvalue (a) / num_get_rvalue (b));
741
742 return ret;
743}
744
745static num
746num_sub (num a, num b)
747{
748 num ret;
749
750 num_set_fixnum (ret, num_is_fixnum (a) && num_is_fixnum (b));
751
752 if (num_is_fixnum (ret))
753 num_set_ivalue (ret, num_get_ivalue (a) - num_get_ivalue (b));
754 else
755 num_set_rvalue (ret, num_get_rvalue (a) - num_get_rvalue (b));
756 734
757 return ret; 735 return ret;
758} 736}
759 737
760static num 738static num
… …
4107 4085
4108 case OP_ADD: /* + */ 4086 case OP_ADD: /* + */
4109 v = num_zero; 4087 v = num_zero;
4110 4088
4111 for (x = SCHEME_V->args; x != NIL; x = cdr (x)) 4089 for (x = SCHEME_V->args; x != NIL; x = cdr (x))
4112 v = num_add (v, nvalue (car (x))); 4090 v = num_op ('+', v, nvalue (car (x)));
4113 4091
4114 s_return (mk_number (SCHEME_A_ v)); 4092 s_return (mk_number (SCHEME_A_ v));
4115 4093
4116 case OP_MUL: /* * */ 4094 case OP_MUL: /* * */
4117 v = num_one; 4095 v = num_one;
4118 4096
4119 for (x = SCHEME_V->args; x != NIL; x = cdr (x)) 4097 for (x = SCHEME_V->args; x != NIL; x = cdr (x))
4120 v = num_mul (v, nvalue (car (x))); 4098 v = num_op ('+', v, nvalue (car (x)));
4121 4099
4122 s_return (mk_number (SCHEME_A_ v)); 4100 s_return (mk_number (SCHEME_A_ v));
4123 4101
4124 case OP_SUB: /* - */ 4102 case OP_SUB: /* - */
4125 if (cdr (SCHEME_V->args) == NIL) 4103 if (cdr (SCHEME_V->args) == NIL)
… …
4132 x = cdr (SCHEME_V->args); 4110 x = cdr (SCHEME_V->args);
4133 v = nvalue (car (SCHEME_V->args)); 4111 v = nvalue (car (SCHEME_V->args));
4134 } 4112 }
4135 4113
4136 for (; x != NIL; x = cdr (x)) 4114 for (; x != NIL; x = cdr (x))
4137 v = num_sub (v, nvalue (car (x))); 4115 v = num_op ('+', v, nvalue (car (x)));
4138 4116
4139 s_return (mk_number (SCHEME_A_ v)); 4117 s_return (mk_number (SCHEME_A_ v));
4140 4118
4141 case OP_DIV: /* / */ 4119 case OP_DIV: /* / */
4142 if (cdr (SCHEME_V->args) == NIL) 4120 if (cdr (SCHEME_V->args) == NIL)
… …
4173 } 4151 }
4174 4152
4175 for (; x != NIL; x = cdr (x)) 4153 for (; x != NIL; x = cdr (x))
4176 { 4154 {
4177 if (ivalue (car (x)) != 0) 4155 if (ivalue (car (x)) != 0)
4178 v = num_intdiv (v, nvalue (car (x))); 4156 v = num_op ('/', v, nvalue (car (x)));
4179 else 4157 else
4180 Error_0 ("quotient: division by zero"); 4158 Error_0 ("quotient: division by zero");
4181 } 4159 }
4182 4160
4183 s_return (mk_number (SCHEME_A_ v)); 4161 s_return (mk_number (SCHEME_A_ v));

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines