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

Comparing microscheme/scheme.c (file contents):
Revision 1.66 by root, Mon Dec 7 18:10:57 2015 UTC vs.
Revision 1.67 by root, Mon Dec 7 19:49:35 2015 UTC

… …
329string_value (pointer p) 329string_value (pointer p)
330{ 330{
331 return strvalue (p); 331 return strvalue (p);
332} 332}
333 333
334#define ivalue_unchecked(p) CELL(p)->object.ivalue 334#define ivalue_unchecked(p) (CELL(p)->object.ivalue + 0)
335#define set_ivalue(p,v) CELL(p)->object.ivalue = (v) 335#define set_ivalue(p,v) CELL(p)->object.ivalue = (v)
336 336
337#if USE_REAL 337#if USE_REAL
338#define rvalue_unchecked(p) CELL(p)->object.rvalue 338#define rvalue_unchecked(p) CELL(p)->object.rvalue
339#define set_rvalue(p,v) CELL(p)->object.rvalue = (v) 339#define set_rvalue(p,v) CELL(p)->object.rvalue = (v)
… …
1259 if (!*pp) 1259 if (!*pp)
1260 { 1260 {
1261 pointer x = get_cell (SCHEME_A_ NIL, NIL); 1261 pointer x = get_cell (SCHEME_A_ NIL, NIL);
1262 1262
1263 set_typeflag (x, T_INTEGER | T_ATOM); 1263 set_typeflag (x, T_INTEGER | T_ATOM);
1264 setimmutable (x); /* shouldn't do anythi9ng, doesn't cost anything */ 1264 setimmutable (x); /* shouldn't do anything, doesn't cost anything */
1265 set_ivalue (x, n); 1265 set_ivalue (x, n);
1266 1266
1267 *pp = x; 1267 *pp = x;
1268 } 1268 }
1269 1269
… …
1546 return mk_character (SCHEME_A_ c); 1546 return mk_character (SCHEME_A_ c);
1547 } 1547 }
1548 else 1548 else
1549 { 1549 {
1550 /* identify base by string index */ 1550 /* identify base by string index */
1551 const char baseidx[17] = "ffbf" "ffff" "ofdf" "ffff" "x"; 1551 const char baseidx[18] = "ffbf" "ffff" "ofdf" "ffff" "x";
1552 char *base = strchr (baseidx, *name); 1552 char *base = strchr (baseidx, *name);
1553 1553
1554 if (base) 1554 if (base && *base)
1555 return mk_integer (SCHEME_A_ strtol (name + 1, 0, base - baseidx)); 1555 return mk_integer (SCHEME_A_ strtol (name + 1, 0, base - baseidx));
1556 1556
1557 return NIL; 1557 return NIL;
1558 } 1558 }
1559} 1559}
… …
2613 } 2613 }
2614 else if (is_symbol (l)) 2614 else if (is_symbol (l))
2615 p = symname (l); 2615 p = symname (l);
2616 else if (is_proc (l)) 2616 else if (is_proc (l))
2617 { 2617 {
2618 p = (char *)procname (l); // ok with r7rs display, but not r7rs write
2619#if 0
2618#if USE_PRINTF 2620#if USE_PRINTF
2619 p = SCHEME_V->strbuff; 2621 p = SCHEME_V->strbuff;
2620 snprintf (p, STRBUFFSIZE, "#<%s PROCEDURE %ld>", procname (l), procnum (l)); 2622 snprintf (p, STRBUFFSIZE, " PROCEDURE %ld>", procname (l), procnum (l));
2621#else 2623#else
2622 p = "#<PROCEDURE>"; 2624 p = "#<PROCEDURE>";
2625#endif
2623#endif 2626#endif
2624 } 2627 }
2625 else if (is_macro (l)) 2628 else if (is_macro (l))
2626 p = "#<MACRO>"; 2629 p = "#<MACRO>";
2627 else if (is_closure (l)) 2630 else if (is_closure (l))
… …
5597 s_return (S_T); 5600 s_return (S_T);
5598 } 5601 }
5599 5602
5600 case OP_PVECFROM: 5603 case OP_PVECFROM:
5601 { 5604 {
5602 int i = ivalue_unchecked (cdr (args)); 5605 IVALUE i = ivalue_unchecked (cdr (args));
5603 pointer vec = car (args); 5606 pointer vec = car (args);
5604 int len = veclength (vec); 5607 uint32_t len = veclength (vec);
5605 5608
5606 if (i == len) 5609 if (i == len)
5607 { 5610 {
5608 putcharacter (SCHEME_A_ ')'); 5611 putcharacter (SCHEME_A_ ')');
5609 s_return (S_T); 5612 s_return (S_T);
5610 } 5613 }
5611 else 5614 else
5612 { 5615 {
5613 pointer elem = vector_get (vec, i); 5616 pointer elem = vector_get (vec, i);
5614 5617
5615 ivalue_unchecked (cdr (args)) = i + 1; 5618 set_cdr (args, mk_integer (SCHEME_A_ i + 1));
5616 s_save (SCHEME_A_ OP_PVECFROM, args, NIL); 5619 s_save (SCHEME_A_ OP_PVECFROM, args, NIL);
5617 SCHEME_V->args = elem; 5620 SCHEME_V->args = elem;
5618 5621
5619 if (i > 0) 5622 if (i > 0)
5620 putcharacter (SCHEME_A_ ' '); 5623 putcharacter (SCHEME_A_ ' ');
… …
5920static pointer 5923static pointer
5921mk_proc (SCHEME_P_ enum scheme_opcodes op) 5924mk_proc (SCHEME_P_ enum scheme_opcodes op)
5922{ 5925{
5923 pointer y = get_cell (SCHEME_A_ NIL, NIL); 5926 pointer y = get_cell (SCHEME_A_ NIL, NIL);
5924 set_typeflag (y, (T_PROC | T_ATOM)); 5927 set_typeflag (y, (T_PROC | T_ATOM));
5925 ivalue_unchecked (y) = op; 5928 set_ivalue (y, op);
5926 return y; 5929 return y;
5927} 5930}
5928 5931
5929/* Hard-coded for the given keywords. Remember to rewrite if more are added! */ 5932/* Hard-coded for the given keywords. Remember to rewrite if more are added! */
5930ecb_hot static int 5933ecb_hot static int

Diff Legend

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