Cleanup of init functions using new GLOBAL_ macros

svn: r11592
This commit is contained in:
Kevin Tew 2008-09-09 15:52:39 +00:00
parent c8de743d18
commit f9bf7f2467
4 changed files with 215 additions and 731 deletions

View File

@ -1,22 +1,22 @@
{
static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,48,46,49,50,0,0,0,1,0,0,6,0,9,0,
16,0,20,0,25,0,28,0,33,0,40,0,47,0,60,0,64,0,69,0,78,
14,0,17,0,24,0,31,0,35,0,42,0,47,0,60,0,65,0,69,0,78,
0,84,0,98,0,112,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0,
177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,68,1,107,1,146,
1,215,1,4,2,92,2,137,2,142,2,162,2,53,3,73,3,124,3,190,3,
75,4,233,4,20,5,31,5,110,5,0,0,118,7,0,0,65,98,101,103,105,
110,29,11,11,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,62,
111,114,64,99,111,110,100,66,108,101,116,114,101,99,66,117,110,108,101,115,115,
72,112,97,114,97,109,101,116,101,114,105,122,101,63,108,101,116,64,119,104,101,
110,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68,
110,29,11,11,64,99,111,110,100,62,111,114,66,108,101,116,114,101,99,66,117,
110,108,101,115,115,63,108,101,116,66,100,101,102,105,110,101,64,119,104,101,110,
72,112,97,114,97,109,101,116,101,114,105,122,101,64,108,101,116,42,63,97,110,
100,68,104,101,114,101,45,115,116,120,65,113,117,111,116,101,29,94,2,14,68,
35,37,107,101,114,110,101,108,11,29,94,2,14,68,35,37,112,97,114,97,109,
122,11,62,105,102,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101,
115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109,
98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,
45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,98,
10,35,11,8,181,219,94,159,2,16,35,35,159,2,15,35,35,16,20,2,3,
2,2,2,6,2,2,2,4,2,2,2,5,2,2,2,8,2,2,2,7,2,
2,2,9,2,2,2,10,2,2,2,11,2,2,2,12,2,2,97,36,11,8,
2,2,2,5,2,2,2,6,2,2,2,7,2,2,2,8,2,2,2,9,2,
2,2,4,2,2,2,10,2,2,2,11,2,2,2,12,2,2,97,36,11,8,
181,219,93,159,2,15,35,36,16,2,2,13,161,2,2,36,2,13,2,2,2,
13,97,10,11,11,8,181,219,16,0,97,10,37,11,8,181,219,16,0,13,16,
4,35,29,11,11,2,2,11,18,98,64,104,101,114,101,8,31,8,30,8,29,
@ -26,14 +26,14 @@
17,248,22,88,23,200,2,249,22,63,2,1,248,22,90,23,202,1,12,27,248,
22,65,248,22,190,3,23,197,1,28,248,22,71,23,194,2,20,15,159,36,35,
36,28,248,22,71,248,22,65,23,195,2,248,22,64,193,249,22,183,3,80,158,
38,35,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,4,248,22,65,
38,35,251,22,73,2,17,248,22,64,23,200,2,249,22,63,2,12,248,22,65,
23,202,1,11,18,100,10,8,31,8,30,8,29,8,28,8,27,16,4,11,11,
2,18,3,1,7,101,110,118,56,49,54,51,16,4,11,11,2,19,3,1,7,
101,110,118,56,49,54,52,27,248,22,65,248,22,190,3,23,197,1,28,248,22,
71,23,194,2,20,15,159,36,35,36,28,248,22,71,248,22,65,23,195,2,248,
22,64,193,249,22,183,3,80,158,38,35,250,22,73,2,20,248,22,73,249,22,
73,248,22,73,2,21,248,22,64,23,202,2,251,22,73,2,17,2,21,2,21,
249,22,63,2,6,248,22,65,23,205,1,18,100,11,8,31,8,30,8,29,8,
249,22,63,2,4,248,22,65,23,205,1,18,100,11,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,49,54,54,16,4,
11,11,2,19,3,1,7,101,110,118,56,49,54,55,248,22,190,3,193,27,248,
22,190,3,194,249,22,63,248,22,73,248,22,64,196,248,22,65,195,27,248,22,
@ -49,7 +49,7 @@
22,2,32,0,89,162,8,44,36,46,9,222,33,42,248,22,190,3,248,22,64,
201,248,22,65,198,27,248,22,65,248,22,190,3,196,27,248,22,190,3,248,22,
64,195,249,22,183,3,80,158,39,35,28,248,22,71,195,250,22,74,2,20,9,
248,22,65,199,250,22,73,2,11,248,22,73,248,22,64,199,250,22,74,2,5,
248,22,65,199,250,22,73,2,7,248,22,73,248,22,64,199,250,22,74,2,11,
248,22,65,201,248,22,65,202,27,248,22,65,248,22,190,3,23,197,1,27,249,
22,1,22,77,249,22,2,22,190,3,248,22,190,3,248,22,64,199,249,22,183,
3,80,158,39,35,251,22,73,1,22,119,105,116,104,45,99,111,110,116,105,110,
@ -61,10 +61,10 @@
15,159,36,35,36,249,22,183,3,80,158,38,35,27,248,22,190,3,248,22,64,
23,198,2,28,249,22,151,8,62,61,62,248,22,184,3,248,22,88,23,197,2,
250,22,73,2,20,248,22,73,249,22,73,21,93,2,25,248,22,64,199,250,22,
74,2,7,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202,
74,2,3,249,22,73,2,25,249,22,73,248,22,97,203,2,25,248,22,65,202,
251,22,73,2,17,28,249,22,151,8,248,22,184,3,248,22,64,23,201,2,64,
101,108,115,101,10,248,22,64,23,198,2,250,22,74,2,20,9,248,22,65,23,
201,1,249,22,63,2,7,248,22,65,23,203,1,99,8,31,8,30,8,29,8,
201,1,249,22,63,2,3,248,22,65,23,203,1,99,8,31,8,30,8,29,8,
28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,56,49,56,57,16,4,
11,11,2,19,3,1,7,101,110,118,56,49,57,48,18,158,94,10,64,118,111,
105,100,8,47,27,248,22,65,248,22,190,3,196,249,22,183,3,80,158,38,35,
@ -78,22 +78,22 @@
11,11,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,
2,10,2,11,2,12,35,45,36,11,11,16,0,16,0,16,0,35,35,11,11,
11,16,0,16,0,16,0,35,35,16,11,16,5,93,2,13,20,15,159,35,35,
35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,9,89,162,8,
35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,93,2,6,89,162,8,
44,36,52,9,223,0,33,33,35,20,103,159,35,16,1,20,25,159,36,2,2,
2,13,16,0,11,16,5,93,2,12,89,162,8,44,36,52,9,223,0,33,34,
2,13,16,0,11,16,5,93,2,9,89,162,8,44,36,52,9,223,0,33,34,
35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,
2,4,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,20,
25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,6,89,162,8,44,
2,12,89,162,8,44,36,52,9,223,0,33,35,35,20,103,159,35,16,1,20,
25,159,36,2,2,2,13,16,1,33,36,11,16,5,93,2,4,89,162,8,44,
36,55,9,223,0,33,37,35,20,103,159,35,16,1,20,25,159,36,2,2,2,
13,16,1,33,38,11,16,5,93,2,11,89,162,8,44,36,57,9,223,0,33,
13,16,1,33,38,11,16,5,93,2,7,89,162,8,44,36,57,9,223,0,33,
41,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,
93,2,8,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,1,
20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,5,89,162,8,44,36,
93,2,5,89,162,8,44,36,52,9,223,0,33,43,35,20,103,159,35,16,1,
20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,11,89,162,8,44,36,
53,9,223,0,33,44,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,
16,0,11,16,5,93,2,10,89,162,8,44,36,54,9,223,0,33,45,35,20,
103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,7,
103,159,35,16,1,20,25,159,36,2,2,2,13,16,0,11,16,5,93,2,3,
89,162,8,44,36,57,9,223,0,33,46,35,20,103,159,35,16,1,20,25,159,
36,2,2,2,13,16,1,33,48,11,16,5,93,2,3,89,162,8,44,36,53,
36,2,2,2,13,16,1,33,48,11,16,5,93,2,8,89,162,8,44,36,53,
9,223,0,33,49,35,20,103,159,35,16,1,20,25,159,36,2,2,2,13,16,
0,11,16,0,94,2,15,2,16,93,2,15,9,9,35,0};
EVAL_ONE_SIZED_STR((char *)expr, 2031);
@ -131,8 +131,8 @@
32,98,121,116,101,32,115,116,114,105,110,103,6,36,36,99,97,110,110,111,116,
32,97,100,100,32,97,32,115,117,102,102,105,120,32,116,111,32,97,32,114,111,
111,116,32,112,97,116,104,58,32,5,0,27,20,14,159,80,158,36,50,250,80,
158,39,51,249,22,27,11,80,158,41,50,22,167,12,10,248,22,135,5,23,196,
2,28,248,22,177,5,23,194,2,12,87,94,248,22,154,8,23,194,1,248,80,
158,39,51,249,22,27,11,80,158,41,50,22,167,12,10,248,22,145,5,23,196,
2,28,248,22,141,6,23,194,2,12,87,94,248,22,154,8,23,194,1,248,80,
159,37,53,36,195,28,248,22,71,23,195,2,9,27,248,22,64,23,196,2,27,
28,248,22,148,13,23,195,2,23,194,1,28,248,22,147,13,23,195,2,249,22,
149,13,23,196,1,250,80,158,42,48,248,22,163,13,2,20,11,10,250,80,158,
@ -237,7 +237,7 @@
93,34,248,22,130,13,23,203,1,6,1,1,95,28,248,22,146,6,23,202,2,
249,22,158,7,23,203,1,8,63,23,201,1,28,248,22,189,12,23,199,2,248,
22,190,12,23,199,1,87,94,23,198,1,247,22,191,12,28,248,22,188,12,194,
249,22,142,13,195,194,192,249,247,22,133,6,194,11,248,80,158,36,46,9,27,
249,22,142,13,195,194,192,249,247,22,178,4,194,11,248,80,158,36,46,9,27,
247,22,167,13,249,80,158,38,47,28,23,195,2,27,248,22,163,7,6,11,11,
80,76,84,67,79,76,76,69,67,84,83,28,192,192,6,0,0,6,0,0,27,
28,23,196,1,250,22,142,13,248,22,163,13,69,97,100,100,111,110,45,100,105,
@ -295,13 +295,13 @@
1,9,28,249,22,151,8,247,22,165,7,2,21,249,22,63,248,22,133,13,5,
1,46,23,195,1,192,9,27,248,22,149,13,23,196,1,28,248,22,136,13,193,
250,2,51,198,199,195,11,250,80,158,38,48,196,197,11,250,80,158,38,48,196,
11,11,87,94,249,22,138,6,247,22,179,4,195,248,22,153,5,249,22,163,3,
11,11,87,94,249,22,137,6,247,22,174,4,195,248,22,163,5,249,22,163,3,
35,249,22,147,3,197,198,27,28,23,197,2,87,95,23,196,1,23,195,1,23,
197,1,87,94,23,197,1,27,248,22,163,13,2,20,27,249,80,158,40,48,23,
196,1,11,27,27,248,22,166,3,23,200,1,28,192,192,35,27,27,248,22,166,
3,23,202,1,28,192,192,35,249,22,132,5,23,197,1,83,158,39,20,97,95,
3,23,202,1,28,192,192,35,249,22,141,5,23,197,1,83,158,39,20,97,95,
89,162,8,44,35,47,9,224,3,2,33,57,23,195,1,23,196,1,27,248,22,
183,4,23,195,1,248,80,159,38,53,36,193,159,35,20,103,159,35,16,1,65,
190,4,23,195,1,248,80,159,38,53,36,193,159,35,20,103,159,35,16,1,65,
98,101,103,105,110,16,0,83,158,41,20,100,137,67,35,37,117,116,105,108,115,
2,1,11,10,10,42,80,158,35,35,20,103,159,37,16,17,30,2,1,2,2,
193,30,2,1,2,3,193,30,2,1,2,4,193,30,2,1,2,5,193,30,2,
@ -386,9 +386,9 @@
195,1,80,158,36,47,27,248,22,162,4,23,197,2,28,248,22,188,12,23,194,
2,91,159,38,11,90,161,38,35,11,248,22,145,13,23,197,1,87,95,83,160,
37,11,80,158,40,46,198,83,160,37,11,80,158,40,47,192,192,11,11,28,23,
193,2,192,87,94,23,193,1,27,247,22,134,6,28,192,192,247,22,164,13,20,
14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,134,
6,28,248,22,188,12,23,198,2,23,197,1,87,94,23,197,1,247,22,164,13,
193,2,192,87,94,23,193,1,27,247,22,179,4,28,192,192,247,22,164,13,20,
14,159,80,158,35,39,250,80,158,38,40,249,22,27,11,80,158,40,39,22,179,
4,28,248,22,188,12,23,198,2,23,197,1,87,94,23,197,1,247,22,164,13,
247,194,250,22,142,13,23,197,1,23,199,1,249,80,158,42,38,23,198,1,2,
18,252,22,142,13,23,199,1,23,201,1,6,6,6,110,97,116,105,118,101,247,
22,166,7,249,80,158,44,38,23,200,1,80,158,44,35,87,94,23,194,1,27,
@ -397,12 +397,12 @@
196,11,32,0,89,162,8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,
249,247,22,169,13,248,22,64,195,195,27,250,22,142,13,23,198,1,23,200,1,
249,80,158,43,38,23,199,1,2,18,27,250,22,159,13,196,11,32,0,89,162,
8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,132,6,248,
22,64,195,195,249,247,22,132,6,194,195,87,94,28,248,80,158,36,37,23,195,
8,44,35,40,9,222,11,28,192,249,22,63,195,194,11,249,247,22,177,4,248,
22,64,195,195,249,247,22,177,4,194,195,87,94,28,248,80,158,36,37,23,195,
2,12,250,22,181,8,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105,
108,101,100,6,25,25,112,97,116,104,32,111,114,32,118,97,108,105,100,45,112,
97,116,104,32,115,116,114,105,110,103,23,197,2,91,159,41,11,90,161,36,35,
11,28,248,22,148,13,23,201,2,23,200,1,27,247,22,134,6,28,23,193,2,
11,28,248,22,148,13,23,201,2,23,200,1,27,247,22,179,4,28,23,193,2,
249,22,149,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,145,13,23,
194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,151,8,23,196,2,68,
114,101,108,97,116,105,118,101,87,94,23,194,1,2,17,23,194,1,90,161,36,
@ -448,7 +448,7 @@
126,101,23,200,1,249,22,2,22,65,248,22,78,249,22,63,23,206,1,23,202,
1,12,12,247,192,20,14,159,80,158,39,44,249,22,63,247,22,171,11,23,197,
1,20,14,159,80,158,39,39,250,80,158,42,40,249,22,27,11,80,158,44,39,
22,143,4,23,196,1,249,247,22,133,6,23,198,1,248,22,52,248,22,128,13,
22,143,4,23,196,1,249,247,22,178,4,23,198,1,248,22,52,248,22,128,13,
23,198,1,87,94,28,28,248,22,188,12,23,197,2,10,248,22,165,4,23,197,
2,12,28,23,198,2,250,22,180,8,11,6,15,15,98,97,100,32,109,111,100,
117,108,101,32,112,97,116,104,23,201,2,250,22,181,8,2,20,6,19,19,109,
@ -522,7 +522,7 @@
91,159,37,10,90,161,36,35,10,11,90,161,36,36,10,83,158,38,20,96,96,
2,20,89,162,8,44,36,50,9,224,2,0,33,42,89,162,43,38,48,9,223,
1,33,43,89,162,43,39,8,30,9,225,2,3,0,33,49,208,87,95,248,22,
142,4,248,80,158,37,49,247,22,171,11,248,22,133,6,80,158,36,36,248,22,
142,4,248,80,158,37,49,247,22,171,11,248,22,178,4,80,158,36,36,248,22,
162,12,80,159,36,41,36,159,35,20,103,159,35,16,1,65,98,101,103,105,110,
16,0,83,158,41,20,100,137,66,35,37,98,111,111,116,2,1,11,10,10,36,
80,158,35,35,20,103,159,39,16,19,30,2,1,2,2,193,30,2,1,2,3,

View File

@ -529,141 +529,55 @@ void scheme_init_error(Scheme_Env *env)
REGISTER_SO(scheme_raise_arity_error_proc);
scheme_add_global_constant("error",
scheme_make_noncm_prim(error,
"error",
1, -1),
env);
scheme_add_global_constant("raise-user-error",
scheme_make_noncm_prim(raise_user_error,
"raise-user-error",
1, -1),
env);
scheme_add_global_constant("raise-syntax-error",
scheme_make_noncm_prim(raise_syntax_error,
"raise-syntax-error",
2, 4),
env);
scheme_add_global_constant("raise-type-error",
scheme_make_noncm_prim(raise_type_error,
"raise-type-error",
3, -1),
env);
scheme_add_global_constant("raise-mismatch-error",
scheme_make_noncm_prim(raise_mismatch_error,
"raise-mismatch-error",
3, 3),
env);
scheme_raise_arity_error_proc = scheme_make_noncm_prim(raise_arity_error,
"raise-arity-error",
2, -1);
scheme_add_global_constant("raise-arity-error",
scheme_raise_arity_error_proc,
env);
scheme_add_global_constant("error-display-handler",
scheme_register_parameter(error_display_handler,
"error-display-handler",
MZCONFIG_ERROR_DISPLAY_HANDLER),
env);
scheme_add_global_constant("error-value->string-handler",
scheme_register_parameter(error_value_string_handler,
"error-value->string-handler",
MZCONFIG_ERROR_PRINT_VALUE_HANDLER),
env);
scheme_add_global_constant("error-escape-handler",
scheme_register_parameter(error_escape_handler,
"error-escape-handler",
MZCONFIG_ERROR_ESCAPE_HANDLER),
env);
scheme_add_global_constant("exit-handler",
scheme_register_parameter(exit_handler,
"exit-handler",
MZCONFIG_EXIT_HANDLER),
env);
scheme_add_global_constant("error-print-width",
scheme_register_parameter(error_print_width,
"error-print-width",
MZCONFIG_ERROR_PRINT_WIDTH),
env);
scheme_add_global_constant("error-print-context-length",
scheme_register_parameter(error_print_context_length,
"error-print-context-length",
MZCONFIG_ERROR_PRINT_CONTEXT_LENGTH),
env);
scheme_add_global_constant("error-print-source-location",
scheme_register_parameter(error_print_srcloc,
"error-print-source-location",
MZCONFIG_ERROR_PRINT_SRCLOC),
env);
scheme_add_global_constant("exit",
scheme_make_noncm_prim(scheme_do_exit,
"exit",
0, 1),
env);
/* errors */
GLOBAL_NONCM_PRIM("error", error, 1, -1, env);
GLOBAL_NONCM_PRIM("raise-user-error", raise_user_error, 1, -1, env);
GLOBAL_NONCM_PRIM("raise-syntax-error", raise_syntax_error, 2, 4, env);
GLOBAL_NONCM_PRIM("raise-type-error", raise_type_error, 3, -1, env);
GLOBAL_NONCM_PRIM("raise-mismatch-error", raise_mismatch_error, 3, 3, env);
scheme_add_global_constant("log-message",
scheme_make_prim_w_arity(log_message,
"log-message",
4, 4),
env);
scheme_add_global_constant("log-level?",
scheme_make_noncm_prim(log_level_p,
"log-level?",
2, 2),
env);
scheme_add_global_constant("make-logger",
scheme_make_noncm_prim(make_logger,
"make-logger",
0, 2),
env);
scheme_add_global_constant("logger?",
scheme_make_folding_prim(logger_p,
"logger?",
1, 1, 1),
env);
scheme_add_global_constant("logger-name",
scheme_make_folding_prim(logger_name,
"logger-name",
1, 1, 1),
env);
scheme_add_global_constant("make-log-receiver",
scheme_make_noncm_prim(make_log_reader,
"make-log-receiver",
2, 2),
env);
scheme_add_global_constant("log-receiver?",
scheme_make_folding_prim(log_reader_p,
"log-receiver?",
1, 1, 1),
env);
scheme_add_global_constant("current-logger",
scheme_register_parameter(current_logger,
"current-logger",
MZCONFIG_LOGGER),
env);
scheme_raise_arity_error_proc = scheme_make_noncm_prim(raise_arity_error, "raise-arity-error", 2, -1);
scheme_add_global_constant("raise-arity-error", scheme_raise_arity_error_proc, env);
GLOBAL_PARAMETER("error-display-handler", error_display_handler, MZCONFIG_ERROR_DISPLAY_HANDLER, env);
GLOBAL_PARAMETER("error-value->string-handler", error_value_string_handler, MZCONFIG_ERROR_PRINT_VALUE_HANDLER, env);
GLOBAL_PARAMETER("error-escape-handler", error_escape_handler, MZCONFIG_ERROR_ESCAPE_HANDLER, env);
GLOBAL_PARAMETER("exit-handler", exit_handler, MZCONFIG_EXIT_HANDLER, env);
GLOBAL_PARAMETER("error-print-width", error_print_width, MZCONFIG_ERROR_PRINT_WIDTH, env);
GLOBAL_PARAMETER("error-print-context-length", error_print_context_length, MZCONFIG_ERROR_PRINT_CONTEXT_LENGTH, env);
GLOBAL_PARAMETER("error-print-source-location", error_print_srcloc, MZCONFIG_ERROR_PRINT_SRCLOC, env);
/* logging */
GLOBAL_NONCM_PRIM("exit", scheme_do_exit, 0, 1, env);
GLOBAL_NONCM_PRIM("log-level?", log_level_p, 2, 2, env);
GLOBAL_NONCM_PRIM("make-logger", make_logger, 0, 2, env);
GLOBAL_NONCM_PRIM("make-log-receiver", make_log_reader, 2, 2, env);
GLOBAL_PRIM_W_ARITY("log-message", log_message, 4, 4, env);
GLOBAL_FOLDING_PRIM("logger?", logger_p, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("logger-name", logger_name, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("log-receiver?", log_reader_p, 1, 1, 1, env);
GLOBAL_PARAMETER("current-logger", current_logger, MZCONFIG_LOGGER, env);
scheme_add_evt(scheme_log_reader_type, (Scheme_Ready_Fun)log_reader_get, NULL, NULL, 1);
REGISTER_SO(scheme_def_exit_proc);
scheme_def_exit_proc = scheme_make_prim_w_arity(def_exit_handler_proc,
"default-exit-handler",
1, 1);
scheme_def_exit_proc = scheme_make_prim_w_arity(def_exit_handler_proc, "default-exit-handler", 1, 1);
REGISTER_SO(def_err_val_proc);
def_err_val_proc = scheme_make_prim_w_arity(def_error_value_string_proc,
"default-error-value->string-handler",
2, 2);
def_err_val_proc = scheme_make_prim_w_arity(def_error_value_string_proc, "default-error-value->string-handler", 2, 2);
REGISTER_SO(fatal_symbol);
REGISTER_SO(error_symbol);
REGISTER_SO(warning_symbol);
REGISTER_SO(info_symbol);
REGISTER_SO(debug_symbol);
fatal_symbol = scheme_intern_symbol("fatal");
error_symbol = scheme_intern_symbol("error");
warning_symbol = scheme_intern_symbol("warning");
info_symbol = scheme_intern_symbol("info");
debug_symbol = scheme_intern_symbol("debug");
fatal_symbol = scheme_intern_symbol("fatal");
error_symbol = scheme_intern_symbol("error");
warning_symbol = scheme_intern_symbol("warning");
info_symbol = scheme_intern_symbol("info");
debug_symbol = scheme_intern_symbol("debug");
{
REGISTER_SO(scheme_main_logger);
@ -676,11 +590,8 @@ void scheme_init_error(Scheme_Env *env)
REGISTER_SO(arity_property);
{
Scheme_Object *guard;
guard = scheme_make_prim_w_arity(check_arity_property_value_ok,
"guard-for-prop:arity-string",
2, 2);
arity_property = scheme_make_struct_type_property_w_guard(scheme_intern_symbol("arity-string"),
guard);
guard = scheme_make_prim_w_arity(check_arity_property_value_ok, "guard-for-prop:arity-string", 2, 2);
arity_property = scheme_make_struct_type_property_w_guard(scheme_intern_symbol("arity-string"), guard);
}
scheme_add_global_constant("prop:arity-string", arity_property, env);
@ -701,17 +612,12 @@ void scheme_init_error_config(void)
REGISTER_SO(default_display_handler);
REGISTER_SO(emergency_display_handler);
default_display_handler = scheme_make_prim_w_arity(def_error_display_proc,
"default-error-display-handler",
2, 2);
emergency_display_handler = scheme_make_prim_w_arity(emergency_error_display_proc,
"emergency-error-display-handler",
2, 2);
default_display_handler = scheme_make_prim_w_arity(def_error_display_proc, "default-error-display-handler", 2, 2);
emergency_display_handler = scheme_make_prim_w_arity(emergency_error_display_proc, "emergency-error-display-handler", 2, 2);
scheme_set_root_param(MZCONFIG_ERROR_DISPLAY_HANDLER, default_display_handler);
scheme_set_root_param(MZCONFIG_ERROR_PRINT_VALUE_HANDLER,
def_err_val_proc);
scheme_set_root_param(MZCONFIG_ERROR_PRINT_VALUE_HANDLER, def_err_val_proc);
}
static void

View File

@ -138,9 +138,11 @@ static int pipe_out_ready(Scheme_Output_Port *p);
static void register_traversers(void);
#endif
static Scheme_Object *any_symbol, *any_one_symbol;
static Scheme_Object *cr_symbol, *lf_symbol, *crlf_symbol;
static Scheme_Object *any_symbol;
static Scheme_Object *any_one_symbol;
static Scheme_Object *cr_symbol;
static Scheme_Object *lf_symbol;
static Scheme_Object *crlf_symbol;
static Scheme_Object *module_symbol;
static Scheme_Object *default_read_handler;
@ -150,9 +152,12 @@ static Scheme_Object *default_print_handler;
Scheme_Object *scheme_default_global_print_handler;
Scheme_Object *scheme_write_proc, *scheme_display_proc, *scheme_print_proc;
Scheme_Object *scheme_write_proc;
Scheme_Object *scheme_display_proc;
Scheme_Object *scheme_print_proc;
static Scheme_Object *dummy_input_port, *dummy_output_port;
static Scheme_Object *dummy_input_port;
static Scheme_Object *dummy_output_port;
#define fail_err_symbol scheme_false
@ -183,560 +188,142 @@ scheme_init_port_fun(Scheme_Env *env)
REGISTER_SO(cr_symbol);
REGISTER_SO(lf_symbol);
REGISTER_SO(crlf_symbol);
any_symbol = scheme_intern_symbol("any");
any_one_symbol = scheme_intern_symbol("any-one");
cr_symbol = scheme_intern_symbol("return");
lf_symbol = scheme_intern_symbol("linefeed");
crlf_symbol = scheme_intern_symbol("return-linefeed");
REGISTER_SO(module_symbol);
module_symbol = scheme_intern_symbol("module");
any_symbol = scheme_intern_symbol("any");
any_one_symbol = scheme_intern_symbol("any-one");
cr_symbol = scheme_intern_symbol("return");
lf_symbol = scheme_intern_symbol("linefeed");
crlf_symbol = scheme_intern_symbol("return-linefeed");
module_symbol = scheme_intern_symbol("module");
scheme_write_proc = scheme_make_noncm_prim(sch_write,
"write",
1, 2);
scheme_display_proc = scheme_make_noncm_prim(display,
"display",
1, 2);
scheme_print_proc = scheme_make_noncm_prim(sch_print,
"print",
1, 2);
scheme_write_proc = scheme_make_noncm_prim(sch_write, "write", 1, 2);
scheme_display_proc = scheme_make_noncm_prim(display, "display", 1, 2);
scheme_print_proc = scheme_make_noncm_prim(sch_print, "print", 1, 2);
/* Made as a closed prim so we can get the arity right: */
default_read_handler = scheme_make_closed_prim_w_arity(sch_default_read_handler,
NULL,
"default-port-read-handler",
1, 2);
default_read_handler = scheme_make_closed_prim_w_arity(sch_default_read_handler, NULL, "default-port-read-handler", 1, 2);
default_display_handler = scheme_make_prim_w_arity(sch_default_display_handler,
"default-port-display-handler",
2, 2);
default_write_handler = scheme_make_prim_w_arity(sch_default_write_handler,
"default-port-write-handler",
2, 2);
default_print_handler = scheme_make_prim_w_arity(sch_default_print_handler,
"default-port-print-handler",
2, 2);
default_display_handler = scheme_make_prim_w_arity(sch_default_display_handler, "default-port-display-handler", 2, 2);
default_write_handler = scheme_make_prim_w_arity(sch_default_write_handler, "default-port-write-handler", 2, 2);
default_print_handler = scheme_make_prim_w_arity(sch_default_print_handler, "default-port-print-handler", 2, 2);
scheme_init_port_fun_config();
scheme_add_global_constant("eof", scheme_eof, env);
GLOBAL_PARAMETER("current-input-port", current_input_port, MZCONFIG_INPUT_PORT, env);
GLOBAL_PARAMETER("current-output-port", current_output_port, MZCONFIG_OUTPUT_PORT, env);
GLOBAL_PARAMETER("current-error-port", current_error_port, MZCONFIG_ERROR_PORT, env);
GLOBAL_PARAMETER("current-load", current_load, MZCONFIG_LOAD_HANDLER, env);
GLOBAL_PARAMETER("current-load/use-compiled", current_load_use_compiled, MZCONFIG_LOAD_COMPILED_HANDLER, env);
GLOBAL_PARAMETER("current-load-relative-directory", current_load_directory, MZCONFIG_LOAD_DIRECTORY, env);
GLOBAL_PARAMETER("current-write-relative-directory", current_write_directory, MZCONFIG_WRITE_DIRECTORY, env);
GLOBAL_PARAMETER("global-port-print-handler", global_port_print_handler, MZCONFIG_PORT_PRINT_HANDLER, env);
#ifdef LOAD_ON_DEMAND
GLOBAL_PARAMETER("load-on-demand-enabled", load_on_demand_enabled, MZCONFIG_LOAD_DELAY_ENABLED, env);
#endif
GLOBAL_PARAMETER("port-count-lines-enabled", global_port_count_lines, MZCONFIG_PORT_COUNT_LINES, env);
scheme_add_global_constant("input-port?",
scheme_make_folding_prim(input_port_p,
"input-port?",
1, 1, 1),
env);
scheme_add_global_constant("output-port?",
scheme_make_folding_prim(output_port_p,
"output-port?",
1, 1, 1),
env);
GLOBAL_FOLDING_PRIM("input-port?", input_port_p, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("output-port?", output_port_p, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("file-stream-port?", scheme_file_stream_port_p, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("terminal-port?", scheme_terminal_port_p, 1, 1, 1, env);
scheme_add_global_constant("file-stream-port?",
scheme_make_folding_prim(scheme_file_stream_port_p,
"file-stream-port?",
1, 1, 1),
env);
scheme_add_global_constant("terminal-port?",
scheme_make_folding_prim(scheme_terminal_port_p,
"terminal-port?",
1, 1, 1),
env);
GLOBAL_PRIM_W_ARITY("port-closed?", port_closed_p, 1, 1, env);
GLOBAL_PRIM_W_ARITY("open-input-file", open_input_file, 1, 2, env);
GLOBAL_PRIM_W_ARITY("open-input-bytes", open_input_byte_string, 1, 2, env);
GLOBAL_PRIM_W_ARITY("open-input-string", open_input_char_string, 1, 2, env);
GLOBAL_PRIM_W_ARITY("open-output-file", open_output_file, 1, 3, env);
GLOBAL_PRIM_W_ARITY("open-output-bytes", open_output_string, 0, 1, env);
GLOBAL_PRIM_W_ARITY("open-output-string", open_output_string, 0, 1, env);
GLOBAL_PRIM_W_ARITY("get-output-bytes", get_output_byte_string, 1, 4, env);
GLOBAL_PRIM_W_ARITY("get-output-string", get_output_char_string, 1, 1, env);
GLOBAL_PRIM_W_ARITY("open-input-output-file", open_input_output_file, 1, 3, env);
GLOBAL_PRIM_W_ARITY("close-input-port", close_input_port, 1, 1, env);
GLOBAL_PRIM_W_ARITY("close-output-port", close_output_port, 1, 1, env);
GLOBAL_PRIM_W_ARITY("make-input-port", make_input_port, 4, 10, env);
GLOBAL_PRIM_W_ARITY("make-output-port", make_output_port, 4, 11, env);
GLOBAL_PRIM_W_ARITY2("call-with-output-file", call_with_output_file, 2, 4, 0, -1, env);
GLOBAL_PRIM_W_ARITY2("call-with-input-file", call_with_input_file, 2, 3, 0, -1, env);
GLOBAL_PRIM_W_ARITY2("with-output-to-file", with_output_to_file, 2, 4, 0, -1, env);
GLOBAL_PRIM_W_ARITY2("with-input-from-file", with_input_from_file, 2, 3, 0, -1, env);
GLOBAL_PRIM_W_ARITY2("load", load, 1, 1, 0, -1, env);
GLOBAL_PRIM_W_ARITY2("make-pipe", sch_pipe, 0, 3, 2, 2, env);
GLOBAL_PRIM_W_ARITY2("port-next-location", port_next_location, 1, 1, 3, 3, env);
scheme_add_global_constant("port-closed?",
scheme_make_prim_w_arity(port_closed_p,
"port-closed?",
1, 1),
env);
scheme_add_global_constant("current-input-port",
scheme_register_parameter(current_input_port,
"current-input-port",
MZCONFIG_INPUT_PORT),
env);
scheme_add_global_constant("current-output-port",
scheme_register_parameter(current_output_port,
"current-output-port",
MZCONFIG_OUTPUT_PORT),
env);
scheme_add_global_constant("current-error-port",
scheme_register_parameter(current_error_port,
"current-error-port",
MZCONFIG_ERROR_PORT),
env);
scheme_add_global_constant("open-input-file",
scheme_make_prim_w_arity(open_input_file,
"open-input-file",
1, 2),
env);
scheme_add_global_constant("open-input-bytes",
scheme_make_prim_w_arity(open_input_byte_string,
"open-input-bytes",
1, 2),
env);
scheme_add_global_constant("open-input-string",
scheme_make_prim_w_arity(open_input_char_string,
"open-input-string",
1, 2),
env);
scheme_add_global_constant("open-output-file",
scheme_make_prim_w_arity(open_output_file,
"open-output-file",
1, 3),
env);
scheme_add_global_constant("open-output-bytes",
scheme_make_prim_w_arity(open_output_string,
"open-output-bytes",
0, 1),
env);
scheme_add_global_constant("open-output-string",
scheme_make_prim_w_arity(open_output_string,
"open-output-string",
0, 1),
env);
scheme_add_global_constant("get-output-bytes",
scheme_make_prim_w_arity(get_output_byte_string,
"get-output-bytes",
1, 4),
env);
scheme_add_global_constant("get-output-string",
scheme_make_prim_w_arity(get_output_char_string,
"get-output-string",
1, 1),
env);
scheme_add_global_constant("open-input-output-file",
scheme_make_prim_w_arity(open_input_output_file,
"open-input-output-file",
1, 3),
env);
scheme_add_global_constant("close-input-port",
scheme_make_prim_w_arity(close_input_port,
"close-input-port",
1, 1),
env);
scheme_add_global_constant("close-output-port",
scheme_make_prim_w_arity(close_output_port,
"close-output-port",
1, 1),
env);
scheme_add_global_constant("call-with-output-file",
scheme_make_prim_w_arity2(call_with_output_file,
"call-with-output-file",
2, 4,
0, -1),
env);
scheme_add_global_constant("call-with-input-file",
scheme_make_prim_w_arity2(call_with_input_file,
"call-with-input-file",
2, 3,
0, -1),
env);
scheme_add_global_constant("with-output-to-file",
scheme_make_prim_w_arity2(with_output_to_file,
"with-output-to-file",
2, 4,
0, -1),
env);
scheme_add_global_constant("with-input-from-file",
scheme_make_prim_w_arity2(with_input_from_file,
"with-input-from-file",
2, 3,
0, -1),
env);
scheme_add_global_constant("make-input-port",
scheme_make_prim_w_arity(make_input_port,
"make-input-port",
4, 10),
env);
scheme_add_global_constant("make-output-port",
scheme_make_prim_w_arity(make_output_port,
"make-output-port",
4, 11),
env);
scheme_add_global_constant("read",
scheme_make_noncm_prim(read_f,
"read",
0, 1),
env);
scheme_add_global_constant("read/recursive",
scheme_make_noncm_prim(read_recur_f,
"read/recursive",
0, 4),
env);
scheme_add_global_constant("read-syntax",
scheme_make_noncm_prim(read_syntax_f,
"read-syntax",
0, 2),
env);
scheme_add_global_constant("read-syntax/recursive",
scheme_make_noncm_prim(read_syntax_recur_f,
"read-syntax/recursive",
0, 5),
env);
scheme_add_global_constant("read-honu",
scheme_make_noncm_prim(read_honu_f,
"read-honu",
0, 1),
env);
scheme_add_global_constant("read-honu/recursive",
scheme_make_noncm_prim(read_honu_recur_f,
"read-honu/recursive",
0, 1),
env);
scheme_add_global_constant("read-honu-syntax",
scheme_make_noncm_prim(read_honu_syntax_f,
"read-honu-syntax",
0, 2),
env);
scheme_add_global_constant("read-honu-syntax/recursive",
scheme_make_noncm_prim(read_honu_syntax_recur_f,
"read-honu-syntax/recursive",
0, 2),
env);
scheme_add_global_constant("read-char",
scheme_make_noncm_prim(read_char,
"read-char",
0, 1),
env);
scheme_add_global_constant("read-char-or-special",
scheme_make_noncm_prim(read_char_spec,
"read-char-or-special",
0, 1),
env);
scheme_add_global_constant("read-byte",
scheme_make_noncm_prim(read_byte,
"read-byte",
0, 1),
env);
scheme_add_global_constant("read-byte-or-special",
scheme_make_noncm_prim(read_byte_spec,
"read-byte-or-special",
0, 1),
env);
scheme_add_global_constant("read-bytes-line",
scheme_make_noncm_prim(read_byte_line,
"read-bytes-line",
0, 2),
env);
scheme_add_global_constant("read-line",
scheme_make_noncm_prim(read_line,
"read-line",
0, 2),
env);
scheme_add_global_constant("read-string",
scheme_make_noncm_prim(sch_read_string,
"read-string",
1, 2),
env);
scheme_add_global_constant("read-string!",
scheme_make_noncm_prim(sch_read_string_bang,
"read-string!",
1, 4),
env);
scheme_add_global_constant("peek-string",
scheme_make_noncm_prim(sch_peek_string,
"peek-string",
2, 3),
env);
scheme_add_global_constant("peek-string!",
scheme_make_noncm_prim(sch_peek_string_bang,
"peek-string!",
2, 5),
env);
scheme_add_global_constant("read-bytes",
scheme_make_noncm_prim(sch_read_bytes,
"read-bytes",
1, 2),
env);
scheme_add_global_constant("read-bytes!",
scheme_make_noncm_prim(sch_read_bytes_bang,
"read-bytes!",
1, 4),
env);
scheme_add_global_constant("peek-bytes",
scheme_make_noncm_prim(sch_peek_bytes,
"peek-bytes",
2, 3),
env);
scheme_add_global_constant("peek-bytes!",
scheme_make_noncm_prim(sch_peek_bytes_bang,
"peek-bytes!",
2, 5),
env);
scheme_add_global_constant("read-bytes-avail!",
scheme_make_noncm_prim(read_bytes_bang,
"read-bytes-avail!",
1, 4),
env);
scheme_add_global_constant("read-bytes-avail!*",
scheme_make_noncm_prim(read_bytes_bang_nonblock,
"read-bytes-avail!*",
1, 4),
env);
scheme_add_global_constant("read-bytes-avail!/enable-break",
scheme_make_noncm_prim(read_bytes_bang_break,
"read-bytes-avail!/enable-break",
1, 4),
env);
scheme_add_global_constant("peek-bytes-avail!",
scheme_make_noncm_prim(peek_bytes_bang,
"peek-bytes-avail!",
2, 6),
env);
scheme_add_global_constant("peek-bytes-avail!*",
scheme_make_noncm_prim(peek_bytes_bang_nonblock,
"peek-bytes-avail!*",
2, 6),
env);
scheme_add_global_constant("peek-bytes-avail!/enable-break",
scheme_make_noncm_prim(peek_bytes_bang_break,
"peek-bytes-avail!/enable-break",
2, 6),
env);
scheme_add_global_constant("port-provides-progress-evts?",
scheme_make_noncm_prim(can_provide_progress_evt,
"port-provides-progress-evts?",
1, 1),
env);
scheme_add_global_constant("write-bytes",
scheme_make_noncm_prim(write_bytes,
"write-bytes",
1, 4),
env);
scheme_add_global_constant("write-string",
scheme_make_noncm_prim(write_string,
"write-string",
1, 4),
env);
scheme_add_global_constant("write-bytes-avail",
scheme_make_noncm_prim(write_bytes_avail,
"write-bytes-avail",
1, 4),
env);
scheme_add_global_constant("write-bytes-avail*",
scheme_make_noncm_prim(write_bytes_avail_nonblock,
"write-bytes-avail*",
1, 4),
env);
scheme_add_global_constant("write-bytes-avail/enable-break",
scheme_make_noncm_prim(write_bytes_avail_break,
"write-bytes-avail/enable-break",
1, 4),
env);
scheme_add_global_constant("port-writes-atomic?",
scheme_make_noncm_prim(can_write_atomic,
"port-writes-atomic?",
1, 1),
env);
scheme_add_global_constant("port-writes-special?",
scheme_make_noncm_prim(can_write_special,
"port-writes-special?",
1, 1),
env);
scheme_add_global_constant("write-special",
scheme_make_noncm_prim(scheme_write_special,
"write-special",
1, 2),
env);
scheme_add_global_constant("write-special-avail*",
scheme_make_noncm_prim(scheme_write_special_nonblock,
"write-special-avail*",
1, 2),
env);
scheme_add_global_constant("peek-char",
scheme_make_noncm_prim(peek_char,
"peek-char",
0, 2),
env);
scheme_add_global_constant("peek-char-or-special",
scheme_make_noncm_prim(peek_char_spec,
"peek-char-or-special",
0, 2),
env);
scheme_add_global_constant("peek-byte",
scheme_make_noncm_prim(peek_byte,
"peek-byte",
0, 2),
env);
scheme_add_global_constant("peek-byte-or-special",
scheme_make_noncm_prim(peek_byte_spec,
"peek-byte-or-special",
0, 3),
env);
GLOBAL_NONCM_PRIM("read", read_f, 0, 1, env);
GLOBAL_NONCM_PRIM("read/recursive", read_recur_f, 0, 4, env);
GLOBAL_NONCM_PRIM("read-syntax", read_syntax_f, 0, 2, env);
GLOBAL_NONCM_PRIM("read-syntax/recursive", read_syntax_recur_f, 0, 5, env);
GLOBAL_NONCM_PRIM("read-honu", read_honu_f, 0, 1, env);
GLOBAL_NONCM_PRIM("read-honu/recursive", read_honu_recur_f, 0, 1, env);
GLOBAL_NONCM_PRIM("read-honu-syntax", read_honu_syntax_f, 0, 2, env);
GLOBAL_NONCM_PRIM("read-honu-syntax/recursive", read_honu_syntax_recur_f, 0, 2, env);
GLOBAL_NONCM_PRIM("read-char", read_char, 0, 1, env);
GLOBAL_NONCM_PRIM("read-char-or-special", read_char_spec, 0, 1, env);
GLOBAL_NONCM_PRIM("read-byte", read_byte, 0, 1, env);
GLOBAL_NONCM_PRIM("read-byte-or-special", read_byte_spec, 0, 1, env);
GLOBAL_NONCM_PRIM("read-bytes-line", read_byte_line, 0, 2, env);
GLOBAL_NONCM_PRIM("read-line", read_line, 0, 2, env);
GLOBAL_NONCM_PRIM("read-string", sch_read_string, 1, 2, env);
GLOBAL_NONCM_PRIM("read-string!", sch_read_string_bang, 1, 4, env);
GLOBAL_NONCM_PRIM("peek-string", sch_peek_string, 2, 3, env);
GLOBAL_NONCM_PRIM("peek-string!", sch_peek_string_bang, 2, 5, env);
GLOBAL_NONCM_PRIM("read-bytes", sch_read_bytes, 1, 2, env);
GLOBAL_NONCM_PRIM("read-bytes!", sch_read_bytes_bang, 1, 4, env);
GLOBAL_NONCM_PRIM("peek-bytes", sch_peek_bytes, 2, 3, env);
GLOBAL_NONCM_PRIM("peek-bytes!", sch_peek_bytes_bang, 2, 5, env);
GLOBAL_NONCM_PRIM("read-bytes-avail!", read_bytes_bang, 1, 4, env);
GLOBAL_NONCM_PRIM("read-bytes-avail!*", read_bytes_bang_nonblock, 1, 4, env);
GLOBAL_NONCM_PRIM("read-bytes-avail!/enable-break", read_bytes_bang_break, 1, 4, env);
GLOBAL_NONCM_PRIM("peek-bytes-avail!", peek_bytes_bang, 2, 6, env);
GLOBAL_NONCM_PRIM("peek-bytes-avail!*", peek_bytes_bang_nonblock, 2, 6, env);
GLOBAL_NONCM_PRIM("peek-bytes-avail!/enable-break", peek_bytes_bang_break, 2, 6, env);
GLOBAL_NONCM_PRIM("port-provides-progress-evts?", can_provide_progress_evt, 1, 1, env);
GLOBAL_NONCM_PRIM("write-bytes", write_bytes, 1, 4, env);
GLOBAL_NONCM_PRIM("write-string", write_string, 1, 4, env);
GLOBAL_NONCM_PRIM("write-bytes-avail", write_bytes_avail, 1, 4, env);
GLOBAL_NONCM_PRIM("write-bytes-avail*", write_bytes_avail_nonblock, 1, 4, env);
GLOBAL_NONCM_PRIM("write-bytes-avail/enable-break", write_bytes_avail_break, 1, 4, env);
GLOBAL_NONCM_PRIM("port-writes-atomic?", can_write_atomic, 1, 1, env);
GLOBAL_NONCM_PRIM("port-writes-special?", can_write_special, 1, 1, env);
GLOBAL_NONCM_PRIM("write-special", scheme_write_special, 1, 2, env);
GLOBAL_NONCM_PRIM("write-special-avail*", scheme_write_special_nonblock, 1, 2, env);
GLOBAL_NONCM_PRIM("peek-char", peek_char, 0, 2, env);
GLOBAL_NONCM_PRIM("peek-char-or-special", peek_char_spec, 0, 2, env);
GLOBAL_NONCM_PRIM("peek-byte", peek_byte, 0, 2, env);
GLOBAL_NONCM_PRIM("peek-byte-or-special", peek_byte_spec, 0, 3, env);
GLOBAL_NONCM_PRIM("byte-ready?", byte_ready_p, 0, 1, env);
GLOBAL_NONCM_PRIM("char-ready?", char_ready_p, 0, 1, env);
GLOBAL_NONCM_PRIM("newline", newline, 0, 1, env);
GLOBAL_NONCM_PRIM("write-char", write_char, 1, 2, env);
GLOBAL_NONCM_PRIM("write-byte", write_byte, 1, 2, env);
GLOBAL_NONCM_PRIM("port-commit-peeked", peeked_read, 3, 4, env);
GLOBAL_NONCM_PRIM("port-progress-evt", progress_evt, 0, 1, env);
GLOBAL_NONCM_PRIM("write-bytes-avail-evt", write_bytes_avail_evt, 1, 4, env);
GLOBAL_NONCM_PRIM("write-special-evt", write_special_evt, 2, 2, env);
GLOBAL_NONCM_PRIM("port-read-handler", port_read_handler, 1, 2, env);
GLOBAL_NONCM_PRIM("port-display-handler", port_display_handler, 1, 2, env);
GLOBAL_NONCM_PRIM("port-write-handler", port_write_handler, 1, 2, env);
GLOBAL_NONCM_PRIM("port-print-handler", port_print_handler, 1, 2, env);
GLOBAL_NONCM_PRIM("flush-output", flush_output, 0, 1, env);
GLOBAL_NONCM_PRIM("file-position", scheme_file_position, 1, 2, env);
GLOBAL_NONCM_PRIM("file-stream-buffer-mode", scheme_file_buffer, 1, 2, env);
GLOBAL_NONCM_PRIM("port-file-identity", scheme_file_identity, 1, 1, env);
GLOBAL_NONCM_PRIM("port-count-lines!", port_count_lines, 1, 1, env);
p = scheme_make_folding_prim(eof_object_p, "eof-object?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("eof-object?", p, env);
scheme_add_global_constant("byte-ready?",
scheme_make_noncm_prim(byte_ready_p,
"byte-ready?",
0, 1),
env);
scheme_add_global_constant("char-ready?",
scheme_make_noncm_prim(char_ready_p,
"char-ready?",
0, 1),
env);
scheme_add_global_constant("write", scheme_write_proc, env);
scheme_add_global_constant("display", scheme_display_proc, env);
scheme_add_global_constant("print", scheme_print_proc, env);
scheme_add_global_constant("write", scheme_write_proc, env);
scheme_add_global_constant("display", scheme_display_proc, env);
scheme_add_global_constant("print", scheme_print_proc, env);
scheme_add_global_constant("newline",
scheme_make_noncm_prim(newline,
"newline",
0, 1),
env);
scheme_add_global_constant("write-char",
scheme_make_noncm_prim(write_char,
"write-char",
1, 2),
env);
scheme_add_global_constant("write-byte",
scheme_make_noncm_prim(write_byte,
"write-byte",
1, 2),
env);
scheme_add_global_constant("port-commit-peeked",
scheme_make_noncm_prim(peeked_read,
"port-commit-peeked",
3, 4),
env);
scheme_add_global_constant("port-progress-evt",
scheme_make_noncm_prim(progress_evt,
"port-progress-evt",
0, 1),
env);
scheme_add_global_constant("write-bytes-avail-evt",
scheme_make_noncm_prim(write_bytes_avail_evt,
"write-bytes-avail-evt",
1, 4),
env);
scheme_add_global_constant("write-special-evt",
scheme_make_noncm_prim(write_special_evt,
"write-special-evt",
2, 2),
env);
scheme_add_global_constant("port-read-handler",
scheme_make_noncm_prim(port_read_handler,
"port-read-handler",
1, 2),
env);
scheme_add_global_constant("port-display-handler",
scheme_make_noncm_prim(port_display_handler,
"port-display-handler",
1, 2),
env);
scheme_add_global_constant("port-write-handler",
scheme_make_noncm_prim(port_write_handler,
"port-write-handler",
1, 2),
env);
scheme_add_global_constant("port-print-handler",
scheme_make_noncm_prim(port_print_handler,
"port-print-handler",
1, 2),
env);
scheme_add_global_constant("global-port-print-handler",
scheme_register_parameter(global_port_print_handler,
"global-port-print-handler",
MZCONFIG_PORT_PRINT_HANDLER),
env);
scheme_add_global_constant("load",
scheme_make_prim_w_arity2(load,
"load",
1, 1,
0, -1),
env);
scheme_add_global_constant("current-load",
scheme_register_parameter(current_load,
"current-load",
MZCONFIG_LOAD_HANDLER),
env);
scheme_add_global_constant("current-load/use-compiled",
scheme_register_parameter(current_load_use_compiled,
"current-load/use-compiled",
MZCONFIG_LOAD_COMPILED_HANDLER),
env);
scheme_add_global_constant("current-load-relative-directory",
scheme_register_parameter(current_load_directory,
"current-load-relative-directory",
MZCONFIG_LOAD_DIRECTORY),
env);
scheme_add_global_constant("current-write-relative-directory",
scheme_register_parameter(current_write_directory,
"current-write-relative-directory",
MZCONFIG_WRITE_DIRECTORY),
env);
#ifdef LOAD_ON_DEMAND
scheme_add_global_constant("load-on-demand-enabled",
scheme_register_parameter(load_on_demand_enabled,
"load-on-demand-enabled",
MZCONFIG_LOAD_DELAY_ENABLED),
env);
#endif
scheme_add_global_constant("flush-output",
scheme_make_noncm_prim(flush_output,
"flush-output",
0, 1),
env);
scheme_add_global_constant("file-position",
scheme_make_noncm_prim(scheme_file_position,
"file-position",
1, 2),
env);
scheme_add_global_constant("file-stream-buffer-mode",
scheme_make_noncm_prim(scheme_file_buffer,
"file-stream-buffer-mode",
1, 2),
env);
scheme_add_global_constant("port-file-identity",
scheme_make_noncm_prim(scheme_file_identity,
"port-file-identity",
1, 1),
env);
scheme_add_global_constant("make-pipe",
scheme_make_prim_w_arity2(sch_pipe,
"make-pipe",
0, 3,
2, 2),
env);
scheme_add_global_constant("pipe-content-length",
scheme_make_immed_prim(pipe_length,
"pipe-content-length",
1, 1),
env);
scheme_add_global_constant("port-count-lines!",
scheme_make_noncm_prim(port_count_lines,
"port-count-lines!",
1, 1),
env);
scheme_add_global_constant("port-next-location",
scheme_make_prim_w_arity2(port_next_location,
"port-next-location",
1, 1,
3, 3),
env);
scheme_add_global_constant("port-count-lines-enabled",
scheme_register_parameter(global_port_count_lines,
"port-count-lines-enabled",
MZCONFIG_PORT_COUNT_LINES),
env);
GLOBAL_IMMED_PRIM("pipe-content-length", pipe_length, 1, 1, env);
}
@ -744,30 +331,19 @@ void scheme_init_port_fun_config(void)
{
scheme_set_root_param(MZCONFIG_LOAD_DIRECTORY, scheme_false);
scheme_set_root_param(MZCONFIG_WRITE_DIRECTORY, scheme_false);
scheme_set_root_param(MZCONFIG_USE_COMPILED_KIND,
scheme_make_pair(scheme_make_path("compiled"),
scheme_null));
scheme_set_root_param(MZCONFIG_USE_USER_PATHS,
(scheme_ignore_user_paths
? scheme_false
: scheme_true));
scheme_set_root_param(MZCONFIG_USE_COMPILED_KIND, scheme_make_pair(scheme_make_path("compiled"), scheme_null));
scheme_set_root_param(MZCONFIG_USE_USER_PATHS, (scheme_ignore_user_paths ? scheme_false : scheme_true));
{
Scheme_Object *dlh;
dlh = scheme_make_prim_w_arity2(default_load,
"default-load-handler",
2, 2,
0, -1);
dlh = scheme_make_prim_w_arity2(default_load, "default-load-handler", 2, 2, 0, -1);
scheme_set_root_param(MZCONFIG_LOAD_HANDLER, dlh);
}
REGISTER_SO(scheme_default_global_print_handler);
scheme_default_global_print_handler
= scheme_make_prim_w_arity(sch_default_global_port_print_handler,
"default-global-port-print-handler",
2, 2);
scheme_set_root_param(MZCONFIG_PORT_PRINT_HANDLER,
scheme_default_global_print_handler);
= scheme_make_prim_w_arity(sch_default_global_port_print_handler, "default-global-port-print-handler", 2, 2);
scheme_set_root_param(MZCONFIG_PORT_PRINT_HANDLER, scheme_default_global_print_handler);
}
/*========================================================================*/

View File

@ -2606,11 +2606,13 @@ void scheme_add_global_keyword_symbol(Scheme_Object *name, Scheme_Object *v, Sch
void scheme_add_global_constant(const char *name, Scheme_Object *v, Scheme_Env *env);
void scheme_add_global_constant_symbol(Scheme_Object *name, Scheme_Object *v, Scheme_Env *env);
#define GLOBAL_FOLDING_PRIM(name, func, a1, a2, a3, env) scheme_add_global_constant(name, scheme_make_folding_prim(func, name, a1, a2, a3), env)
#define GLOBAL_IMMED_PRIM(name, func, a1, a2, env) scheme_add_global_constant(name, scheme_make_immed_prim(func, name, a1, a2), env)
#define GLOBAL_PARAMETER(name, func, constant, env) scheme_add_global_constant(name, scheme_register_parameter(func, name, constant), env)
#define GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env) scheme_add_global_constant(name, scheme_make_prim_w_arity(func, name, a1, a2), env)
#define GLOBAL_FOLDING_PRIM(name, func, a1, a2, a3, env) scheme_add_global_constant(name, scheme_make_folding_prim(func, name, a1, a2, a3), env)
#define GLOBAL_IMMED_PRIM(name, func, a1, a2, env) scheme_add_global_constant(name, scheme_make_immed_prim(func, name, a1, a2), env)
#define GLOBAL_PARAMETER(name, func, constant, env) scheme_add_global_constant(name, scheme_register_parameter(func, name, constant), env)
#define GLOBAL_PRIM_W_ARITY(name, func, a1, a2, env) scheme_add_global_constant(name, scheme_make_prim_w_arity(func, name, a1, a2), env)
#define GLOBAL_PRIM_W_ARITY2(name, func, a1, a2, a3, a4, env) scheme_add_global_constant(name, scheme_make_prim_w_arity2(func, name, a1, a2, a3, a4), env)
#define GLOBAL_NONCM_PRIM(name, func, a1, a2, env) scheme_add_global_constant(name, scheme_make_noncm_prim(func, name, a1, a2), env)
Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Object *bdg, int is_def, Scheme_Object *phase);