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

… …
18 * 18 *
19 */ 19 */
20 20
21#define EXPERIMENT 1 21#define EXPERIMENT 1
22 22
23#if 1
23#define PAGE_SIZE 4096 /* does not work on sparc/alpha */ 24#define PAGE_SIZE 4096 /* does not work on sparc/alpha */
24#include "malloc.c" 25#include "malloc.c"
26#endif
25 27
26#define SCHEME_SOURCE 28#define SCHEME_SOURCE
27#include "scheme-private.h" 29#include "scheme-private.h"
28#ifndef WIN32 30#ifndef WIN32
29# include <unistd.h> 31# include <unistd.h>
… …
101 } 103 }
102 104
103 char *p = s; 105 char *p = s;
104 106
105 do { 107 do {
106 *p++ = '0' + n % base; 108 *p++ = "0123456789abcdef"[n % base];
107 n /= base; 109 n /= base;
108 } while (n); 110 } while (n);
109 111
110 *p-- = 0; 112 *p-- = 0;
111 113
… …
121{ 123{
122 xbase (s, n, 10); 124 xbase (s, n, 10);
123} 125}
124 126
125static void 127static void
126xwrstr (const char *s) 128putnum (SCHEME_P_ long n)
127{
128 write (1, s, strlen (s));
129}
130
131static void
132xwrnum (long n)
133{ 129{
134 char buf[64]; 130 char buf[64];
135 131
136 xnum (buf, n); 132 xnum (buf, n);
137 xwrstr (buf); 133 putstr (SCHEME_A_ buf);
138} 134}
139 135
140static char 136static char
141xtoupper (char c) 137xtoupper (char c)
142{ 138{
… …
1056static void 1052static void
1057check_cell_alloced (pointer p, int expect_alloced) 1053check_cell_alloced (pointer p, int expect_alloced)
1058{ 1054{
1059 /* 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. */
1060 if (typeflag (p) & !expect_alloced) 1056 if (typeflag (p) & !expect_alloced)
1061 xwrstr ("Cell is already allocated!\n"); 1057 putstr (SCHEME_A_ "Cell is already allocated!\n");
1062 1058
1063 if (!(typeflag (p)) & expect_alloced) 1059 if (!(typeflag (p)) & expect_alloced)
1064 xwrstr ("Cell is not allocated!\n"); 1060 putstr (SCHEME_A_ "Cell is not allocated!\n");
1065} 1061}
1066 1062
1067static void 1063static void
1068check_range_alloced (pointer p, int n, int expect_alloced) 1064check_range_alloced (pointer p, int n, int expect_alloced)
1069{ 1065{
… …
1672 clrmark (NIL); 1668 clrmark (NIL);
1673 SCHEME_V->fcells = 0; 1669 SCHEME_V->fcells = 0;
1674 SCHEME_V->free_cell = NIL; 1670 SCHEME_V->free_cell = NIL;
1675 1671
1676 if (SCHEME_V->gc_verbose) 1672 if (SCHEME_V->gc_verbose)
1677 xwrstr ("freeing..."); 1673 putstr (SCHEME_A_ "freeing...");
1678 1674
1679 uint32_t total = 0; 1675 uint32_t total = 0;
1680 1676
1681 /* Here we scan the cells to build the free-list. */ 1677 /* Here we scan the cells to build the free-list. */
1682 for (i = SCHEME_V->last_cell_seg; i >= 0; i--) 1678 for (i = SCHEME_V->last_cell_seg; i >= 0; i--)
… …
1708 } 1704 }
1709 } 1705 }
1710 1706
1711 if (SCHEME_V->gc_verbose) 1707 if (SCHEME_V->gc_verbose)
1712 { 1708 {
1713 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");
1714 } 1710 }
1715} 1711}
1716 1712
1717static void 1713static void
1718finalize_cell (SCHEME_P_ pointer a) 1714finalize_cell (SCHEME_P_ pointer a)
… …
2091 *pt->rep.string.curr++ = *s; 2087 *pt->rep.string.curr++ = *s;
2092 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))
2093 *pt->rep.string.curr++ = *s; 2089 *pt->rep.string.curr++ = *s;
2094 2090
2095#else 2091#else
2096 xwrstr (s); 2092 write (pt->rep.stdio.file, s, strlen (s));
2097#endif 2093#endif
2098} 2094}
2099 2095
2100static void 2096static void
2101putchars (SCHEME_P_ const char *s, int len) 2097putchars (SCHEME_P_ const char *s, int len)
… …
3341 s_return (S_T); 3337 s_return (S_T);
3342#endif 3338#endif
3343 case OP_LOAD: /* load */ 3339 case OP_LOAD: /* load */
3344 if (file_interactive (SCHEME_A)) 3340 if (file_interactive (SCHEME_A))
3345 { 3341 {
3346 xwrstr ("Loading "); xwrstr (strvalue (car (args))); xwrstr ("\n"); 3342 putstr (SCHEME_A_ "Loading "); putstr (SCHEME_A_ strvalue (car (args))); putstr (SCHEME_A_ "\n");
3347 //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)));
3348 } 3344 }
3349 3345
3350 if (!file_push (SCHEME_A_ strvalue (car (args)))) 3346 if (!file_push (SCHEME_A_ strvalue (car (args))))
3351 Error_1 ("unable to open", car (args)); 3347 Error_1 ("unable to open", car (args));
… …
5544 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))
5545 return; 5541 return;
5546 5542
5547 if (SCHEME_V->no_memory && USE_ERROR_CHECKING) 5543 if (SCHEME_V->no_memory && USE_ERROR_CHECKING)
5548 { 5544 {
5549 xwrstr ("No memory!\n"); 5545 putstr (SCHEME_A_ "No memory!\n");
5550 return; 5546 return;
5551 } 5547 }
5552 } 5548 }
5553} 5549}
5554 5550
… …
6038 int isfile = 1; 6034 int isfile = 1;
6039 system ("ps v $PPID");//D 6035 system ("ps v $PPID");//D
6040 6036
6041 if (argc == 2 && strcmp (argv[1], "-?") == 0) 6037 if (argc == 2 && strcmp (argv[1], "-?") == 0)
6042 { 6038 {
6043 xwrstr ("Usage: tinyscheme -?\n"); 6039 putstr (SCHEME_A_ "Usage: tinyscheme -?\n");
6044 xwrstr ("or: tinyscheme [<file1> <file2> ...]\n"); 6040 putstr (SCHEME_A_ "or: tinyscheme [<file1> <file2> ...]\n");
6045 xwrstr ("followed by\n"); 6041 putstr (SCHEME_A_ "followed by\n");
6046 xwrstr (" -1 <file> [<arg1> <arg2> ...]\n"); 6042 putstr (SCHEME_A_ " -1 <file> [<arg1> <arg2> ...]\n");
6047 xwrstr (" -c <Scheme commands> [<arg1> <arg2> ...]\n"); 6043 putstr (SCHEME_A_ " -c <Scheme commands> [<arg1> <arg2> ...]\n");
6048 xwrstr ("assuming that the executable is named tinyscheme.\n"); 6044 putstr (SCHEME_A_ "assuming that the executable is named tinyscheme.\n");
6049 xwrstr ("Use - as filename for stdin.\n"); 6045 putstr (SCHEME_A_ "Use - as filename for stdin.\n");
6050 return 1; 6046 return 1;
6051 } 6047 }
6052 6048
6053 if (!scheme_init (SCHEME_A)) 6049 if (!scheme_init (SCHEME_A))
6054 { 6050 {
6055 xwrstr ("Could not initialize!\n"); 6051 putstr (SCHEME_A_ "Could not initialize!\n");
6056 return 2; 6052 return 2;
6057 } 6053 }
6058 6054
6059# if USE_PORTS 6055# if USE_PORTS
6060 scheme_set_input_port_file (SCHEME_A_ STDIN_FILENO); 6056 scheme_set_input_port_file (SCHEME_A_ STDIN_FILENO);
… …
6105 fin = open (file_name, O_RDONLY); 6101 fin = open (file_name, O_RDONLY);
6106#endif 6102#endif
6107 6103
6108 if (isfile && fin < 0) 6104 if (isfile && fin < 0)
6109 { 6105 {
6110 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");
6111 } 6107 }
6112 else 6108 else
6113 { 6109 {
6114 if (isfile) 6110 if (isfile)
6115 scheme_load_named_file (SCHEME_A_ fin, file_name); 6111 scheme_load_named_file (SCHEME_A_ fin, file_name);
… …
6119#if USE_PORTS 6115#if USE_PORTS
6120 if (!isfile || fin != STDIN_FILENO) 6116 if (!isfile || fin != STDIN_FILENO)
6121 { 6117 {
6122 if (SCHEME_V->retcode != 0) 6118 if (SCHEME_V->retcode != 0)
6123 { 6119 {
6124 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");
6125 } 6121 }
6126 6122
6127 if (isfile) 6123 if (isfile)
6128 close (fin); 6124 close (fin);
6129 } 6125 }

Diff Legend

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