1:
2: #define LIBGAUCHE_BODY
3: #include <gauche.h>
4: #if defined(__CYGWIN__) || defined(GAUCHE_WINDOWS)
5: #define SCM_CGEN_CONST
6: #else
7: #define SCM_CGEN_CONST const
8: #endif
9:
10: #include <gauche/class.h>
11: #include <gauche/exception.h>
12:
13: static SCM_CGEN_CONST struct scm__scRec {
14: ScmString d638[9];
15: } scm__sc = {
16: {
17: SCM_STRING_CONST_INITIALIZER("rewind-before", 13, 13),
18: SCM_STRING_CONST_INITIALIZER("with-error-handler", 18, 18),
19: SCM_STRING_CONST_INITIALIZER("current-exception-handler", 25, 25),
20: SCM_STRING_CONST_INITIALIZER("with-exception-handler", 22, 22),
21: SCM_STRING_CONST_INITIALIZER("raise", 5, 5),
22: SCM_STRING_CONST_INITIALIZER("report-error", 12, 12),
23: SCM_STRING_CONST_INITIALIZER("condition?", 10, 10),
24: SCM_STRING_CONST_INITIALIZER("condition-has-type?", 19, 19),
25: SCM_STRING_CONST_INITIALIZER("make-compound-condition", 23, 23),
26: },
27: };
28: static struct scm__rcRec {
29: ScmObj d637[1];
30: } scm__rc = {
31: {
32: SCM_UNBOUND,
33: },
34: };
35: static ScmObj exclib_with_error_handler(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
36: {
37: ScmObj handler_scm;
38: ScmObj handler;
39: ScmObj thunk_scm;
40: ScmObj thunk;
41: ScmObj rewind_before_scm = SCM_FALSE;
42: int rewind_before;
43: ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
44: SCM_ENTER_SUBR("with-error-handler");
45: handler_scm = SCM_ARGREF(0);
46: handler = (handler_scm);
47: thunk_scm = SCM_ARGREF(1);
48: thunk = (thunk_scm);
49: if (Scm_Length(SCM_OPTARGS) % 2)
50: Scm_Error("keyword list not even: %S", SCM_OPTARGS);
51: while (!SCM_NULLP(SCM_OPTARGS)) {
52: if (SCM_EQ(SCM_CAR(SCM_OPTARGS), scm__rc.d637[0])) {
53: rewind_before_scm = SCM_CADR(SCM_OPTARGS);
54: }
55: else Scm_Warn("unknown keyword %S", SCM_CAR(SCM_OPTARGS));
56: SCM_OPTARGS = SCM_CDDR(SCM_OPTARGS);
57: }
58: if (!SCM_BOOLP(rewind_before_scm)) Scm_Error("boolean required, but got %S", rewind_before_scm);
59: rewind_before = SCM_BOOL_VALUE(rewind_before_scm);
60: {
61: {
62: ScmObj SCM_RESULT;
63:
64: #line 49 "exclib.stub"
65: if (!(SCM_PROCEDURE_TAKE_NARG_P(handler,1))){
66: Scm_Error("error handler must take at least 1 argument, but got %S",handler);}
67:
68: #line 52 "exclib.stub"
69: if (!(SCM_PROCEDURE_THUNK_P(thunk))){
70: Scm_Error("thunk required, but got %S",thunk);}
71:
72: #line 54 "exclib.stub"
73: if (rewind_before)
74: SCM_RESULT=Scm_VMWithGuardHandler(handler,thunk); else
75: SCM_RESULT=Scm_VMWithErrorHandler(handler,thunk);
76: SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
77: }
78: }
79: }
80:
81: static SCM_DEFINE_SUBR(exclib_with_error_handler__STUB, 2, 1, SCM_OBJ(&scm__sc.d638[1]), exclib_with_error_handler, NULL, NULL);
82:
83: static ScmObj exclib_current_exception_handler(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
84: {
85: SCM_ENTER_SUBR("current-exception-handler");
86: {
87: {
88: ScmObj SCM_RESULT;
89: SCM_RESULT = (
90: #line 60 "exclib.stub"
91: (Scm_VM())->exceptionHandler);
92: SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
93: }
94: }
95: }
96:
97: static SCM_DEFINE_SUBR(exclib_current_exception_handler__STUB, 0, 0, SCM_OBJ(&scm__sc.d638[2]), exclib_current_exception_handler, NULL, NULL);
98:
99: static ScmObj exclib_with_exception_handler(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
100: {
101: ScmObj handler_scm;
102: ScmObj handler;
103: ScmObj thunk_scm;
104: ScmObj thunk;
105: SCM_ENTER_SUBR("with-exception-handler");
106: handler_scm = SCM_ARGREF(0);
107: handler = (handler_scm);
108: thunk_scm = SCM_ARGREF(1);
109: thunk = (thunk_scm);
110: {
111: {
112: ScmObj SCM_RESULT;
113: SCM_RESULT = Scm_VMWithExceptionHandler(handler, thunk);
114: SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
115: }
116: }
117: }
118:
119: static SCM_DEFINE_SUBR(exclib_with_exception_handler__STUB, 2, 0, SCM_OBJ(&scm__sc.d638[3]), exclib_with_exception_handler, NULL, NULL);
120:
121: static ScmObj exclib_raise(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
122: {
123: ScmObj exception_scm;
124: ScmObj exception;
125: SCM_ENTER_SUBR("raise");
126: exception_scm = SCM_ARGREF(0);
127: exception = (exception_scm);
128: {
129: {
130: ScmObj SCM_RESULT;
131: SCM_RESULT = Scm_Raise(exception);
132: SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
133: }
134: }
135: }
136:
137: static SCM_DEFINE_SUBR(exclib_raise__STUB, 1, 0, SCM_OBJ(&scm__sc.d638[4]), exclib_raise, NULL, NULL);
138:
139: static ScmObj exclib_report_error(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
140: {
141: ScmObj exception_scm;
142: ScmObj exception;
143: SCM_ENTER_SUBR("report-error");
144: exception_scm = SCM_ARGREF(0);
145: exception = (exception_scm);
146: {
147: Scm_ReportError(exception);
148: SCM_RETURN(SCM_UNDEFINED);
149: }
150: }
151:
152: static SCM_DEFINE_SUBR(exclib_report_error__STUB, 1, 0, SCM_OBJ(&scm__sc.d638[5]), exclib_report_error, NULL, NULL);
153:
154: static ScmObj exclib_conditionP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
155: {
156: ScmObj obj_scm;
157: ScmObj obj;
158: SCM_ENTER_SUBR("condition?");
159: obj_scm = SCM_ARGREF(0);
160: obj = (obj_scm);
161: {
162: {
163: int SCM_RESULT;
164: SCM_RESULT = SCM_CONDITIONP(obj);
165: SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
166: }
167: }
168: }
169:
170: static SCM_DEFINE_SUBR(exclib_conditionP__STUB, 1, 0, SCM_OBJ(&scm__sc.d638[6]), exclib_conditionP, NULL, NULL);
171:
172: static ScmObj exclib_condition_has_typeP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
173: {
174: ScmObj c_scm;
175: ScmObj c;
176: ScmObj k_scm;
177: ScmObj k;
178: SCM_ENTER_SUBR("condition-has-type?");
179: c_scm = SCM_ARGREF(0);
180: c = (c_scm);
181: k_scm = SCM_ARGREF(1);
182: k = (k_scm);
183: {
184: {
185: int SCM_RESULT;
186: SCM_RESULT = Scm_ConditionHasType(c, k);
187: SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
188: }
189: }
190: }
191:
192: static SCM_DEFINE_SUBR(exclib_condition_has_typeP__STUB, 2, 0, SCM_OBJ(&scm__sc.d638[7]), exclib_condition_has_typeP, NULL, NULL);
193:
194: static ScmObj exclib_make_compound_condition(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
195: {
196: ScmObj conditions_scm;
197: ScmObj conditions;
198: ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
199: SCM_ENTER_SUBR("make-compound-condition");
200: conditions_scm = SCM_OPTARGS;
201: conditions = (conditions_scm);
202: {
203: {
204: ScmObj SCM_RESULT;
205: SCM_RESULT = Scm_MakeCompoundCondition(conditions);
206: SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
207: }
208: }
209: }
210:
211: static SCM_DEFINE_SUBR(exclib_make_compound_condition__STUB, 0, 1, SCM_OBJ(&scm__sc.d638[8]), exclib_make_compound_condition, NULL, NULL);
212:
213: void Scm_Init_exclib(ScmModule *module)
214: {
215:
216: scm__rc.d637[0] = Scm_MakeKeyword(SCM_STRING(SCM_OBJ(&scm__sc.d638[0])));
217: SCM_DEFINE(module, "with-error-handler", SCM_OBJ(&exclib_with_error_handler__STUB));
218: SCM_DEFINE(module, "current-exception-handler", SCM_OBJ(&exclib_current_exception_handler__STUB));
219: SCM_DEFINE(module, "with-exception-handler", SCM_OBJ(&exclib_with_exception_handler__STUB));
220: SCM_DEFINE(module, "raise", SCM_OBJ(&exclib_raise__STUB));
221: SCM_DEFINE(module, "report-error", SCM_OBJ(&exclib_report_error__STUB));
222: SCM_DEFINE(module, "condition?", SCM_OBJ(&exclib_conditionP__STUB));
223: SCM_DEFINE(module, "condition-has-type?", SCM_OBJ(&exclib_condition_has_typeP__STUB));
224: SCM_DEFINE(module, "make-compound-condition", SCM_OBJ(&exclib_make_compound_condition__STUB));
225: }
