langdll.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langdll.c 1260 2006-04-13 06:13:10Z sethdill $    */
00003 
00004 /******************************************************************************
00005 
00006     UserLand Frontier(tm) -- High performance Web content management,
00007     object database, system-level and Internet scripting environment,
00008     including source code editing and debugging.
00009 
00010     Copyright (C) 1992-2004 UserLand Software, Inc.
00011 
00012     This program is free software; you can redistribute it and/or modify
00013     it under the terms of the GNU General Public License as published by
00014     the Free Software Foundation; either version 2 of the License, or
00015     (at your option) any later version.
00016 
00017     This program is distributed in the hope that it will be useful,
00018     but WITHOUT ANY WARRANTY; without even the implied warranty of
00019     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00020     GNU General Public License for more details.
00021 
00022     You should have received a copy of the GNU General Public License
00023     along with this program; if not, write to the Free Software
00024     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00025 
00026 ******************************************************************************/
00027 
00028 #include "frontier.h"
00029 #include "standard.h"
00030 
00031 #ifdef MACVERSION
00032 #include "langxcmd.h"
00033 #endif
00034 
00035 #include "memory.h"
00036 #include "frontierconfig.h"
00037 #include "cursor.h"
00038 #include "dialogs.h"
00039 #include "error.h"
00040 #include "file.h"
00041 #include "font.h"
00042 #include "kb.h"
00043 #include "mouse.h"
00044 #include "ops.h"
00045 #include "quickdraw.h"
00046 #include "resources.h"
00047 #include "sounds.h"
00048 #include "strings.h"
00049 #include "frontierwindows.h"
00050 #include "cancoon.h"
00051 #include "shell.h"
00052 #include "shellhooks.h"
00053 #include "lang.h"
00054 #include "langinternal.h"
00055 #include "langexternal.h"
00056 #include "langipc.h"
00057 #ifdef WIN95VERSION
00058 #include "langwinipc.h"
00059 #include "FrontierWinMain.h"
00060 #endif
00061 #include "langsystem7.h"
00062 #include "langtokens.h"
00063 #include "oplist.h"
00064 #include "BASE64.H"
00065 #include "tablestructure.h"
00066 #include "tableverbs.h"
00067 #include "process.h"
00068 #include "processinternal.h"
00069 #include "kernelverbdefs.h"
00070 #include "langdll.h"
00071 
00072 #if defined(MACVERSION) && TARGET_RT_MAC_MACHO
00073 #include "CallMachOFrameWork.h"
00074 #endif
00075 
00076 #define NEW_DLL_INTERFACE 1 /* 2002-11-03 AR: defined to enable new DLL interface */
00077 //#undef NEW_DLL_INTERFACE
00078 
00079 
00080 #ifdef NEW_DLL_INTERFACE
00081 
00082     /*
00083     #pragma message ("*********************** NEW_DLL_INTERFACE is ON ***********************")
00084     */
00085 
00086     /* type definitions */
00087     
00088     #ifdef WIN95VERSION
00089         typedef HINSTANCE tydllsyshandle;
00090     #endif
00091     #ifdef MACVERSION
00092         typedef CFragConnectionID tydllsyshandle;
00093     #endif
00094 
00095     #define ctprocinfohashbuckets 29 /* should be a prime number */
00096 
00097     typedef struct typrocinfostruct *typrocinfoptr, **typrocinfohandle; /* forward declaration */
00098     
00099     typedef struct typrocinfostruct {
00100     
00101         typrocinfohandle hashlink;                  /* handle linking to next node in hash bucket */
00102         
00103         long ctparams;                              /* number of params expected by the proc */
00104         
00105         tyvaluetype paramtypes[maxdllparams];       /* types of params expected by the proc */
00106 
00107         tyvaluetype resulttype;                     /* type of result value returned by the proc */
00108 
00109         tyDLLEXTROUTINE procaddress;                /* pointer to the proc in the library */
00110         
00111         #if MACVERSION && !TARGET_API_MAC_CARBON
00112             RoutineDescriptor moduledesc;           /* needed for calling the proc on Mac OS Classic */
00113             UniversalProcPtr moduleUPP;
00114         #endif
00115         
00116         bigstring bsprocname;                       /* name of the proc (null-terminated pascal string!) */
00117 
00118         } typrocinfostruct;
00119     
00120     typedef struct tydllinfostruct *tydllinfoptr, **tydllinfohandle; /* forward declaration */
00121     
00122     typedef struct tydllinfostruct {
00123 
00124         tydllinfohandle hnextdll;                               /* if stay-resident, handle to next library in linked list */
00125         
00126         tyfilespec fs;                                          /* file path of library */
00127         
00128         tydllsyshandle hdllsyshandle;                           /* platform-specific handle returned by system function for loading DLL */
00129         
00130         Handle hres;                                            /* temp handle to ProcInfo resource */
00131     
00132         char *resdata;                                          /* temp pointer to data in ProcInfo resource */
00133         
00134         long ctreferences;                                      /* number of calls into library currently under way */
00135         
00136         boolean flunload;                                       /* set flag to unload library when ctreferences drops to nil */
00137 
00138         typrocinfohandle hashbucket[ctprocinfohashbuckets];     /* array of hash buckets for procinfo structs */
00139         
00140         } tydllinfostruct;
00141     
00142     /* static variables */
00143     
00144     static tydllinfohandle loadeddlls; /* linked list of currently loaded stay-resident DLLs */
00145 
00146     static XDLLProcTable *dllcallbacks; /* global pointer to array of callback functions */
00147 
00148 #else
00149 
00150     typedef struct tydllmoduleinfo {
00151         
00152         long ctparams;
00153         
00154         tyvaluetype paramtypes [maxdllparams];
00155         
00156         tyvaluetype resulttype;
00157         
00158         Handle moduleHandle;
00159 
00160         #ifdef MACVERSION
00161             RoutineDescriptor moduleDesc;
00162             UniversalProcPtr moduleUPP;
00163             Handle hresdata; 
00164         #endif
00165 
00166         char * pdata;
00167 
00168         tyDLLEXTROUTINE procAddress;
00169         } tydllmoduleinfo;
00170 
00171 #endif /* NEW_DLL_INTERFACE */
00172 
00173 
00174 /* External Reference functions */
00175     pascal boolean odbUpdateOdbref (WindowPtr w, odbRef odb);
00176 
00177     boolean odbnewfile (hdlfilenum fnum);
00178     boolean odbaccesswindow (WindowPtr w, odbRef *odb);
00179     boolean odbopenfile (hdlfilenum fnum, odbRef *odb, boolean flreadonly);
00180     boolean odbsavefile (odbRef odb);
00181     boolean odbclosefile (odbRef odb);
00182     boolean odbdefined (odbRef odb, bigstring bspath);
00183     boolean odbdelete (odbRef odb, bigstring bspath);
00184     boolean odbgettype (odbRef odb, bigstring bspath, OSType *odbType);
00185     boolean odbgetvalue (odbRef odb, bigstring bspath, odbValueRecord *value);
00186     boolean odbsetvalue (odbRef odb, bigstring bspath, odbValueRecord *value);
00187     boolean odbnewtable (odbRef odb, bigstring bspath);
00188     boolean odbcountitems (odbRef odb, bigstring bspath, long *count);
00189     boolean odbgetnthitem (odbRef odb, bigstring bspath, long n, bigstring bsname);
00190     boolean odbgetmoddate (odbRef odb, bigstring bspath, unsigned long *date);
00191     boolean odbdisposevalue (odbRef odb, odbValueRecord *value);
00192     extern pascal void odbGetError (bigstring bs);
00193 
00194 #ifdef MACVERSION
00195 
00196     enum {
00197          uppdllcallProcInfo = kCStackBased
00198          | RESULT_SIZE(SIZE_CODE(sizeof(boolean)))
00199          | STACK_ROUTINE_PARAMETER(1, SIZE_CODE(sizeof(tydllparamblock *)))
00200          | STACK_ROUTINE_PARAMETER(2, SIZE_CODE(sizeof(XDLLProcTable *)))
00201          };
00202 
00203 #endif
00204 
00205 
00206 Handle xCALLBACK extfrontierReAlloc (Handle h, long sz) {
00207     grabthreadglobals ();
00208 
00209     SetHandleSize (h, sz);
00210 
00211     releasethreadglobals ();
00212 
00213     return (h);
00214     } /*extfrontierReAlloc*/
00215     
00216 
00217 Handle xCALLBACK extfrontierAlloc (long sz) {
00218     Handle h;
00219 
00220     grabthreadglobals ();
00221 
00222     h = NewHandle(sz);
00223 
00224     releasethreadglobals ();
00225 
00226     return (h);
00227     } /*extfrontierAlloc*/
00228 
00229 
00230 char * xCALLBACK extfrontierLock (Handle h) {
00231     char * res;
00232 
00233     grabthreadglobals ();
00234 
00235     #ifdef MACVERSION
00236         HLock (h);
00237 
00238         res = (char *) *h;
00239     #endif
00240 
00241     #ifdef WIN95VERSION
00242         res = frontierLock (h);
00243     #endif
00244 
00245     releasethreadglobals ();
00246 
00247     return (res);
00248     } /*extfrontierLock*/
00249 
00250 
00251 void xCALLBACK extfrontierFree (Handle h) {
00252     grabthreadglobals ();
00253 
00254     DisposeHandle (h);
00255 
00256     releasethreadglobals ();
00257     } /*extfrontierFree*/
00258 
00259 
00260 long xCALLBACK extfrontierSize (Handle h) {
00261     long res;
00262 
00263     grabthreadglobals ();
00264 
00265     res = GetHandleSize(h);
00266 
00267     releasethreadglobals ();
00268 
00269     return (res);
00270     } /*extfrontierSize*/
00271 
00272 
00273 void xCALLBACK extfrontierUnlock (Handle h) {
00274     grabthreadglobals ();
00275 
00276     HUnlock (h);
00277 
00278     releasethreadglobals ();
00279     } /*extfrontierUnlock*/
00280 
00281 
00282 static boolean convertodbtotyval (odbValueRecord *odbval, tyvaluerecord * val) {
00283     tyvaluetype type;
00284     type = langexternalgetvaluetype ((OSType) (*odbval).valuetype);
00285     
00286     if (type == -1) /*no match; must have been a binary value*/
00287         type = binaryvaluetype;
00288     
00289     initvalue (val, type);
00290     
00291     val->data.binaryvalue = (*odbval).data.binaryvalue;
00292 
00293     return (true);
00294     } /*convertodbtotyval*/
00295 
00296 
00297 static boolean converttyvaltoodb (tyvaluerecord * val, odbValueRecord *odbval) {
00298     tyvaluerecord newval;
00299 
00300     if (!copyvaluerecord (*val, &newval))
00301         return (false);
00302     
00303     if (!copyvaluedata (&newval))
00304         return (false);
00305     
00306     exemptfromtmpstack (&newval);
00307     
00308     (*odbval).valuetype = (odbValueType) langexternalgettypeid (newval);
00309     
00310     /*
00311     if (val.valuetype == binaryvaluetype)
00312         pullfromhandle (val.data.binaryvalue, 0L, sizeof (typeid), &(*value).valuetype);
00313     */
00314     
00315     (*odbval).data.binaryvalue = newval.data.binaryvalue; /*largest field covers everything*/
00316 
00317     return (true);
00318     } /*converttyvaltoodb*/
00319 
00320 
00321 odbBool xCALLBACK extOdbNewListValue (odbRef odb, odbValueRecord *value, odbBool flRecord) {
00322     odbBool res;
00323     hdllistrecord hlist;
00324 
00325     res = false;
00326 
00327     grabthreadglobals ();
00328 
00329     if (opnewlist (&hlist, flRecord)) {
00330     
00331         if (flRecord) {
00332             value->valuetype = odb_recordvaluetype;
00333             value->data.recordvalue = (Handle) hlist;
00334             }
00335         else {
00336             value->valuetype = odb_listvaluetype;
00337             value->data.listvalue = (Handle) hlist;
00338             }
00339 
00340         if (hlist != NULL)
00341             res = true;
00342         }
00343 
00344     releasethreadglobals ();
00345 
00346     return (res);
00347     } /*extOdbNewListValue*/
00348 
00349                 
00350 odbBool xCALLBACK extOdbGetListCount (odbRef odb, odbValueRecord *value, long * cnt) {
00351 #pragma unused (odb)
00352     odbBool res;
00353 
00354     res = false;
00355 
00356     grabthreadglobals ();
00357 
00358     if (((value->valuetype == odb_recordvaluetype) || (value->valuetype == odb_listvaluetype)) && (value->data.listvalue != NULL)) {
00359         *cnt = opcountlistitems ((hdllistrecord) value->data.listvalue);
00360 
00361         res = true;
00362         }
00363 
00364     releasethreadglobals ();
00365 
00366     return (res);
00367     } /*extOdbGetListCount*/
00368 
00369 
00370 odbBool xCALLBACK extOdbDeleteListValue (odbRef odb, odbValueRecord *value, long idx, char * recordname) {
00371 #pragma unused (odb)
00372     odbBool res;
00373 
00374     res = false;
00375 
00376     grabthreadglobals ();
00377 
00378     if (((value->valuetype == odb_recordvaluetype) || (value->valuetype == odb_listvaluetype)) && (value->data.listvalue != NULL)) {
00379         res = opdeletelistitem ((hdllistrecord) value->data.listvalue, (short) idx, (ptrstring)recordname);
00380         }
00381 
00382     releasethreadglobals ();
00383 
00384     return (res);
00385     } /*extOdbDeleteListValue*/
00386 
00387 
00388 odbBool xCALLBACK extOdbSetListValue (odbRef odb, odbValueRecord *value, long idx, char * recordname, odbValueRecord *valueData) {
00389     odbBool res;
00390     tyvaluerecord val;
00391 
00392     res = false;
00393 
00394     grabthreadglobals ();
00395 
00396     if (((value->valuetype == odb_recordvaluetype) || (value->valuetype == odb_listvaluetype)) && (value->data.listvalue != NULL)) {
00397 
00398         convertodbtotyval (valueData, &val);
00399 
00400         res = setnthlistval ((hdllistrecord) value->data.listvalue, idx, (ptrstring) recordname, &val);
00401         }
00402 
00403     releasethreadglobals ();
00404 
00405     return (res);
00406     } /*extOdbSetListValue*/
00407 
00408 
00409 odbBool xCALLBACK extOdbGetListValue (odbRef odb, odbValueRecord *value, long idx, char * recordname, odbValueRecord *valueReturn) {
00410 #pragma unused (odb)
00411     odbBool res;
00412     tyvaluerecord valret;
00413 
00414     res = false;
00415 
00416     grabthreadglobals ();
00417 
00418     if (((value->valuetype == odb_recordvaluetype) || (value->valuetype == odb_listvaluetype)) && (value->data.listvalue != NULL)) {
00419         res = getnthlistval ((hdllistrecord) value->data.listvalue, idx, (ptrstring) recordname, &valret);
00420 
00421         if (res)
00422             res = converttyvaltoodb (&valret, valueReturn);
00423         }
00424 
00425     releasethreadglobals ();
00426 
00427     return (res);
00428     } /*extOdbGetListValue*/
00429 
00430 
00431 odbBool xCALLBACK extOdbAddListValue (odbRef odb, odbValueRecord *value, char * recordname, odbValueRecord *valueData) {
00432 #pragma unused (odb)
00433     odbBool res;
00434     tyvaluerecord val;
00435 
00436     res = false;
00437 
00438     grabthreadglobals ();
00439 
00440     if (((value->valuetype == odb_recordvaluetype) || (value->valuetype == odb_listvaluetype)) && (value->data.listvalue != NULL)) {
00441 
00442         convertodbtotyval (valueData, &val);
00443 
00444         res = langpushlistval ((hdllistrecord) value->data.listvalue, (ptrstring) recordname, &val);
00445         }
00446 
00447     releasethreadglobals ();
00448 
00449     return (res);
00450     } /*extOdbAddListValue*/
00451 
00452 //This global is so users of getcurrentroot do not have to do a close on the return value each time.
00453 odbRef globalodb = NULL;
00454 
00455 odbRef xCALLBACK extOdbGetCurrentRoot (void) {
00456     odbRef odb;
00457 
00458     grabthreadglobals ();
00459 
00460     if (globalodb == NULL)
00461         odbaccesswindow (NULL, &globalodb);
00462     else
00463         odbUpdateOdbref (NULL, globalodb);
00464 
00465     odb = globalodb;
00466 
00467     releasethreadglobals ();
00468 
00469     return (odb);
00470     } /*extOdbGetCurrentRoot*/
00471 
00472 
00473 odbBool xCALLBACK extOdbNewFile (hdlfilenum h) {
00474     odbBool res;
00475 
00476     grabthreadglobals ();
00477 
00478     res = odbnewfile (h);
00479 
00480     releasethreadglobals ();
00481 
00482     return (res);
00483     } /*extOdbNewFile*/
00484 
00485 
00486 odbBool xCALLBACK extOdbOpenFile (hdlfilenum h, odbRef *odb) {
00487     odbBool res;
00488 
00489     grabthreadglobals ();
00490 
00491     res = odbopenfile (h, odb, false);
00492 
00493     releasethreadglobals ();
00494 
00495     return (res);
00496     } /*extOdbOpenFile*/
00497 
00498 
00499 odbBool xCALLBACK extOdbSaveFile (odbRef odb) {
00500     odbBool res;
00501 
00502     grabthreadglobals ();
00503 
00504     res = odbsavefile (odb);
00505 
00506     releasethreadglobals ();
00507 
00508     return (res);
00509     } /*extOdbSaveFile*/
00510 
00511 
00512 odbBool xCALLBACK extOdbCloseFile (odbRef odb) {
00513     odbBool res;
00514 
00515     grabthreadglobals ();
00516 
00517     res = odbclosefile (odb);
00518 
00519     releasethreadglobals ();
00520 
00521     return (res);
00522     } /*extOdbCloseFile*/
00523 
00524 
00525 odbBool xCALLBACK extOdbDefined (odbRef odb, bigstring bspath) {
00526     odbBool res;
00527 
00528     grabthreadglobals ();
00529 
00530     res = odbdefined (odb, bspath);
00531 
00532     releasethreadglobals ();
00533 
00534     return (res);
00535     } /*extOdbDefined*/
00536 
00537 
00538 odbBool xCALLBACK extOdbDelete (odbRef odb, bigstring bspath) {
00539     odbBool res;
00540 
00541     grabthreadglobals ();
00542 
00543     res = odbdelete (odb, bspath);
00544 
00545     releasethreadglobals ();
00546 
00547     return (res);
00548     } /*extOdbDelete*/
00549 
00550 
00551 odbBool xCALLBACK extOdbGetType (odbRef odb, bigstring bspath, OSType *type) {
00552     odbBool res;
00553 
00554     grabthreadglobals ();
00555 
00556     res = odbgettype (odb, bspath, type);
00557 
00558     releasethreadglobals ();
00559 
00560     return (res);
00561     } /*extOdbGetType*/
00562 
00563 
00564 odbBool xCALLBACK extOdbCountItems (odbRef odb, bigstring bspath, long *count) {
00565     odbBool res;
00566 
00567     grabthreadglobals ();
00568 
00569     res = odbcountitems (odb, bspath, count);
00570 
00571     releasethreadglobals ();
00572 
00573     return (res);
00574     } /*extOdbCountItems*/
00575 
00576 
00577 odbBool xCALLBACK extOdbGetNthItem (odbRef odb, bigstring bspath, long n, bigstring bsname) {
00578     odbBool res;
00579 
00580     grabthreadglobals ();
00581 
00582     res = odbgetnthitem (odb, bspath, n, bsname);
00583 
00584     releasethreadglobals ();
00585 
00586     return (res);
00587     } /*extOdbGetNthItem*/
00588 
00589 
00590 odbBool xCALLBACK extOdbGetValue (odbRef odb, bigstring bspath, odbValueRecord *value) {
00591     odbBool res;
00592 
00593     grabthreadglobals ();
00594 
00595     res = odbgetvalue (odb, bspath, value);
00596 
00597     releasethreadglobals ();
00598 
00599     return (res);
00600     } /*extOdbGetValue*/
00601 
00602 
00603 odbBool xCALLBACK extOdbSetValue (odbRef odb, bigstring bspath, odbValueRecord *value) {
00604     odbBool res;
00605 
00606     grabthreadglobals ();
00607 
00608     res = odbsetvalue (odb, bspath, value);
00609 
00610     releasethreadglobals ();
00611 
00612     return (res);
00613     } /*extOdbSetValue*/
00614 
00615 
00616 odbBool xCALLBACK extOdbNewTable (odbRef odb, bigstring bspath) {
00617     odbBool res;
00618 
00619     grabthreadglobals ();
00620 
00621     res = odbnewtable (odb, bspath);
00622 
00623     releasethreadglobals ();
00624 
00625     return (res);
00626     } /*extOdbNewTable*/
00627 
00628 
00629 odbBool xCALLBACK extOdbGetModDate (odbRef odb, bigstring bspath, unsigned long *date) {
00630     odbBool res;
00631 
00632     grabthreadglobals ();
00633 
00634     res = odbgetmoddate (odb, bspath, date);
00635 
00636     releasethreadglobals ();
00637 
00638     return (res);
00639     } /*extOdbGetModDate*/
00640 
00641 
00642 void xCALLBACK extOdbDisposeValue (odbRef odb, odbValueRecord *value) {
00643     grabthreadglobals ();
00644 
00645     if (value->data.binaryvalue != NULL) {
00646         odbdisposevalue (odb, value);
00647 
00648         value->data.binaryvalue = NULL;
00649         }
00650 
00651     releasethreadglobals ();
00652     } /*extOdbDisposeValue*/
00653 
00654 
00655 void xCALLBACK extOdbGetError (bigstring bs) {
00656     grabthreadglobals ();
00657 
00658     odbGetError (bs);
00659 
00660     releasethreadglobals ();
00661     } /*extOdbGetError*/
00662 
00663 
00664 odbBool xCALLBACK extDoScript (char * script, long len, odbValueRecord *value) {
00665     tyvaluerecord val;
00666     Handle h;
00667     odbBool res;
00668 
00669     res = false; // until otherwise
00670 
00671     clearbytes (value, sizeof (*value)); // 5.1.4
00672     
00673     grabthreadglobals ();
00674 
00675     if (newfilledhandle (script, len,  &h)) {
00676         if (langrun (h, &val)) {
00677 
00678             exemptfromtmpstack (&val);
00679             
00680             (*value).valuetype = (odbValueType) langexternalgettypeid (val);
00681             
00682             /*
00683             if (val.valuetype == binaryvaluetype)
00684                 pullfromhandle (val.data.binaryvalue, 0L, sizeof (typeid), &(*value).valuetype);
00685             */
00686             
00687             (*value).data.binaryvalue = val.data.binaryvalue; /*largest field covers everything*/
00688 
00689             res = true;
00690             }
00691         }
00692 
00693     releasethreadglobals ();
00694     return (res);
00695     } /*extDoScript*/
00696 
00697 
00698 odbBool xCALLBACK extDoScriptText (char * script, long len, Handle * text) {
00699     tyvaluerecord val;
00700     Handle h;
00701     odbBool res;
00702 
00703     res = false; // until otherwise
00704 
00705     *text = nil; // 5.1.4
00706     
00707     grabthreadglobals ();
00708 
00709     if (newfilledhandle (script, len,  &h)) {
00710         if (langrun (h, &val)) {
00711 
00712             if (coercetostring (&val)) {
00713                 exemptfromtmpstack (&val);
00714 
00715                 *text = val.data.binaryvalue;
00716             
00717                 res = true;
00718                 }
00719             }
00720         }
00721 
00722     releasethreadglobals ();
00723     
00724     return (res);
00725     } /*extDoScriptText*/
00726 
00727 
00728 odbBool xCALLBACK extInvoke (bigstring bsscriptname, void * pDispParams, odbValueRecord * retval, boolean *flfoundhandler, unsigned int * errarg) {
00729 #if MACVERSION
00730 #   pragma unused (bsscriptname, pDispParams, flfoundhandler, errarg)
00731 #endif
00732     boolean res;
00733     tyvaluerecord val;
00734 
00735     res = false; // until otherwise
00736 
00737     grabthreadglobals ();
00738 
00739     #ifdef WIN95VERSION
00740         convertodbtotyval (retval, &val);
00741         res = langwinipchandleCOM (bsscriptname, pDispParams, &val, flfoundhandler, errarg);
00742     #endif
00743     #ifdef MACVERSION
00744         res = false;
00745         setstringvalue (BIGSTRING ("\x29" "Invoke is not supported on this platform."), &val);
00746     #endif
00747 
00748     converttyvaltoodb (&val, retval);
00749 
00750     disposevaluerecord (val, false);
00751 
00752     releasethreadglobals ();
00753     
00754     return (res);
00755     } /*extInvoke*/
00756 
00757 
00758 odbBool xCALLBACK extCoerce (odbValueRecord * odbval, odbValueType newtype) {
00759     boolean res;
00760     tyvaluerecord val;
00761     tyvaluetype newvaltype;
00762 
00763     res = false; // until otherwise
00764 
00765     grabthreadglobals ();
00766 
00767     convertodbtotyval (odbval, &val);
00768 
00769     newvaltype = langexternalgetvaluetype ((OSType) newtype);
00770     
00771     if (newvaltype == -1)   /*no match; must have been a binary value*/
00772         newvaltype = binaryvaluetype;
00773 
00774     if (coercevalue (&val, newvaltype)) {
00775         converttyvaltoodb (&val, odbval);
00776 
00777         res = true;
00778         }
00779 
00780     releasethreadglobals ();
00781     
00782     return (res);
00783     } /*extInvoke*/
00784 
00785 
00786 odbBool xCALLBACK extCallScript (odbString bspath, odbValueRecord *vparams, odbValueRecord *value) {
00787     
00788     /*
00789     2002-10-13 AR: Run the script at bspath with the parameters supplied in vparams.
00790     This is an adaption of callscriptverb (langverbs.c) for the DLL callback interface.
00791     */
00792 
00793     odbBool res = false;
00794     tyvaluerecord val;
00795     tyvaluerecord vret;
00796 
00797     grabthreadglobals ();
00798 
00799     if (((vparams->valuetype == odb_recordvaluetype) || (vparams->valuetype == odb_listvaluetype)) && (vparams->data.listvalue != NULL)) {
00800 
00801         convertodbtotyval (vparams, &val);
00802 
00803         if (langrunscript (bspath, &val, nil, &vret)) {
00804 
00805             exemptfromtmpstack (&vret);
00806             
00807             (*value).valuetype = (odbValueType) langexternalgettypeid (vret);
00808             
00809             (*value).data.binaryvalue = vret.data.binaryvalue; /*largest field covers everything*/
00810 
00811             res = true;
00812             }
00813         }
00814 
00815     releasethreadglobals ();
00816 
00817     return (res);
00818     } /* extCallScript */
00819 
00820 
00821 odbBool xCALLBACK extCallScriptText (odbString bspath, odbValueRecord *vparams, Handle * text) {
00822 
00823     /*
00824     2002-10-13 AR: Like extCallScript, but coerce the result to a string and return it
00825     */
00826 
00827     odbBool res = false;
00828     tyvaluerecord val;
00829     tyvaluerecord vret;
00830 
00831     grabthreadglobals ();
00832 
00833     if (((vparams->valuetype == odb_recordvaluetype) || (vparams->valuetype == odb_listvaluetype)) && (vparams->data.listvalue != NULL)) {
00834 
00835         convertodbtotyval (vparams, &val);
00836 
00837         if (langrunscript (bspath, &val, nil, &vret)) {
00838 
00839             if (coercetostring (&vret)) {
00840             
00841                 exemptfromtmpstack (&vret);
00842 
00843                 *text = vret.data.binaryvalue;
00844             
00845                 res = true;
00846                 }
00847             }
00848         }
00849 
00850     releasethreadglobals ();
00851 
00852     return (res);
00853     } /* extCallScriptText */
00854 
00855 
00856 odbBool xCALLBACK extThreadYield (void) {
00857     
00858     /*
00859     2003-04-22 AR: Yield the processor to other threads. This is only really useful
00860     on the Mac. On Win32, DLL threads multitask preemptively anyway.
00861     
00862     If this function returns false, the caller should terminate processing and return
00863     to the kernel as soon as possible since the the current thread has been killed.
00864     */
00865     
00866     odbBool res;
00867 
00868     grabthreadglobals ();
00869     
00870     res = langbackgroundtask(false);
00871     
00872     if (res) {
00873         res = !languserescaped(false);
00874         }
00875 
00876     releasethreadglobals ();
00877 
00878     return (res);
00879     } /* extThreadYield */
00880 
00881 
00882 odbBool xCALLBACK extThreadSleep (long sleepticks) {
00883     
00884     /*
00885     2003-04-22 AR: Go to sleep for the indicated number of ticks (60ths of a second).
00886     
00887     If this function returns false, the caller should terminate processing and return
00888     to the kernel as soon as possible since the the current thread has been killed.
00889     */
00890 
00891     odbBool res;
00892 
00893     grabthreadglobals ();
00894     
00895     res = processsleep (nil, sleepticks);
00896     
00897     if (res) {
00898         res = !languserescaped(false);
00899         }
00900 
00901     releasethreadglobals ();
00902 
00903     return (res);
00904     } /* extThreadSleep */
00905 
00906 
00912 
00913 
00914 static tyvaluetype gettypefromchar (char val) {
00915 
00916     tyvaluetype ret;
00917 
00918     switch (val)
00919         {
00920         case 'v':
00921         case 'V':
00922             ret = novaluetype;
00923             break;
00924 
00925         case 'i':
00926         case 'I':
00927             ret = longvaluetype;
00928             break;
00929 
00930         case 's':
00931         case 'S':
00932             ret = stringvaluetype;
00933             break;
00934 
00935         case 'l':
00936         case 'L':
00937             ret = listvaluetype;
00938             break;
00939 
00940         case 'r':
00941         case 'R':
00942             ret = recordvaluetype;
00943             break;
00944 
00945         default:
00946             ret = novaluetype;
00947             break;
00948         }
00949 
00950     return (ret);
00951     } /*gettypefromchar*/
00952 
00953 
00954 #ifdef NEW_DLL_INTERFACE
00955 
00956 
00957 static unsigned long procnamehashfunction (bigstring bs) {
00958 
00959     register unsigned long x;
00960     register unsigned long len = stringlength (bs);
00961     
00962     // #define  stringlength(bs) ((unsigned char)(bs)[0])
00963     
00964     len = (unsigned long) stringlength (bs);
00965      
00966     if (len == 0)
00967         return (0);
00968     
00969     // #define getstringcharacter(bs,pos) bs[(pos)+1]
00970     
00971     x = getstringcharacter (bs, 0);
00972     
00973     x += getstringcharacter (bs, (len-1)/3);
00974     
00975     x += getstringcharacter (bs, (2*(len-1))/3);
00976     
00977     x += getstringcharacter (bs, len-1);
00978     
00979     return (x % ctprocinfohashbuckets);  /* results range 0..ctprocinfohashbuckets */
00980     } /*procnamehashfunction*/
00981 
00982 
00983 static void addprocinfo (tydllinfohandle hdll, typrocinfohandle hprocinfo) {
00984 
00985     /*
00986     Insert proc info node at start of hash bucket
00987     */
00988 
00989     long ixhashbucket;
00990 
00991     ixhashbucket = procnamehashfunction ((**hprocinfo).bsprocname);
00992     
00993     (**hprocinfo).hashlink = (**hdll).hashbucket[ixhashbucket];
00994     
00995     (**hdll).hashbucket[ixhashbucket] = hprocinfo;
00996      
00997     return;
00998     } /*addprocinfo*/
00999 
01000 
01001 static boolean locateprocinfo (tydllinfohandle hdll, bigstring bsprocname, typrocinfohandle *hprocinfoptr) {
01002 
01003     /*
01004     Look up the proc name in the hash table of procs
01005     */
01006 
01007     typrocinfohandle hnomad;
01008     tyfilespec fs = (**hdll).fs;
01009     long ixhashbucket;
01010 
01011     //assert (hdll != nil && *hdll != nil);
01012     
01013     ixhashbucket = procnamehashfunction (bsprocname);
01014     
01015     hnomad = (**hdll).hashbucket[ixhashbucket];
01016     
01017     while (hnomad != nil) {
01018     
01019         if (comparestrings ((**hnomad).bsprocname, bsprocname) == 0) {
01020         
01021             *hprocinfoptr = hnomad;
01022             
01023             return (true);
01024             }
01025         
01026         hnomad = (**hnomad).hashlink;
01027         }/*while*/
01028     
01029     lang2paramerror (cantfindprocinfofunctionerror, bsprocname, fsname (&fs));
01030 
01031     return (false);
01032     } /*locateprocinfo*/
01033 
01034 
01035 static void freeprocinfobuckets (tydllinfohandle hdll) {
01036     
01037     typrocinfohandle h, hnext;
01038     long k;
01039     
01040     for (k = 0; k < ctprocinfohashbuckets; k++) {
01041     
01042         h = (**hdll).hashbucket[k];
01043         
01044         while (h != nil) {
01045         
01046             hnext = (**h).hashlink;
01047             
01048             #if defined(MACVERSION) && TARGET_RT_MAC_MACHO
01049                 disposemachofuncptr ((void *) (**h).procaddress);   
01050             #endif
01051 
01052             disposehandle ((Handle) h);
01053             
01054             h = hnext;
01055             }/*while*/
01056         
01057         (**hdll).hashbucket[k] = nil;
01058         }/*for*/
01059     
01060     return;
01061     } /*freeprocinfobuckets*/
01062 
01063 
01064 static typrocinfohandle newprocinfo (char *pname, long lenname, char *pparams, long lenparams) {
01065     
01066     /*
01067     Create a new proc info handle from the given information
01068     */
01069     
01070     typrocinfohandle hprocinfo;
01071     long k;
01072     
01073     /* Allocate and clear memory */
01074     
01075     if (!newclearhandle (sizeof (**hprocinfo), (Handle *)&hprocinfo))
01076         return (nil);
01077 
01078     /* Copy procname to a null-terminated pascal string */
01079     
01080     memcpy (stringbaseaddress ((**hprocinfo).bsprocname), pname, lenname);
01081     
01082     setstringlength((**hprocinfo).bsprocname, lenname);
01083     
01084     nullterminate((**hprocinfo).bsprocname);
01085     
01086     /* Set result type */
01087     
01088     (**hprocinfo).resulttype = gettypefromchar (pparams[0]);
01089     
01090     /* Set param count and types */
01091     
01092     (**hprocinfo).ctparams = lenparams - 1; /* subtract one for result type */
01093 
01094     for (k = 0; k < (**hprocinfo).ctparams; k++)
01095         (**hprocinfo).paramtypes[k] = gettypefromchar (pparams[k+1]);
01096 
01097     return (hprocinfo);
01098     } /*newprocinfo*/
01099 
01100 
01101 static boolean loadprocinforesource (tydllinfohandle hdll) {
01102 
01103     /*
01104     Platoform-specific code for loading the library's ProcInfo resource
01105     
01106     Caller is responsible for setting langerror
01107     */
01108 
01109     #ifdef MACVERSION
01110         tyfilespec fs = (**hdll).fs;
01111         short resfile;
01112         Handle hRes;
01113 
01114         resfile = FSpOpenResFile (&fs, fsRdPerm);
01115 
01116         if (ResError() == noErr) {
01117             
01118             hRes = Get1NamedResource ('DATA', "\pProcInfo");
01119 
01120             if (hRes != NULL) {
01121             
01122                 DetachResource (hRes);
01123                 
01124                 HLock (hRes);
01125                 
01126                 (**hdll).hres = hRes;
01127                 
01128                 (**hdll).resdata = *hRes;
01129                 }
01130             
01131             CloseResFile (resfile);
01132             }
01133     #endif
01134 
01135     #ifdef WIN95VERSION
01136         HRSRC frh;
01137         HGLOBAL rh;
01138 
01139         frh = FindResource ((**hdll).hdllsyshandle, "ProcInfo", RT_RCDATA);
01140 
01141         if (frh != NULL) {
01142         
01143             rh = LoadResource ((**hdll).hdllsyshandle, frh);
01144             
01145             if (rh != NULL) {
01146             
01147                 (**hdll).hres = (Handle) rh;
01148             
01149                 (**hdll).resdata = LockResource (rh);
01150                 }
01151             }
01152     #endif
01153 
01154     return ((**hdll).hres != NULL);
01155     } /*loadprocinforesource*/
01156 
01157 
01158 static void unloadprocinforesource (tydllinfohandle hdll) {
01159 
01160     /*
01161     Platoform-specific code for unloading the library's ProcInfo resource
01162     */
01163 
01164 #ifdef MACVERSION
01165 
01166     HUnlock ((**hdll).hres);
01167 
01168     disposehandle ((**hdll).hres);
01169 
01170 #endif
01171     
01172     return;
01173     } /*unlockprocinforesource*/
01174 
01175 
01176 static boolean parseprocinforesource (tydllinfohandle hdll, bigstring bsprocname, typrocinfohandle *hprocinfoptr) {
01177     
01178     /*
01179     Parse the library's ProcInfo resource
01180     
01181     Stay-resident DLLs: If bsprocname and hprocinfoptr are nil,
01182     build a hash table in hdll with information about all procs found in the DLL.
01183     
01184     Volatile DLLs: If bsprocname and hprocinfoptr are not nil,
01185     the caller wants us to just return info about the specified proc in hprocinfoptr.
01186     The caller is then responsible for disposing *hprocinfoptr.
01187     
01188     Here's all the info we published about the format of the ProcInfo resource:
01189     
01190         Procedure Entries in the Resource File
01191         <http://frontier.userland.com/stories/storyReader$1181>
01192 
01193         Program errors, including failures in Frontier, can occur
01194         if the format is not followed. Every line and procedure must
01195         be separated by a NULL, and the end of the data must have
01196         two NULLs. A semicolon indicates the start of a comment which
01197         will extend to the next NULL -- i.e. the remainder of the line.
01198 
01199         Each Frontier-visible procedure must have its own line which
01200         starts out with the return type and parameter types listed.
01201         The supported types are I for integer (a long value), S for
01202         string, and V for void (used only for the return type when
01203         the procedure has no result).
01204 
01205         In the example below, the procedure UpperCase has a result
01206         value of S (a string) and a single parameter of type S (string).
01207         The procedure Counter has no parameters and a return type of
01208         integer.
01209 
01210         #include
01211         ProcInfo RT_RCDATA
01212         BEGIN
01213         "; This is a comment to describe your library\0",
01214         "SS UpperCase ;Uppercase the string\0",
01215         "I Counter ;Count the next number\0",
01216         "\0\0"
01217         END
01218  
01219     */
01220 
01221     typrocinfohandle hprocinfo;
01222     char *p;
01223     char *pparams;
01224     char *pprocname;
01225     long lenparams;
01226     long lenprocname;
01227     long lenwhitespace;
01228     boolean flresult = false;
01229     
01230     /* Load the ProcInfo resource from the DLL */
01231     
01232     if (!loadprocinforesource (hdll)) {
01233     
01234         tyfilespec fs = (**hdll).fs;
01235         
01236         if (bsprocname != nil)
01237             lang2paramerror (cantfindprocinfoerror, bsprocname, fsname (&fs));
01238         else
01239             langparamerror (cantfindprocinfoloaderror, fsname (&fs));
01240             
01241         return (false);
01242         }
01243     
01244     /* Parse the ProcInfo resource line by line */
01245     
01246     p = (**hdll).resdata;
01247     
01248     do {
01249         /* Get params at start of line */
01250         
01251         pparams = p;
01252         
01253         lenparams = strspn (p, "VISLRvislr");
01254         
01255         if (lenparams == 0 || lenparams > maxdllparams)
01256             goto nextline;
01257         
01258         p += lenparams;
01259         
01260         /* Jump over whitespace between params and procname */
01261         
01262         lenwhitespace = strspn (p, " \t");
01263         
01264         if (lenwhitespace == 0)
01265             goto nextline;
01266         
01267         p += lenwhitespace;
01268 
01269         /* Get procname, ends before semicolon or whitespace */
01270         
01271         pprocname = p;
01272         
01273         lenprocname = strcspn (p, "; \t");
01274         
01275         if (lenprocname == 0 || lenprocname > lenbigstring)
01276             goto nextline;
01277         
01278         /* We got a valid entry, deal with it as requested by the caller */
01279         
01280         if (bsprocname != nil) {
01281             
01282             /* Check whether it's the proc we are looking for */
01283             
01284             if (memcmp (stringbaseaddress (bsprocname), pprocname, lenprocname) == 0) {
01285             
01286                 //assert (hprocinfoptr != nil);
01287                     
01288                 hprocinfo = newprocinfo (pprocname, lenprocname, pparams, lenparams);
01289                 
01290                 if (hprocinfo == nil)
01291                     goto exit;
01292             
01293                 *hprocinfoptr = hprocinfo;
01294                 
01295                 flresult = true; /* we found it and built the info handle */
01296                 
01297                 goto exit;
01298                 }
01299             }
01300         else {
01301             
01302             /* Build the proc info handle and add it to the hash table */
01303             
01304             hprocinfo = newprocinfo (pprocname, lenprocname, pparams, lenparams);
01305             
01306             if (hprocinfo == nil)
01307                 goto exit;
01308                 
01309             addprocinfo (hdll, hprocinfo);      
01310             } 
01311         
01312     nextline:
01313         /* Advance ptr to beginning of next line */
01314         
01315         p += strlen (p) + 1;
01316     
01317         } while (*p != '\0'); /* Resource must end with two consecutive nil chars */
01318 
01319     flresult = true;
01320     
01321 exit:
01322     /* Unload the ProcInfo resource (no-op on Win32) */
01323         
01324     unloadprocinforesource (hdll);
01325     
01326     return (flresult);  
01327     } /*parseprocinforesource*/
01328 
01329 
01330 static void addlibrary (tydllinfohandle hdll) {
01331 
01332     /*
01333     Insert at head of linked-list of stay-resident libraries
01334     */
01335 
01336     //assert (hdll != nil && *hdll != nil);
01337     
01338     (**hdll).hnextdll = loadeddlls;
01339     
01340     loadeddlls = hdll;
01341 
01342     return;
01343     } /*addlibrary*/
01344 
01345 
01346 static void removelibrary (tydllinfohandle hdll) {
01347 
01348     /*
01349     Remove from linked-list of stay-resident libraries
01350     */
01351 
01352     tydllinfohandle hnomad;
01353     tydllinfohandle hlastdll;
01354     
01355     //assert (loadeddlls != nil && *loadeddlls != nil);
01356     //assert (hdll != nil && *hdll != nil);
01357     
01358     if (loadeddlls == hdll) {
01359         loadeddlls = (**hdll).hnextdll;
01360         (**hdll).hnextdll = nil;
01361         return;
01362         }
01363     
01364     hlastdll = loadeddlls;
01365     hnomad = (**loadeddlls).hnextdll;
01366     
01367     while (hnomad) {
01368         
01369         if (hnomad == hdll) {
01370             (**hlastdll).hnextdll = (**hnomad).hnextdll;
01371             (**hnomad).hnextdll = nil;
01372             return;
01373             }
01374     
01375         hlastdll = hnomad;
01376         hnomad = (**hnomad).hnextdll;
01377         }/*while*/
01378 
01379     return;
01380     } /*removelibrary*/
01381 
01382 
01383 static tydllinfohandle getlibrary (const tyfilespec *fs) {
01384 
01385     /*
01386     Search linked list of stay-resident libraries for one with the given file path
01387     */
01388 
01389     tydllinfohandle hnomad = loadeddlls;
01390 
01391     while (hnomad) {
01392 
01393         if (equalfilespecs (&(**hnomad).fs, fs))
01394             return (hnomad);
01395         
01396         hnomad = (**hnomad).hnextdll;
01397         
01398         }/*while*/
01399 
01400     return (nil);   
01401     } /*getlibrary*/
01402 
01403 
01404 static tydllinfohandle newlibrary (const tyfilespec *fs) {
01405 
01406     /*
01407     Allocate and clear a handle for the library
01408     */
01409     
01410     tydllinfohandle hdll;
01411     
01412     if (!newclearhandle (sizeof (**hdll), (Handle *)&hdll))
01413         return (nil);
01414     
01415     (**hdll).fs = *fs;
01416 
01417     return (hdll);
01418     } /*newlibrary*/
01419 
01420 
01421 static void freelibrary (tydllinfohandle hdll) {
01422 
01423     /*
01424     Free a handle for the library
01425     
01426     The caller is responsible for removing it from the linked list
01427     */
01428     
01429     //assert (hdll == nil || (**hdll).hnextdll == nil);
01430 
01431     if (hdll) {
01432         
01433         freeprocinfobuckets (hdll);
01434     
01435         disposehandle ((Handle) hdll);
01436         }
01437 
01438     return;
01439     } /*freelibrary*/
01440 
01441 
01442 static boolean openlibrary (tydllinfohandle hdll) {
01443 
01444     /*
01445     Platform-specific code for loading the library code into memory
01446     */
01447 
01448     tyfilespec fs = (**hdll).fs;
01449 
01450 #ifdef WIN95VERSION
01451 
01452     bigstring fn;
01453 
01454     #if (FRONTIERCOM == 1)
01455         filefrompath ((ptrstring) fsname (&fs), fn);
01456 
01457         nullterminate(fn);
01458 
01459         if (stricmp (stringbaseaddress(fn), "COMDLL.DLL") == 0) {
01460         
01461             (**hdll).hdllsyshandle = (tydllsyshandle) COMStartup(); /*** FIXME: make sure we deal properly with the COM DLL ***/
01462             
01463             return ((**hdll).hdllsyshandle != nil);
01464             }
01465     #endif
01466 
01467     copystring (fsname (&fs), fn);
01468     
01469     nullterminate(fn);
01470 
01471     (**hdll).hdllsyshandle = LoadLibrary (stringbaseaddress(fn));
01472 
01473 #endif
01474 
01475 #ifdef MACVERSION
01476 
01477     long response;
01478     OSErr err;
01479     CFragConnectionID connID;
01480     Ptr mainAddr;
01481     Str255 errName;
01482     
01483     err = Gestalt (gestaltCFMAttr, &response);  /* make sure we have the Code Fragment Manager (CFM) */
01484     
01485     if ((err != noErr) || (response & (1 << gestaltCFMPresent)) == 0)
01486         goto exit;
01487     
01488     err = GetDiskFragment (&fs, 0, kCFragGoesToEOF, fsname (&fs), kReferenceCFrag, &connID, &mainAddr, errName);
01489     
01490     if (err != noErr)
01491         goto exit;
01492         
01493     (**hdll).hdllsyshandle = connID;
01494 
01495 exit:
01496 
01497 #endif
01498     
01499     if ((**hdll).hdllsyshandle == NULL) {
01500     
01501         lang2paramerror (cantconnecttodllerror, bsfunctionname, fsname (&fs));
01502         
01503         return (false);
01504         }
01505     
01506     return (true);
01507     } /*openlibrary*/
01508 
01509 
01510 static void closelibrary (tydllinfohandle hdll) {
01511 
01512     /*
01513     Platform-specific code for unloading the library code from memory
01514     */
01515 
01516 #ifdef WIN95VERSION
01517 
01518     #if (FRONTIERCOM == 1)
01519         if ((**hdll).hdllsyshandle == (tydllsyshandle) COMSYSModule()) /*** FIXME: make sure we deal properly with the COM DLL ***/
01520             COMShutdown();
01521         else
01522     #endif
01523             FreeLibrary ((**hdll).hdllsyshandle);
01524 
01525 #endif
01526 
01527 #ifdef MACVERSION
01528 
01529     lockhandle ((Handle) hdll);
01530     
01531     CloseConnection (&(**hdll).hdllsyshandle);
01532     
01533     unlockhandle ((Handle) hdll);
01534 
01535 #endif
01536     
01537     return;
01538     } /*closelibrary*/
01539 
01540 
01541 static tydllinfohandle loadlibrary (const tyfilespec *fs) {
01542     
01543     /*
01544     Load the library into memory and prepare it for use
01545     */
01546     
01547     tydllinfohandle hdll;
01548 
01549     hdll = newlibrary (fs);
01550 
01551     if (hdll == nil)
01552         return (nil);
01553 
01554     if (!openlibrary (hdll)) {
01555     
01556         freelibrary (hdll);
01557         
01558         return (nil);
01559         }
01560 
01561     return (hdll);
01562     } /*loadlibrary*/
01563 
01564 
01565 static void unloadlibrary (tydllinfohandle hdll) {
01566 
01567     /*
01568     Unload the library from memory
01569     
01570     If there are currently calls into the library under way,
01571     we defer until all calls have completed
01572     */
01573 
01574     if ((**hdll).ctreferences == 0) {
01575         
01576         closelibrary (hdll);
01577         
01578         freelibrary (hdll);
01579     
01580         }
01581     else {
01582 
01583         /* defer unloading until all calls have completed */
01584 
01585         (**hdll).flunload = true;
01586         }
01587 
01588     return;
01589     } /*unloadlibrary*/
01590 
01591 
01592 static boolean initparamblock (hdltreenode hp1, typrocinfohandle hprocinfo, tydllparamblock *params, Handle *orighandles) {
01593     
01594     /*
01595     Initialize the param block for the call,
01596     save and lock original handles for heap-based params,
01597     and convert params to FDllCall.h format
01598     */
01599     
01600     tyvaluerecord val;
01601     tyvaluetype paramtype;
01602     Handle hdata;
01603     long kmax = (**hprocinfo).ctparams;
01604     long k;
01605     
01606     if (!langcheckparamcount (hp1, (short) ((**hprocinfo).ctparams + 2)))
01607         return (false);
01608     
01609     clearbytes (params, sizeof (tydllparamblock));
01610     
01611     clearbytes (orighandles, kmax * sizeof (Handle));
01612     
01613     for (k = 0; k < kmax; k++) {
01614         
01615         paramtype = (**hprocinfo).paramtypes[k];
01616 
01617         if (!getparamvalue (hp1, (short)(3 + k), &val))
01618             return (false);
01619         
01620         if (!coercevalue (&val, paramtype))
01621             return (false);
01622         
01623         langgetvalsize (val, &params->paramsize[k]);
01624         
01625         if (langheapallocated (&val, &hdata)) {
01626             
01627             exemptfromtmpstack (&val);
01628             
01629             orighandles[k] = hdata;
01630 
01631             if ((paramtype != listvaluetype) && (paramtype != recordvaluetype)) {
01632                 lockhandle (hdata);
01633                 params->paramdata[k] = (long) *hdata;
01634                 }
01635             else {
01636                 params->paramdata[k] = (long) hdata;
01637                 }
01638             }
01639         else
01640             params->paramdata[k] = val.data.longvalue;
01641         }
01642     
01643     return (true);
01644     } /*initparamblock*/
01645 
01646 
01647 static void freeparamblock (typrocinfohandle hprocinfo, Handle *orighandles) {
01648 
01649     /*
01650     Unlock and dispose handles of heap-based params
01651     */
01652     
01653     tyvaluerecord val;
01654     tyvaluetype paramtype;
01655     long kmax = (**hprocinfo).ctparams;
01656     long k;
01657 
01658     for (k = 0; k < kmax; k++)
01659 
01660         if (orighandles[k] != nil) {
01661         
01662             paramtype = (**hprocinfo).paramtypes[k];
01663             
01664             if ((paramtype != listvaluetype) && (paramtype != recordvaluetype))
01665                 unlockhandle (orighandles[k]);
01666             
01667             initvalue (&val, paramtype);
01668             
01669             val.data.binaryvalue = orighandles[k];
01670             
01671             disposevaluerecord (val, false);
01672             }
01673 
01674     return;
01675     } /*freeparamblock*/
01676 
01677 
01678 static boolean lookupprocaddress (tydllinfohandle hdll, typrocinfohandle hprocinfo) {
01679 
01680     /*
01681     Platform-specific code for looking up the address of a proc in the library
01682     */
01683     
01684     #ifdef MACVERSION
01685         CFragSymbolClass procclass;
01686         OSErr err;
01687         #if !TARGET_API_MAC_CARBON
01688             RoutineDescriptor desctemplate = BUILD_ROUTINE_DESCRIPTOR (uppdllcallProcInfo, NULL);
01689         #endif
01690         
01691         err = FindSymbol ((**hdll).hdllsyshandle, (**hprocinfo).bsprocname, (Ptr*) &(**hprocinfo).procaddress, &procclass); 
01692 
01693         #if !TARGET_API_MAC_CARBON
01694             if (err == noErr) {
01695                 (**hprocinfo).moduledesc = desctemplate;
01696                 (**hprocinfo).moduledesc.routineRecords[0].procDescriptor = (ProcPtr) (**hprocinfo).procaddress;    /* fill in the blank */
01697                 (**hprocinfo).moduleUPP = (UniversalProcPtr) &(**hprocinfo).moduledesc;
01698                 }
01699         #elif TARGET_RT_MAC_MACHO
01700             if (err == noErr) {
01701                 (**hprocinfo).procaddress = convertcfmtomachofuncptr ((**hprocinfo).procaddress);
01702                 }
01703         #endif
01704     #endif
01705 
01706     #ifdef WIN95VERSION
01707         (**hprocinfo).procaddress = (tyDLLEXTROUTINE) GetProcAddress ((**hdll).hdllsyshandle, stringbaseaddress((**hprocinfo).bsprocname));
01708     #endif
01709 
01710     return ((**hprocinfo).procaddress != nil);
01711     } /*lookupprocaddress*/
01712 
01713 
01714 static boolean callprocwithparams (tydllinfohandle hdll, typrocinfohandle hprocinfo, tydllparamblock *params, tyvaluerecord *vreturned) {
01715     
01716     /*
01717     Call the library proc with the given set of parameters
01718     
01719     If the proc address hasn't been looked up yet, we do so now and save it for later
01720     
01721     After completing the call, we set up the result value or the error message
01722     */
01723     
01724     boolean fl = false;
01725 
01726     lockhandle ((Handle) hprocinfo); /* just to be sure our data doesn't move around */
01727 
01728     /* If procaddress is undefined, look it up now and save it for future reference */
01729     
01730     if ((**hprocinfo).procaddress == nil)
01731     
01732         if (!lookupprocaddress (hdll, hprocinfo)) {
01733         
01734             tyfilespec fs = (**hdll).fs;
01735             
01736             lang2paramerror (cantfinddllfunctionerror, (**hprocinfo).bsprocname, fsname (&fs));
01737         
01738             goto exit;
01739             }
01740 
01741     /* Now release the thread globals, call the library proc, and grab the thread globals again */
01742 
01743     releasethreadglobals ();
01744     
01745     #if MACVERSION && !TARGET_API_MAC_CARBON
01746         #if GENERATINGCFM
01747             fl = CallUniversalProc ((**hprocinfo).moduleUPP, uppdllcallProcInfo, params, dllcallbacks);
01748         #else
01749             fl = (*(tyDLLEXTROUTINE) ((**hprocinfo).moduleUPP)) (params, dllcallbacks);
01750         #endif
01751     #else
01752         fl = (*(**hprocinfo).procaddress) (params, dllcallbacks);
01753     #endif
01754     
01755     grabthreadglobals ();
01756 
01757     /* Set up the return value of the call or the error message */
01758     
01759     if (fl) {
01760     
01761         if (langheaptype ((**hprocinfo).resulttype))
01762             fl = sethandlesize ((Handle) params->resultdata, params->resultsize);
01763         
01764         if (fl) {
01765             
01766             initvalue (vreturned, (**hprocinfo).resulttype);
01767             
01768             (*vreturned).data.longvalue = params->resultdata;
01769             
01770             pushvalueontmpstack (vreturned); 
01771             }
01772         }
01773     else
01774         {
01775         bigstring errmsg;
01776         
01777         #ifdef MACVERSION
01778             copystring (params->errormessage, errmsg);
01779         #else
01780             copyctopstring (params->errormessage, errmsg);
01781         #endif
01782         
01783         langerrormessage (errmsg);
01784         }
01785 
01786 exit:
01787 
01788     unlockhandle ((Handle) hprocinfo);
01789         
01790     return (fl);
01791     } /*callprocwithparams*/
01792 
01793 
01794 static boolean callproc (hdltreenode hparam1, tydllinfohandle hdll, typrocinfohandle hprocinfo, tyvaluerecord *vreturned) {
01795 
01796     /*
01797     Build param block and call the named proc in the library
01798     */
01799     
01800     tydllparamblock dllparamblock;
01801     Handle orighandles[maxdllparams];
01802     boolean fl;
01803 
01804     /* Increment the reference count so that will know not to unload it while we're still executing library code */
01805     
01806     (**hdll).ctreferences++;
01807     
01808     /* Set up the paramblock for the call and save the original param handles */
01809     
01810     fl = initparamblock (hparam1, hprocinfo, &dllparamblock, orighandles);
01811     
01812     if (fl) {
01813         
01814         /* Call the desired library proc */
01815 
01816         fl = callprocwithparams (hdll, hprocinfo, &dllparamblock, vreturned);
01817     
01818         /* Restore original param handles and free heap-allocated params */
01819     
01820         freeparamblock (hprocinfo, orighandles);
01821         }
01822 
01823     /* Decrement reference count and possibly unload if the task has been deferred to us */
01824     
01825     (**hdll).ctreferences--;
01826     
01827     return (fl);
01828     } /*callproc*/
01829 
01830 
01831 static boolean callstayresident (hdltreenode hparam1, tydllinfohandle hdll, bigstring bsprocname, tyvaluerecord *vreturned) {
01832 
01833     /*
01834     Locate the proc info and make the call
01835     */
01836 
01837     typrocinfohandle hprocinfo;
01838     boolean fl = false;
01839     
01840     /* Look up the procinfo for the given procname */
01841     
01842     if (!locateprocinfo (hdll, bsprocname, &hprocinfo))
01843         return (false);
01844     
01845     /* Make the call */
01846     
01847     fl = callproc (hparam1, hdll, hprocinfo, vreturned);
01848     
01849     /* Unload the DLL if the task has been deferred to us*/
01850     
01851     if ((**hdll).flunload)
01852         unloadlibrary (hdll);
01853 
01854     return (fl);
01855     } /*callstayresident*/
01856 
01857 
01858 static boolean callvolatile (hdltreenode hparam1, const tyfilespec *fs, bigstring bsprocname, tyvaluerecord *vreturned) {
01859 
01860     /*
01861     Load the library just for this call, get the procinfo, make the call, and unload the library
01862     */
01863 
01864     tydllinfohandle hdll;
01865     typrocinfohandle hprocinfo;
01866     boolean fl;
01867 
01868     /* Load the library */
01869         
01870     hdll = loadlibrary (fs);
01871 
01872     if (hdll == nil)
01873         return (false);
01874     
01875     /* Look up just the one proc we are interested in, don't build the hash table */
01876         
01877     if (!parseprocinforesource (hdll, bsprocname, &hprocinfo)) {
01878         
01879         unloadlibrary (hdll);
01880         
01881         return (false);
01882         }
01883         
01884     /* Make the call */
01885     
01886     fl = callproc (hparam1, hdll, hprocinfo, vreturned);
01887     
01888     /* Dispose proc info here because we didn't ask for the hash table to be built */
01889     
01890 #if defined(MACVERSION) && TARGET_RT_MAC_MACHO
01891     disposemachofuncptr ((void*) (**hprocinfo).procaddress);
01892 #endif
01893     
01894     disposehandle ((Handle) hprocinfo);
01895 
01896     /* Unload the DLL */
01897 
01898     unloadlibrary (hdll);
01899     
01900     return (fl);
01901     } /*callvolatile*/
01902 
01903 
01904 static boolean islibraryloaded (const tyfilespec *fs) {
01905     
01906     /*
01907     Implements the dll.isloaded kernel verb
01908     
01909     Determine whether the library with the given file path has already been loaded
01910     */
01911 
01912     return (getlibrary (fs) != nil);
01913     } /*islibraryloaded*/
01914 
01915 
01916 static boolean dodllload (const tyfilespec *fs, tydllinfohandle *hdllptr) {
01917     
01918     /*
01919     Implements dll.load kernel verb
01920     
01921     Load the library into memory as stay-resident 
01922     */
01923     
01924     tydllinfohandle hdll;
01925     
01926     hdll = getlibrary (fs);
01927     
01928     if (hdll == nil) {
01929     
01930         hdll = loadlibrary (fs);
01931     
01932         if (hdll == nil)
01933             return (false);
01934         
01935         if (!parseprocinforesource (hdll, nil, nil)) {
01936             
01937             unloadlibrary (hdll);
01938             
01939             return (false);
01940             }
01941 
01942         addlibrary (hdll);
01943         }
01944     
01945     *hdllptr = hdll;
01946     
01947     return (true);
01948     } /*dodllload*/
01949 
01950 
01951 static boolean dodllunload (const tyfilespec *fs) {
01952 
01953     /*
01954     Implements dll.unload kernel verb
01955     
01956     Unload a stay-resident library
01957     */
01958     
01959     tydllinfohandle hdll;
01960     
01961     hdll = getlibrary (fs);
01962     
01963     if (hdll) {
01964         
01965         removelibrary (hdll);
01966         
01967         unloadlibrary (hdll);
01968         }
01969     
01970     return (true);
01971     } /*dodllunload*/
01972 
01973 
01974 static boolean dodllcall (hdltreenode hparam1, const tyfilespec *fs, bigstring bsprocname, tyvaluerecord *vreturned) {
01975 
01976     /*
01977     Implements the dll.call kernel verb
01978     */
01979 
01980     tydllinfohandle hdll;
01981     boolean fl;
01982     
01983     hdll = getlibrary (fs);
01984     
01985     if (hdll != nil)
01986         fl = callstayresident (hparam1, hdll, bsprocname, vreturned);
01987     else
01988         fl = callvolatile (hparam1, fs, bsprocname, vreturned);
01989     
01990     return (fl);
01991     } /*dodllcall*/
01992 
01993 
01994 #else
01995 
01996 
01997 static boolean parseprocdata (bigstring bsprocname, tydllmoduleinfo *info) {
01998     /* It is assumed that the bsprocname is a std string with a null termination */
01999 
02000     char * pdata;
02001     char inputline[1024];
02002     char parameterline[100];
02003     short nextblock, commentpoint, endparam, endwhitespace, startname;
02004     int i;
02005 
02006     pdata = info->pdata;
02007 
02008     while (true) {
02009         nextblock = strlen (pdata) + 1;
02010 
02011         if (nextblock > 1000)
02012             return (false);
02013 
02014         if (nextblock <= 1)
02015             return (false);
02016 
02017         strcpy (inputline, pdata);
02018 
02019         pdata = pdata + nextblock;              /*advance pdata in event we need next line */
02020 
02021         commentpoint = strcspn(inputline, ";");  /*locate start of comment */
02022 
02023         inputline [commentpoint] = 0;           /* remove comment from line */
02024 
02025         if ((short) strlen (inputline) < (stringlength(bsprocname) + 2))
02026             continue;
02027 
02028         /*peel off parameter info*/
02029 
02030         endparam = strspn (inputline, "VISLRvislr");
02031 
02032         if (endparam == 0)      /* Not a proper line */
02033             continue;
02034 
02035         memmove (parameterline, inputline, endparam);
02036         parameterline[endparam] = 0;
02037 
02038         info->ctparams = strlen(parameterline) - 1;  /*minus one for return code*/
02039 
02040         endwhitespace = strspn (inputline + endparam, " \t");
02041 
02042         if (endwhitespace == 0)     /*must have white space between parameters and module name*/
02043             continue;
02044 
02045         startname = endwhitespace + endparam;
02046 
02047         endwhitespace = strcspn (inputline + startname, " \t");     /*Find end of name */
02048 
02049         inputline[endwhitespace + startname] = 0;
02050 
02051         if (strcmp (inputline + startname, stringbaseaddress(bsprocname)) == 0) {
02052             /*set parameter values */
02053             info->resulttype = gettypefromchar (parameterline[0]);
02054 
02055             for (i = 0; i < info->ctparams; i++) {
02056                 info->paramtypes[i] = gettypefromchar (parameterline[i+1]);
02057                 }
02058 
02059             return (true);
02060             }
02061 
02062         }
02063 
02064     } /*parseprocdata*/
02065 
02066 //Code change by Timothy Paustian Wednesday, June 14, 2000 8:30:47 PM
02067 //Changed to Opaque call for Carbon
02068 //I have to ask andre how to handle this stuff, this looks like plug in stuff.
02069 //This routine
02070 static boolean getprocinfo (const tyfilespec *fs, bigstring bsprocname, tydllmoduleinfo *info) {
02071 
02072     /*
02073     5.0.2 dmb: added fs parameter for errror reporting
02074     */
02075     
02076     char procname[300];
02077 
02078     //Code change by Timothy Paustian Friday, June 16, 2000 1:03:09 PM
02079     //Changed to Opaque call for Carbon - UPP aren't needed for Carbon
02080     #ifdef MACVERSION
02081 
02082         CFragSymbolClass procclass;
02083         OSErr err;
02084          #if !TARGET_API_MAC_CARBON
02085         RoutineDescriptor desctemplate = BUILD_ROUTINE_DESCRIPTOR (uppdllcallProcInfo, NULL);
02086         #endif
02087     #endif
02088     /*
02089     load the dll, find the module, and map its parameter info to our types.
02090     */
02091     
02092     copystring (bsprocname, procname);
02093     
02094     nullterminate (procname);
02095 
02096     #ifdef MACVERSION
02097         #if TARGET_API_MAC_CARBON
02098         info->procAddress = NULL;
02099     
02100         err = FindSymbol ((CFragConnectionID)info->moduleHandle, procname, (Ptr*)&(info->procAddress), &procclass); 
02101 
02102         if (err == noErr) {
02103             
02104             info->moduleDesc.routineRecords [0].procDescriptor = (ProcPtr)info->procAddress;    // fill in the blank
02105             //null this out so that we get a nasty crash if it is dereferences.
02106             //This may be dangerrous
02107             //I switched it below to call procPtr directly as in windows and not the UPP.
02108             //This is the only place the frontier code uses moduleUPP so it should be save. 
02109             info->moduleUPP = NULL;
02110             }
02111         #else
02112         info->moduleDesc = desctemplate;
02113 
02114         info->procAddress = NULL;
02115     
02116         err = FindSymbol ((CFragConnectionID)info->moduleHandle, procname, (Ptr*)&(info->procAddress), &procclass); 
02117 
02118         if (err == noErr) {
02119             
02120             info->moduleDesc.routineRecords [0].procDescriptor = (ProcPtr)info->procAddress;    // fill in the blank
02121     
02122             info->moduleUPP = (UniversalProcPtr) &(info->moduleDesc);
02123             }
02124         #endif
02125     #endif
02126 
02127     #ifdef WIN95VERSION
02128         info->procAddress = (tyDLLEXTROUTINE) GetProcAddress ((HINSTANCE) info->moduleHandle, stringbaseaddress(procname));
02129     #endif
02130 
02131     if (info->procAddress == NULL) {
02132         
02133         lang2paramerror (cantfinddllfunctionerror, bsprocname, fsname (fs));
02134         
02135         return (false);
02136         }
02137 
02138     if (!parseprocdata (procname, info)) {
02139         
02140         lang2paramerror (cantfindprocinfofunctionerror, bsprocname, fsname (fs));
02141         
02142         return (false);
02143         }
02144 
02145     return (true);
02146     } /*getprocinfo*/
02147 
02148 
02149 static boolean islibraryloaded (const tyfilespec *fs, Handle * hModule) {
02150 
02151     #ifdef WIN95VERSION
02152         bigstring fn;
02153         
02154         copystring (fsname (fs), fn);
02155         
02156         nullterminate(fn);
02157         
02158         *hModule = (Handle) GetModuleHandle (stringbaseaddress(fn));
02159     #endif
02160 
02161     #ifdef MACVERSION
02162         long response;
02163         OSErr err;
02164         CFragConnectionID connID;
02165         Ptr mainAddr;
02166         Str255 errName;
02167         
02168         err = Gestalt (gestaltCFMAttr, &response);  // make sure we have the CFM
02169         
02170         if ((err != noErr) || (response & (1 << gestaltCFMPresent)) == 0)
02171             return (false);
02172         
02173         #if TARGET_API_MAC_CARBON == 1
02174             err = GetDiskFragment (fs, 0, kCFragGoesToEOF, fs->name, kReferenceCFrag, &connID, &mainAddr, errName);     
02175         #else
02176             err = GetDiskFragment (fs, 0, kCFragGoesToEOF, fs->name, kFindCFrag, &connID, &mainAddr, errName);      
02177         #endif
02178         
02179         if (err != noErr)
02180             return (false);
02181         
02182         *hModule = (Handle) connID;
02183     #endif
02184     
02185     return (*hModule != NULL);
02186     } /*islibraryloaded*/
02187 
02188 
02189 static Handle doloadlibrary (const tyfilespec *fs, boolean flforce) {
02190 
02191     Handle hModule = NULL;
02192 
02193     #ifdef WIN95VERSION
02194         bigstring fn;
02195 
02196     //  if (! flforce) {
02197     //      if (islibraryloaded (fs, &hModule))
02198     //          return (hModule);
02199     //      }
02200 
02201         #if (FRONTIERCOM == 1)
02202             filefrompath ((ptrstring) fsname (fs), fn);
02203 
02204             nullterminate(fn);
02205 
02206             if (stricmp (stringbaseaddress(fn), "COMDLL.DLL") == 0)
02207                     return (COMStartup());
02208         #endif
02209 
02210         copystring (fsname (fs), fn);
02211         
02212         nullterminate(fn);
02213 
02214         hModule = (Handle) LoadLibrary (stringbaseaddress(fn));
02215 
02216     //  if (hModule != NULL) {
02217     //      namelen = GetModuleFileName (hModule, stringbaseaddress(namebuf), sizeof(namebuf));
02218     //      setstringlength (namebuf, namelen);
02219     //      alllower(namebuf);
02220     //      addopenlibrary (hModule, fs, namebuf);
02221     //      }
02222 
02223     #endif
02224 
02225     #ifdef MACVERSION
02226         long response;
02227         OSErr err;
02228         CFragConnectionID connID;
02229         Ptr mainAddr;
02230         Str255 errName;
02231         
02232         err = Gestalt (gestaltCFMAttr, &response);  // make sure we have the CFM
02233         
02234         if ((err != noErr) || (response & (1 << gestaltCFMPresent)) == 0)
02235             goto exit;
02236         
02237         err = GetDiskFragment (fs, 0, kCFragGoesToEOF, fs->name, kReferenceCFrag, &connID, &mainAddr, errName);
02238         
02239         if (err != noErr)
02240             goto exit;
02241         
02242         hModule = (Handle) connID;
02243     
02244         exit:
02245     #endif
02246     
02247     if (hModule == NULL)
02248         lang2paramerror (cantconnecttodllerror, bsfunctionname, fsname (fs));
02249     
02250     return (hModule);
02251     } /*doloadlibrary*/
02252 
02253 
02254 static boolean dofreelibrary (Handle hModule, boolean flforce) {
02255     #ifdef WIN95VERSION
02256         #if (FRONTIERCOM == 1)
02257             if (hModule == COMSYSModule())
02258                 return (COMShutdown());
02259         #endif
02260 
02261         return (FreeLibrary ((HINSTANCE) hModule));
02262     #endif
02263 
02264     #ifdef MACVERSION
02265         return (CloseConnection ((CFragConnectionID *) &hModule) == noErr);
02266     #endif
02267     } /*dofreelibrary*/
02268 
02269 
02270 static boolean loaddllmodule (const tyfilespec *fs, bigstring bsprocname, tydllmoduleinfo *info) {
02271     
02272     boolean fl = false;
02273     #ifdef WIN95VERSION
02274         HRSRC frh;
02275         HGLOBAL rh;
02276     #endif
02277     #ifdef MACVERSION
02278         short resfile;
02279         Handle hRes = nil;
02280     #endif
02281 
02282     /*
02283     load the dll, find the module, and map its parameter info to our types.
02284     */
02285     
02286     copystring (bsprocname, bsfunctionname); // for error reporting
02287         
02288     info->moduleHandle = doloadlibrary (fs, false);
02289 
02290     if (info->moduleHandle == NULL)
02291         return (false);
02292 
02293     info->pdata = NULL;
02294 
02295     #ifdef WIN95VERSION
02296         frh = FindResource ((HINSTANCE) info->moduleHandle, "ProcInfo", RT_RCDATA);
02297 
02298         if (frh != NULL) {
02299             
02300             rh = LoadResource ((HINSTANCE) info->moduleHandle, frh);
02301 
02302             if (rh != NULL)
02303                 info->pdata = LockResource (rh);
02304             }
02305     #endif
02306 
02307     #ifdef MACVERSION
02308         resfile = FSpOpenResFile (fs, fsRdPerm);
02309 
02310         if (ResError() == noErr) {
02311             
02312             hRes = Get1NamedResource ('DATA', "\pProcInfo");
02313 
02314             if (hRes != NULL) {
02315                 
02316                 DetachResource (hRes);
02317                 
02318                 HLock (hRes);
02319                 
02320                 info->pdata = *hRes;
02321                 }
02322             
02323             CloseResFile (resfile);
02324             }
02325     #endif
02326     
02327     if (info->pdata == NULL) {
02328         
02329         lang2paramerror (cantfindprocinfoerror, bsprocname, fsname (fs));
02330         
02331         dofreelibrary (info->moduleHandle, false);
02332         
02333         goto exit;
02334         }
02335     
02336     if (getprocinfo (fs, bsprocname, info))
02337         fl = true;
02338     else
02339         dofreelibrary (info->moduleHandle, false);
02340     
02341     exit:
02342     
02343     #ifdef MACVERSION
02344         disposehandle (hRes);
02345     #endif
02346     
02347     return (fl);
02348     } /*loaddllmodule*/
02349 
02350 
02351 static boolean langcalldll (tydllmoduleinfo *dllinfo, tydllparamblock *dllcall) {
02352     
02353     /*
02354     call the dll. 
02355     */
02356     boolean fl = false;
02357 
02358     releasethreadglobals ();
02359 
02360     #ifdef WIN95VERSION
02361         fl = (*(dllinfo->procAddress)) (dllcall, dllcallbacks);
02362     #endif
02363 
02364     #ifdef MACVERSION
02365         #if TARGET_API_MAC_CARBON == 1
02366             //Code change by Timothy Paustian Friday, June 16, 2000 1:13:28 PM
02367             //Changed to Opaque call for Carbon - we don't need UPPs in Carbon.
02368             //fl = (*(tyDLLEXTROUTINE) (dllinfo->moduleUPP)) (dllcall, dllcallbacks); // call it
02369             fl = (*(dllinfo->procAddress)) (dllcall, dllcallbacks); // call it
02370         #else
02371             #if GENERATINGCFM
02372                 fl = CallUniversalProc (dllinfo->moduleUPP, uppdllcallProcInfo, dllcall, dllcallbacks);
02373             #else
02374                 fl = (*(tyDLLEXTROUTINE) (dllinfo->moduleUPP)) (dllcall, dllcallbacks); // call it
02375             #endif
02376         #endif
02377     #endif
02378 
02379     dofreelibrary (dllinfo->moduleHandle, false);  /*okay we used it, now release it.*/
02380 
02381     grabthreadglobals ();
02382     
02383     return fl;
02384     } /*langcalldll*/
02385 
02386 #endif /* NEW_DLL_INTERFACE */
02387 
02388 
02389 void fillcalltable (XDLLProcTable *pt) {
02390 
02391     #if defined(MACVERSION) && TARGET_RT_MAC_MACHO
02392 
02393         pt->xMemAlloc = convertmachotocfmfuncptr (&extfrontierAlloc);
02394         pt->xMemResize = convertmachotocfmfuncptr (&extfrontierReAlloc);
02395         pt->xMemLock = convertmachotocfmfuncptr (&extfrontierLock);
02396         pt->xMemUnlock = convertmachotocfmfuncptr (&extfrontierUnlock);
02397         pt->xMemFree = convertmachotocfmfuncptr (&extfrontierFree);
02398         pt->xMemGetSize = convertmachotocfmfuncptr (&extfrontierSize);
02399 
02400         pt->xOdbGetCurrentRoot = convertmachotocfmfuncptr (&extOdbGetCurrentRoot);
02401         pt->xOdbNewFile = convertmachotocfmfuncptr (&extOdbNewFile);
02402         pt->xOdbOpenFile = convertmachotocfmfuncptr (&extOdbOpenFile);
02403         pt->xOdbSaveFile = convertmachotocfmfuncptr (&extOdbSaveFile);
02404         pt->xOdbCloseFile = convertmachotocfmfuncptr (&extOdbCloseFile);
02405         pt->xOdbDefined = convertmachotocfmfuncptr (&extOdbDefined);
02406         pt->xOdbDelete = convertmachotocfmfuncptr (&extOdbDelete);
02407         pt->xOdbGetType = convertmachotocfmfuncptr (&extOdbGetType);
02408         pt->xOdbCountItems = convertmachotocfmfuncptr (&extOdbCountItems);
02409         pt->xOdbGetNthItem = convertmachotocfmfuncptr (&extOdbGetNthItem);
02410         pt->xOdbGetValue = convertmachotocfmfuncptr (&extOdbGetValue);
02411         pt->xOdbSetValue = convertmachotocfmfuncptr (&extOdbSetValue);
02412         pt->xOdbNewTable = convertmachotocfmfuncptr (&extOdbNewTable);
02413         pt->xOdbGetModDate = convertmachotocfmfuncptr (&extOdbGetModDate);
02414         pt->xOdbDisposeValue = convertmachotocfmfuncptr (&extOdbDisposeValue);
02415         pt->xOdbGetError = convertmachotocfmfuncptr (&extOdbGetError);
02416 
02417         pt->xDoScript = convertmachotocfmfuncptr (&extDoScript);
02418         pt->xDoScriptText = convertmachotocfmfuncptr (&extDoScriptText);
02419 
02420         pt->xOdbNewListValue = convertmachotocfmfuncptr (&extOdbNewListValue);
02421         pt->xOdbGetListCount = convertmachotocfmfuncptr (&extOdbGetListCount);
02422         pt->xOdbDeleteListValue = convertmachotocfmfuncptr (&extOdbDeleteListValue);
02423         pt->xOdbSetListValue = convertmachotocfmfuncptr (&extOdbSetListValue);
02424         pt->xOdbGetListValue = convertmachotocfmfuncptr (&extOdbGetListValue);
02425         pt->xOdbAddListValue = convertmachotocfmfuncptr (&extOdbAddListValue);
02426 
02427         pt->xInvoke = convertmachotocfmfuncptr (&extInvoke);
02428         pt->xCoerce = convertmachotocfmfuncptr (&extCoerce);
02429         
02430         pt->xCallScript = convertmachotocfmfuncptr (&extCallScript);
02431         pt->xCallScriptText = convertmachotocfmfuncptr (&extCallScriptText);
02432         
02433         pt->xThreadYield = convertmachotocfmfuncptr (&extThreadYield);
02434         pt->xThreadSleep = convertmachotocfmfuncptr (&extThreadSleep);
02435 
02436     #else
02437 
02438         pt->xMemAlloc = &extfrontierAlloc;
02439         pt->xMemResize = &extfrontierReAlloc;
02440         pt->xMemLock = &extfrontierLock;
02441         pt->xMemUnlock = &extfrontierUnlock;
02442         pt->xMemFree = &extfrontierFree;
02443         pt->xMemGetSize = &extfrontierSize;
02444 
02445         pt->xOdbGetCurrentRoot = &extOdbGetCurrentRoot;
02446         pt->xOdbNewFile = &extOdbNewFile;
02447         pt->xOdbOpenFile = &extOdbOpenFile;
02448         pt->xOdbSaveFile = &extOdbSaveFile;
02449         pt->xOdbCloseFile = &extOdbCloseFile;
02450         pt->xOdbDefined = &extOdbDefined;
02451         pt->xOdbDelete = &extOdbDelete;
02452         pt->xOdbGetType = &extOdbGetType;
02453         pt->xOdbCountItems = &extOdbCountItems;
02454         pt->xOdbGetNthItem = &extOdbGetNthItem;
02455         pt->xOdbGetValue = &extOdbGetValue;
02456         pt->xOdbSetValue = &extOdbSetValue;
02457         pt->xOdbNewTable = &extOdbNewTable;
02458         pt->xOdbGetModDate = &extOdbGetModDate;
02459         pt->xOdbDisposeValue = &extOdbDisposeValue;
02460         pt->xOdbGetError = &extOdbGetError;
02461 
02462         pt->xDoScript = &extDoScript;
02463         pt->xDoScriptText = &extDoScriptText;
02464 
02465         pt->xOdbNewListValue = &extOdbNewListValue;
02466         pt->xOdbGetListCount = &extOdbGetListCount;
02467         pt->xOdbDeleteListValue = &extOdbDeleteListValue;
02468         pt->xOdbSetListValue = &extOdbSetListValue;
02469         pt->xOdbGetListValue = &extOdbGetListValue;
02470         pt->xOdbAddListValue = &extOdbAddListValue;
02471 
02472         pt->xInvoke = &extInvoke;
02473         pt->xCoerce = &extCoerce;
02474         
02475         pt->xCallScript = &extCallScript;
02476         pt->xCallScriptText = &extCallScriptText;
02477         
02478         pt->xThreadYield = &extThreadYield;
02479         pt->xThreadSleep = &extThreadSleep;
02480 
02481     #endif
02482 
02483     } /*fillcalltable*/
02484 
02485 
02486 #if 0
02487 
02488 void smashcalltable (XDLLProcTable *pt) {
02489 
02490     #if defined(MACVERSION) && TARGET_RT_MAC_MACHO
02491 
02492         disposecfmfuncptr (pt->xMemAlloc);
02493         disposecfmfuncptr (pt->xMemResize);
02494         disposecfmfuncptr (pt->xMemLock);
02495         disposecfmfuncptr (pt->xMemUnlock);
02496         disposecfmfuncptr (pt->xMemFree);
02497         disposecfmfuncptr (pt->xMemGetSize);
02498 
02499         disposecfmfuncptr (pt->xOdbGetCurrentRoot);
02500         disposecfmfuncptr (pt->xOdbNewFile);
02501         disposecfmfuncptr (pt->xOdbOpenFile);
02502         disposecfmfuncptr (pt->xOdbSaveFile);
02503         disposecfmfuncptr (pt->xOdbCloseFile);
02504         disposecfmfuncptr (pt->xOdbDefined);
02505         disposecfmfuncptr (pt->xOdbDelete);
02506         disposecfmfuncptr (pt->xOdbGetType);
02507         disposecfmfuncptr (pt->xOdbCountItems);
02508         disposecfmfuncptr (pt->xOdbGetNthItem);
02509         disposecfmfuncptr (pt->xOdbGetValue);
02510         disposecfmfuncptr (pt->xOdbSetValue);
02511         disposecfmfuncptr (pt->xOdbNewTable);
02512         disposecfmfuncptr (pt->xOdbGetModDate);
02513         disposecfmfuncptr (pt->xOdbDisposeValue);
02514         disposecfmfuncptr (pt->xOdbGetError);
02515 
02516         disposecfmfuncptr (pt->xDoScript);
02517         disposecfmfuncptr (pt->xDoScriptText);
02518 
02519         disposecfmfuncptr (pt->xOdbNewListValue);
02520         disposecfmfuncptr (pt->xOdbGetListCount);
02521         disposecfmfuncptr (pt->xOdbDeleteListValue);
02522         disposecfmfuncptr (pt->xOdbSetListValue);
02523         disposecfmfuncptr (pt->xOdbGetListValue);
02524         disposecfmfuncptr (pt->xOdbAddListValue);
02525 
02526         disposecfmfuncptr (pt->xInvoke);
02527         disposecfmfuncptr (pt->xCoerce);
02528         
02529         disposecfmfuncptr (pt->xCallScript);
02530         disposecfmfuncptr (pt->xCallScriptText);
02531         
02532         disposecfmfuncptr (pt->xThreadYield);
02533         disposecfmfuncptr (pt->xThreadSleep);
02534 
02535     #endif
02536     
02537     } /*smashcalltable*/
02538 
02539 #endif
02540 
02541 
02542 boolean dllisloadedverb (hdltreenode hparam1, tyvaluerecord *vreturned) {
02543 
02544     /*
02545     Glue for dll.isloaded kernel verb
02546 
02547     2002-10-14 AR: Moved from langverbs.c to langdll.c.
02548     Started work on new DLL interface, still ifdef'd out.
02549     */
02550     
02551 #ifdef NEW_DLL_INTERFACE
02552 
02553     tyfilespec fsdll;
02554     
02555     flnextparamislast = true;
02556 
02557     if (!getfilespecvalue (hparam1, 1, &fsdll))
02558         return (false);
02559 
02560     return (setbooleanvalue (islibraryloaded (&fsdll), vreturned));
02561 
02562 #else
02563 
02564     tyfilespec fsdll;
02565     Handle hModule;
02566     boolean res;
02567     
02568     flnextparamislast = true;
02569 
02570     if (!getfilespecvalue (hparam1, 1, &fsdll))
02571         return (false);
02572 
02573     res = islibraryloaded (&fsdll, &hModule);
02574 
02575     return (setbooleanvalue (res, vreturned));
02576 
02577 #endif /* NEW_DLL_INTERFACE */
02578 
02579     } /*dllisloadedverb*/
02580 
02581 
02582 boolean dllloadverb (hdltreenode hparam1, tyvaluerecord *vreturned) {
02583 
02584     /*
02585     Glue for dll.load kernel verb
02586 
02587     2002-10-14 AR: Moved from langverbs.c to langdll.c.
02588     Started work on new DLL interface, still ifdef'd out.
02589     */
02590     
02591 #ifdef NEW_DLL_INTERFACE
02592 
02593     tyfilespec fsdll;
02594     tydllinfohandle hdll;
02595     
02596     flnextparamislast = true;
02597 
02598     if (!getfilespecvalue (hparam1, 1, &fsdll))
02599         return (false);
02600 
02601     if (!dodllload (&fsdll, &hdll))
02602         return (false);
02603 
02604     return (setlongvalue ((long) hdll, vreturned));
02605 
02606 #else
02607 
02608     tyfilespec fsdll;
02609     Handle hModule;
02610     
02611     flnextparamislast = true;
02612 
02613     if (!getfilespecvalue (hparam1, 1, &fsdll))
02614         return (false);
02615 
02616     hModule = doloadlibrary (&fsdll, true);
02617 
02618     return (setlongvalue ((long) hModule, vreturned));
02619 
02620 #endif /* NEW_DLL_INTERFACE */
02621 
02622     } /*dllloadverb*/
02623 
02624 
02625 boolean dllunloadverb (hdltreenode hparam1, tyvaluerecord *vreturned) {
02626 
02627     /*
02628     Glue for dll.unload kernel verb
02629 
02630     2002-10-14 AR: Moved from langverbs.c to langdll.c.
02631     Started work on new DLL interface, still ifdef'd out.
02632     */
02633     
02634 #ifdef NEW_DLL_INTERFACE
02635 
02636     tyfilespec fsdll;
02637     
02638     flnextparamislast = true;
02639 
02640     if (!getfilespecvalue (hparam1, 1, &fsdll))
02641         return (false);
02642 
02643     return (setbooleanvalue (dodllunload (&fsdll), vreturned));
02644 
02645 #else
02646 
02647     tyfilespec fsdll;
02648     Handle hModule;
02649     
02650     flnextparamislast = true;
02651 
02652     if (!getfilespecvalue (hparam1, 1, &fsdll))
02653         return (false);
02654 
02655     if (islibraryloaded (&fsdll, &hModule))
02656         dofreelibrary (hModule, true);
02657 
02658     return (setbooleanvalue (true, vreturned));
02659 
02660 #endif /* NEW_DLL_INTERFACE */
02661 
02662     } /*dllunloadverb*/
02663 
02664 
02665 boolean dllcallverb (hdltreenode hparam1, tyvaluerecord *vreturned) {
02666     
02667     /*
02668     Glue for dll.call kernel verb
02669     
02670     5/4/92 dmb: created.
02671     
02672     5.0.2b3 dmb: on Mac, error message is already a pascal string
02673 
02674     2002-10-14 AR: Moved from langverbs.c to langdll.c.
02675     Started work on new DLL interface, still ifdef'd out.
02676     */
02677     
02678 #ifdef NEW_DLL_INTERFACE
02679 
02680     tyfilespec fsdll;
02681     bigstring bsprocname;
02682 
02683     if (!getfilespecvalue (hparam1, 1, &fsdll))
02684         return (false);
02685     
02686     if (!getstringvalue (hparam1, 2, bsprocname))
02687         return (false);
02688 
02689     return (dodllcall (hparam1, &fsdll, bsprocname, vreturned));
02690 
02691 #else
02692 
02693     register hdltreenode hp1 = hparam1;
02694     tyfilespec fsdll;
02695     bigstring bsmodule;
02696     tydllmoduleinfo dllinfo;
02697     tydllparamblock dllcall;
02698     tyvaluerecord val;
02699     Handle hdata;
02700     Handle orighandles [maxdllparams];
02701     short i;
02702     boolean fl;
02703     
02704     if (!getfilespecvalue (hp1, 1, &fsdll))
02705         return (false);
02706     
02707     if (!getstringvalue (hp1, 2, bsmodule))
02708         return (false);
02709     
02710     if (!loaddllmodule (&fsdll, bsmodule, &dllinfo))
02711         return (false);
02712     
02713     if (!langcheckparamcount (hp1, (short) (dllinfo.ctparams + 2)))
02714         return (false);
02715     
02716     clearbytes (&dllcall, sizeof (dllcall));
02717     
02718     for (i = 0; i < dllinfo.ctparams; ++i) {
02719         
02720         if (!getparamvalue (hp1, (short)(3 + i), &val))
02721             return (false);
02722         
02723         if (!coercevalue (&val, dllinfo.paramtypes [i]))
02724             return (false);
02725         
02726         langgetvalsize (val, &dllcall.paramsize [i]);
02727         
02728         if (langheapallocated (&val, &hdata)) {
02729             
02730             exemptfromtmpstack (&val);
02731             
02732             orighandles [i] = hdata;
02733 
02734             if ((dllinfo.paramtypes[i] == listvaluetype) || (dllinfo.paramtypes[i] == recordvaluetype)) {
02735                 dllcall.paramdata [i] = (long) hdata;
02736                 }
02737             else {
02738                 lockhandle (hdata);
02739                 
02740                 dllcall.paramdata [i] = (long) *hdata;
02741                 }
02742             }
02743         else {
02744             orighandles [i] = nil;
02745 
02746             dllcall.paramdata [i] = val.data.longvalue;
02747             }
02748         }
02749     
02750     fl = langcalldll (&dllinfo, &dllcall);
02751     
02752     for (i = 0; i < dllinfo.ctparams; ++i) {
02753     
02754         unlockhandle (orighandles[i]);
02755         
02756         initvalue (&val, dllinfo.paramtypes [i]);
02757         
02758         val.data.binaryvalue = orighandles [i];
02759         
02760         disposevaluerecord (val, false);
02761         }
02762     
02763     if (fl) {
02764     
02765         if (langheaptype (dllinfo.resulttype))
02766             fl = sethandlesize ((Handle) dllcall.resultdata, dllcall.resultsize);
02767         
02768         if (fl) {
02769             
02770             initvalue (vreturned, dllinfo.resulttype);
02771             
02772             (*vreturned).data.longvalue = dllcall.resultdata;
02773             
02774             pushvalueontmpstack (vreturned); 
02775             }
02776         }
02777     else
02778         {
02779         bigstring errmsg;
02780         
02781         #ifdef MACVERSION
02782             copystring (dllcall.errormessage, errmsg);
02783         #else
02784             copyctopstring (dllcall.errormessage, errmsg);
02785         #endif
02786         
02787         langerrormessage (errmsg);
02788         }
02789         
02790     return (fl);
02791 
02792 #endif /* NEW_DLL_INTERFACE */
02793 
02794     } /*calldllverb*/
02795 
02796 
02797 void dllinitverbs (void) {
02798     
02799     if (dllcallbacks == nil) {
02800 
02801         dllcallbacks = (XDLLProcTable *) malloc (sizeof (XDLLProcTable));
02802         
02803         if (dllcallbacks != nil)
02804             fillcalltable (dllcallbacks);
02805         }
02806     } /*initdllverbs*/

Generated on Wed May 31 18:19:51 2006 for frontierkernel 10.1.10a by  doxygen 1.4.6