1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: J.Wielemaker@cs.vu.nl
5 WWW: http://www.swi-prolog.org/projects/xpce/
6 Copyright (c) 2011-2015, University of Amsterdam
7 VU University Amsterdam
8 All rights reserved.
9
10 Redistribution and use in source and binary forms, with or without
11 modification, are permitted provided that the following conditions
12 are met:
13
14 1. Redistributions of source code must retain the above copyright
15 notice, this list of conditions and the following disclaimer.
16
17 2. Redistributions in binary form must reproduce the above copyright
18 notice, this list of conditions and the following disclaimer in
19 the documentation and/or other materials provided with the
20 distribution.
21
22 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
23 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
24 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
25 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
26 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
27 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
28 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
29 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
30 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
31 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
32 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
33 POSSIBILITY OF SUCH DAMAGE.
34 */
35
36 #ifdef HAVE_CONFIG_H
37 #include <config.h>
38 #endif
39
40 #include <stdio.h>
41 #include <SWI-Stream.h>
42 #include <SWI-Prolog.h>
43
44 #ifdef __WINDOWS__
45 #define O_PLMT 1
46 #include <windows.h>
47 #include <console.h>
48
49 #else /*__WINDOWS__*/
50
51 #include <X11/Xlib.h>
52 #include <X11/Intrinsic.h>
53 #define HAVE_UNISTD_H 1
54
55 #endif /*__WINDOWS__*/
56
57 #include <h/interface.h>
58
59 #ifdef HAVE_SYS_SELECT_H
60 #include <sys/select.h>
61 #endif
62 #ifdef HAVE_SYS_TIME_H
63 #include <sys/time.h>
64 #endif
65 #ifdef HAVE_SYS_TYPES_H
66 #include <sys/types.h>
67 #endif
68 #ifdef HAVE_UNISTD_H
69 #include <unistd.h>
70 #endif
71
72 #ifdef _REENTRANT
73 #include <pthread.h>
74
75 static pthread_mutex_t pce_dispatch_mutex = PTHREAD_MUTEX_INITIALIZER;
76 #define DLOCK() pthread_mutex_lock(&pce_dispatch_mutex)
77 #define DUNLOCK() pthread_mutex_unlock(&pce_dispatch_mutex)
78 #else
79 #define DLOCK()
80 #define DUNLOCK()
81 #define pthread_cleanup_push(h,a)
82 #define pthread_cleanup_pop(e)
83 #endif
84
85 #ifdef HAVE_SCHED_H
86 #include <sched.h>
87 #endif
88
89
90 /*******************************
91 * TYPES *
92 *******************************/
93
94 typedef enum goal_state
95 { G_WAITING,
96 G_RUNNING,
97 G_TRUE,
98 G_FALSE,
99 G_ERROR
100 } goal_state;
101
102 typedef struct
103 { module_t module; /* module to call in */
104 record_t goal; /* the term to call */
105 record_t result; /* exception/variables */
106 int acknowledge; /* If set, wait ( */
107 goal_state state; /* G_* */
108 #ifdef __WINDOWS__
109 DWORD client; /* id of client thread */
110 #else
111 pthread_cond_t cv;
112 pthread_mutex_t mutex;
113 #endif
114 } prolog_goal;
115
116
117 typedef struct
118 { int pce_thread;
119 PL_dispatch_hook_t input_hook;
120 int input_hook_saved;
121 #ifdef __WINDOWS__
122 HINSTANCE hinstance;
123 HWND window;
124 RlcUpdateHook update_hook;
125 #else /*__WINDOWS__*/
126 int pipe[2];
127 XtInputId id;
128 #endif /*__WINDOWS__*/
129 } context_t;
130
131 #ifdef O_PLMT
132 static int init_prolog_goal(prolog_goal *g, term_t goal, int acknowledge);
133 static void call_prolog_goal(prolog_goal *g);
134 #endif
135
136 static context_t context;
137
138
139 /*******************************
140 * ERRORS *
141 *******************************/
142
143 #ifdef O_PLMT
144 static int
type_error(term_t actual,const char * expected)145 type_error(term_t actual, const char *expected)
146 { term_t ex = PL_new_term_ref();
147
148 if ( (ex = PL_new_term_ref()) &&
149 PL_unify_term(ex,
150 PL_FUNCTOR_CHARS, "error", 2,
151 PL_FUNCTOR_CHARS, "type_error", 2,
152 PL_CHARS, expected,
153 PL_TERM, actual,
154 PL_VARIABLE) )
155 return PL_raise_exception(ex);
156
157 return FALSE;
158 }
159 #endif
160
161 #ifdef __WINDOWS__
162
163 /*******************************
164 * WINDOWS SOLUTION *
165 *******************************/
166
167 #define WM_CALL (WM_USER+56)
168 #define WM_CALL_DONE (WM_USER+57)
169
170 static LRESULT WINAPI
call_wnd_proc(HWND hwnd,UINT message,WPARAM wParam,LPARAM lParam)171 call_wnd_proc(HWND hwnd, UINT message, WPARAM wParam, LPARAM lParam)
172 { switch( message )
173 { case WM_CALL:
174 { prolog_goal *g = (prolog_goal *)lParam;
175
176 call_prolog_goal(g);
177 if ( g->acknowledge )
178 { PostThreadMessage(g->client, WM_CALL_DONE, 0, 0);
179 } else
180 { free(g);
181 }
182 pceRedraw(FALSE);
183
184 return 0;
185 }
186 }
187
188 return DefWindowProc(hwnd, message, wParam, lParam);
189 }
190
191 static char *
HiddenFrameClass()192 HiddenFrameClass()
193 { static char *name;
194 static WNDCLASS wndClass;
195
196 if ( !name )
197 { char buf[50];
198
199 context.hinstance = GetModuleHandle("xpce2pl");
200 sprintf(buf, "PceCallWin%d", (int)(intptr_t)context.hinstance);
201 name = strdup(buf);
202
203 wndClass.style = 0;
204 wndClass.lpfnWndProc = (LPVOID) call_wnd_proc;
205 wndClass.cbClsExtra = 0;
206 wndClass.cbWndExtra = 0;
207 wndClass.hInstance = context.hinstance;
208 wndClass.hIcon = NULL;
209 wndClass.hCursor = NULL;
210 wndClass.hbrBackground = GetStockObject(WHITE_BRUSH);
211 wndClass.lpszMenuName = NULL;
212 wndClass.lpszClassName = name;
213
214 RegisterClass(&wndClass);
215 }
216
217 return name;
218 }
219
220
221 static int
unsetup(int code,void * closure)222 unsetup(int code, void *closure)
223 { if ( context.window )
224 { DestroyWindow(context.window);
225 context.window = 0;
226 }
227
228 return 0;
229 }
230
231
232 static int
setup(void)233 setup(void)
234 { if ( context.window )
235 return TRUE;
236
237 DLOCK();
238 if ( !context.window )
239 { context.window = CreateWindow(HiddenFrameClass(),
240 "XPCE/SWI-Prolog call window",
241 WS_POPUP,
242 0, 0, 32, 32,
243 NULL, NULL, context.hinstance, NULL);
244 PL_on_halt(unsetup, NULL);
245 }
246 DUNLOCK();
247
248 return TRUE;
249 }
250
251
252 static foreign_t
in_pce_thread(term_t goal)253 in_pce_thread(term_t goal)
254 { prolog_goal *g = malloc(sizeof(*g));
255
256 if ( !g )
257 return PL_resource_error("memory");
258
259 if ( !init_prolog_goal(g, goal, FALSE) )
260 { free(g);
261 return FALSE;
262 }
263
264 PostMessage(context.window, WM_CALL, (WPARAM)0, (LPARAM)g);
265
266 return TRUE;
267 }
268
269
270 static foreign_t
in_pce_thread_sync2(term_t goal,term_t vars)271 in_pce_thread_sync2(term_t goal, term_t vars)
272 { prolog_goal *g = malloc(sizeof(*g));
273 MSG msg;
274 int rc = FALSE;
275
276 if ( !g )
277 return PL_resource_error("memory");
278
279 if ( !init_prolog_goal(g, goal, TRUE) )
280 { free(g);
281 return FALSE;
282 }
283
284 g->client = GetCurrentThreadId();
285 PostMessage(context.window, WM_CALL, (WPARAM)0, (LPARAM)g);
286
287 while( GetMessage(&msg, NULL, 0, 0) )
288 { TranslateMessage(&msg);
289 DispatchMessage(&msg);
290 if ( PL_handle_signals() < 0 )
291 return FALSE;
292
293 switch(g->state)
294 { case G_TRUE:
295 { term_t v = PL_new_term_ref();
296
297 rc = PL_recorded(g->result, v) && PL_unify(vars, v);
298 PL_erase(g->result);
299 goto out;
300 }
301 case G_FALSE:
302 goto out;
303 case G_ERROR:
304 { term_t ex = PL_new_term_ref();
305
306 if ( PL_recorded(g->result, ex) )
307 rc = PL_raise_exception(ex);
308 PL_erase(g->result);
309 goto out;
310 }
311 default:
312 continue;
313 }
314 }
315
316 out:
317 free(g);
318 return rc;
319 }
320
321
322 #else /*!__WINDOWS__*/
323
324
325 /*******************************
326 * X11 SCHEDULING *
327 *******************************/
328
329 #ifdef O_PLMT
330
331 static void
on_input(XtPointer xp,int * source,XtInputId * id)332 on_input(XtPointer xp, int *source, XtInputId *id)
333 { context_t *ctx = (context_t *)xp;
334 prolog_goal *g;
335 int n;
336
337 if ( (n=read(ctx->pipe[0], &g, sizeof(g))) == sizeof(g) )
338 { call_prolog_goal(g);
339 if ( g->acknowledge )
340 { pthread_cond_signal(&g->cv);
341 } else
342 { free(g);
343 }
344 pceRedraw(FALSE);
345 } else if ( n == 0 ) /* EOF: quit */
346 { close(ctx->pipe[0]);
347 ctx->pipe[0] = -1;
348 }
349 }
350
351
352 static int
setup(void)353 setup(void)
354 { if ( context.pipe[0] > 0 )
355 return TRUE;
356
357 DLOCK();
358 if ( context.pipe[0] == -1 )
359 { if ( pipe(context.pipe) == -1 )
360 { DUNLOCK();
361 return PL_resource_error("open_files");
362 }
363
364 context.id = XtAppAddInput(pceXtAppContext(NULL),
365 context.pipe[0],
366 (XtPointer)(XtInputReadMask),
367 on_input, &context);
368 }
369 DUNLOCK();
370
371 return TRUE;
372 }
373 #endif
374
375
376 static foreign_t
in_pce_thread(term_t goal)377 in_pce_thread(term_t goal)
378 {
379 #ifdef O_PLMT
380 prolog_goal *g;
381 int rc;
382
383 if ( !setup() )
384 return FALSE;
385
386 if ( !(g = malloc(sizeof(*g))) )
387 return PL_resource_error("memory");
388
389 if ( !init_prolog_goal(g, goal, FALSE) )
390 return FALSE;
391
392 rc = write(context.pipe[1], &g, sizeof(g));
393
394 if ( rc == sizeof(g) )
395 return TRUE;
396
397 return FALSE;
398 #else
399 return PL_call(goal, NULL);
400 #endif
401 }
402
403
404 static foreign_t
in_pce_thread_sync2(term_t goal,term_t vars)405 in_pce_thread_sync2(term_t goal, term_t vars)
406 {
407 #ifdef O_PLMT
408 prolog_goal *g;
409 int rc;
410
411 if ( !setup() )
412 return FALSE;
413
414 if ( !(g = malloc(sizeof(*g))) )
415 return PL_resource_error("memory");
416
417 if ( !init_prolog_goal(g, goal, TRUE) )
418 return FALSE;
419
420 pthread_cond_init(&g->cv, NULL);
421 pthread_mutex_init(&g->mutex, NULL);
422 rc = write(context.pipe[1], &g, sizeof(g));
423
424 if ( rc == sizeof(g) )
425 { rc = FALSE;
426 pthread_mutex_lock(&g->mutex);
427
428 for(;;)
429 {
430 struct timespec timeout;
431 #ifdef HAVE_CLOCK_GETTIME
432 struct timespec now;
433
434 clock_gettime(CLOCK_REALTIME, &now);
435 timeout.tv_sec = now.tv_sec;
436 timeout.tv_nsec = (now.tv_nsec+250000000);
437 #else
438 struct timeval now;
439
440 gettimeofday(&now, NULL);
441 timeout.tv_sec = now.tv_sec;
442 timeout.tv_nsec = (now.tv_usec+250000) * 1000;
443 #endif
444
445 if ( timeout.tv_nsec >= 1000000000 ) /* some platforms demand this */
446 { timeout.tv_nsec -= 1000000000;
447 timeout.tv_sec += 1;
448 }
449
450 pthread_cond_timedwait(&g->cv, &g->mutex, &timeout);
451 if ( PL_handle_signals() < 0 )
452 goto out;
453
454 switch(g->state)
455 { case G_TRUE:
456 { term_t v = PL_new_term_ref();
457
458 rc = PL_recorded(g->result, v) && PL_unify(vars, v);
459 PL_erase(g->result);
460 goto out;
461 }
462 case G_FALSE:
463 goto out;
464 case G_ERROR:
465 { term_t ex = PL_new_term_ref();
466
467 if ( PL_recorded(g->result, ex) )
468 rc = PL_raise_exception(ex);
469 PL_erase(g->result);
470 goto out;
471 }
472 default:
473 continue;
474 }
475 }
476 out:
477 pthread_mutex_unlock(&g->mutex);
478 }
479
480 pthread_mutex_destroy(&g->mutex);
481 pthread_cond_destroy(&g->cv);
482 free(g);
483
484 return rc;
485 #else /*O_PLMT*/
486 return PL_call(goal, NULL);
487 #endif /*O_PLMT*/
488 }
489
490 #endif /*!__WINDOWS__*/
491
492
493 /*******************************
494 * CREATE/EXECUTE GOAL *
495 *******************************/
496
497 #if O_PLMT
498 static int
init_prolog_goal(prolog_goal * g,term_t goal,int acknowledge)499 init_prolog_goal(prolog_goal *g, term_t goal, int acknowledge)
500 { term_t plain = PL_new_term_ref();
501
502 g->module = NULL;
503 g->acknowledge = acknowledge;
504 g->state = G_WAITING;
505 if ( !PL_strip_module(goal, &g->module, plain) )
506 return FALSE;
507 if ( !(PL_is_compound(plain) || PL_is_atom(plain)) )
508 return type_error(goal, "callable");
509 g->goal = PL_record(plain);
510
511 return TRUE;
512 }
513
514
515 static void
call_prolog_goal(prolog_goal * g)516 call_prolog_goal(prolog_goal *g)
517 { fid_t fid;
518 static predicate_t pred = NULL;
519 int rc;
520
521 if ( !pred )
522 pred = PL_predicate("call", 1, "user");
523
524 if ( (fid = PL_open_foreign_frame()) )
525 { term_t t = PL_new_term_ref();
526 term_t vars;
527 rc = PL_recorded(g->goal, t);
528 PL_erase(g->goal);
529 g->goal = 0;
530 g->state = G_RUNNING;
531 if ( rc )
532 { qid_t qid;
533 int flags = PL_Q_NORMAL;
534
535 if ( g->acknowledge )
536 { flags |= PL_Q_CATCH_EXCEPTION;
537 vars = PL_new_term_ref();
538 if ( !PL_get_arg(2, t, vars) || /* Goal-Vars */
539 !PL_get_arg(1, t, t) )
540 { PL_warning("ERROR: in_pce_thread: bad goal-vars term");
541 }
542 } else
543 { vars = 0;
544 }
545
546 if ( (qid = PL_open_query(g->module, flags, pred, t)) )
547 { rc = PL_next_solution(qid);
548
549 if ( rc )
550 { g->state = G_TRUE;
551 if ( vars )
552 g->result = PL_record(vars);
553 } else
554 { term_t ex;
555
556 if ( g->acknowledge && (ex=PL_exception(qid)) )
557 { g->result = PL_record(ex);
558 g->state = G_ERROR;
559 } else
560 { g->state = G_FALSE;
561 }
562 }
563
564 PL_cut_query(qid);
565 } else
566 PL_warning("ERROR: pce: out of global stack");
567 }
568 PL_discard_foreign_frame(fid);
569 } else
570 PL_warning("ERROR: pce: out of global stack");
571 }
572 #endif
573
574
575 #ifdef __WINDOWS__
576 /* from interface.c */
577 extern RlcUpdateHook indirect_rlc_update_hook(RlcUpdateHook hook);
578
579 static int
set_menu_thread(void)580 set_menu_thread(void)
581 { HMODULE hconsole;
582 int (*set_mt)(void);
583
584 if ( (hconsole=GetModuleHandle(NULL)) ) /* NULL gets the executable */
585 { if ( (set_mt = (void*)GetProcAddress(hconsole, "PL_set_menu_thread")) )
586 return (*set_mt)();
587 }
588
589 return FALSE;
590 }
591 #endif
592
593
594 static foreign_t
set_pce_thread(void)595 set_pce_thread(void)
596 { int tid = PL_thread_self();
597
598 if ( tid != context.pce_thread )
599 { context.pce_thread = tid;
600
601 if ( context.input_hook_saved )
602 { PL_dispatch_hook(context.input_hook);
603 #ifdef __WINDOWS__
604 indirect_rlc_update_hook(context.update_hook);
605 #endif
606 context.input_hook_saved = FALSE;
607 }
608
609 #ifdef __WINDOWS__
610 if ( context.window )
611 { DestroyWindow(context.window);
612 context.window = 0;
613 }
614 setPceThread(GetCurrentThreadId());
615 setup();
616 set_menu_thread();
617 #endif
618
619 if ( context.pce_thread != 1 )
620 { context.input_hook = PL_dispatch_hook(NULL);
621 #ifdef __WINDOWS__
622 context.update_hook = indirect_rlc_update_hook(NULL);
623 #endif
624 context.input_hook_saved = TRUE;
625 }
626 }
627
628 return TRUE;
629 }
630
631
632 static foreign_t
pl_pce_dispatch(void)633 pl_pce_dispatch(void)
634 { pceDispatch(-1, 250);
635
636 if ( PL_handle_signals() == -1 || PL_exception(0) )
637 return FALSE;
638
639 return TRUE;
640 }
641
642
643
644 /*******************************
645 * INSTALL *
646 *******************************/
647
648 install_t
install_pcecall(void)649 install_pcecall(void)
650 { context.pce_thread = PL_thread_self();
651
652 #ifdef __WINDOWS__
653 setup();
654 #else
655 context.pipe[0] = context.pipe[1] = -1;
656 #endif
657
658 PL_register_foreign("in_pce_thread", 1,
659 in_pce_thread, PL_FA_META, "0");
660 PL_register_foreign("in_pce_thread_sync2", 2, in_pce_thread_sync2, 0);
661 PL_register_foreign("set_pce_thread", 0, set_pce_thread, 0);
662 PL_register_foreign("pce_dispatch", 0, pl_pce_dispatch, 0);
663 }
664