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

Comparing cvsroot/microscheme/scheme.c (file contents):
Revision 1.9 by root, Wed Nov 25 22:39:19 2015 UTC vs.
Revision 1.10 by root, Thu Nov 26 00:03:19 2015 UTC

… …
64#define NIL (&SCHEME_V->xNIL) //TODO: make this 0? 64#define NIL (&SCHEME_V->xNIL) //TODO: make this 0?
65#define S_T (&SCHEME_V->xT) //TODO: magic ptr value? 65#define S_T (&SCHEME_V->xT) //TODO: magic ptr value?
66#define S_F (&SCHEME_V->xF) //TODO: magic ptr value? 66#define S_F (&SCHEME_V->xF) //TODO: magic ptr value?
67#define S_SINK (&SCHEME_V->xsink) 67#define S_SINK (&SCHEME_V->xsink)
68#define S_EOF (&SCHEME_V->xEOF_OBJ) 68#define S_EOF (&SCHEME_V->xEOF_OBJ)
69
70/* should use libecb */
71#if __GNUC__ >= 4
72# define ecb_expect(expr,value) __builtin_expect ((expr),(value))
73# define ecb_expect_false(expr) ecb_expect (!!(expr), 0)
74# define ecb_expect_true(expr) ecb_expect (!!(expr), 1)
75#endif
69 76
70#if !USE_MULTIPLICITY 77#if !USE_MULTIPLICITY
71static scheme sc; 78static scheme sc;
72#endif 79#endif
73 80
… …
965 972
966/* get new cell. parameter a, b is marked by gc. */ 973/* get new cell. parameter a, b is marked by gc. */
967static INLINE pointer 974static INLINE pointer
968get_cell_x (SCHEME_P_ pointer a, pointer b) 975get_cell_x (SCHEME_P_ pointer a, pointer b)
969{ 976{
970 if (SCHEME_V->free_cell == NIL) 977 if (ecb_expect_false (SCHEME_V->free_cell == NIL))
971 { 978 {
972 if (SCHEME_V->no_memory && USE_ERROR_CHECKING) 979 if (SCHEME_V->no_memory && USE_ERROR_CHECKING)
973 return S_SINK; 980 return S_SINK;
974 981
975 if (SCHEME_V->free_cell == NIL) 982 if (SCHEME_V->free_cell == NIL)
… …
1536 1543
1537/*-- 1544/*--
1538 * We use algorithm E (Knuth, The Art of Computer Programming Vol.1, 1545 * We use algorithm E (Knuth, The Art of Computer Programming Vol.1,
1539 * sec. 2.3.5), the Schorr-Deutsch-Waite link-inversion algorithm, 1546 * sec. 2.3.5), the Schorr-Deutsch-Waite link-inversion algorithm,
1540 * for marking. 1547 * for marking.
1548 *
1549 * The exception is vectors - vectors are currently marked recursively,
1550 * which is inherited form tinyscheme and could be fixed by having another
1551 * word of context in the vector
1541 */ 1552 */
1542static void 1553static void
1543mark (pointer a) 1554mark (pointer a)
1544{ 1555{
1545 pointer t, q, p; 1556 pointer t, q, p;
… …
1547 t = 0; 1558 t = 0;
1548 p = a; 1559 p = a;
1549E2: 1560E2:
1550 setmark (p); 1561 setmark (p);
1551 1562
1552 if (is_vector (p)) 1563 if (ecb_expect_false (is_vector (p)))
1553 { 1564 {
1554 int i; 1565 int i;
1555 1566
1556 for (i = 0; i < p->object.vector.length; i++) 1567 for (i = 0; i < p->object.vector.length; i++)
1557 mark (vecvalue (p)[i]); 1568 mark (vecvalue (p)[i]);
… …
1680} 1691}
1681 1692
1682static void 1693static void
1683finalize_cell (SCHEME_P_ pointer a) 1694finalize_cell (SCHEME_P_ pointer a)
1684{ 1695{
1696 /* TODO, fast bitmap check? */
1685 if (is_string (a)) 1697 if (is_string (a))
1686 free (strvalue (a)); 1698 free (strvalue (a));
1687 else if (is_vector (a)) 1699 else if (is_vector (a))
1688 free (vecvalue (a)); 1700 free (vecvalue (a));
1689#if USE_PORTS 1701#if USE_PORTS
… …
5535 int ok = 1; 5547 int ok = 1;
5536 char msg[STRBUFFSIZE]; 5548 char msg[STRBUFFSIZE];
5537 int n = list_length (SCHEME_A_ SCHEME_V->args); 5549 int n = list_length (SCHEME_A_ SCHEME_V->args);
5538 5550
5539 /* Check number of arguments */ 5551 /* Check number of arguments */
5540 if (n < pcd->min_arity) 5552 if (ecb_expect_false (n < pcd->min_arity))
5541 { 5553 {
5542 ok = 0; 5554 ok = 0;
5543 snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", 5555 snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",
5544 pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity); 5556 pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at least", pcd->min_arity);
5545 } 5557 }
5546 5558 else if (ecb_excpect_false (n > pcd->max_arity))
5547 if (ok && n > pcd->max_arity)
5548 { 5559 {
5549 ok = 0; 5560 ok = 0;
5550 snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)", 5561 snprintf (msg, STRBUFFSIZE, "%s: needs%s %d argument(s)",
5551 pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity); 5562 pcd->name, pcd->min_arity == pcd->max_arity ? "" : " at most", pcd->max_arity);
5552 } 5563 }
5553 5564
5554 if (ok) 5565 if (ecb_expect_false (ok))
5555 { 5566 {
5556 if (pcd->arg_tests_encoding) 5567 if (pcd->arg_tests_encoding)
5557 { 5568 {
5558 int i = 0; 5569 int i = 0;
5559 int j; 5570 int j;
… …
5603 } 5614 }
5604#endif 5615#endif
5605 5616
5606 ok_to_freely_gc (SCHEME_A); 5617 ok_to_freely_gc (SCHEME_A);
5607 5618
5608 if (pcd->func (SCHEME_A_ SCHEME_V->op) == NIL) 5619 if (ecb_expect_false (pcd->func (SCHEME_A_ SCHEME_V->op) == NIL))
5609 return; 5620 return;
5610 5621
5611 if (SCHEME_V->no_memory && USE_ERROR_CHECKING) 5622 if (SCHEME_V->no_memory && USE_ERROR_CHECKING)
5612 { 5623 {
5613 xwrstr ("No memory!\n"); 5624 xwrstr ("No memory!\n");
… …
5671 5682
5672 case 'd': 5683 case 'd':
5673 return OP_COND0; /* cond */ 5684 return OP_COND0; /* cond */
5674 5685
5675 case '*': 5686 case '*':
5676 return OP_LET0AST; /* let* */ 5687 return OP_LET0AST;/* let* */
5677 5688
5678 default: 5689 default:
5679 return OP_SET0; /* set! */ 5690 return OP_SET0; /* set! */
5680 } 5691 }
5681 5692
… …
5703 5714
5704 case 'f': 5715 case 'f':
5705 return OP_DEF0; /* define */ 5716 return OP_DEF0; /* define */
5706 5717
5707 default: 5718 default:
5708 return OP_LET0REC; /* letrec */ 5719 return OP_LET0REC;/* letrec */
5709 } 5720 }
5710 5721
5711 default: 5722 default:
5712 return OP_C0STREAM; /* cons-stream */ 5723 return OP_C0STREAM; /* cons-stream */
5713 } 5724 }

Diff Legend

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