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 #include <h/kernel.h>
36 #include "c.h"
37
38 typedef struct c_obj* CObj;
39
NewClass(c_obj)40 NewClass(c_obj)
41 ABSTRACT_HOST /* Class host */
42 End;
43
44
45 static status
46 initialiseC(CObj h)
47 { initialiseHost((Host)h, CtoName("C"));
48 assign(h, language, NAME_c);
49
50 succeed;
51 }
52
53
54 static status
callCv(CObj host,CPointer function,int argc,Any * argv)55 callCv(CObj host, CPointer function, int argc, Any *argv)
56 { status rval;
57 SendFunc f = (SendFunc) function->pointer;
58 int n;
59
60 for(n=0; n<argc; n++)
61 if ( isObject(argv[n]) )
62 addCodeReference(argv[n]);
63
64 switch(argc)
65 { case 0: rval = (*f)(); break;
66 case 1: rval = (*f)(argv[0]); break;
67 case 2: rval = (*f)(argv[0], argv[1]); break;
68 case 3: rval = (*f)(argv[0], argv[1], argv[2]); break;
69 case 4: rval = (*f)(argv[0], argv[1], argv[2], argv[3]); break;
70 case 5: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4]); break;
71 case 6: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
72 argv[5]); break;
73 case 7: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
74 argv[5], argv[6]); break;
75 case 8: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
76 argv[5], argv[6], argv[7]); break;
77 case 9: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
78 argv[5], argv[6], argv[7], argv[8]); break;
79 default:
80 rval = errorPce(host, NAME_tooManyArguments, argc);
81 }
82
83 for(n=0; n<argc; n++)
84 if ( isObject(argv[n]) && !isFreedObj(argv[n]) )
85 delCodeReference(argv[n]);
86
87 return rval ? SUCCEED : FAIL;
88 }
89
90
91 static Any
getCallCv(CObj host,CPointer function,int argc,Any * argv)92 getCallCv(CObj host, CPointer function, int argc, Any *argv)
93 { Any rval;
94 GetFunc f = function->pointer;
95 int n;
96
97 for(n=0; n<argc; n++)
98 if ( isObject(argv[n]) )
99 addCodeReference(argv[n]);
100
101 switch(argc)
102 { case 0: rval = (*f)(); break;
103 case 1: rval = (*f)(argv[0]); break;
104 case 2: rval = (*f)(argv[0], argv[1]); break;
105 case 3: rval = (*f)(argv[0], argv[1], argv[2]); break;
106 case 4: rval = (*f)(argv[0], argv[1], argv[2], argv[3]); break;
107 case 5: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4]); break;
108 case 6: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
109 argv[5]); break;
110 case 7: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
111 argv[5], argv[6]); break;
112 case 8: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
113 argv[5], argv[6], argv[7]); break;
114 case 9: rval = (*f)(argv[0], argv[1], argv[2], argv[3], argv[4],
115 argv[5], argv[6], argv[7], argv[8]); break;
116 default:
117 errorPce(host, NAME_tooManyArguments, argc);
118 rval = FAIL;
119 }
120
121 for(n=0; n<argc; n++)
122 if ( isObject(argv[n]) && !isFreedObj(argv[n]) )
123 delCodeReference(argv[n]);
124
125 return rval;
126 }
127
128
129 status
makeClassC(Class class)130 makeClassC(Class class)
131 { sourceClass(class, makeClassC, __FILE__, "$Revision$");
132
133 sendMethod(class, NAME_initialise, DEFAULT, 0,
134 "Create C interface",
135 initialiseC);
136 sendMethod(class, NAME_call, NAME_callback, 2,
137 "c_pointer", "unchecked ...",
138 "Invoke a C-function send_method",
139 callCv);
140
141 getMethod(class, NAME_call, NAME_callback, "unchecked", 2,
142 "c_pointer", "unchecked ...",
143 "Invoke a C-function get_method",
144 getCallCv);
145
146 initClass(class);
147
148 succeed;
149 }
150
151
152 /*******************************
153 * PUBLIC FUNCTIONS *
154 *******************************/
155
156 void
XPCE_initialise()157 XPCE_initialise()
158 { if ( !XPCE_initialised )
159 pceInitialise(0, NULL, NULL, 0, NULL);
160 }
161
162 /* C ---> XPCE */
163
164 XPCE_Object
XPCE_to_string(char * text)165 XPCE_to_string(char *text)
166 { if ( text )
167 return CtoString(text);
168
169 fail;
170 }
171
172
173 XPCE_Object
XPCE_to_tmp_char_array(char * text)174 XPCE_to_tmp_char_array(char *text)
175 { if ( text )
176 return CtoScratchCharArray(text);
177
178 fail;
179 }
180
181
182 void
XPCE_done_tmp_char_array(XPCE_Object ca)183 XPCE_done_tmp_char_array(XPCE_Object ca)
184 { if ( ca )
185 doneScratchCharArray(ca);
186 }
187
188
189 XPCE_Object
XPCE_to_name(char * text)190 XPCE_to_name(char *text)
191 { if ( text )
192 { XPCE_initialise(); /* Bah, not other way? */
193 return CtoName(text);
194 }
195
196 fail;
197 }
198
199
200 XPCE_Object
XPCE_to_integer(long value)201 XPCE_to_integer(long value)
202 { if ( value >= PCE_MIN_INT && value <= PCE_MAX_INT )
203 return toInt(value);
204
205 errorPce(PCE, NAME_intOutOfRange);
206 fail;
207 }
208
209
210 XPCE_Object
XPCE_to_real(float value)211 XPCE_to_real(float value)
212 { return CtoReal(value);
213 }
214
215
216 XPCE_Object
XPCE_to_pointer(void * ptr)217 XPCE_to_pointer(void *ptr)
218 { return answerObjectv(ClassCPointer, 1, &ptr);
219 }
220
221
222 XPCE_Object
XPCE_to_object(XPCE_Object name)223 XPCE_to_object(XPCE_Object name)
224 { if ( isName(name) )
225 return getObjectFromReferencePce(PCE, name);
226
227 fail;
228 }
229
230
231 XPCE_Object
XPCE_to_class(XPCE_Object name)232 XPCE_to_class(XPCE_Object name)
233 { if ( isName(name) )
234 return getConvertClass(ClassClass, name);
235
236 fail;
237 }
238
239 /* XPCE ---> C */
240
241 char *
XPCE_charp_of(XPCE_Object string)242 XPCE_charp_of(XPCE_Object string)
243 { return toCharp(string);
244 }
245
246
247 long
XPCE_int_of(XPCE_Object integer)248 XPCE_int_of(XPCE_Object integer)
249 { Int i;
250
251 if ( isInteger(integer) )
252 return valInt(integer);
253 else if ( (i = toInteger(integer)) )
254 return valInt(i);
255
256 errorPce(TypeInt, NAME_cannotConvert, integer);
257 return 0L;
258 }
259
260
261 float
XPCE_float_of(XPCE_Object real)262 XPCE_float_of(XPCE_Object real)
263 { Real r;
264
265 if ( (r = toReal(getConvertReal(ClassReal, real))) )
266 return valReal(r);
267
268 errorPce(CtoType("real"), NAME_cannotConvert, real);
269 return 0.0; /*NaN;*/
270 }
271
272
273 void *
XPCE_pointer_of(XPCE_Object cptr)274 XPCE_pointer_of(XPCE_Object cptr)
275 { if ( instanceOfObject(cptr, ClassCPointer) )
276 { CPointer ptr = (CPointer)cptr;
277
278 return ptr->pointer;
279 }
280
281 return NULL;
282 }
283
284
285 /*******************************
286 * VMI *
287 *******************************/
288
289
290 #define CHECKARGV { int n; for(n=argc; --n>=0; ) if ( !argv[n] ) fail; }
291
292 XPCE_status
XPCE_sendv(XPCE_Object receiver,XPCE_Object selector,int argc,const XPCE_Object argv[])293 XPCE_sendv(XPCE_Object receiver, XPCE_Object selector,
294 int argc, const XPCE_Object argv[])
295 { if ( receiver )
296 { CHECKARGV;
297 return vm_send(receiver, selector, NULL, argc, argv);
298 }
299 fail;
300 }
301
302
303 XPCE_Object
XPCE_getv(XPCE_Object receiver,XPCE_Object selector,int argc,const XPCE_Object argv[])304 XPCE_getv(XPCE_Object receiver, XPCE_Object selector,
305 int argc, const XPCE_Object argv[])
306 { if ( receiver )
307 { CHECKARGV;
308 return vm_get(receiver, selector, NULL, argc, argv);
309 }
310 fail;
311 }
312
313
314 XPCE_Object
XPCE_newv(XPCE_Object class,const XPCE_Object name,int argc,const XPCE_Object argv[])315 XPCE_newv(XPCE_Object class, const XPCE_Object name,
316 int argc, const XPCE_Object argv[])
317 { XPCE_Object rval;
318
319 XPCE_initialise();
320 CHECKARGV;
321 rval = createObjectv(name ? name : (Name) NIL, class, argc, argv);
322 if ( rval )
323 pushAnswerObject(rval);
324
325 return rval;
326 }
327
328
329
330 XPCE_status
XPCE_free(XPCE_Object object)331 XPCE_free(XPCE_Object object)
332 { return freeObject(object);
333 }
334
335
336 /* va-arg versions */
337
338 XPCE_status
XPCE_send(XPCE_Object receiver,XPCE_Object selector,...)339 XPCE_send(XPCE_Object receiver, XPCE_Object selector, ...)
340 { va_list args;
341 Any argv[VA_PCE_MAX_ARGS];
342 int argc;
343
344 va_start(args, selector);
345 for(argc=0; (argv[argc] = va_arg(args, Any)) != XPCE_END; argc++)
346 { if ( argc > VA_PCE_MAX_ARGS )
347 { va_end(args);
348 return errorPce(receiver, NAME_badCArgList, CtoName("->"), selector);
349 }
350 }
351 va_end(args);
352
353 return XPCE_sendv(receiver, selector, argc, argv);
354 }
355
356
357 XPCE_Object
XPCE_get(XPCE_Object receiver,XPCE_Object selector,...)358 XPCE_get(XPCE_Object receiver, XPCE_Object selector, ...)
359 { va_list args;
360 Any argv[VA_PCE_MAX_ARGS];
361 int argc;
362
363 va_start(args, selector);
364 for(argc=0; (argv[argc] = va_arg(args, Any)) != XPCE_END; argc++)
365 { if ( argc > VA_PCE_MAX_ARGS )
366 { va_end(args);
367 errorPce(receiver, NAME_badCArgList, CtoName("<-"), selector);
368 fail;
369 }
370 }
371 va_end(args);
372
373 return XPCE_getv(receiver, selector, argc, argv);
374 }
375
376
377 XPCE_Object
XPCE_new(XPCE_Object class,const XPCE_Object name,...)378 XPCE_new(XPCE_Object class, const XPCE_Object name, ...)
379 { va_list args;
380 Any argv[VA_PCE_MAX_ARGS];
381 int argc;
382
383 va_start(args, name);
384 for(argc=0; (argv[argc] = va_arg(args, Any)) != XPCE_END; argc++)
385 { if ( argc > VA_PCE_MAX_ARGS )
386 { va_end(args);
387 errorPce(class, NAME_badCArgList, CtoName("<-"), NAME_instance);
388 fail;
389 }
390 }
391 va_end(args);
392
393 return XPCE_newv(class, name, argc, argv);
394 }
395
396
397 /*******************************
398 * FUNCALL *
399 *******************************/
400
401 XPCE_Object
XPCE_CHost(void)402 XPCE_CHost(void)
403 { static XPCE_Object me = NULL;
404
405 if ( !me )
406 { me = globalObject(NAME_c, ClassC, EAV);
407 protectObject(me);
408 }
409
410 return me;
411 }
412
413
414 XPCE_Object
XPCE_callv(XPCE_Procedure function,int argc,const XPCE_Object argv[])415 XPCE_callv(XPCE_Procedure function, int argc, const XPCE_Object argv[])
416 { ArgVector(av, argc+3);
417 int i;
418
419 av[0] = XPCE_CHost();
420 av[1] = NAME_call;
421 av[2] = CtoCPointer(function);
422 for(i=0; i<argc; i++)
423 av[i+3] = argv[i];
424
425 return answerObjectv(ClassMessage, argc+3, av);
426 }
427
428
429 XPCE_Object
XPCE_funcallv(XPCE_Function function,int argc,const XPCE_Object argv[])430 XPCE_funcallv(XPCE_Function function, int argc, const XPCE_Object argv[])
431 { ArgVector(av, argc+3);
432 int i;
433
434 av[0] = XPCE_CHost();
435 av[1] = NAME_call;
436 av[2] = CtoCPointer(function);
437 for(i=0; i<argc; i++)
438 av[i+3] = argv[i];
439
440 return answerObjectv(ClassObtain, argc+3, av);
441 }
442
443
444 XPCE_Object
XPCE_call(XPCE_Procedure function,...)445 XPCE_call(XPCE_Procedure function, ...)
446 { va_list args;
447 Any argv[VA_PCE_MAX_ARGS];
448 int argc;
449
450 va_start(args, function);
451 for(argc=0; (argv[argc] = va_arg(args, Any)) != XPCE_END; argc++)
452 { if ( argc > VA_PCE_MAX_ARGS )
453 { va_end(args);
454 errorPce(XPCE_CHost(), NAME_badCArgList, CtoName("->"), NAME_call);
455 fail;
456 }
457 }
458 va_end(args);
459
460 return XPCE_callv(function, argc, argv);
461 }
462
463
464 XPCE_Object /* ? */
XPCE_funcall(XPCE_Function function,...)465 XPCE_funcall(XPCE_Function function, ...)
466 { va_list args;
467 Any argv[VA_PCE_MAX_ARGS];
468 int argc;
469
470 va_start(args, function);
471 for(argc=0; (argv[argc] = va_arg(args, Any)) != XPCE_END; argc++)
472 { if ( argc > VA_PCE_MAX_ARGS )
473 { va_end(args);
474 errorPce(XPCE_CHost(), NAME_badCArgList, CtoName("<-"), NAME_call);
475 fail;
476 }
477 }
478 va_end(args);
479
480 return XPCE_funcallv(function, argc, argv);
481 }
482
483 /*******************************
484 * CLASSES *
485 *******************************/
486
487 XPCE_Object
XPCE_defclass(XPCE_Object name,XPCE_Object super,XPCE_Object summary,XPCE_Procedure makefunc)488 XPCE_defclass(XPCE_Object name, XPCE_Object super, XPCE_Object summary,
489 XPCE_Procedure makefunc)
490 { if ( name && super && summary && makefunc )
491 { Class class;
492
493 if ( (class = defineClass(name, super, summary, (SendFunc)makefunc)) )
494 { numberTreeClass(ClassObject, 0);
495 answer(class);
496 }
497 }
498
499 fail;
500 }
501
502
503 XPCE_Object
XPCE_defcxxclass(XPCE_Object name,XPCE_Object super,XPCE_Object summary,XPCE_Procedure makefunc)504 XPCE_defcxxclass(XPCE_Object name, XPCE_Object super, XPCE_Object summary,
505 XPCE_Procedure makefunc)
506 { if ( name && super && summary && makefunc )
507 { Class class;
508
509 if ( (class = defineClass(name, super, summary, (SendFunc)makefunc)) )
510 { setDFlag(class, D_CXX);
511 assign(class, creator, name_cxx);
512 numberTreeClass(ClassObject, 0);
513 answer(class);
514 }
515 }
516
517 fail;
518 }
519
520
521
522 XPCE_Object /* class */
XPCE_makeclass(XPCE_Object name,XPCE_Object super,XPCE_Object summary)523 XPCE_makeclass(XPCE_Object name, XPCE_Object super, XPCE_Object summary)
524 { Class class, superclass;
525
526 if ( !(superclass = getConvertClass(ClassClass, super)) )
527 { errorPce(name, NAME_noSuperClass, super);
528 fail;
529 }
530
531 TRY(class = newObject(superclass->class, name, superclass, EAV));
532
533 if ( instanceOfObject(summary, ClassCharArray) )
534 assign(class, summary, summary);
535
536 return class;
537 }
538
539
540 XPCE_Variable
XPCE_defvar(XPCE_Object class,XPCE_Object name,XPCE_Object group,XPCE_Object summary,XPCE_Object type,XPCE_Object access,XPCE_Object initial)541 XPCE_defvar(XPCE_Object class,
542 XPCE_Object name, XPCE_Object group, XPCE_Object summary,
543 XPCE_Object type, XPCE_Object access, XPCE_Object initial)
544 { Variable var;
545
546 if ( !instanceOfObject(summary, ClassCharArray) )
547 summary = DEFAULT;
548 if ( !instanceOfObject(group, ClassCharArray) )
549 group = DEFAULT;
550 if ( !validPceDatum(initial) )
551 initial = NIL;
552 if ( !(type = checkType(type, TypeType, NIL)) )
553 type = TypeAny;
554
555 var = newObject(ClassObjOfVariable, name, type, access, summary, group, EAV);
556 initialValueVariable(var, initial);
557 TRY(instanceVariableClass(class, var));
558
559 return var;
560 }
561
562
563 static XPCE_Object
NoCode()564 NoCode()
565 { static XPCE_Object me = NULL;
566
567 if ( !me )
568 { me = newObject(ClassAnd, EAV);
569 protectObject(me);
570 }
571
572 return me;
573 }
574
575
576 XPCE_status
XPCE_defsendmethodv(XPCE_Object class,XPCE_Object name,XPCE_Object group,XPCE_Object summary,XPCE_Procedure implementation,int argc,const XPCE_Object types[])577 XPCE_defsendmethodv(XPCE_Object class,
578 XPCE_Object name, XPCE_Object group, XPCE_Object summary,
579 XPCE_Procedure implementation,
580 int argc, const XPCE_Object types[])
581 { SendMethod method;
582
583 if ( !instanceOfObject(summary, ClassCharArray) )
584 summary = DEFAULT;
585 if ( !instanceOfObject(group, ClassCharArray) )
586 group = DEFAULT;
587
588 method = newObject(ClassSendMethod, name,
589 newObjectv(ClassVector, argc, types),
590 NoCode(), /* hack to avoid type-conflict */
591 summary, DEFAULT, group, EAV);
592 assign(method, message, NIL);
593 setDFlag(method, D_CXX);
594 method->function = (SendFunc)implementation;
595
596 return sendMethodClass(class, method);
597 }
598
599
600 XPCE_status
XPCE_defgetmethodv(XPCE_Object class,XPCE_Object name,XPCE_Object group,XPCE_Object summary,XPCE_Object return_type,XPCE_Function implementation,int argc,const XPCE_Object types[])601 XPCE_defgetmethodv(XPCE_Object class,
602 XPCE_Object name, XPCE_Object group, XPCE_Object summary,
603 XPCE_Object return_type, XPCE_Function implementation,
604 int argc, const XPCE_Object types[])
605 { GetMethod method;
606
607 if ( !instanceOfObject(summary, ClassCharArray) )
608 summary = DEFAULT;
609 if ( !instanceOfObject(group, ClassCharArray) )
610 group = DEFAULT;
611
612 method = newObject(ClassGetMethod, name, return_type,
613 newObjectv(ClassVector, argc, types),
614 Arg(1), /* hack to avoid type-conflict */
615 summary, DEFAULT, group, EAV);
616 assign(method, message, NIL);
617 setDFlag(method, D_CXX);
618 method->function = (Func)implementation;
619
620 return getMethodClass(class, method);
621 }
622
623
624 XPCE_status
XPCE_store(XPCE_Object in,XPCE_Variable var,XPCE_Object value)625 XPCE_store(XPCE_Object in, XPCE_Variable var, XPCE_Object value)
626 { if ( !in || !value )
627 fail;
628
629 return sendVariable(var, in, value);
630 }
631
632
633 XPCE_Object
XPCE_fetch(XPCE_Object in,XPCE_Variable var)634 XPCE_fetch(XPCE_Object in, XPCE_Variable var)
635 { if ( !in )
636 fail;
637
638 return getGetVariable(var, in);
639 }
640
641 /*******************************
642 * CHAINS *
643 *******************************/
644
645 XPCE_Object
XPCE_chain_head(XPCE_Object chain)646 XPCE_chain_head(XPCE_Object chain)
647 { if ( instanceOfObject(chain, ClassChain) )
648 { Chain ch = chain;
649
650 return (XPCE_Object) (notNil(ch->head) ? ch->head : NULL);
651 }
652
653 fail; /* error? */
654 }
655
656
657 XPCE_Object
XPCE_next_cell(XPCE_Object cell)658 XPCE_next_cell(XPCE_Object cell)
659 { if ( cell )
660 { XPCE_Object next = ((Cell)cell)->next;
661
662 return notNil(next) ? next : NULL;
663 }
664
665 fail;
666 }
667
668
669 XPCE_Object
XPCE_cell_value(XPCE_Object cell)670 XPCE_cell_value(XPCE_Object cell)
671 { if ( cell )
672 return ((Cell)cell)->value;
673
674 fail;
675 }
676
677 /*******************************
678 * GLOBALS *
679 *******************************/
680
681 Any XPCE_on;
682 Any XPCE_off;
683 Any XPCE_nil;
684 Any XPCE_default;
685 Any XPCE_arg1;
686 Any XPCE_arg2;
687 Any XPCE_arg3;
688 Any XPCE_arg4;
689 Any XPCE_arg5;
690 Any XPCE_arg6;
691 Any XPCE_arg7;
692 Any XPCE_arg8;
693 Any XPCE_arg9;
694 Any XPCE_arg10;
695 Any XPCE_event;
696 Any XPCE_receiver;
697 Any XPCE_pce;
698 Any XPCE_display;
699
700 void
initCGlobals()701 initCGlobals()
702 { XPCE_on = ON;
703 XPCE_off = OFF;
704 XPCE_nil = NIL;
705 XPCE_default = DEFAULT;
706 XPCE_arg1 = Arg(1);
707 XPCE_arg2 = Arg(2);
708 XPCE_arg3 = Arg(3);
709 XPCE_arg4 = Arg(4);
710 XPCE_arg5 = Arg(5);
711 XPCE_arg6 = Arg(6);
712 XPCE_arg7 = Arg(7);
713 XPCE_arg8 = Arg(8);
714 XPCE_arg9 = Arg(9);
715 XPCE_arg10 = Arg(10);
716 XPCE_event = EVENT;
717 XPCE_receiver = RECEIVER;
718 XPCE_pce = PCE;
719 XPCE_display = findGlobal(NAME_display);
720 }
721
722 /*******************************
723 * C++ SUPPORT *
724 *******************************/
725
726 #if O_CPLUSPLUS
727
728 XPCE_Object
XPCE_callCPlusPlusMethodv(XPCE_Procedure function,void * obj,int argc,const XPCE_Object argv[])729 XPCE_callCPlusPlusMethodv(XPCE_Procedure function, void *obj,
730 int argc, const XPCE_Object argv[])
731 { ArgVector(av, argc+4);
732 int i;
733
734 av[0] = XPCE_CHost();
735 av[1] = NAME_callCPlusPlusMethod;
736 av[2] = CtoCPointer(function);
737 av[3] = CtoCPointer(obj);
738 for(i=0; i<argc; i++)
739 av[i+4] = argv[i];
740
741 return answerObjectv(ClassMessage, argc+4, av);
742 }
743
744
745 XPCE_Object
XPCE_funcallCPlusPlusMethodv(XPCE_Function function,void * obj,int argc,const XPCE_Object argv[])746 XPCE_funcallCPlusPlusMethodv(XPCE_Function function, void *obj,
747 int argc, const XPCE_Object argv[])
748 { ArgVector(av, argc+4);
749 int i;
750
751 av[0] = XPCE_CHost();
752 av[1] = NAME_callCPlusPlusMethod;
753 av[2] = CtoCPointer(function);
754 av[3] = CtoCPointer(obj);
755 for(i=0; i<argc; i++)
756 av[i+4] = argv[i];
757
758 return answerObjectv(ClassObtain, argc+4, av);
759 }
760
761
762 XPCE_Object
XPCE_callCPlusPlusv(XPCE_Procedure f,int argc,const XPCE_Object argv[])763 XPCE_callCPlusPlusv(XPCE_Procedure f, int argc, const XPCE_Object argv[])
764 { ArgVector(av, argc+3);
765 int i;
766
767 av[0] = XPCE_CHost();
768 av[1] = NAME_callCPlusPlus;
769 av[2] = CtoCPointer(f);
770 for(i=0; i<argc; i++)
771 av[i+3] = argv[i];
772
773 return answerObjectv(ClassMessage, argc+3, av);
774 }
775
776
777 XPCE_Object
XPCE_funcallCPlusPlusv(XPCE_Function f,int argc,const XPCE_Object argv[])778 XPCE_funcallCPlusPlusv(XPCE_Function f, int argc, const XPCE_Object argv[])
779 { ArgVector(av, argc+3);
780 int i;
781
782 av[0] = XPCE_CHost();
783 av[1] = NAME_callCPlusPlus;
784 av[2] = CtoCPointer(f);
785 for(i=0; i<argc; i++)
786 av[i+3] = argv[i];
787
788 return answerObjectv(ClassObtain, argc+3, av);
789 }
790
791
792 #endif /*O_CPLUSPLUS*/
793