diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index 68d02bfaf7..7788721844 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -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, diff --git a/src/mzscheme/src/error.c b/src/mzscheme/src/error.c index 1f53775c9e..f5dc7df568 100644 --- a/src/mzscheme/src/error.c +++ b/src/mzscheme/src/error.c @@ -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 diff --git a/src/mzscheme/src/portfun.c b/src/mzscheme/src/portfun.c index 2ba62999b4..7614cbafeb 100644 --- a/src/mzscheme/src/portfun.c +++ b/src/mzscheme/src/portfun.c @@ -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); } /*========================================================================*/ diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index c7f94ef4a8..5267a9edb3 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -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);