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.52 by root, Tue Dec 1 01:56:22 2015 UTC vs.
Revision 1.53 by root, Tue Dec 1 02:21:49 2015 UTC

… …
103 } 103 }
104 104
105 char *p = s; 105 char *p = s;
106 106
107 do { 107 do {
108 *p++ = '0' + n % base; 108 *p++ = "0123456789abcdef"[n % base];
109 n /= base; 109 n /= base;
110 } while (n); 110 } while (n);
111 111
112 *p-- = 0; 112 *p-- = 0;
113 113
… …
123{ 123{
124 xbase (s, n, 10); 124 xbase (s, n, 10);
125} 125}
126 126
127static void 127static void
128xwrstr (const char *s) 128putnum (SCHEME_P_ long n)
129{
130 write (1, s, strlen (s));
131}
132
133static void
134xwrnum (long n)
135{ 129{
136 char buf[64]; 130 char buf[64];
137 131
138 xnum (buf, n); 132 xnum (buf, n);
139 xwrstr (buf); 133 putstr (SCHEME_A_ buf);
140} 134}
141 135
142static char 136static char
143xtoupper (char c) 137xtoupper (char c)
144{ 138{
… …
1058static void 1052static void
1059check_cell_alloced (pointer p, int expect_alloced) 1053check_cell_alloced (pointer p, int expect_alloced)
1060{ 1054{
1061 /* Can't use putstr(SCHEME_A_ str) because callers have no access to sc. */ 1055 /* Can't use putstr(SCHEME_A_ str) because callers have no access to sc. */
1062 if (typeflag (p) & !expect_alloced) 1056 if (typeflag (p) & !expect_alloced)
1063 xwrstr ("Cell is already allocated!\n"); 1057 putstr (SCHEME_A_ "Cell is already allocated!\n");
1064 1058
1065 if (!(typeflag (p)) & expect_alloced) 1059 if (!(typeflag (p)) & expect_alloced)
1066 xwrstr ("Cell is not allocated!\n"); 1060 putstr (SCHEME_A_ "Cell is not allocated!\n");
1067} 1061}
1068 1062
1069static void 1063static void
1070check_range_alloced (pointer p, int n, int expect_alloced) 1064check_range_alloced (pointer p, int n, int expect_alloced)
1071{ 1065{
… …
1674 clrmark (NIL); 1668 clrmark (NIL);
1675 SCHEME_V->fcells = 0; 1669 SCHEME_V->fcells = 0;
1676 SCHEME_V->free_cell = NIL; 1670 SCHEME_V->free_cell = NIL;
1677 1671
1678 if (SCHEME_V->gc_verbose) 1672 if (SCHEME_V->gc_verbose)
1679 xwrstr ("freeing..."); 1673 putstr (SCHEME_A_ "freeing...");
1680 1674
1681 uint32_t total = 0; 1675 uint32_t total = 0;
1682 1676
1683 /* Here we scan the cells to build the free-list. */ 1677 /* Here we scan the cells to build the free-list. */
1684 for (i = SCHEME_V->last_cell_seg; i >= 0; i--) 1678 for (i = SCHEME_V->last_cell_seg; i >= 0; i--)
… …
1710 } 1704 }
1711 } 1705 }
1712 1706
1713 if (SCHEME_V->gc_verbose) 1707 if (SCHEME_V->gc_verbose)
1714 { 1708 {
1715 xwrstr ("done: "); xwrnum (SCHEME_V->fcells); xwrstr (" out of "); xwrnum (total); xwrstr (" cells were recovered.\n"); 1709 putstr (SCHEME_A_ "done: "); putnum (SCHEME_A_ SCHEME_V->fcells); putstr (SCHEME_A_ " out of "); putnum (SCHEME_A_ total); putstr (SCHEME_A_ " cells were recovered.\n");
1716 } 1710 }
1717} 1711}
1718 1712
1719static void 1713static void
1720finalize_cell (SCHEME_P_ pointer a) 1714finalize_cell (SCHEME_P_ pointer a)
… …
2093 *pt->rep.string.curr++ = *s; 2087 *pt->rep.string.curr++ = *s;
2094 else if (pt->kind & port_srfi6 && realloc_port_string (SCHEME_A_ pt)) 2088 else if (pt->kind & port_srfi6 && realloc_port_string (SCHEME_A_ pt))
2095 *pt->rep.string.curr++ = *s; 2089 *pt->rep.string.curr++ = *s;
2096 2090
2097#else 2091#else
2098 xwrstr (s); 2092 write (pt->rep.stdio.file, s, strlen (s));
2099#endif 2093#endif
2100} 2094}
2101 2095
2102static void 2096static void
2103putchars (SCHEME_P_ const char *s, int len) 2097putchars (SCHEME_P_ const char *s, int len)
… …
3343 s_return (S_T); 3337 s_return (S_T);
3344#endif 3338#endif
3345 case OP_LOAD: /* load */ 3339 case OP_LOAD: /* load */
3346 if (file_interactive (SCHEME_A)) 3340 if (file_interactive (SCHEME_A))
3347 { 3341 {
3348 xwrstr ("Loading "); xwrstr (strvalue (car (args))); xwrstr ("\n"); 3342 putstr (SCHEME_A_ "Loading "); putstr (SCHEME_A_ strvalue (car (args))); putstr (SCHEME_A_ "\n");
3349 //D fprintf (port (SCHEME_V->outport)->rep.stdio.file, "Loading %s\n", strvalue (car (args))); 3343 //D fprintf (port (SCHEME_V->outport)->rep.stdio.file, "Loading %s\n", strvalue (car (args)));
3350 } 3344 }
3351 3345
3352 if (!file_push (SCHEME_A_ strvalue (car (args)))) 3346 if (!file_push (SCHEME_A_ strvalue (car (args))))
3353 Error_1 ("unable to open", car (args)); 3347 Error_1 ("unable to open", car (args));
… …
5546 if (ecb_expect_false (dispatch_funcs [pcd->func] (SCHEME_A_ SCHEME_V->op) != 0)) 5540 if (ecb_expect_false (dispatch_funcs [pcd->func] (SCHEME_A_ SCHEME_V->op) != 0))
5547 return; 5541 return;
5548 5542
5549 if (SCHEME_V->no_memory && USE_ERROR_CHECKING) 5543 if (SCHEME_V->no_memory && USE_ERROR_CHECKING)
5550 { 5544 {
5551 xwrstr ("No memory!\n"); 5545 putstr (SCHEME_A_ "No memory!\n");
5552 return; 5546 return;
5553 } 5547 }
5554 } 5548 }
5555} 5549}
5556 5550
… …
6040 int isfile = 1; 6034 int isfile = 1;
6041 system ("ps v $PPID");//D 6035 system ("ps v $PPID");//D
6042 6036
6043 if (argc == 2 && strcmp (argv[1], "-?") == 0) 6037 if (argc == 2 && strcmp (argv[1], "-?") == 0)
6044 { 6038 {
6045 xwrstr ("Usage: tinyscheme -?\n"); 6039 putstr (SCHEME_A_ "Usage: tinyscheme -?\n");
6046 xwrstr ("or: tinyscheme [<file1> <file2> ...]\n"); 6040 putstr (SCHEME_A_ "or: tinyscheme [<file1> <file2> ...]\n");
6047 xwrstr ("followed by\n"); 6041 putstr (SCHEME_A_ "followed by\n");
6048 xwrstr (" -1 <file> [<arg1> <arg2> ...]\n"); 6042 putstr (SCHEME_A_ " -1 <file> [<arg1> <arg2> ...]\n");
6049 xwrstr (" -c <Scheme commands> [<arg1> <arg2> ...]\n"); 6043 putstr (SCHEME_A_ " -c <Scheme commands> [<arg1> <arg2> ...]\n");
6050 xwrstr ("assuming that the executable is named tinyscheme.\n"); 6044 putstr (SCHEME_A_ "assuming that the executable is named tinyscheme.\n");
6051 xwrstr ("Use - as filename for stdin.\n"); 6045 putstr (SCHEME_A_ "Use - as filename for stdin.\n");
6052 return 1; 6046 return 1;
6053 } 6047 }
6054 6048
6055 if (!scheme_init (SCHEME_A)) 6049 if (!scheme_init (SCHEME_A))
6056 { 6050 {
6057 xwrstr ("Could not initialize!\n"); 6051 putstr (SCHEME_A_ "Could not initialize!\n");
6058 return 2; 6052 return 2;
6059 } 6053 }
6060 6054
6061# if USE_PORTS 6055# if USE_PORTS
6062 scheme_set_input_port_file (SCHEME_A_ STDIN_FILENO); 6056 scheme_set_input_port_file (SCHEME_A_ STDIN_FILENO);
… …
6107 fin = open (file_name, O_RDONLY); 6101 fin = open (file_name, O_RDONLY);
6108#endif 6102#endif
6109 6103
6110 if (isfile && fin < 0) 6104 if (isfile && fin < 0)
6111 { 6105 {
6112 xwrstr ("Could not open file "); xwrstr (file_name); xwrstr ("\n"); 6106 putstr (SCHEME_A_ "Could not open file "); putstr (SCHEME_A_ file_name); putstr (SCHEME_A_ "\n");
6113 } 6107 }
6114 else 6108 else
6115 { 6109 {
6116 if (isfile) 6110 if (isfile)
6117 scheme_load_named_file (SCHEME_A_ fin, file_name); 6111 scheme_load_named_file (SCHEME_A_ fin, file_name);
… …
6121#if USE_PORTS 6115#if USE_PORTS
6122 if (!isfile || fin != STDIN_FILENO) 6116 if (!isfile || fin != STDIN_FILENO)
6123 { 6117 {
6124 if (SCHEME_V->retcode != 0) 6118 if (SCHEME_V->retcode != 0)
6125 { 6119 {
6126 xwrstr ("Errors encountered reading "); xwrstr (file_name); xwrstr ("\n"); 6120 putstr (SCHEME_A_ "Errors encountered reading "); putstr (SCHEME_A_ file_name); putstr (SCHEME_A_ "\n");
6127 } 6121 }
6128 6122
6129 if (isfile) 6123 if (isfile)
6130 close (fin); 6124 close (fin);
6131 } 6125 }

Diff Legend

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