1 /*
2 Copyright (C) 2004-2017,2018 John E. Davis
3
4 This file is part of the S-Lang Library.
5
6 The S-Lang Library is free software; you can redistribute it and/or
7 modify it under the terms of the GNU General Public License as
8 published by the Free Software Foundation; either version 2 of the
9 License, or (at your option) any later version.
10
11 The S-Lang Library is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
14 General Public License for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with this library; if not, write to the Free Software
18 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
19 USA.
20 */
21
22 #include "slinclud.h"
23 #include "slang.h"
24 #include "_slang.h"
25
26 #if SLANG_HAS_BOSEOS
27 static SLang_Name_Type *BOS_Callback_Handler = NULL;
28 static SLang_Name_Type *EOS_Callback_Handler = NULL;
29 static SLang_Name_Type *BOF_Callback_Handler = NULL;
30 static SLang_Name_Type *EOF_Callback_Handler = NULL;
31
set_bos_eos_handlers(SLang_Name_Type * bos,SLang_Name_Type * eos)32 static void set_bos_eos_handlers (SLang_Name_Type *bos, SLang_Name_Type *eos)
33 {
34 if (BOS_Callback_Handler != NULL)
35 SLang_free_function (BOS_Callback_Handler);
36 BOS_Callback_Handler = bos;
37
38 if (EOS_Callback_Handler != NULL)
39 SLang_free_function (EOS_Callback_Handler);
40 EOS_Callback_Handler = eos;
41 }
42
set_bof_eof_handlers(SLang_Name_Type * bof,SLang_Name_Type * eof)43 static void set_bof_eof_handlers (SLang_Name_Type *bof, SLang_Name_Type *eof)
44 {
45 if (BOF_Callback_Handler != NULL)
46 SLang_free_function (BOF_Callback_Handler);
47 BOF_Callback_Handler = bof;
48
49 if (EOF_Callback_Handler != NULL)
50 SLang_free_function (EOF_Callback_Handler);
51 EOF_Callback_Handler = eof;
52 }
53
54 static int Handler_Active = 0;
55
_pSLcall_bos_handler(SLFUTURE_CONST char * file,int line)56 int _pSLcall_bos_handler (SLFUTURE_CONST char *file, int line)
57 {
58 int status = 0;
59 int err;
60
61 if (BOS_Callback_Handler == NULL)
62 return 0;
63
64 if (Handler_Active)
65 return 0;
66
67 if ((0 != (err = _pSLang_Error))
68 && (-1 == _pSLang_push_error_context ()))
69 return -1;
70
71 Handler_Active++;
72 if ((-1 == SLang_start_arg_list ())
73 || (-1 == SLang_push_string (file))
74 || (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
75 || (-1 == SLang_end_arg_list ())
76 || (-1 == SLexecute_function (BOS_Callback_Handler)))
77 {
78 set_bos_eos_handlers (NULL, NULL);
79 status = -1;
80 }
81 Handler_Active--;
82
83 if (err)
84 _pSLang_pop_error_context (status != 0);
85
86 return status;
87 }
88
_pSLcall_eos_handler(void)89 int _pSLcall_eos_handler (void)
90 {
91 int err, status = 0;
92
93 if ((EOS_Callback_Handler == NULL)
94 || (Handler_Active))
95 return 0;
96
97 if ((0 != (err = _pSLang_Error))
98 && (-1 == _pSLang_push_error_context ()))
99 return -1;
100
101 Handler_Active++;
102 if ((-1 == SLang_start_arg_list ())
103 || (-1 == SLang_end_arg_list ())
104 || (-1 == SLexecute_function (EOS_Callback_Handler)))
105 {
106 status = -1;
107 set_bos_eos_handlers (NULL, NULL);
108 }
109 Handler_Active--;
110 if (err)
111 _pSLang_pop_error_context (status != 0);
112
113 return status;
114 }
115
_pSLcall_bof_handler(SLFUTURE_CONST char * fun,SLFUTURE_CONST char * file)116 int _pSLcall_bof_handler (SLFUTURE_CONST char *fun, SLFUTURE_CONST char *file)
117 {
118 int status = 0, err;
119
120 if (BOF_Callback_Handler == NULL)
121 return 0;
122
123 if (Handler_Active)
124 return 0;
125
126 if ((0 != (err = _pSLang_Error))
127 && (-1 == _pSLang_push_error_context ()))
128 return -1;
129
130 Handler_Active++;
131 if ((-1 == SLang_start_arg_list ())
132 || (-1 == SLang_push_string (fun))
133 || (-1 == SLang_push_string (file))
134 || (-1 == SLang_end_arg_list ())
135 || (-1 == SLexecute_function (BOF_Callback_Handler)))
136 {
137 set_bof_eof_handlers (NULL, NULL);
138 status = -1;
139 }
140 Handler_Active--;
141 if (err)
142 _pSLang_pop_error_context (status != 0);
143 return status;
144 }
145
_pSLcall_eof_handler(void)146 int _pSLcall_eof_handler (void)
147 {
148 int status = 0, err;
149
150 if ((EOF_Callback_Handler == NULL)
151 || (Handler_Active))
152 return 0;
153
154 if ((0 != (err = _pSLang_Error))
155 && (-1 == _pSLang_push_error_context ()))
156 return -1;
157
158 Handler_Active++;
159 if ((-1 == SLang_start_arg_list ())
160 || (-1 == SLang_end_arg_list ())
161 || (-1 == SLexecute_function (EOF_Callback_Handler)))
162 {
163 status = -1;
164 set_bof_eof_handlers (NULL, NULL);
165 }
166 Handler_Active--;
167 if (err)
168 _pSLang_pop_error_context (status != 0);
169 return status;
170 }
171
pop_new_push_old(SLang_Name_Type ** handler)172 static int pop_new_push_old (SLang_Name_Type **handler)
173 {
174 SLang_Name_Type *new_handler;
175 SLang_Name_Type *old_handler;
176
177 old_handler = *handler;
178 if (SLang_peek_at_stack () == SLANG_NULL_TYPE)
179 {
180 SLang_pop_null ();
181 new_handler = NULL;
182 }
183 else if (NULL == (new_handler = SLang_pop_function ()))
184 return -1;
185
186 if (-1 == _pSLang_push_nt_as_ref (old_handler))
187 {
188 SLang_free_function (new_handler);
189 return -1;
190 }
191
192 SLang_free_function (old_handler);
193 *handler = new_handler;
194 return 0;
195 }
196
set_bos_handler(void)197 static void set_bos_handler (void)
198 {
199 (void) pop_new_push_old (&BOS_Callback_Handler);
200 }
201
set_eos_handler(void)202 static void set_eos_handler (void)
203 {
204 (void) pop_new_push_old (&EOS_Callback_Handler);
205 }
206
set_bof_handler(void)207 static void set_bof_handler (void)
208 {
209 (void) pop_new_push_old (&BOF_Callback_Handler);
210 }
211
set_eof_handler(void)212 static void set_eof_handler (void)
213 {
214 (void) pop_new_push_old (&EOF_Callback_Handler);
215 }
216
217 #if SLANG_HAS_DEBUGGER_SUPPORT
218 static SLang_Name_Type *Debug_Hook = NULL;
219 static int Debug_Handler_Active = 0;
220
set_debug_hook(SLang_Name_Type * deb)221 static void set_debug_hook (SLang_Name_Type *deb)
222 {
223 if (Debug_Hook != NULL)
224 SLang_free_function (Debug_Hook);
225 Debug_Hook = deb;
226 }
227
228 /* int _pSLcall_debug_hook (char *file, int line, char *funct) */
_pSLcall_debug_hook(SLFUTURE_CONST char * file,int line)229 int _pSLcall_debug_hook (SLFUTURE_CONST char *file, int line)
230 {
231 int status = 0, err;
232
233 if (Debug_Hook == NULL)
234 return 0;
235
236 if (Debug_Handler_Active)
237 return 0;
238
239 if ((0 != (err = _pSLang_Error))
240 && (-1 == _pSLang_push_error_context ()))
241 return -1;
242
243 Debug_Handler_Active++;
244 if ((-1 == SLang_start_arg_list ())
245 || (-1 == SLang_push_string (file))
246 || (-1 == SLclass_push_int_obj (SLANG_INT_TYPE, line))
247 || (-1 == SLang_end_arg_list ())
248 || (-1 == SLexecute_function (Debug_Hook)))
249 {
250 status = -1;
251 set_debug_hook (NULL);
252 }
253 Debug_Handler_Active--;
254
255 if (err)
256 (void) _pSLang_pop_error_context (status != 0);
257
258 return status;
259 }
260
set_debug_hook_intrin(void)261 static void set_debug_hook_intrin (void)
262 {
263 pop_new_push_old (&Debug_Hook);
264 }
265
get_frame_variable(int * depth,char * name)266 static void get_frame_variable (int *depth, char *name)
267 {
268 (void) _pSLang_get_frame_variable ((unsigned int) *depth, name);
269 }
270
set_frame_variable(void)271 static void set_frame_variable (void)
272 {
273 char *name;
274 int depth;
275
276 if (-1 == SLroll_stack (3))
277 return;
278
279 if (-1 == SLang_pop_slstring (&name))
280 return;
281
282 if (0 == SLang_pop_int (&depth))
283 (void) _pSLang_set_frame_variable ((unsigned int) depth, name);
284 SLang_free_slstring (name);
285 }
286
get_frame_info(int * depth)287 static void get_frame_info (int *depth)
288 {
289 #define NUM_INFO_FIELDS 5
290 static SLFUTURE_CONST char *field_names[NUM_INFO_FIELDS] =
291 {
292 "file", "line", "function", "locals", "namespace"
293 };
294 SLtype field_types[NUM_INFO_FIELDS];
295 VOID_STAR field_values[NUM_INFO_FIELDS];
296 SLang_Array_Type *at = NULL;
297 _pSLang_Frame_Info_Type f;
298 unsigned int i;
299
300 if (-1 == _pSLang_get_frame_fun_info ((unsigned int)*depth, &f))
301 return;
302
303 i = 0;
304
305 field_values[i] = (VOID_STAR) &f.file;
306 if (f.file == NULL)
307 field_types[i] = SLANG_NULL_TYPE;
308 else
309 field_types[i] = SLANG_STRING_TYPE;
310 i++;
311
312 field_values[i] = &f.line;
313 field_types[i] = SLANG_UINT_TYPE;
314 i++;
315
316 field_values[i] = (VOID_STAR) &f.function;
317 if (f.function == NULL)
318 field_types[i] = SLANG_NULL_TYPE;
319 else
320 field_types[i] = SLANG_STRING_TYPE;
321 i++;
322
323 if (f.locals == NULL)
324 {
325 field_types[i] = SLANG_NULL_TYPE;
326 field_values[i] = (VOID_STAR) &f.locals;
327 }
328 else
329 {
330 if (NULL == (at = _pSLstrings_to_array (f.locals, f.nlocals)))
331 return;
332
333 field_values[i] = &at;
334 field_types[i] = SLANG_ARRAY_TYPE;
335 }
336 i++;
337
338 field_values[i] = (VOID_STAR) &f.ns;
339 if (f.ns == NULL)
340 field_types[i] = SLANG_NULL_TYPE;
341 else
342 field_types[i] = SLANG_STRING_TYPE;
343 i++;
344
345 (void) SLstruct_create_struct (NUM_INFO_FIELDS, field_names, field_types, field_values);
346
347 if (at != NULL)
348 SLang_free_array (at);
349 }
350
get_frame_depth(void)351 static int get_frame_depth (void)
352 {
353 return _pSLang_get_frame_depth ();
354 }
355
use_frame_namespace(int * depth)356 static void use_frame_namespace (int *depth)
357 {
358 _pSLang_use_frame_namespace (*depth);
359 }
360
361 #endif
362
363 static SLang_Intrin_Fun_Type Intrin_Funs [] =
364 {
365 MAKE_INTRINSIC_0("_set_bos_handler", set_bos_handler, SLANG_VOID_TYPE),
366 MAKE_INTRINSIC_0("_set_eos_handler", set_eos_handler, SLANG_VOID_TYPE),
367 MAKE_INTRINSIC_0("_set_bof_handler", set_bof_handler, SLANG_VOID_TYPE),
368 MAKE_INTRINSIC_0("_set_eof_handler", set_eof_handler, SLANG_VOID_TYPE),
369 #if SLANG_HAS_DEBUGGER_SUPPORT
370 MAKE_INTRINSIC_0("_set_frame_variable", set_frame_variable, SLANG_VOID_TYPE),
371 MAKE_INTRINSIC_IS("_get_frame_variable", get_frame_variable, SLANG_VOID_TYPE),
372 MAKE_INTRINSIC_0("_get_frame_depth", get_frame_depth, SLANG_INT_TYPE),
373 MAKE_INTRINSIC_I("_get_frame_info", get_frame_info, SLANG_VOID_TYPE),
374 MAKE_INTRINSIC_I("_use_frame_namespace", use_frame_namespace, SLANG_VOID_TYPE),
375 MAKE_INTRINSIC_0("_set_debug_hook", set_debug_hook_intrin, SLANG_VOID_TYPE),
376 #endif
377 SLANG_END_INTRIN_FUN_TABLE
378 };
379
_pSLang_init_boseos(void)380 int _pSLang_init_boseos (void)
381 {
382 return SLadd_intrin_fun_table (Intrin_Funs, NULL);
383 }
384 #endif /* SLANG_HAS_BOSEOS */
385