1 /* Part of XPCE --- The SWI-Prolog GUI toolkit
2
3 Author: Jan Wielemaker and Anjo Anjewierden
4 E-mail: jan@swi.psy.uva.nl
5 WWW: http://www.swi.psy.uva.nl/projects/xpce/
6 Copyright (c) 1985-2002, University of Amsterdam
7 All rights reserved.
8
9 Redistribution and use in source and binary forms, with or without
10 modification, are permitted provided that the following conditions
11 are met:
12
13 1. Redistributions of source code must retain the above copyright
14 notice, this list of conditions and the following disclaimer.
15
16 2. Redistributions in binary form must reproduce the above copyright
17 notice, this list of conditions and the following disclaimer in
18 the documentation and/or other materials provided with the
19 distribution.
20
21 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
24 FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
25 COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
26 INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
27 BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
28 LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
29 CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
30 LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
31 ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
32 POSSIBILITY OF SUCH DAMAGE.
33 */
34
35 #define INLINE_UTILITIES 1
36 #include <h/kernel.h>
37 #include <h/trace.h>
38 #include <h/interface.h>
39 #include <h/graphics.h>
40 #include <h/unix.h>
41 #include "stub.h"
42 #ifdef HAVE_UNISTD_H
43 #include <unistd.h>
44 #endif
45
46 #if !defined(FD_ZERO) && HAVE_SELECT
47 #include <sys/select.h>
48 #endif
49 #ifdef HAVE_CONIO_H /* AIX 4.1 requires this */
50 #include <conio.h>
51 #endif
52 #ifdef HAVE_BSTRING_H
53 #include <bstring.h>
54 #endif
55
56 /********************************
57 * C --> PCE *
58 ********************************/
59
60 Any
cToPceInteger(intptr_t i)61 cToPceInteger(intptr_t i)
62 { Int n = toInt(i);
63
64 if ( valInt(n) != i )
65 { errorPce(PCE, NAME_intRange);
66 fail;
67 }
68
69 return n;
70 }
71
72
73 Any
cToPceReal(double f)74 cToPceReal(double f)
75 { return CtoReal(f);
76 }
77
78
79 Any
cToPceStringA(Name assoc,const char * s,size_t len,int translate)80 cToPceStringA(Name assoc, const char *s, size_t len, int translate)
81 { Any str;
82 string ss;
83 Any c;
84
85 str_set_n_ascii(&ss, len, (char *)s);
86 c = StringToScratchCharArray(&ss);
87
88 if ( translate )
89 str = pceNew(assoc, ClassString, 1, &c);
90 else
91 { Any av[2];
92
93 av[0] = name_procent_s;
94 av[1] = c;
95 str = pceNew(assoc, ClassString, 2, av);
96 }
97 doneScratchCharArray(c);
98
99 return str;
100 }
101
102
103 Any
cToPceStringW(Name assoc,const wchar_t * s,size_t len,int translate)104 cToPceStringW(Name assoc, const wchar_t *s, size_t len, int translate)
105 { Any str;
106 string ss;
107 Any c;
108
109 str_set_n_wchar(&ss, len, (wchar_t*)s);
110 c = StringToScratchCharArray(&ss);
111
112 if ( translate )
113 str = pceNew(assoc, ClassString, 1, &c);
114 else
115 { Any av[2];
116
117 av[0] = name_procent_s;
118 av[1] = c;
119 str = pceNew(assoc, ClassString, 2, av);
120 }
121 doneScratchCharArray(c);
122
123 return str;
124 }
125
126
127 Any
cToPceName(const char * text)128 cToPceName(const char *text)
129 { if ( text )
130 { string s;
131
132 str_set_n_ascii(&s, strlen(text), (char *)text);
133
134 return StringToName(&s);
135 } else
136 fail;
137 }
138
139
140 Any
cToPceName_nA(const char * text,size_t len)141 cToPceName_nA(const char *text, size_t len)
142 { if ( text )
143 { string s;
144
145 str_set_n_ascii(&s, len, (char *)text);
146
147 return StringToName(&s);
148 } else
149 fail;
150 }
151
152
153 Any
cToPceName_nW(const wchar_t * text,size_t len)154 cToPceName_nW(const wchar_t *text, size_t len)
155 { return WCToName(text, len);
156 }
157
158
159 Any
cToPcePointer(void * ptr)160 cToPcePointer(void *ptr)
161 { CPointer p = answerObjectv(ClassCPointer, 0, NULL);
162
163 p->pointer = ptr;
164
165 return p;
166 }
167
168
169 void *
pcePointerToC(PceObject obj)170 pcePointerToC(PceObject obj)
171 { if ( instanceOfObject(obj, ClassCPointer) )
172 { CPointer ptr = (CPointer)obj;
173
174 return ptr->pointer;
175 }
176
177 return PCE_NO_POINTER;
178 }
179
180
181 Any
cToPceAssoc(const char * s)182 cToPceAssoc(const char *s)
183 { return getObjectFromReferencePce(PCE, CtoName(s));
184 }
185
186
187 PceObject
pceObjectFromName(PceName name)188 pceObjectFromName(PceName name)
189 { return findGlobal(name);
190 }
191
192
193 Any
cToPceReference(uintptr_t val)194 cToPceReference(uintptr_t val)
195 { Instance rval = longToPointer(val);
196
197 if ( rval &&
198 validAddress(rval) &&
199 (rval->flags & (OBJ_MAGIC_MASK|F_FREED)) == OBJ_MAGIC )
200 answer(rval);
201
202 fail;
203 }
204
205
206 int
pceExistsReference(uintptr_t ref)207 pceExistsReference(uintptr_t ref)
208 { Any addr = longToPointer(ref);
209
210 if ( !isProperObject(addr) || isFreedObj(addr) )
211 return PCE_FAIL;
212
213 return PCE_SUCCEED;
214 }
215
216
217 char *
pcePPReference(PceObject ref)218 pcePPReference(PceObject ref)
219 { if ( isInteger(ref) )
220 { Any addr = longToPointer(valInt(ref));
221 char *rval = pp(addr);
222
223 if ( rval[0] != '@' )
224 { char tmp[256];
225 sprintf(tmp, "@" INTPTR_FORMAT, valInt(ref));
226 return save_string(tmp);
227 } else
228 return rval;
229 } else if ( isName(ref) )
230 { Any addr;
231
232 if ( !(addr = getObjectAssoc(ref)) )
233 { char tmp[256];
234
235 sprintf(tmp, "@%s", strName(ref));
236 return save_string(tmp);
237 } else
238 return pp(addr);
239 } else
240 return save_string("invalid reference");
241 }
242
243
244 int
pceExistsAssoc(PceName assoc)245 pceExistsAssoc(PceName assoc)
246 { Any addr;
247
248 if ( !(addr = getObjectAssoc(assoc)) )
249 return PCE_FAIL;
250 if ( !isProperObject(addr) || isFreedObj(addr) )
251 return PCE_FAIL;
252
253 return PCE_SUCCEED;
254 }
255
256
257 PceObject
cToPceTmpCharArray(const char * s)258 cToPceTmpCharArray(const char *s)
259 { return CtoScratchCharArray(s);
260 }
261
262
263 void
donePceTmpCharArray(Any ca)264 donePceTmpCharArray(Any ca)
265 { doneScratchCharArray(ca);
266 }
267
268 /*******************************
269 * GC *
270 *******************************/
271
272 export void
_markAnswerStack(AnswerMark * mark)273 _markAnswerStack(AnswerMark *mark)
274 { *mark = AnswerStack->index;
275 }
276
277
278 /********************************
279 * TYPE TEST *
280 ********************************/
281
282 status
pceInstanceOf(Any obj,Any classspec)283 pceInstanceOf(Any obj, Any classspec)
284 { Class class;
285
286 if ( (class = checkType(classspec, TypeClass, NIL)) )
287 return instanceOfObject(obj, class);
288
289 errorPce(CtoName(pp(classspec)), NAME_unexpectedType, TypeClass);
290 fail;
291 }
292
293
294 PceClass
nameToExistingClass(PceName Name)295 nameToExistingClass(PceName Name)
296 { return getMemberHashTable(classTable, Name);
297 }
298
299
300 PceClass
pceClassOfObject(PceObject obj)301 pceClassOfObject(PceObject obj)
302 { if ( isObject(obj) )
303 return classOfObject(obj);
304
305 fail;
306 }
307
308
309 int
pceReferencesOfObject(PceObject obj)310 pceReferencesOfObject(PceObject obj)
311 { if ( isObject(obj) )
312 return refsObject(obj);
313
314 return -1;
315 }
316
317
318 int
pceFreeObject(PceObject obj)319 pceFreeObject(PceObject obj)
320 { if ( isObject(obj) )
321 return freeObject(obj);
322
323 fail;
324 }
325
326
327 void
pceSendMethod(PceClass class,const char * name,const char * group,int argc,...)328 pceSendMethod(PceClass class,
329 const char *name,
330 const char *group,
331 int argc,
332 ...)
333 { Name n, g;
334 va_list args;
335
336 va_start(args, argc);
337
338 n = cToPceName(name);
339 g = group ? cToPceName(group) : (Name)DEFAULT;
340 sendMethodv(class, n, g, argc, args);
341 va_end(args);
342 }
343
344
345 void
pceGetMethod(PceClass class,const char * name,const char * group,const char * rtype,int argc,...)346 pceGetMethod(PceClass class,
347 const char *name,
348 const char *group,
349 const char *rtype,
350 int argc,
351 ...)
352 { Name n, g;
353 va_list args;
354
355 va_start(args, argc);
356
357 n = cToPceName(name);
358 g = group ? cToPceName(group) : (Name)DEFAULT;
359 getMethodv(class, n, g, rtype, argc, args);
360 va_end(args);
361 }
362
363
364 /********************************
365 * PCE --> C *
366 ********************************/
367
368 int
pceToCReference(Any obj,PceCValue * rval)369 pceToCReference(Any obj, PceCValue *rval)
370 { assert(isObject(obj));
371
372 if ( onFlag(obj, F_ASSOC) )
373 { rval->itf_symbol = getMemberHashTable(ObjectToITFTable, obj);
374 return PCE_ASSOC;
375 } else
376 { rval->integer = valInt(PointerToInt(obj));
377 return PCE_REFERENCE;
378 }
379 }
380
381
382 int
pceToC(Any obj,PceCValue * rval)383 pceToC(Any obj, PceCValue *rval)
384 { if ( isInteger(obj) )
385 { rval->integer = valInt((Int) obj);
386 return PCE_INTEGER;
387 }
388
389 assert(obj);
390
391 if ( onFlag(obj, F_ASSOC|F_ISNAME|F_ISREAL|F_ISHOSTDATA) )
392 { if ( onFlag(obj, F_ASSOC) )
393 { rval->itf_symbol = getMemberHashTable(ObjectToITFTable, obj);
394 return PCE_ASSOC;
395 }
396 if ( onFlag(obj, F_ISNAME) )
397 { rval->itf_symbol = getITFSymbolName(obj);
398 return PCE_NAME;
399 }
400 if ( onFlag(obj, F_ISHOSTDATA) )
401 { rval->pointer = ((HostData)obj)->handle;
402 return PCE_HOSTDATA;
403 }
404 { rval->real = valReal(obj);
405 return PCE_REAL;
406 }
407 } else
408 { rval->integer = PointerToCInt(obj);
409 return PCE_REFERENCE;
410 }
411 }
412
413
414 int
pceIsString(Any val)415 pceIsString(Any val)
416 { return instanceOfObject(val, ClassString) ? TRUE : FALSE;
417 }
418
419
420 char *
pceCharArrayToCA(Any val,size_t * len)421 pceCharArrayToCA(Any val, size_t *len)
422 { if ( instanceOfObject(val, ClassCharArray) )
423 { CharArray ca = val;
424
425 if ( isstrA(&ca->data) )
426 { if ( len )
427 *len = ca->data.s_size;
428
429 return (char*)ca->data.s_textA;
430 }
431 }
432
433 return NULL;
434 }
435
436
437 wchar_t *
pceCharArrayToCW(Any val,size_t * len)438 pceCharArrayToCW(Any val, size_t *len)
439 { if ( instanceOfObject(val, ClassCharArray) )
440 { CharArray ca = val;
441
442 if ( isstrW(&ca->data) )
443 { if ( len )
444 *len = ca->data.s_size;
445
446 return ca->data.s_textW;
447 }
448 }
449
450 return NULL;
451 }
452
453
454 int
pceObject(Any obj)455 pceObject(Any obj)
456 { return isObject(obj) ? PCE_SUCCEED : PCE_FAIL;
457 }
458
459 /*******************************
460 * METHOD *
461 *******************************/
462
463 static void
convert_trace_flags(PceMethod m,int * flags)464 convert_trace_flags(PceMethod m, int *flags)
465 { static struct dflagmap
466 { int internal;
467 int external;
468 } staticmap[] =
469 { { D_TRACE_ENTER, PCE_METHOD_INFO_TRACE_ENTER },
470 { D_TRACE_EXIT, PCE_METHOD_INFO_TRACE_EXIT },
471 { D_TRACE_FAIL, PCE_METHOD_INFO_TRACE_FAIL },
472 { D_BREAK_ENTER, PCE_METHOD_INFO_BREAK_ENTER },
473 { D_BREAK_EXIT, PCE_METHOD_INFO_BREAK_EXIT },
474 { D_BREAK_FAIL, PCE_METHOD_INFO_BREAK_FAIL },
475 { 0, 0 }
476 };
477 struct dflagmap *map = staticmap;
478
479 for( ; map->internal; map++ )
480 { if ( onDFlag(m, map->internal) )
481 *flags |= map->external;
482 }
483 }
484
485
486 int
pceGetMethodInfo(PceMethod m,pce_method_info * info)487 pceGetMethodInfo(PceMethod m, pce_method_info *info)
488 { if ( onDFlag(m, D_HOSTMETHOD) )
489 { CPointer p = (CPointer)m->message;
490
491 info->handle = p->pointer;
492 if ( DebuggingProgramObject(m, D_TRACE|D_BREAK) )
493 convert_trace_flags(m, &info->flags);
494
495 if ( !(m->flags & PCE_METHOD_INFO_HANDLE_ONLY) )
496 { info->name = m->name;
497 info->context = ((Class)m->context)->name;
498 info->argc = valInt(m->types->size);
499 info->types = (PceType*)m->types->elements;
500 }
501
502 succeed;
503 }
504
505 fail;
506 }
507
508
509 /********************************
510 * SYMBOL-TABLE *
511 ********************************/
512
513 PceITFSymbol
getITFSymbolName(Name name)514 getITFSymbolName(Name name)
515 { if ( onFlag(name, F_ITFNAME) )
516 return getMemberHashTable(NameToITFTable, name);
517 else
518 { PceITFSymbol symbol = newSymbol(NULL, name);
519
520 setFlag(name, F_ITFNAME);
521 appendHashTable(NameToITFTable, name, symbol);
522
523 return symbol;
524 }
525 }
526
527
528 PceITFSymbol
pceLookupHandle(int n,hostHandle handle)529 pceLookupHandle(int n, hostHandle handle)
530 { return getMemberHashTable(HandleToITFTables[n], handle);
531 }
532
533
534 void
pceRegisterName(int n,hostHandle handle,Name name)535 pceRegisterName(int n, hostHandle handle, Name name)
536 { PceITFSymbol symbol = getITFSymbolName(name);
537
538 symbol->handle[n] = handle;
539 appendHashTable(HandleToITFTables[n], handle, symbol);
540 }
541
542
543 void
pceRegisterAssoc(int n,hostHandle handle,Any obj)544 pceRegisterAssoc(int n, hostHandle handle, Any obj)
545 { if ( (isObject(obj) && onFlag(obj, F_ASSOC)) )
546 { PceITFSymbol symbol = getMemberHashTable(ObjectToITFTable, obj);
547 symbol->handle[n] = handle;
548 appendHashTable(HandleToITFTables[n], handle, symbol);
549 } else
550 { PceITFSymbol symbol = newSymbol(obj, NULL);
551 symbol->handle[n] = handle;
552
553 if ( isObject(obj) )
554 setFlag(obj, F_ASSOC);
555 appendHashTable(HandleToITFTables[n], handle, symbol);
556 appendHashTable(ObjectToITFTable, obj, symbol);
557 }
558 }
559
560
561 /********************************
562 * VIRTUAL MACHINE INSTRUCTIONS *
563 ********************************/
564
565 Any
pceNew(Name assoc,Any class,int argc,Any * argv)566 pceNew(Name assoc, Any class, int argc, Any *argv)
567 { Any rval;
568
569 if ( (rval = createObjectv(assoc, class, argc, argv)) )
570 pushAnswerObject(rval);
571
572 return rval;
573 }
574
575
576 status
pceSend(Any receiver,Name classname,Name selector,int argc,Any * argv)577 pceSend(Any receiver, Name classname, Name selector, int argc, Any *argv)
578 { Class cl;
579
580 if ( classname )
581 { if ( !(cl = getMemberHashTable(classTable, classname)) )
582 return errorPce(receiver, NAME_noClass, classname);
583 if ( !instanceOfObject(receiver, cl) )
584 return errorPce(receiver, NAME_noSuperClassOf, classname);
585 } else
586 cl = NULL;
587
588 return vm_send(receiver, selector, cl, argc, argv);
589 }
590
591
592 Any
pceGet(Any receiver,Name classname,Name selector,int argc,Any * argv)593 pceGet(Any receiver, Name classname, Name selector, int argc, Any *argv)
594 { Class cl;
595
596 if ( classname )
597 { if ( !(cl = getMemberHashTable(classTable, classname)) )
598 { errorPce(receiver, NAME_noClass, classname);
599 fail;
600 }
601 if ( !instanceOfObject(receiver, cl) )
602 { errorPce(receiver, NAME_noSuperClassOf, classname);
603 fail;
604 }
605 } else
606 cl = NULL;
607
608 return vm_get(receiver, selector, cl, argc, argv);
609 }
610
611
612 /********************************
613 * EVENT DISPATCHING *
614 ********************************/
615
616 #ifndef FD_ZERO
617 #define FD_ZERO(x) {(x)->fds_bits[0] = 0;}
618 #define FD_SET(n, x) {(x)->fds_bits[0] |= 1<<(n); }
619 #endif
620
621 #if !defined(HAVE_SELECT) && defined(HAVE_CONIO_H)
622 #include <conio.h>
623 #endif
624
625 int
pceDispatch(int fd,int time)626 pceDispatch(int fd, int time)
627 { if ( DispatchEvents != NULL )
628 { int rval;
629
630 rval = (*DispatchEvents)(fd, time);
631
632 return (rval == SUCCEED ? PCE_DISPATCH_INPUT : PCE_DISPATCH_TIMEOUT);
633 } else
634 {
635 #ifndef HAVE_SELECT
636 ws_dispatch(toInt(fd), toInt(time));
637 return PCE_DISPATCH_TIMEOUT;
638 #else
639 if ( time > 0 )
640 { struct timeval timeout;
641 fd_set readfds;
642
643 timeout.tv_sec = time / 1000;
644 timeout.tv_usec = (time % 1000) * 1000;
645
646 FD_ZERO(&readfds);
647 FD_SET(fd, &readfds);
648 if ( select(fd+1, &readfds, NULL, NULL, &timeout) > 0 )
649 return PCE_DISPATCH_INPUT;
650 else
651 return PCE_DISPATCH_TIMEOUT;
652 } else
653 { fd_set readfds;
654 FD_ZERO(&readfds);
655 FD_SET(fd, &readfds);
656 select(fd+1, &readfds, NULL, NULL, NULL);
657 return PCE_DISPATCH_INPUT;
658 }
659 #endif /*HAVE_SELECT*/
660 }
661 }
662
663
664 void
pceRedraw(int sync)665 pceRedraw(int sync)
666 { if ( sync )
667 { static DisplayObj d = NULL;
668
669 if ( !d && !(d = CurrentDisplay(NIL)) )
670 return;
671
672 synchroniseDisplay(d);
673 } else
674 { static DisplayManager dm = NULL;
675
676 if ( !dm && !(dm = getObjectAssoc(NAME_displayManager)) )
677 return;
678
679 RedrawDisplayManager(dm);
680 }
681 }
682
683 /********************************
684 * DEBUGGING *
685 ********************************/
686
687 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
688 pceExecuteMode()
689 returns PCE_EXEC_USER is the goal is to be processed in `user'
690 space, and PCE_EXEC_SERVICE otherwise. goals of the latter type
691 are not supposed to be visible in the host tracer.
692 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
693
694 int
pceExecuteMode(void)695 pceExecuteMode(void)
696 { return ServiceMode;
697 }
698
699
700 void
pceReset(void)701 pceReset(void)
702 { resetPce(PCE);
703 }
704
705
706 void
pceWriteCurrentGoal(void)707 pceWriteCurrentGoal(void)
708 {
709 #ifndef O_RUNTIME
710 writeGoal(CurrentGoal);
711 #endif
712 }
713
714
715 void
pceWriteErrorGoal(void)716 pceWriteErrorGoal(void)
717 {
718 #ifndef O_RUNTIME
719 writeErrorGoal();
720 #endif
721 }
722
723 /*******************************
724 * DLL CALLBACK *
725 *******************************/
726
727 static void
outOfMemory(void)728 outOfMemory(void)
729 { static int nesting = 0;
730
731 if ( nesting++ > 2 )
732 abort();
733 Cprintf("Out of memory: ");
734 Cprintf("%s", strName(getOsErrorPce(PCE)));
735 hostAction(HOST_RECOVER_FROM_FATAL_ERROR);
736 nesting--;
737 }
738
739
740 static void *
pce_malloc(size_t bytes)741 pce_malloc(size_t bytes)
742 { void *mem;
743
744 if ( !(mem = malloc(bytes)) )
745 outOfMemory();
746
747 return mem;
748 }
749
750
751 static void *
pce_realloc(void * old,size_t bytes)752 pce_realloc(void *old, size_t bytes)
753 { void *mem;
754
755 if ( !(mem = realloc(old, bytes)) )
756 outOfMemory();
757
758 return mem;
759 }
760
761
762 pce_callback_functions TheCallbackFunctions =
763 { Stub__HostSend, /* hostSend() */
764 Stub__HostGet, /* hostGet() */
765 Stub__HostCall, /* hostCallProc() */
766 Stub__HostQuery, /* hostQuery() */
767 Stub__HostActionv, /* hostActionv() */
768 Stub__vCprintf, /* console IO */
769 Stub__Cputchar, /* print single character */
770 Stub__Cflush, /* flush console output */
771 Stub__Cgetline, /* read line from console */
772 pce_malloc, /* malloc */
773 pce_realloc, /* realloc */
774 free /* free */
775 };
776
777
778 void
pceRegisterCallbacks(pce_callback_functions * fs)779 pceRegisterCallbacks(pce_callback_functions *fs)
780 { void **new = (void **)fs;
781 void **old = (void **)&TheCallbackFunctions;
782 int i = sizeof(TheCallbackFunctions)/sizeof(void *);
783
784 for( ; i-- > 0; old++, new++)
785 { if ( *new )
786 *old = *new;
787 }
788 }
789
790
791 int
hostSend(PceObject host,PceName selector,int argc,PceObject argv[])792 hostSend(PceObject host, PceName selector, int argc, PceObject argv[])
793 { if ( TheCallbackFunctions.hostSend )
794 return (*TheCallbackFunctions.hostSend)(host, selector, argc, argv);
795
796 return FAIL;
797 }
798
799
800 PceObject
hostGet(PceObject host,PceName selector,int argc,PceObject argv[])801 hostGet(PceObject host, PceName selector, int argc, PceObject argv[])
802 { if ( TheCallbackFunctions.hostGet )
803 return (*TheCallbackFunctions.hostGet)(host, selector, argc, argv);
804
805 return FAIL;
806 }
807
808
809 int
hostQuery(int what,PceCValue * value)810 hostQuery(int what, PceCValue *value)
811 { if ( TheCallbackFunctions.hostQuery )
812 return (*TheCallbackFunctions.hostQuery)(what, value);
813
814 return FAIL;
815 }
816
817
818 int
hostAction(int what,...)819 hostAction(int what, ...)
820 { if ( TheCallbackFunctions.hostActionv )
821 { va_list args;
822 int rval;
823
824 va_start(args, what);
825 rval = (*TheCallbackFunctions.hostActionv)(what, args);
826 va_end(args);
827 return rval;
828 }
829
830 return FAIL;
831 }
832
833
834 void
Cprintf(const char * fmt,...)835 Cprintf(const char *fmt, ...)
836 { if ( TheCallbackFunctions.vCprintf )
837 { va_list args;
838
839 va_start(args, fmt);
840 (*TheCallbackFunctions.vCprintf)(fmt, args);
841 va_end(args);
842 }
843 }
844
845
846 void
Cvprintf(const char * fmt,va_list args)847 Cvprintf(const char *fmt, va_list args)
848 { if ( TheCallbackFunctions.vCprintf )
849 (*TheCallbackFunctions.vCprintf)(fmt, args);
850 }
851
852
853 int
Cputchar(int chr)854 Cputchar(int chr)
855 { if ( TheCallbackFunctions.Cputchar )
856 return (*TheCallbackFunctions.Cputchar)(chr);
857 else
858 { Cprintf("%c", chr);
859 return chr;
860 }
861 }
862
863
864 int
Cputstr(PceString s)865 Cputstr(PceString s)
866 { if ( TheCallbackFunctions.Cputchar )
867 { int i;
868
869 for(i=0; i<s->s_size; i++)
870 { (*TheCallbackFunctions.Cputchar)(str_fetch(s, i));
871 }
872
873 return s->s_size;
874 } else if ( isstrA(s) )
875 { Cprintf("%s", s->s_textA);
876
877 return s->s_size;
878 } else
879 return 0;
880 }
881
882
883 void
Cflush()884 Cflush()
885 { if ( TheCallbackFunctions.Cflush )
886 (*TheCallbackFunctions.Cflush)();
887 }
888
889
890 char *
Cgetline(char * line,int size)891 Cgetline(char *line, int size)
892 { if ( TheCallbackFunctions.Cgetline )
893 return (*TheCallbackFunctions.Cgetline)(line, size);
894 else
895 { size = 0; /* signal end-of-file */
896 line[0] = '\0';
897 return NULL;
898 }
899 }
900
901 pce_profile_hooks PceProfile =
902 { NULL, /* call */
903 NULL, /* exit */
904 NULL /* handle */
905 };
906
907 int
pceSetProfileHooks(pce_profile_hooks * hooks)908 pceSetProfileHooks(pce_profile_hooks *hooks)
909 { PceProfile = *hooks; /* structure copy */
910
911 return TRUE;
912 }
913
914
915 /*******************************
916 * MEMORY ALLOCATION *
917 *******************************/
918
919 #undef pceMalloc
920 #undef pceRealloc
921 #undef pceFree
922
923 void *
pceMalloc(size_t size)924 pceMalloc(size_t size)
925 { return (*TheCallbackFunctions.malloc)(size);
926 }
927
928
929 void *
pceRealloc(void * ptr,size_t size)930 pceRealloc(void *ptr, size_t size)
931 { return (*TheCallbackFunctions.realloc)(ptr, size);
932 }
933
934
935 void
pceFree(void * ptr)936 pceFree(void *ptr)
937 { (*TheCallbackFunctions.free)(ptr);
938 }
939
940 /*******************************
941 * INTERFACE ALLOC *
942 *******************************/
943
944 void *
pceAlloc(int bytes)945 pceAlloc(int bytes)
946 { return alloc(bytes);
947 }
948
949
950 void
pceUnAlloc(int bytes,void * p)951 pceUnAlloc(int bytes, void *p)
952 { unalloc(bytes, p);
953 }
954
955
956 /*******************************
957 * COLLECTIONS *
958 *******************************/
959
960 /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
961 Function to help foreign-code enumerating the elements of XPCE chains
962 and vectors.
963 - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
964
965 int
pceEnumElements(PceObject collection,int (* enumfunc)(PceObject,void *),void * closure)966 pceEnumElements(PceObject collection,
967 int (*enumfunc)(PceObject, void *),
968 void *closure)
969 { if ( instanceOfObject(collection, ClassChain) )
970 { Chain ch = collection;
971 PceObject e;
972
973 for_chain(ch, e,
974 if ( !(*enumfunc)(e, closure) )
975 fail;
976 );
977 succeed;
978 }
979
980 if ( instanceOfObject(collection, ClassVector) )
981 { Vector v = collection;
982 PceObject e;
983
984 for_vector(v, e,
985 if ( !(*enumfunc)(e, closure) )
986 fail;
987 );
988 succeed;
989 }
990
991 assert(0);
992 fail;
993 }
994