Version:
~ [ 10.0 ] ~
** Warning: Cannot open xref database.
1
2 /* $Id: langwinipc.c,v 1.6 2005/01/24 04:24:24 terry_teague Exp $ */
3
4 /******************************************************************************
5
6 UserLand Frontier(tm) -- High performance Web content management,
7 object database, system-level and Internet scripting environment,
8 including source code editing and debugging.
9
10 Copyright (C) 1992-2004 UserLand Software, Inc.
11
12 This program is free software; you can redistribute it and/or modify
13 it under the terms of the GNU General Public License as published by
14 the Free Software Foundation; either version 2 of the License, or
15 (at your option) any later version.
16
17 This program is distributed in the hope that it will be useful,
18 but WITHOUT ANY WARRANTY; without even the implied warranty of
19 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 GNU General Public License for more details.
21
22 You should have received a copy of the GNU General Public License
23 along with this program; if not, write to the Free Software
24 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25
26 ******************************************************************************/
27
28 #include "frontier.h"
29 #include "standard.h"
30
31 #ifdef MACVERSION
32 #include "langxcmd.h"
33 #endif
34
35 #include "memory.h"
36 #include "frontierconfig.h"
37 #include "cursor.h"
38 #include "dialogs.h"
39 #include "error.h"
40 #include "font.h"
41 #include "kb.h"
42 #include "mouse.h"
43 #include "ops.h"
44 #include "quickdraw.h"
45 #include "resources.h"
46 #include "sounds.h"
47 #include "strings.h"
48 #include "frontierwindows.h"
49 #include "shell.h"
50 #include "shellhooks.h"
51 #include "oplist.h"
52 #include "lang.h"
53 #include "langinternal.h"
54 #include "langexternal.h"
55 #include "langipc.h"
56 #include "langdll.h"
57 #include "langsystem7.h"
58 #include "langtokens.h"
59 #include "langwinipc.h"
60 #include "BASE64.H"
61 #include "tablestructure.h"
62 #include "tableverbs.h"
63 #include "process.h"
64 #include "processinternal.h"
65 #include "kernelverbdefs.h"
66 #include "WinSockNetEvents.h"
67 #include "notify.h"
68 #include "timedate.h"
69
70
71 boolean langwinipcerrorroutine (bigstring bs, ptrvoid refcon) {
72
73 /*
74 if an error occurs while processing a runscript verb, we want to
75 return the text that would normally go into the langerror window as
76 an error string to our caller.
77 */
78
79 tyvaluerecord * val = nil;
80
81 if (currentprocess != nil)
82 val = (tyvaluerecord *) (**currentprocess).processrefcon;
83
84 if (val == nil)
85 return (false); //should never be....
86
87 setstringvalue (bs, val);
88
89 exemptfromtmpstack (val);
90
91 return (false); /*consume the error*/
92 } /*langwinipcerrorroutine*/
93
94
95 #ifdef WIN95VERSION
96
97 static void langwinipchookerrors (langerrormessagecallback *savecallback) {
98
99 *savecallback = langcallbacks.errormessagecallback;
100
101 langcallbacks.errormessagecallback = &langwinipcerrorroutine;
102
103 shellpusherrorhook ((errorhookcallback) &langwinipcerrorroutine);
104
105 // hipcverb = hverb; /*make visible to errorroutine*/
106 } /*langwinipchookerrors*/
107
108
109 static boolean langwinipcunhookerrors (langerrormessagecallback savecallback) {
110
111 shellpoperrorhook ();
112
113 langcallbacks.errormessagecallback = savecallback;
114
115 fllangerror = false; /*make sure error flag is cleared*/
116
117 // hipcverb = nil;
118
119 return (true);
120 } /*langwinipcunhookerrors*/
121
122
123 static boolean langwinipccoerceparam (VARIANTARG * var, tyvaluerecord * val);
124
125 boolean convertBSTRVariantToValue (VARIANTARG * var, tyvaluerecord * val) {
126 int cSize;
127 int cOut;
128 Handle h;
129
130 if (V_VT(var) == VT_BSTR) { /*just make sure it is a string */
131 if (V_BSTR(var) != NULL) {
132 cSize = WideCharToMultiByte(CP_ACP,0,V_BSTR(var),-1,NULL,0,NULL,NULL);
133
134 if (cSize != 0) {
135 if (newhandle ((cSize+1), &h)) {
136 cOut = WideCharToMultiByte(CP_ACP,0,V_BSTR(var),-1,*h,cSize,NULL,NULL);
137
138 if (cOut != 0) {
139 sethandlesize (h, cOut-1);
140
141 setheapvalue(h, stringvaluetype, val);
142
143 return (true);
144 }
145
146 disposehandle (h);
147 }
148 }
149 }
150 }
151
152 return (false);
153 } /*convertBSTRVariantToValue*/
154
155 static boolean insertToList (hdllistrecord hlist, tyvaluerecord * val) {
156 boolean res;
157
158 res = langpushlistval (hlist, nil, val);
159
160 return (res);
161 } /*insertToList*/
162
163 static boolean insertToTable (hdlhashtable htable, tyvaluerecord * val2, tyvaluerecord * val1) {
164 bigstring name;
165 boolean res;
166 long ct;
167 bigstring serializedname;
168
169 if (val2->valuetype != stringvaluetype)
170 return (false);
171
172 hashcountitems (htable, &ct);
173
174 numbertostring (ct + 1, serializedname);
175
176 while (stringlength (serializedname) < 4)
177 insertchar ('', serializedname);
178
179 pushchar ('\t', serializedname);
180
181 pullstringvalue (val2, name);
182
183 //uncomment out the line below if we think that matrix (tables) should be order dependent.
184 //I'm mixed, right now I think not. It is the name that matters.
185
186 // insertstring (serializedname, name);
187
188 pushhashtable (htable);
189
190 res = hashinsert (name, *val1);
191
192 pophashtable();
193
194 return (res);
195 } /*insertToTable*/
196
197 static boolean getArrayElement (VARTYPE elementType, SAFEARRAY *psa, long * index, tyvaluerecord * val) {
198 boolean res;
199 HRESULT hres;
200 VARIANTARG var;
201
202 res = true;
203
204 VariantInit (&var);
205
206 switch (elementType) {
207 case VT_EMPTY:
208 case VT_NULL:
209 setlongvalue (0, val);
210 break;
211
212 case VT_I2: {
213 short fooI2;
214
215 hres = SafeArrayGetElement (psa, index, &fooI2);
216
217 if (FAILED(hres))
218 return (false);
219
220 setintvalue (fooI2, val);
221 break;
222 }
223
224 case VT_I4: {
225 long fooI4;
226
227 hres = SafeArrayGetElement (psa, index, &fooI4);
228
229 if (FAILED(hres))
230 return (false);
231
232 setlongvalue (fooI4, val);
233 break;
234 }
235
236 case VT_R4: {
237 float fooR4;
238
239 hres = SafeArrayGetElement (psa, index, &fooR4);
240
241 if (FAILED(hres))
242 return (false);
243
244 setsinglevalue (fooR4, val);
245 break;
246 }
247
248 case VT_R8: {
249 double fooR8;
250
251 hres = SafeArrayGetElement (psa, index, &fooR8);
252
253 if (FAILED(hres))
254 return (false);
255
256 setdoublevalue (fooR8, val);
257 break;
258 }
259
260 case VT_BOOL: {
261 short fooBOOL;
262
263 hres = SafeArrayGetElement (psa, index, &fooBOOL);
264
265 if (FAILED(hres))
266 return (false);
267
268 setbooleanvalue (fooBOOL, val);
269 break;
270 }
271
272 case VT_UI1: {
273 unsigned char fooUI1;
274
275 hres = SafeArrayGetElement (psa, index, &fooUI1);
276
277 if (FAILED(hres))
278 return (false);
279
280 setcharvalue (fooUI1, val);
281 break;
282 }
283
284 case VT_BSTR: {
285 BSTR fooBSTR;
286
287 hres = SafeArrayGetElement (psa, index, &fooBSTR);
288
289 if (FAILED(hres))
290 return (false);
291
292 V_VT(&var) = VT_BSTR;
293
294 V_BSTR(&var) = fooBSTR;
295
296 return (convertBSTRVariantToValue (&var, val));
297 break;
298 }
299
300 case VT_DATE: {
301 DATE fooDATE;
302
303 hres = SafeArrayGetElement (psa, index, &fooDATE);
304
305 if (FAILED(hres))
306 return (false);
307
308 V_VT(&var) = VT_DATE;
309
310 V_DATE(&var) = fooDATE;
311
312 return (langwinipccoerceparam (&var, val));
313 break;
314 }
315
316 case VT_CY: {
317 CY fooCY;
318
319 hres = SafeArrayGetElement (psa, index, &fooCY);
320
321 if (FAILED(hres))
322 return (false);
323
324 V_VT(&var) = VT_CY;
325
326 V_CY(&var) = fooCY;
327
328 return (langwinipccoerceparam (&var, val));
329 break;
330 }
331
332 case VT_VARIANT: {
333 hres = SafeArrayGetElement (psa, index, &var);
334
335 if (FAILED(hres))
336 return (false);
337
338 return (langwinipccoerceparam (&var, val));
339 break;
340 }
341
342
343 case VT_ERROR:
344 case VT_DISPATCH:
345 case VT_UNKNOWN:
346 default:
347 res = false;
348 }
349
350 return (res);
351 } /*getArrayElement*/
352
353
354 static boolean langwinipccoercearray (VARIANTARG * var, tyvaluerecord * val) {
355 SAFEARRAY FAR *psa;
356 HRESULT hres;
357 unsigned int dimCount, elementSize;
358 long ub1, lb1, ub2, lb2, k;
359 long index[2]; /*we only support upto 2 dimensions */
360 tyvaluerecord val1, val2;
361 hdllistrecord hlist;
362 hdlhashtable htable;
363 VARTYPE elementType;
364
365 hlist = NULL;
366 htable = NULL;
367
368 if (V_ISBYREF(var))
369 psa = *V_ARRAYREF(var);
370 else
371 psa=V_ARRAY(var);
372
373 dimCount = SafeArrayGetDim(psa);
374
375 elementSize = SafeArrayGetElemsize (psa);
376
377 elementType = V_VT(var) & VT_TYPEMASK;
378
379 if (dimCount > 2)
380 return (false); /*to many dimensions, we only handle 1 for lists and 2 for records */
381
382 hres = SafeArrayGetLBound(psa, 1, &lb1);
383
384 if (FAILED(hres))
385 return (false); /* Failure here not good, but safe exit */
386
387 hres = SafeArrayGetUBound(psa, 1, &ub1);
388
389 if (FAILED(hres))
390 return (false); /* Failure here not good, but safe exit */
391
392 if (dimCount == 2) {
393 hres = SafeArrayGetLBound(psa, 2, &lb2);
394
395 if (FAILED(hres))
396 return (false); /* Failure here not good, but safe exit */
397
398 hres = SafeArrayGetUBound(psa, 2, &ub2);
399
400 if (FAILED(hres))
401 return (false); /* Failure here not good, but safe exit */
402
403 if ((ub2-lb2) != 1)
404 return (false); /*only support matrix of 2 by n */
405 }
406 else {
407 lb2 = 0;
408 ub2 = 0;
409 }
410
411 for (k = lb1; k <= ub1; k++) {
412 index[0] = k;
413 index[1] = lb2;
414
415 if (! getArrayElement (elementType, psa, index, &val1))
416 goto arrayerrorexit;
417
418 if (dimCount == 2) {
419 index[1] = lb2+1;
420
421 if (! getArrayElement (elementType, psa, index, &val2)) {
422 disposevaluerecord (val1, false);
423
424 goto arrayerrorexit;
425 }
426
427 if (htable == NULL) {
428 if (!langexternalnewvalue (idtableprocessor, nil, val)) {
429 disposevaluerecord (val1, false);
430
431 disposevaluerecord (val2, false);
432
433 goto arrayerrorexit;
434 }
435
436 langexternalvaltotable (*val, &htable, HNoNode);
437 }
438
439 if (htable != NULL)
440 if (! insertToTable (htable, &val1, &val2)) {
441 disposevaluerecord (val1, false);
442
443 disposevaluerecord (val2, false);
444
445 goto arrayerrorexit; /*needs to cleanup*/
446 }
447 }
448 else {
449 if (hlist == NULL) {
450 if (! opnewlist (&hlist, false)) {
451 disposevaluerecord (val1, false);
452
453 goto arrayerrorexit;
454 }
455 }
456
457 if (hlist != NULL)
458 if (! insertToList (hlist, &val1)) {
459 disposevaluerecord (val1, false);
460
461 goto arrayerrorexit; /*needs to cleanup*/
462 }
463 }
464 }
465
466 if (dimCount == 2) {
467 // initvalue (val, tablevaluetype);
468 // val->data.binaryvalue = (Handle) htable;
469 }
470 else {
471 initvalue (val, listvaluetype);
472 val->data.listvalue = hlist;
473 }
474
475 //there is nothing to clean up here since everything is contained in the val record.
476 return (true);
477
478 arrayerrorexit:
479 if (hlist != NULL)
480 opdisposelist (hlist);
481
482 if (htable != NULL)
483 disposevaluerecord (*val, false);
484
485 setnilvalue (val); //safety
486
487 return (false);
488 } /*langwinipccoercearray*/
489
490
491 static boolean langwinipccoerceparam (VARIANTARG * var, tyvaluerecord * val) {
492 VARIANTARG var2; /*used for conversion*/
493 VARIANT var3;
494 boolean res, fl;
495 HRESULT hr;
496
497 res = true;
498
499 VariantInit (&var2);
500 VariantInit (&var3);
501
502 if ((V_ISBYREF (var)) && (! V_ISARRAY (var))) {
503 fl = false;
504
505 hr = VariantCopyInd (&var3, var);
506
507 if (SUCCEEDED(hr)) {
508 fl = langwinipccoerceparam ((VARIANTARG *)&var3, val);
509
510 VariantClear (&var3); /*we need to delete this copy */
511 }
512
513 return (fl);
514 }
515
516 if (V_ISVECTOR (var)) {
517 return (false);
518 }
519
520 if (V_ISARRAY (var)) {
521 return (langwinipccoercearray (var, val));
522 }
523
524 switch (V_VT(var) & VT_TYPEMASK) {
525 case VT_EMPTY:
526 case VT_NULL:
527 setlongvalue (0, val);
528 break;
529
530 case VT_I2:
531 setintvalue (V_I2(var), val);
532 break;
533
534 case VT_I4:
535 setlongvalue (V_I4(var), val);
536 break;
537
538 case VT_R4:
539 setsinglevalue (V_R4(var), val);
540 break;
541
542 case VT_R8:
543 setdoublevalue (V_R8(var), val);
544 break;
545
546 case VT_BSTR:
547 return (convertBSTRVariantToValue (var, val));
548 break;
549
550 case VT_BOOL:
551 setbooleanvalue (V_BOOL(var), val);
552 break;
553
554 case VT_UI1:
555 setcharvalue (V_UI1(var), val);
556 break;
557
558
559 case VT_DATE:
560 case VT_CY:
561 {
562 hr = VariantChangeType (&var2, var, 0, VT_BSTR);
563
564 if (SUCCEEDED(hr)) {
565 fl = convertBSTRVariantToValue (&var2, val);
566
567 VariantClear (&var2); /*we need to delete this copy */
568
569 res = fl;
570 }
571 else
572 res = false;
573 break;
574 }
575
576 case VT_ERROR:
577 case VT_DISPATCH:
578 case VT_UNKNOWN:
579 case VT_VARIANT:
580 default:
581 res = false;
582 }
583
584 return (res);
585 } /*langwinipccoerceparam*/
586
587
588 static boolean langwinipcbuildparamlist (hdltreenode hcode, DISPPARAMS* pDispParams, hdltreenode *hparams, unsigned int * errarg, boolean paramOrder) {
589
590 /*
591 take all of the parameters in the incoming verb hverb and build a code
592 tree for the corresponding lang paramter list
593
594 2.1b5 dmb: special case for subroutine events
595
596 2.1b12 dmb: push the root table to make sure address values will work
597
598 3.0.1b2 dmb: for subroutine events, the direct parameter is optional
599
600 5.0d14 dmb: take hcode parameter, so we can see of trap script takes
601 parameters by name. the first (direct) parameter can have any name. if
602 all others are 4 characters long, and appear in the event, we use names.
603 */
604
605 register short i;
606 long ctparams;
607 hdltreenode hlist = nil;
608 tyvaluerecord val;
609 hdltreenode hparam;
610 boolean flpushedroot;
611 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
612 boolean flnamedparams;
613 byte bskey [6];
614 tyvaluerecord vkey;
615 hdltreenode hname, hnamelist;
616 OSErr err;
617 #endif
618 register boolean fl = false;
619
620
621 if (currenthashtable == nil)
622 flpushedroot = pushhashtable (roottable);
623 else
624 flpushedroot = false;
625
626 ctparams = pDispParams->cArgs;
627
628 if (paramOrder == true) { //use fixed foward order
629 for (i = ctparams; i >= 1; i--) {
630
631 if (!langwinipccoerceparam (&pDispParams->rgvarg[i-1], &val)) {
632 if (errarg != NULL)
633 *errarg = i;
634
635 goto exit;
636 }
637
638 exemptfromtmpstack (&val); /*its data is about to belong to code tree*/
639
640 if (!newconstnode (val, &hparam))
641 goto exit;
642
643 if (hlist == nil)
644 hlist = hparam;
645 else
646 pushlastlink (hparam, hlist);
647 } /*for*/
648 }
649 else {
650 for (i = 1; i <= ctparams; i++) {
651 if (!langwinipccoerceparam (&pDispParams->rgvarg[i-1], &val)) {
652 if (errarg != NULL)
653 *errarg = i;
654
655 goto exit;
656 }
657
658 exemptfromtmpstack (&val); /*its data is about to belong to code tree*/
659
660 if (!newconstnode (val, &hparam))
661 goto exit;
662
663 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
664 // if (flnamedparams && i > 1) { // 5.0d14 dmb
665 //
666 // ostypetostring (param.key, bskey);
667 //
668 // if (!findnamedparam (hnamelist, bskey)) { // trap isn't expecting this param
669 //
670 // langdisposetree (hparam);
671 //
672 // continue;
673 // }
674 //
675 // if (!setstringvalue (bskey, &vkey) || !newidnode (vkey, &hname)) {
676 //
677 // langdisposetree (hparam);
678 //
679 // goto exit;
680 // }
681 //
682 // exemptfromtmpstack (&vkey);
683 //
684 // if (!pushbinaryoperation (fieldop, hname, hparam, &hparam))
685 // goto exit;
686 // }
687 #endif
688
689 if (hlist == nil)
690 hlist = hparam;
691 else
692 pushlastlink (hparam, hlist);
693 } /*for*/
694 } /*else use parameter old backwards way*/
695
696 fl = true;
697
698 exit:
699
700 if (flpushedroot)
701 pophashtable ();
702
703 if (fl)
704 *hparams = hlist; /*nil if there weren't any params*/
705 else
706 langdisposetree (hlist); /*checks for nil*/
707
708 return (fl);
709 } /*langwinipcbuildparamlist*/
710
711 #endif
712
713
714 static boolean langwinipcprocessstarted (void) {
715
716 /*
717 we don't want Frontier's menus to dim when serving another application's
718 doscript or trap call.
719 */
720
721 processnotbusy ();
722
723 return (true);
724 } /*langwinipcprocessstarted*/
725
726
727 static boolean langwinipcruncode (hdltreenode hcode, hdlhashtable hcontext, langerrormessagecallback errorcallback, tyvaluerecord * vreturned) {
728
729 /*
730 2.1b12 dmb: shared code between trap and doscript verbs.
731
732 we always consume hcode
733
734 2.1b14 dmb: take hcontext parameter for special kernel call case
735
736 4.0b7 dmb: fixed double-dispose memory bug when
737 */
738
739 hdlprocessrecord hprocess;
740 register boolean fl;
741
742 if (!newprocess (hcode, true, nil, 0L, &hprocess)) {
743
744 langdisposetree (hcode);
745
746 return (false);
747 }
748
749 (**hprocess).processrefcon = (long) vreturned;
750
751 if (errorcallback != NULL)
752 (**hprocess).errormessagecallback = errorcallback;
753
754 (**hprocess).processstartedroutine = &langwinipcprocessstarted;
755
756 (**hprocess).hcontext = hcontext;
757
758 fl = processruncode (hprocess, vreturned);
759
760 disposeprocess (hprocess);
761
762 return (fl);
763 } /*langwinipcruncode*/
764
765
766 #ifdef WIN95VERSION
767
768 boolean langwinipchandleCOM (bigstring bsscriptname, void* pDispParams, tyvaluerecord * retval, boolean *flfoundhandler, unsigned int * errarg) {
769
770 /*
771 6.0a14 dmb: fixed potential memory leak in error case.
772 */
773
774 bigstring bsverb;
775 register boolean fl = false;
776 tyvaluerecord val;
777 langerrormessagecallback savecallback;
778 hdltreenode hfunctioncall;
779 hdltreenode hparamlist;
780 hdltreenode hcode;
781 hdlhashtable htable;
782 hdlhashtable hcontext = nil;
783 tyvaluerecord vhandler;
784 Handle hthread = nil;
785 hdlhashnode handlernode;
786 boolean paramOrder = false;
787
788 *flfoundhandler = false;
789
790 if (retval->data.longvalue == 1)
791 paramOrder = true; //rab 9/3/98 fix for parameter order.
792
793 disablelangerror();
794
795 pushhashtable (roottable);
796
797 fl = langexpandtodotparams (bsscriptname, &htable, bsverb);
798
799 if (fl) {
800
801 if (htable == nil)
802 langsearchpathlookup (bsverb, &htable);
803 }
804
805 pophashtable();
806
807 enablelangerror();
808
809 if (! fl) {
810 /*generate an error message*/
811 return (false);
812 }
813
814 if (!hashtablelookupnode (htable, bsverb, &handlernode))
815 return (false);
816
817 vhandler = (**handlernode).val;
818
819 *flfoundhandler = true;
820
821 /*build a code tree and call the handler, with our error hook in place*/
822
823 langwinipchookerrors (&savecallback);
824
825 hcode = nil;
826
827 if ((**htable).valueroutine == nil) { /*not a kernel table*/
828
829 if (!langexternalvaltocode (vhandler, &hcode))
830 goto exit;
831
832 if (hcode == nil) { /*needs compilation*/
833
834 if (!langcompilescript (handlernode, &hcode))
835 goto exit;
836 }
837 }
838
839 // if (iskernelverb (hv)) { /*special case -- kernel verb specifies context*/
840 //
841 // if (!landgetlongparam (hv, keycurrenttable, (long *) &hcontext))
842 // goto exit;
843 // }
844
845 setaddressvalue (htable, bsverb, &val);
846
847 if (!pushfunctionreference (val, &hfunctioncall))
848 goto exit;
849
850 // if (hcontext != nil)
851 // pushhashtable (hcontext);
852
853 fl = langwinipcbuildparamlist (hcode, (DISPPARAMS*)pDispParams, &hparamlist, errarg, paramOrder);
854
855 // if (hcontext != nil)
856 // pophashtable ();
857
858 if (!fl) {
859 setlongvalue ((long) ResultFromScode(DISP_E_TYPEMISMATCH), retval);
860
861 langdisposetree (hfunctioncall);
862
863 goto exit;
864 }
865
866 if (!pushfunctioncall (hfunctioncall, hparamlist, &hcode)) /*consumes input parameters*/
867 goto exit;
868
869 if (!pushbinaryoperation (moduleop, hcode, nil, &hcode)) /*needs this level*/
870 goto exit;
871
872 fl = langwinipcruncode (hcode, hcontext, langwinipcerrorroutine, retval);
873
874 exit:
875
876 langwinipcunhookerrors (savecallback);
877
878 return (fl);
879 } /*langwinipchandleCOM*/
880
881 #endif
882
883
884 static boolean langkernelbuildparamlist (hdltreenode hcode, tyvaluerecord * listval, hdltreenode *hparams, unsigned int * errarg) {
885
886 /*
887 take all of the parameters in the incoming verb hverb and build a code
888 tree for the corresponding lang paramter list
889
890 2.1b5 dmb: special case for subroutine events
891
892 2.1b12 dmb: push the root table to make sure address values will work
893
894 3.0.1b2 dmb: for subroutine events, the direct parameter is optional
895
896 5.0d14 dmb: take hcode parameter, so we can see of trap script takes
897 parameters by name. the first (direct) parameter can have any name. if
898 all others are 4 characters long, and appear in the event, we use names.
899 */
900
901 register short i;
902 long ctparams;
903 hdltreenode hlist = nil;
904 tyvaluerecord val;
905 hdltreenode hparam;
906 boolean flpushedroot;
907 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
908 boolean flnamedparams;
909 byte bskey [6];
910 tyvaluerecord vkey;
911 hdltreenode hname, hnamelist;
912 OSErr err;
913 #endif
914 register boolean fl = false;
915
916 if (currenthashtable == nil)
917 flpushedroot = pushhashtable (roottable);
918 else
919 flpushedroot = false;
920
921 if (!langgetlistsize (listval, &ctparams))
922 goto exit;
923
924 for (i = 1; i <= ctparams; i++) {
925
926 if (!langgetlistitem (listval, i, NULL, &val)) {
927
928 if (errarg != NULL)
929 *errarg = i;
930
931 goto exit;
932 }
933
934 exemptfromtmpstack (&val); /*its data is about to belong to code tree*/
935
936 if (!newconstnode (val, &hparam))
937 goto exit;
938
939 #ifdef SUPPORT_NAMED_PARAMS_IN_FRONTIER_COM
940 // if (flnamedparams && i > 1) { // 5.0d14 dmb
941 //
942 // ostypetostring (param.key, bskey);
943 //
944 // if (!findnamedparam (hnamelist, bskey)) { // trap isn't expecting this param
945 //
946 // langdisposetree (hparam);
947 //
948 // continue;
949 // }
950 //
951 // if (!setstringvalue (bskey, &vkey) || !newidnode (vkey, &hname)) {
952 //
953 // langdisposetree (hparam);
954 //
955 // goto exit;
956 // }
957 //
958 // exemptfromtmpstack (&vkey);
959 //
960 // if (!pushbinaryoperation (fieldop, hname, hparam, &hparam))
961 // goto exit;
962 // }
963 #endif
964
965 if (hlist == nil)
966 hlist = hparam;
967 else
968 pushlastlink (hparam, hlist);
969 } /*for*/
970
971 fl = true;
972
973 exit:
974
975 if (flpushedroot)
976 pophashtable ();
977
978 if (fl)
979 *hparams = hlist; /*nil if there weren't any params*/
980 else
981 langdisposetree (hlist); /*checks for nil*/
982
983 return (fl);
984 } /*langkernelbuildparamlist*/
985
986
987 boolean langipcrunscript (bigstring bsscriptname, tyvaluerecord *vparams, hdlhashtable hcontext, tyvaluerecord *vreturned) {
988
989 /*
990 5.0.2b6 rab/dmb: new verb
991
992 5.0.2b7 dmb: preserve errormessagecallback through the call
993
994 6.0a14 dmb: fixed potential memory leak in error case.
995 */
996
997 bigstring bsverb;
998 register boolean fl = false;
999 tyvaluerecord val;
1000 hdltreenode hfunctioncall;
1001 hdltreenode hparamlist;
1002 hdltreenode hcode;
1003 hdlhashtable htable;
1004 tyvaluerecord vhandler;
1005 hdlhashnode handlernode;
1006
1007 pushhashtable (roottable);
1008
1009 fl = langexpandtodotparams (bsscriptname, &htable, bsverb);
1010
1011 if (fl) {
1012
1013 if (htable == nil)
1014 langsearchpathlookup (bsverb, &htable);
1015 }
1016
1017 pophashtable();
1018
1019 if (! fl)
1020 return (false);
1021
1022 if (!hashtablelookupnode (htable, bsverb, &handlernode)) {
1023
1024 langparamerror (unknownfunctionerror, bsverb);
1025
1026 return (false);
1027 }
1028
1029 vhandler = (**handlernode).val;
1030
1031 /*build a code tree and call the handler, with our error hook in place*/
1032
1033 hcode = nil;
1034
1035 if ((**htable).valueroutine == nil) { /*not a kernel table*/
1036
1037 if (!langexternalvaltocode (vhandler, &hcode)) {
1038
1039 langparamerror (notfunctionerror, bsverb);
1040
1041 goto exit;
1042 }
1043
1044 if (hcode == nil) { /*needs compilation*/
1045
1046 if (!langcompilescript (handlernode, &hcode))
1047 goto exit;
1048 }
1049 }
1050
1051 setaddressvalue (htable, bsverb, &val);
1052
1053 if (!pushfunctionreference (val, &hfunctioncall))
1054 goto exit;
1055
1056 if (hcontext != nil)
1057 pushhashtable (hcontext);
1058
1059 fl = langkernelbuildparamlist (hcode, vparams, &hparamlist, NULL);
1060
1061 if (hcontext != nil)
1062 pophashtable ();
1063
1064 if (!fl) {
1065
1066 setstringvalue ("0x31" "Can't complete call because of a parameter error.", vreturned);
1067
1068 langdisposetree (hfunctioncall);
1069
1070 goto exit;
1071 }
1072
1073 if (!pushfunctioncall (hfunctioncall, hparamlist, &hcode)) /*consumes input parameters*/
1074 goto exit;
1075
1076 if (!pushbinaryoperation (moduleop, hcode, nil, &hcode)) /*needs this level*/
1077 goto exit;
1078
1079 fl = langwinipcruncode (hcode, hcontext, langcallbacks.errormessagecallback, vreturned);
1080
1081 if (fl)
1082 pushvalueontmpstack (vreturned);
1083
1084 exit:
1085
1086 return (fl);
1087 } /*langipcrunscript*/
1088
This page was automatically generated by the
LXR engine.
Visit the LXR main site for more
information.