langvalue.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langvalue.c 1236 2006-04-09 11:28:08Z andreradke $    */
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 #include "frontierconfig.h"
00032 #include "memory.h"
00033 #include "cursor.h"
00034 #include "db.h"
00035 #include "dialogs.h"
00036 #include "error.h"
00037 #include "file.h"
00038 #include "font.h"
00039 #include "kb.h"
00040 #include "launch.h"
00041 #include "ops.h"
00042 #include "smallicon.h"
00043 #include "strings.h"
00044 #include "oplist.h"
00045 #include "lang.h"
00046 #include "langinternal.h"
00047 #include "langexternal.h"
00048 #include "langipc.h"
00049 #include "langsystem7.h"
00050 #include "langtokens.h"
00051 #include "process.h"
00052 #include "tablestructure.h"
00053 #include "tableverbs.h"
00054 #ifdef flcomponent
00055     #include "osacomponent.h"
00056 #endif
00057 
00058 #include "timedate.h"
00059 #include "byteorder.h"  /* 2006-04-08 aradke: endianness conversion macros */
00060 
00061 
00062 
00063 boolean flparamerrorenabled = true;
00064 
00065 boolean flnextparamislast = false;
00066 
00067 bigstring bsfunctionname; /*available for use in error messages*/
00068 
00069 boolean flcoerceexternaltostring = false;
00070 
00071 boolean flinhibitnilcoercion = false;
00072 
00073 
00074 static byte bshexprefix [] = STR_hexprefix;
00075 
00076 static tyfunctype functiontoken; /*use this if string is empty*/
00077 
00078 static boolean fllocaldotparamsonly = false; /*set to inhibit searchpathvisit in langgetdotparams*/
00079 
00080 
00081 typedef struct tyfastflagsvaluerecord {
00082     
00083     tyvaluetype valuetype;
00084     
00085     byte flags: 8; /*instead of 4 separate bits fields to clear*/
00086     
00087     tyvaluedata data;
00088     } tyfastflagsvaluerecord;
00089 
00090 
00091 
00092 boolean langsymbolreference (hdlhashtable htable, bigstring bs, tyvaluerecord *val, hdlhashnode * hnode) {
00093     
00094     /*
00095     a bundle that was getting replicated everywhere.  look up the indicated name in
00096     the table, and return true with *val equal to its value if the symbol is defined.
00097     */
00098     
00099     boolean fl;
00100     
00101     pushhashtable (htable);
00102     
00103     fl = langgetsymbolval (bs, val, hnode);
00104     
00105     pophashtable ();
00106     
00107     if (!fl) {
00108         
00109         if ((htable == nil) && isemptystring (bs))
00110             langerror (niladdresserror);
00111         else
00112             langparamerror (unknownidentifiererror, bs);
00113         
00114         return (false);
00115         }
00116     
00117     return (true);
00118     } /*langsymbolreference*/
00119 
00120 
00121 static boolean gettokenvisit (bigstring bsname, hdlhashnode hnode, tyvaluerecord val, ptrvoid refcon) {
00122 #pragma unused(bsname, hnode, refcon)
00123     if (val.valuetype != tokenvaluetype)
00124         return (false);
00125         
00126     return (val.data.tokenvalue == functiontoken);
00127     } /*gettokenvisit*/
00128     
00129     
00130 static boolean gettokenname (bigstring bsname) {
00131     
00132     register boolean fl;
00133     
00134     fl = hashinversesearch (hbuiltinfunctions, &gettokenvisit, nil, bsname);
00135     
00136     return (fl);
00137     } /*gettokenname*/
00138 
00139 
00140 void initvalue (tyvaluerecord *val, tyvaluetype type) {
00141     
00142     /*
00143     call this routine to set the type and clear other fields of a new value
00144     */
00145     
00146     (*val).valuetype = type;
00147     
00148     (*val).data.longvalue = 0;
00149     
00150     (*(tyfastflagsvaluerecord *) val).flags = 0;
00151     } /*initvalue*/
00152 
00153 
00154 boolean setnilvalue (tyvaluerecord *val) {
00155     
00156     initvalue (val, novaluetype);
00157 
00158     return (true);
00159     } /*setnilvalue*/
00160 
00161 
00162 boolean setbooleanvalue (boolean fl, tyvaluerecord *val) {
00163     
00164     /*
00165     set val to be a the boolean value fl.  can't fail.
00166     */
00167     
00168     (*val).valuetype = booleanvaluetype;
00169     
00170     (*val).data.flvalue = fl;
00171     
00172     (*(tyfastflagsvaluerecord *) val).flags = 0;
00173     
00174     return (true);
00175     } /*setbooleanvalue*/
00176 
00177 
00178 boolean setcharvalue (byte ch, tyvaluerecord *val) {
00179     
00180     /*
00181     set val to be a the character value ch.  can't fail.
00182     */
00183     
00184     (*val).valuetype = charvaluetype;
00185     
00186     (*val).data.chvalue = ch;
00187     
00188     (*(tyfastflagsvaluerecord *) val).flags = 0;
00189     
00190     return (true);
00191     } /*setcharvalue*/
00192 
00193 
00194 boolean setintvalue (short x, tyvaluerecord *val) {
00195     
00196     /*
00197     set val to be a the integer value x.  can't fail.
00198     */
00199     
00200     (*val).valuetype = intvaluetype;
00201     
00202     (*val).data.intvalue = x;
00203     
00204     (*(tyfastflagsvaluerecord *) val).flags = 0;
00205     
00206     return (true);
00207     } /*setintvalue*/
00208 
00209 
00210 boolean setlongvalue (long x, tyvaluerecord *val) {
00211     
00212     /*
00213     set val to be a the long value x.  can't fail.
00214     */
00215     
00216     (*val).valuetype = longvaluetype;
00217     
00218     (*val).data.longvalue = x;
00219     
00220     (*(tyfastflagsvaluerecord *) val).flags = 0;
00221     
00222     return (true);
00223     } /*setlongvalue*/
00224 
00225 
00226 boolean setdatevalue (unsigned long x, tyvaluerecord *val) {
00227     
00228     /*
00229     set val to be a the date value x.  can't fail.
00230     */
00231     
00232     (*val).valuetype = datevaluetype;
00233     
00234     (*val).data.datevalue = x;
00235     
00236     (*(tyfastflagsvaluerecord *) val).flags = 0;
00237     
00238     return (true);
00239     } /*setdatevalue*/
00240 
00241 
00242 boolean setdirectionvalue (tydirection x, tyvaluerecord *val) {
00243     
00244     /*
00245     set val to be a the direction value x.  can't fail.
00246     */
00247     
00248     (*val).valuetype = directionvaluetype;
00249     
00250     (*val).data.dirvalue = x;
00251     
00252     (*(tyfastflagsvaluerecord *) val).flags = 0;
00253     
00254     return (true);
00255     } /*setdirectionvalue*/
00256 
00257 
00258 boolean setostypevalue (OSType x, tyvaluerecord *val) {
00259     
00260     /*
00261     set val to be a the ostype value x.  can't fail.
00262     */
00263     
00264     (*val).valuetype = ostypevaluetype;
00265     
00266     (*val).data.ostypevalue = x;
00267     
00268     (*(tyfastflagsvaluerecord *) val).flags = 0;
00269     
00270     return (true);
00271     } /*setostypevalue*/
00272 
00273 
00274 boolean setpointvalue (Point x, tyvaluerecord *val) {
00275     
00276     /*
00277     set val to be a the Point value x.  can't fail.
00278     */
00279     
00280     (*val).valuetype = pointvaluetype;
00281     
00282     (*val).data.pointvalue = x;
00283     
00284     (*(tyfastflagsvaluerecord *) val).flags = 0;
00285     
00286     return (true);
00287     } /*setpointvalue*/
00288 
00289 
00290 boolean setfixedvalue (Fixed x, tyvaluerecord *val) {
00291     
00292     /*
00293     set val to be a the Fixed value x.  can't fail.
00294     */
00295     
00296     (*val).valuetype = fixedvaluetype;
00297     
00298     (*val).data.fixedvalue = x;
00299     
00300     (*(tyfastflagsvaluerecord *) val).flags = 0;
00301     
00302     return (true);
00303     } /*setfixedvalue*/
00304 
00305 
00306 boolean setsinglevalue (float x, tyvaluerecord *val) {
00307     
00308     /*
00309     set val to be a the single value x.  can't fail.
00310     */
00311     
00312     (*val).valuetype = singlevaluetype;
00313     
00314     (*val).data.singlevalue = x;
00315     
00316     (*(tyfastflagsvaluerecord *) val).flags = 0;
00317     
00318     return (true);
00319     } /*setsinglevalue*/
00320 
00321 
00322 boolean newheapvalue (ptrvoid pdata, long size, tyvaluetype type, tyvaluerecord *val) {
00323     
00324     /*
00325     create a new heap-allocated value of the indicated type, using the 
00326     provided data.
00327     
00328     we record the handle in the tmpstack, so that it can be sure it gets 
00329     deallocated.
00330     */
00331     
00332     Handle x;
00333     
00334     initvalue (val, type);
00335     
00336     if (!newfilledhandle (pdata, size, &x))
00337         return (false);
00338     
00339     (*val).data.binaryvalue = x;
00340     
00341     if (!pushtmpstackvalue (val)) {
00342         
00343         disposehandle (x);
00344         
00345         (*val).data.binaryvalue = nil; /*neatness counts*/
00346         
00347         return (false);
00348         }
00349     
00350     return (true);
00351     } /*newheapvalue*/
00352 
00353 
00354 boolean setstringvalue (bigstring bs, tyvaluerecord *val) {
00355     
00356     /*
00357     turn val into a string value, allocating a string in the heap.
00358     
00359     the handle is recorded in the tmpstack so that it gets deallocated.
00360     */
00361     
00362     return (newheapvalue (bs + 1, stringlength (bs), stringvaluetype, val));
00363     } /*setstringvalue*/
00364 
00365 
00366 static boolean getaddressparts (const tyvaluerecord *val, hdlhashtable *htable, bigstring bs) {
00367     
00368     /*
00369     5.1.4 dmb: new strategy for addresses. this routine just dissects the address
00370     value. if the table is -1, the address is unresolved and bs is the full path.
00371     */
00372     
00373     hdlstring hstring = (*val).data.addressvalue;
00374     long ixtable;
00375     
00376     copyheapstring (hstring, bs);
00377     
00378     ixtable = stringlength (bs) + 1;
00379     
00380     if (!loadfromhandle ((Handle) hstring, &ixtable, sizeof (hdlhashtable), htable))
00381         *htable = nil;
00382 
00383     return (true);
00384     } /*getaddressparts*/
00385 
00386 
00387 boolean getaddressvalue (tyvaluerecord val, hdlhashtable *htable, bigstring bs) {
00388     
00389     /*
00390     a hash table handle might be tacked onto the end of the string handle. 
00391     if it's not there, return nil for htable.
00392     
00393     we'll also do something fancy: we can catch some coding errors by 
00394     verifying that the table handle, if present, hasn't been disposed.
00395     
00396     3/11/91 dmb: since we can't reliably resolve full paths to addresses 
00397     at unpack time, we need to be prepared to "upgrade" val from a full 
00398     path to a name/table pair on the fly.  if no table has been appended 
00399     to the heap string value, try to do so now.
00400     
00401     3/19/92 dmb: handle new -1 htable convention for unresolved addresses 
00402     */
00403     
00404     
00405     if (!getaddressparts (&val, htable, bs))
00406         return (false);
00407 
00408     if (*htable == (hdlhashtable) -1) { /*an unresolved address*/
00409 
00410         #ifdef version5orgreater
00411             boolean fl;
00412 
00413             pushhashtable (roottable);
00414             
00415             //disablelangerror ();
00416             
00417             fl = langexpandtodotparams (bs, htable, bs);
00418             
00419             //enablelangerror ();
00420             
00421             pophashtable ();
00422             
00423             if (!fl)
00424                 return (false);
00425         #else
00426             *htable = nil;
00427         #endif
00428             }
00429         
00430     else {
00431         if (!validhandle ((Handle) *htable)) {
00432             
00433             langparamerror (badaddresserror, bs);
00434             
00435             return (false);
00436             }
00437         }
00438     
00439     return (true);
00440     
00441     /*
00442     setheapstring (emptystring, hstring); /%avoid recursion%/
00443     
00444     disablelangerror (); /%we don't want to generate errors here%/
00445     
00446     if (langexpandtodotparams (bs, htable, bs)) { /%valid path%/
00447         
00448         setheapstring (bs, hstring); /%now we have just the name%/
00449         
00450         enlargehandle ((Handle) hstring, sizeof (hdlhashtable), htable); /%should never fail%/
00451         }
00452     else
00453         setheapstring (bs, hstring); /%restore original%/
00454     
00455     enablelangerror ();
00456     
00457     return (true);
00458     */
00459     } /*getaddressvalue*/
00460 
00461 
00462 boolean setaddressencoding (tyvaluerecord *val, boolean flfullpath) {
00463     
00464     /*
00465     5.1.4 dmb: to represent a full path, set htable to -1. otherwise, 
00466     the address data is the item name, with htable a valid handle.
00467 
00468     ...but don't set full path encoding if the address is a local one
00469     */
00470 
00471     hdlhashtable htable;
00472     bigstring bs;
00473     Handle h;
00474 
00475     if (!getaddressparts (val, &htable, bs))
00476         return (false);
00477     
00478     if (flfullpath == (htable == (hdlhashtable) -1))
00479         return (true);
00480 
00481     // set htable, bs for the flfullpath state
00482     if (flfullpath) {
00483         
00484         if (htable && (**htable).fllocaltable) //never encode local tables with full paths
00485             return (true);
00486 
00487         if (!getaddresspath (*val, bs))
00488             return (false);
00489 
00490         htable = (hdlhashtable) -1;
00491         }
00492     else {
00493         if (!getaddressvalue (*val, &htable, bs))
00494             return (false);
00495         }
00496 
00497     // set the value with the new encoding
00498     h = (Handle) (*val).data.addressvalue;
00499 
00500     if (!sethandlecontents (bs, stringsize (bs), h))
00501         return (false);
00502     
00503     if (!enlargehandle (h, sizeof (htable), &htable))
00504         return (false);
00505     
00506     return (true);
00507     } /*setaddressencoding*/
00508 
00509 
00510 boolean setaddressvalue (hdlhashtable htable, const bigstring bs, tyvaluerecord *val) {
00511     
00512     return (setexemptaddressvalue (htable, bs, val) && pushtmpstackvalue (val));
00513     } /*setaddressvalue*/
00514 
00515 
00516 boolean setexemptaddressvalue (hdlhashtable htable, const bigstring bs, tyvaluerecord *val) {
00517     
00518     /*
00519     turn val into an address value.  we store a string in the heap which
00520     is the path to the guy whose address we're storing.
00521     
00522     2/2/91 dmb: addresses now contain pointer to hash table.  see comment 
00523     in addressofvalue.
00524     */
00525     
00526     hdlstring hstring;
00527     
00528     initvalue (val, addressvaluetype);
00529     
00530     if (!newheapstring (bs, &hstring))
00531         return (false);
00532     
00533     if (!enlargehandle ((Handle) hstring, sizeof (htable), &htable)) {
00534         
00535         disposehandle ((Handle) hstring);
00536         
00537         return (false);
00538         }
00539     
00540     (*val).data.addressvalue = hstring;
00541     
00542     return (true);
00543     } /*setexemptaddressvalue*/
00544 
00545 
00546 /*
00547 boolean setpasswordvalue (bigstring bs, tyvaluerecord *val) {
00548     
00549     if (!setstringvalue (bs, val))
00550         return (false);
00551     
00552     initvalue (val, passwordvaluetype);
00553     
00554     return (true);
00555     } /%setpasswordvalue%/
00556 */
00557 
00558 
00559 boolean setheapvalue (Handle x, tyvaluetype type, tyvaluerecord *val) {
00560     
00561     /*
00562     simple utility routine for setting up any kind of heap-allocated value.
00563     
00564     unlikely to fail.  but if it does, dispose the handle; the caller isn't 
00565     managing the memory any more.
00566 
00567     5.0a24 dmb: on failure, disposevaluerecord, not disposehandle.
00568     */
00569     
00570     initvalue (val, type);
00571     
00572     (*val).data.binaryvalue = x;
00573     
00574     if (!pushtmpstackvalue (val)) {
00575         
00576         disposevaluerecord (*val, false);
00577         
00578         return (false);
00579         }
00580     
00581     return (true);
00582     } /*setheapvalue*/
00583 
00584 
00585 boolean setbinaryvalue (Handle x, OSType typeid, tyvaluerecord *val) {
00586     
00587     /*
00588     simple utility routine.  prepend the typeid to the handle and 
00589     set the heap value.
00590     
00591     on failure, dispose of the handle; caller should assume we own it 
00592     either way.
00593     */
00594     
00595     memtodisklong (typeid);
00596 
00597     // kw - 2005-12-12 filemaker empty string fix
00598     // we need to be able to handle empty strings that arrive as a binary['utxt']
00599     if (x == nil)
00600         newhandle(0, &x);
00601 
00602     if (!insertinhandle (x, 0L, &typeid, sizeof (typeid))) {
00603         
00604         disposehandle (x);
00605         
00606         return (false);
00607         }
00608     
00609     return (setheapvalue (x, binaryvaluetype, val));
00610     } /*setbinaryvalue*/
00611 
00612 
00613 boolean setbinarytypeid (Handle x, OSType typeid) {
00614     
00615     /*
00616     poke the typeid of the given binary handle
00617     */
00618     
00619     if (gethandlesize (x) < sizeof (OSType)) /*defensive driving*/
00620         return (false);
00621     
00622     **(OSType **) x = conditionallongswap (typeid);
00623     
00624     return (true);
00625     } /*setbinarytypeid*/
00626 
00627 
00628 OSType getbinarytypeid (Handle x) {
00629     
00630     /*
00631     peek at the typeid of the binary handle
00632     */
00633     
00634     return (conditionallongswap (**(OSType **) x));
00635     } /*getbinarytypeid*/
00636 
00637 
00638 boolean stripbinarytypeid (Handle x) {
00639 
00640     return (pullfromhandle (x, 0L, sizeof (OSType), nil));
00641     } /*stripbinarytypeid*/
00642 
00643 
00644 boolean setdoublevalue (double x, tyvaluerecord *val) {
00645     
00646     /*
00647     turn val into a double value, allocated in the heap.
00648     
00649     the handle is recorded in the tmpstack so that it gets deallocated.
00650     */
00651     
00652     return (newheapvalue (&x, sizeof (x), doublevaluetype, val));
00653     } /*setdoublevalue*/
00654 
00655 
00656 boolean setfilespecvalue (tyfilespec *x, tyvaluerecord *val) {
00657     
00658     /*
00659     turn val into a filespec value, allocated in the heap.
00660     
00661     the handle is recorded in the tmpstack so that it gets deallocated.
00662     */
00663     
00664     long len = filespecsize (*x);
00665     
00666     return (newheapvalue (x, len, filespecvaluetype, val));
00667     } /*setfilespecvalue*/
00668 
00669 
00670 boolean setexternalvalue (Handle x, tyvaluerecord *val) {
00671     
00672     /*
00673     turn val into an external value, using the provided external handle as data.
00674     */
00675     
00676     (*val).valuetype = externalvaluetype;
00677     
00678     (*val).data.externalvalue = x;
00679     
00680     (*(tyfastflagsvaluerecord *) val).flags = 0;
00681     
00682     return (true);
00683     } /*setexternalvalue*/
00684 
00685 
00686 boolean copyvaluedata (tyvaluerecord *val) {
00687     
00688     /*
00689     7/26/91 dmb: the beginning of something new.  the problem: passing 
00690     large objects (like external values) on the stack is prohibitively 
00691     expensive.  up to this point, builtin functions like typeof () and 
00692     sizeof () can cheat by avoiding the evaluation of their parameters, 
00693     but normal handler's can't take external values as parameters.
00694     
00695     the idea is to defer the copying if the value data until it's actually 
00696     used in an assignment.  if it's never assigned, it never should have to 
00697     be duplicated.  in copyvaluercord, we now set a bit indicating that the 
00698     value's data hasn't been duplicated, i.e. the data is owned by another 
00699     (the original) value.  in disposevaluerecord, if the flag is set 
00700     nothing is disposed.  in assignvalue, if the flag is set the data is 
00701     duplicated at that time by calling this function.
00702     
00703     for the time being, this mechanism is only used for external values.  it 
00704     would improve performance to use it for all heap values, but a thorough 
00705     pass would have to be made over the code to eliminate the assumtion that 
00706     string values, for instance, own their handle.  right now, coercion functions 
00707     routinely dispose of the old string value by hand.
00708     
00709     5.0.2b12 dmb: use new langexternalcopyvalue (for outlines)
00710     */
00711     
00712     register tyvaluerecord *v = val;
00713     Handle x;
00714     //hdlhashtable ht;
00715     //bigstring bs;
00716     boolean fl;
00717     
00718     if (!(*v).fltmpdata) /*nothing to do*/
00719         return (true);
00720     
00721     switch ((*v).valuetype) {
00722         
00723         /*
00724         case addressvaluetype:
00725             if (!getaddressvalue (*v, &ht, bs))
00726                 return (false);
00727             
00728             if (!setaddressvalue (ht, bs, v))
00729                 return (false);
00730             
00731             break;
00732         
00733         case stringvaluetype: 
00734         case passwordvaluetype:
00735         case rectvaluetype:
00736         case patternvaluetype:
00737         case rgbvaluetype:
00738         case objspecvaluetype:
00739         case filespecvaluetype:
00740         case aliasvaluetype:
00741         case doublevaluetype:
00742         case binaryvaluetype:
00743     #ifndef oplanglists
00744         case listvaluetype:
00745         case recordvaluetype:
00746     #endif
00747             #ifdef flnewfeatures
00748                 
00749                 if ((*v).fldiskval) {
00750                     if (!dbrefhandle ((*v).data.diskvalue, &x))
00751                         return (false);
00752                     }
00753                 else {
00754                     if (!copyhandle ((*v).data.binaryvalue, &x))
00755                         return (false);
00756                     }
00757             #else
00758             
00759                 if (!copyhandle ((*v).data.binaryvalue, &x))
00760                     return (false);
00761             
00762             #endif
00763             
00764             if (!setheapvalue (x, (*v).valuetype, v))
00765                 return (false);
00766             
00767             break;
00768         
00769     #ifdef oplanglists
00770         case listvaluetype:
00771         case recordvaluetype:
00772     #endif
00773         */
00774         case codevaluetype:         
00775             if (!langpackvalue (*v, &x, HNoNode))
00776                 return (false);
00777             
00778             fl = langunpackvalue (x, v);
00779             
00780             disposehandle (x);
00781             
00782             if (!fl)
00783                 return (false);
00784             
00785             break;
00786         
00787         case externalvaluetype:
00788             
00789             if (!langexternalcopyvalue (v, v))
00790                 return (false);
00791             
00792             break;
00793         
00794         default:
00795             shellinternalerror (idbadtempdatatype, STR_Internal_error_bad_type_for_temp_data);
00796             
00797             break;
00798         } /*switch*/
00799     
00800     (*v).fltmpdata = 0; /*we own the data now*/
00801     
00802     return (true); 
00803     } /*copyvaluedata*/
00804 
00805 
00806 #ifdef tmpcopydebug
00807 static boolean findheaptmp (tyvaluerecord *v) {
00808     
00809     register short ctloops;
00810     register tyvaluerecord *p;
00811     
00812     if (currenthashtable == nil)
00813         return (false);
00814     
00815     p = (**currenthashtable).tmpstack;
00816     
00817     for (ctloops = (**currenthashtable).cttmpstack; ctloops--; ++p) {
00818         
00819         if ((*p).data.binaryvalue == (*v).data.binaryvalue)
00820             return (true);
00821         }
00822     
00823     return (false);
00824     } /*findheaptmp*/
00825 #endif
00826 
00827 
00828 boolean copyvaluerecord (tyvaluerecord v, tyvaluerecord *vreturned) {
00829     
00830     /*
00831     create a copy of v in vreturned.  for strings and passwords and other
00832     relatively small heap-allocated objects, we create a copy of the data.
00833     
00834     for other types, externals and binaries, we create another reference
00835     to the heap-allocated object.  it's important that values copied for
00836     externals and binaries not be stored in the symbol table structure.
00837     
00838     2/15/91 dmb: no longer treat binary values like externals.  since we 
00839     now support passing values by reference (i.e. address values), the 
00840     script writer can avoid the overhead of large objects when desired. 
00841     binary values can now be used like any other automatic type.
00842     
00843     8/16/91 dmb: going even further, we'll now use the new fl.tmpdata 
00844     mechanism to avoid copying binary values when we don't need to.
00845     
00846     12/26/91 dmb: make sure that if an allocation failure occurs, we return 
00847     an empty value.
00848     
00849     4.0.2b1 dmb: handle fldiskvals
00850     
00851     5.0.2b12 dmb: use new opcopylist for lists
00852 
00853     5.1.4 dmb: don't do anything special for addresses; just copy the current
00854     binary state.
00855     */
00856     
00857     Handle x;
00858     hdllistrecord hlist;
00859 #ifndef version5orgreater
00860     bigstring bs;
00861     hdlhashtable htable;
00862 #endif
00863     
00864 #ifdef tmpcopydebug
00865     static long ctdups = 0;
00866     static long cttmps = 0;
00867     static long cthits = 0;
00868     
00869     ++ctdups;
00870     
00871     if (v.fltmpstack) {
00872         
00873         ++cttmps;
00874         
00875         if (findheaptmp (&v)) {
00876             ++cthits;
00877             
00878             *vreturned = v;
00879             (*vreturned).fltmpdata = true;      
00880             return (true);
00881             }
00882         }
00883 #endif
00884 
00885     switch (v.valuetype) {
00886         
00887         case addressvaluetype:
00888         #ifndef version5orgreater
00889             initvalue (vreturned, novaluetype);
00890             
00891             if (!getaddressvalue (v, &htable, bs))
00892                 return (false);
00893             
00894             return (setaddressvalue (htable, bs, vreturned));
00895         #endif
00896         case stringvaluetype:
00897         case passwordvaluetype:
00898         case rectvaluetype:
00899         case patternvaluetype:
00900         case rgbvaluetype:
00901         case objspecvaluetype:
00902         case filespecvaluetype:
00903         case aliasvaluetype:
00904         case doublevaluetype:
00905         case binaryvaluetype:
00906     #ifndef oplanglists
00907         case listvaluetype:
00908         case recordvaluetype:
00909     #endif
00910             initvalue (vreturned, novaluetype);
00911             
00912             #ifdef flnewfeatures
00913                 
00914                 if (v.fldiskval) {
00915                     /*
00916                     4.0.2b1 dmb: for disk-based scalars, the copy will be the actual 
00917                     data, while the original value (and the hashtable node) will still
00918                     be on disk
00919                     */
00920                     
00921                     if (!dbrefhandle (v.data.diskvalue, &x))
00922                         return (false);
00923                     }
00924                 else {
00925                     if (!copyhandle (v.data.binaryvalue, &x))
00926                         return (false);
00927                     }
00928             #else
00929             
00930                 if (!copyhandle (v.data.binaryvalue, &x))
00931                     return (false);
00932             
00933             #endif
00934 
00935             return (setheapvalue (x, v.valuetype, vreturned));
00936         
00937     #ifdef oplanglists
00938         case listvaluetype:
00939         case recordvaluetype:
00940             initvalue (vreturned, v.valuetype);
00941             
00942             if (!opcopylist (v.data.listvalue, &hlist))
00943                 return (false);
00944             
00945             return (setheapvalue ((Handle) hlist, v.valuetype, vreturned));
00946     #endif
00947 
00948         case codevaluetype:
00949         case externalvaluetype:
00950             *vreturned = v;
00951             
00952             (*vreturned).fltmpdata = true; /*see hashassign, disposevaluerecord*/
00953             
00954             break;
00955         
00956         default:
00957             *vreturned = v;
00958             
00959             break;
00960         } /*switch*/
00961     
00962     return (true); 
00963     } /*copyvaluerecord*/
00964 
00965 #ifdef DATABASE_DEBUG
00966 
00967 void debug_disposevaluerecord (tyvaluerecord val, boolean fldisk, long line, char *sourcefile)
00968 
00969 #else
00970 
00971 void disposevaluerecord (tyvaluerecord val, boolean fldisk)
00972 
00973 #endif
00974 {
00975     
00976     /*
00977     9/24/92 dmb: never dispose code trees here; there's no such thing as 
00978     a code value whose data isn't a piece of compiled code that will 
00979     disposed independently.
00980     
00981     4/20/93 dmb: now that code values are treated more consistently, and 
00982     code values that shouldn't be disposed have their tmpdata flag set, we 
00983     can go ahead and dispose code trees here.
00984     
00985     4.0.2b1 dmb: handle fldiskvals
00986 
00987     6.1b18 AR: since we allow externals on the tmp stack, we need to remove them, too
00988     */
00989     
00990     if (val.fltmpdata) /*val doesn't own it's data*/
00991         return;
00992     
00993     switch (val.valuetype) {
00994         
00995         case stringvaluetype:
00996         case passwordvaluetype:
00997         case addressvaluetype:
00998         case rectvaluetype:
00999         case patternvaluetype:
01000         case rgbvaluetype:
01001         case objspecvaluetype:
01002         case filespecvaluetype:
01003         case aliasvaluetype:
01004         case doublevaluetype:
01005         case binaryvaluetype:
01006     #ifndef oplanglists
01007         case listvaluetype:
01008         case recordvaluetype:
01009     #endif
01010             if (val.fldiskval) { /*4.0.2b1 dmb: see langhash comments for details*/
01011             
01012                 if (fldisk) {
01013                     #ifdef DATABASE_DEBUG
01014                         debug_dbpushreleasestack (val.data.diskvalue, (long) langexternalgettypeid (val), line, sourcefile);
01015                     #else
01016                         dbpushreleasestack (val.data.diskvalue, (long) langexternalgettypeid (val));
01017                     #endif
01018                     }
01019                 }
01020             else {
01021                 exemptfromtmpstack (&val);
01022                 
01023                 disposehandle (val.data.binaryvalue);
01024                 }
01025             
01026             break;
01027         
01028     #ifdef oplanglists
01029         case listvaluetype:
01030         case recordvaluetype:
01031             exemptfromtmpstack (&val);
01032             
01033             opdisposelist (val.data.listvalue);
01034             
01035             break;
01036     #endif
01037 
01038         case codevaluetype:
01039             exemptfromtmpstack (&val);
01040             
01041             langdisposetree (val.data.codevalue);
01042             
01043             break;
01044         
01045         case externalvaluetype:
01046             exemptfromtmpstack (&val);
01047 
01048             langexternaldisposevalue (val, fldisk);
01049             
01050             break;
01051         
01052         default:
01053             /* do nothing */
01054             break;
01055             
01056         } /*switch*/
01057     } /*disposevaluerecord*/
01058 
01059 
01060 #if 0
01061 
01062 static boolean isgarbagetype (tyvaluetype type) {
01063     
01064     /*
01065     3.0.2b1 dmb: return true if the given type should be garbage collected 
01066     during a an arithmetic operation
01067     */
01068     
01069     switch (type) {
01070         
01071         case stringvaluetype:
01072         case doublevaluetype:
01073         case binaryvaluetype:
01074         case listvaluetype:
01075         case recordvaluetype:
01076             return (true);
01077         
01078         default:
01079             return (false);
01080         } /*switch*/
01081     } /*isgarbagetype*/
01082 
01083 #endif
01084 
01085 
01086 void disposevalues (tyvaluerecord *val1, tyvaluerecord *val2) {
01087     
01088     /*
01089     the assertion made by the caller is that val1 and val2 have served
01090     their purpose and will never be used again.  if they have heap-allocated
01091     objects hanging off them, release the memory.
01092     
01093     we take two params because most operations are binary, for unary ops
01094     call with val2 == nil.
01095     
01096     1/16/91 dmb: use langheapallocated instead of testing valuetype for 
01097     stringvaluetype
01098     
01099     1/23/91 dmb: oops. this version of dispose needs to work similarly to 
01100     copyvaluerecord, only dealing with string-based handles.  binary and 
01101     external handles are not to be disposed.  since addresses and passwords 
01102     are not likely to be passed here, we can only check for stringvaluetype, 
01103     as originally coded.  other values will remain in temp stack
01104     
01105     3.0.2b1 dmb: use new isgarbagetype to decide whether garbage collection 
01106     is needed
01107     
01108     5.0.2b10 dmb: dispose heap values that are actually on the tmp stack; don't
01109     base it on their type
01110     
01111     2004-12-30 SMD: now extern instead of static
01112     */
01113     
01114     register tyvaluerecord *v1 = val1;
01115     register tyvaluerecord *v2 = val2;
01116     
01117     if (v1 != nil)
01118         
01119         if ((*v1).fltmpstack) { //isgarbagetype ((*v1).valuetype)) {
01120             
01121         #ifdef oplanglists
01122             disposevaluerecord (*v1, true);
01123         #else
01124             releaseheaptmp ((Handle) (*v1).data.stringvalue);
01125         #endif
01126             }
01127     
01128     if (v2 != nil)
01129         
01130         if ((*v2).fltmpstack) { //isgarbagetype ((*v2).valuetype)) {
01131 
01132         #ifdef oplanglists
01133             disposevaluerecord (*v2, true);
01134         #else
01135             releaseheaptmp ((Handle) (*v2).data.stringvalue);
01136         #endif
01137             }
01138     
01139     } /*disposevalues*/
01140 
01141 
01142 boolean stringisboolean (bigstring bs, boolean *flboolean) {
01143     
01144     alllower (bs);
01145     
01146     if (equalstrings (bs, bstrue)) {
01147     
01148         *flboolean = true;
01149         
01150         return (true);
01151         }
01152     
01153     if (equalstrings (bs, bsfalse)) {
01154     
01155         *flboolean = false;
01156         
01157         return (true);;
01158         }
01159     
01160     return (false);
01161     } /*stringisboolean*/
01162 
01163 
01164 void pullstringvalue (const tyvaluerecord *v, bigstring bsval) {
01165     
01166     texthandletostring ((Handle) (*v).data.stringvalue, bsval);
01167     } /*pullstringvalue*/
01168 
01169 
01170 static boolean stringtoboolean (tyvaluerecord *val) {
01171     
01172     /*
01173     4/19/91 dmb: if not "false", any non-empty string is true
01174     */
01175     
01176     boolean flboolean;
01177     bigstring bs;
01178     
01179     pullstringvalue (val, bs);
01180     
01181     if (!stringisboolean (bs, &flboolean))
01182         flboolean = !isemptystring (bs);
01183     
01184     releaseheaptmp ((*val).data.stringvalue);
01185     
01186     return (setbooleanvalue (flboolean, val));
01187     } /*stringtoboolean*/
01188 
01189 
01190 static boolean stringtochar (tyvaluerecord *val) {
01191     
01192     bigstring bs;
01193     
01194     pullstringvalue (val, bs);
01195     
01196     if (stringlength (bs) != 1) { /*we only accept strings that are 1 character long*/
01197         
01198         langparamerror (stringcharerror, bs);
01199         
01200         return (false);
01201         }
01202     
01203     releaseheaptmp ((Handle) (*val).data.stringvalue);
01204     
01205     setcharvalue (bs [1], val);
01206     
01207     return (true);
01208     } /*stringtochar*/
01209 
01210 
01211 static boolean stringtolong (tyvaluerecord *val) {
01212     
01213     /*
01214     5/7/93 dmb: don't accept hex strings that don't begin with "0x"
01215     */
01216     
01217     long x;
01218     bigstring bs;
01219     double d;
01220     tydirection dir;
01221     boolean flboolean;
01222     
01223     pullstringvalue (val, bs);
01224     
01225     stringdeletechars (bs, ','); /*get rid of all commas before converting*/
01226     
01227     if (isallnumeric (bs)) {
01228         
01229         stringtonumber (bs, &x);
01230         
01231         goto exit;
01232         }
01233     
01234     if (patternmatch (bshexprefix, bs) && hexstringtonumber (bs, &x))
01235         goto exit;
01236     
01237     if (stringtofloat (bs, &d)) {
01238         
01239         x = (long) d;
01240         
01241         goto exit;
01242         }
01243     
01244     if (stringtodir (bs, &dir)) {
01245         
01246         x = (long) dir;
01247         
01248         goto exit;
01249         }
01250     
01251     if (stringisboolean (bs, &flboolean)) {
01252         
01253         x= (long) flboolean;
01254         
01255         goto exit;
01256         }
01257     
01258     langparamerror (stringlongerror, bs);
01259     
01260     return (false);
01261     
01262     exit:
01263     
01264     releaseheaptmp ((Handle) (*val).data.stringvalue);
01265     
01266     return (setlongvalue (x, val));
01267     } /*stringtolong*/
01268     
01269 
01270 static boolean stringtodirection (tyvaluerecord *val) {
01271     
01272     tydirection dir;
01273     bigstring bs;
01274     
01275     pullstringvalue (val, bs);
01276     
01277     if (!stringtodir (bs, &dir)) {
01278     
01279         langerror (invaliddirectionerror);
01280         
01281         return (false);
01282         }
01283         
01284     releaseheaptmp ((Handle) (*val).data.stringvalue);
01285     
01286     setdirectionvalue (dir, val);
01287     
01288     return (true);
01289     } /*stringtodirection*/
01290 
01291 
01292 static boolean langstringtoostype (tyvaluerecord *val) {
01293     
01294     OSType type;
01295     bigstring bs;
01296     
01297     pullstringvalue (val, bs);
01298     
01299     if (!stringtoostype (bs, &type)) {
01300         
01301         langparamerror (ostypecoerceerror, bs);
01302         
01303         return (false);
01304         }
01305     
01306     releaseheaptmp ((Handle) (*val).data.stringvalue);
01307     
01308     setostypevalue (type, val);
01309     
01310     return (true);
01311     } /*langstringtoostype*/
01312 
01313 
01314 boolean stringtoaddress (tyvaluerecord *val) {
01315     
01316     /*
01317     2/2/91 dmb: addresses are no longer just strings.  see comment 
01318     in addressofvalue
01319     
01320     7/10/91 dmb: special case empty string to empty address
01321     
01322     7/12/91 dmb: if htable is nil, do a searchpath lookup on it.
01323     
01324     10/14/91 dmb: fixed emptystring case; addresses still have length bytes, while 
01325     strings do not.
01326     
01327     7/21/97 dmb: support standalone window titles/paths with langfindexternalwindow
01328 
01329     5.1b21 dmb: leave htable nil for @root
01330     */
01331     
01332     register tyvaluerecord *v = val;
01333     bigstring bs;
01334     hdlhashtable htable;
01335     
01336     pullstringvalue (v, bs);
01337     
01338     if (isemptystring (bs)) {
01339         
01340         htable = nil;
01341         
01342         /*
01343         (*v).valuetype = addressvaluetype;
01344         
01345         return (true);
01346         */
01347         }
01348     else {
01349         
01350         if (!langexpandtodotparams (bs, &htable, bs)) {
01351         
01352             #ifdef xxxversion5orgreater
01353             
01354             hdlwindowinfo hinfo;
01355             
01356             if (flextendedsymbolsearch && shellfindnamedwindow (bs, &hinfo))
01357                 htable = currenthashtable;
01358             else
01359             
01360             #endif
01361             
01362             return (false);
01363             }
01364         
01365         if ((htable == nil) && !equalstrings (bs, nameroottable))
01366             langsearchpathlookup (bs, &htable);
01367         }
01368     
01369     releaseheaptmp ((Handle) (*v).data.stringvalue);
01370     
01371     return (setaddressvalue (htable, bs, v));
01372     } /*stringtoaddress*/
01373 
01374 
01375 /*
01376 static boolean stringtofixed (tyvaluerecord *val) {
01377     
01378     if (!stringtolong (val))
01379         return (false);
01380     
01381     return (setfixedvalue (FixRatio ((*val).data.longvalue, 1), val));
01382     } /%stringtofixed%/
01383 */
01384 
01385 
01386 static long nthint (bigstring bs, short n) {
01387     
01388     /*
01389     10/4/91 dmb: added range check, using coercetoint.  caller must check 
01390     fllangerror.
01391     
01392     3/18/92 dmb: pop leading spaces before converting to int
01393     */
01394     
01395     long x;
01396     bigstring bsint;
01397     tyvaluerecord val;
01398     
01399     nthword (bs, n, ',', bsint);
01400     
01401     stringdeletechars (bsint, '(');
01402     
01403     stringdeletechars (bsint, ')');
01404     
01405     popleadingchars (bsint, ' ');
01406     
01407     if ((stringlength (bsint) > 2) && (bsint [1] == '0') && (bsint [2] == 'x'))
01408         hexstringtonumber (bsint, &x);
01409     else
01410         stringtonumber (bsint, &x);
01411     
01412     setlongvalue (x, &val);
01413     
01414     coercetoint (&val); /*may generate range-checking error*/
01415     
01416     return (val.data.intvalue);
01417     } /*nthint*/
01418 
01419 
01420 static boolean stringtopoint (tyvaluerecord *val) {
01421     
01422     Point pt;
01423     bigstring bs;
01424     
01425     pullstringvalue (val, bs);
01426     
01427     if (countwords (bs, ',') != 2) {
01428         
01429         langparamerror (pointcoerceerror, bs);
01430         
01431         return (false);
01432         }
01433     
01434     pt.h = nthint (bs, 1);
01435     
01436     pt.v = nthint (bs, 2);
01437     
01438     if (fllangerror)
01439         return (false);
01440     
01441     releaseheaptmp ((Handle) (*val).data.stringvalue);
01442     
01443     setpointvalue (pt, val);
01444     
01445     return (true);
01446     } /*stringtopoint*/
01447 
01448 
01449 static boolean stringtorect (tyvaluerecord *val) {
01450     
01451     Rect r;
01452     bigstring bs;
01453     
01454     pullstringvalue (val, bs);
01455     
01456     if (countwords (bs, ',') != 4) {
01457         
01458         langparamerror (rectcoerceerror, bs);
01459         
01460         return (false);
01461         }
01462     
01463     r.top = nthint (bs, 1);
01464     
01465     r.left = nthint (bs, 2);
01466     
01467     r.bottom = nthint (bs, 3);
01468     
01469     r.right = nthint (bs, 4);
01470     
01471     if (fllangerror)
01472         return (false);
01473     
01474     if (!sethandlecontents (&r, sizeof (r), (Handle) (*val).data.stringvalue))
01475         return (false);
01476     
01477     (*val).valuetype = rectvaluetype;
01478     
01479     return (true);
01480     } /*stringtorect*/
01481 
01482 
01483 static boolean stringtorgb (tyvaluerecord *val) {
01484     
01485     RGBColor rgb;
01486     bigstring bs;
01487     
01488     pullstringvalue (val, bs);
01489     
01490     if (countwords (bs, ',') != 3) {
01491         
01492         langparamerror (rgbcoerceerror, bs);
01493         
01494         return (false);
01495         }
01496     
01497     rgb.red = nthint (bs, 1);
01498     
01499     rgb.green = nthint (bs, 2);
01500     
01501     rgb.blue = nthint (bs, 3);
01502     
01503     if (fllangerror)
01504         return (false);
01505     
01506     if (!sethandlecontents (&rgb, sizeof (rgb), (Handle) (*val).data.stringvalue))
01507         return (false);
01508     
01509     (*val).valuetype = rgbvaluetype;
01510     
01511     return (true);
01512     } /*stringtorgb*/
01513 
01514 
01515 #if 0 //THINK_C
01516 
01517     #define pattern(p) (p)
01518 
01519 #else
01520     
01521     #define pattern(p) (p.pat)
01522 
01523 #endif
01524 
01525 static boolean stringtopattern (tyvaluerecord *val) {
01526     
01527 #ifdef MACVERSION
01528     /*
01529     10/14/91 dmb: implemented.
01530     */
01531     
01532     bigstring bs;
01533     Pattern pat;
01534     
01535     pullstringvalue (val, bs);
01536     
01537     subtractstrings (bs, bshexprefix, bs); /*remove prefix, if present*/
01538     
01539     if (stringlength (bs) != 16)
01540         goto error;
01541     
01542     setstringlength (bs, 8); /*limit string to 1st longword of hex digits*/
01543     
01544     if (!hexstringtonumber (bs, (long *) &pattern (pat) [0])) /*first 8 characters weren't hex*/
01545         goto error;
01546     
01547     moveleft (bs + 9, bs + 1, 8); /*shift last 8 digits into string*/
01548     
01549     if (!hexstringtonumber (bs, (long *) &pattern (pat) [4])) /*second 8 characters bytes weren't hex*/
01550         goto error;
01551     
01552     if (!sethandlecontents (&pat, sizeof (Pattern), (Handle) (*val).data.stringvalue))
01553         return (false);
01554     
01555     (*val).valuetype = patternvaluetype;
01556     
01557     return (true);
01558     
01559     error:
01560     
01561     langparamerror (patterncoerceerror, bs);
01562 #endif
01563     
01564     return (false);
01565     } /*stringtopattern*/
01566 
01567 
01568 static boolean pointtostring (Point pt, bigstring bs) {
01569     
01570     shorttostring (pt.h, bs);
01571     
01572     pushchar (',', bs);
01573     
01574     pushint (pt.v, bs);
01575     
01576     return (true);
01577     } /*pointtostring*/
01578 
01579 
01580 static boolean recttostring (Rect r, bigstring bs) {
01581     
01582     shorttostring (r.top, bs);
01583     
01584     pushchar (',', bs);
01585     
01586     pushint (r.left, bs);
01587     
01588     pushchar (',', bs);
01589     
01590     pushint (r.bottom, bs);
01591     
01592     pushchar (',', bs);
01593     
01594     pushint (r.right, bs);
01595     
01596     return (true);
01597     } /*recttostring*/
01598 
01599 
01600 static boolean rgbtostring (RGBColor rgb, bigstring bs) {
01601     
01602     shorttostring (rgb.red, bs);
01603     
01604     pushchar (',', bs);
01605     
01606     pushint (rgb.green, bs);
01607     
01608     pushchar (',', bs);
01609     
01610     pushint (rgb.blue, bs);
01611     
01612     return (true);
01613     } /*rgbtostring*/
01614 
01615 
01616 static boolean patterntostring (Pattern pat, bigstring bs) {
01617 #ifdef MACVERSION
01618     bytestohexstring (&pat, sizeof (Pattern), bs);
01619     
01620     return (true);
01621 #endif
01622 
01623 #ifdef WIN95VERSION
01624     return (false);
01625 #endif
01626     } /*patterntostring*/
01627 
01628 
01629 boolean langgetspecialtable (bigstring bs, hdlhashtable *htable) {
01630     
01631     /*
01632     return true if the string is the name of one of the special tables.
01633     
01634     10/4/91 dmb: there is only one special table name: root.  I don't think 
01635     we need to check for "compiler" here anymore.
01636     */
01637     
01638     if (equalstrings (bs, nameroottable)) {
01639         
01640         *htable = roottable;
01641         
01642         return (true); /*it is a special table*/
01643         }
01644     
01645     /*
01646     if (equalstrings (bs, nameinternaltable)) {
01647         
01648         *htable = internaltable;
01649         
01650         return (true); /%it is a special table%/
01651         }
01652     */
01653     
01654     return (false); /*it isn't a special table, not an error*/
01655     } /*langgetspecialtable*/
01656 
01657 
01658 boolean getaddresspath (tyvaluerecord val, bigstring bs) {
01659     
01660     /*
01661     if the address is in a local table, set bs to the identifier name.
01662     otherwise, set bs to the full path of the address.
01663     
01664     6/17/91 dmb: make sure table name itself is bracketed if necessary.
01665 
01666     5.0b16 dmb: must bracked locals too
01667     
01668     5.0.2b6 dmb: handle local tables that aren't stack frames
01669 
01670     5.1.4 dmb: handle unresolved addresses.
01671     
01672     6.2b18 AR: After the fix in langaddlocals in 6.2b16, scripts like following
01673     began to return unexpected results:
01674     
01675         local (adr = websites.adrdocserver); //points to a top-level GDB table
01676         msg (adr + "." + "string");
01677         
01678     This would yield D:\\docserver.root.string instead of ["D:\\docserver.root"].string.
01679     Here is where we attempt to fix it.
01680     */
01681     
01682     register hdlhashtable ht;
01683     hdlhashtable htable;
01684     bigstring bspath;
01685     
01686 #ifdef version5orgreater
01687     if (!getaddressparts (&val, &htable, bs))
01688         return (false);
01689 
01690     if (htable == (hdlhashtable) -1)
01691         return (true);
01692 
01693     if (!validhandle ((Handle) htable))
01694         htable = nil;
01695 #else
01696     if (!getaddressvalue (val, &htable, bs))
01697         return (false);
01698 #endif
01699     
01700     ht = htable; /*move into register*/
01701     
01702     if (ht == nil) { /*6.2b18 AR: What exactly does ht == nil imply?*/
01703         if (!isemptystring (bs)) /*6.2b18 AR*/
01704             langexternalbracketname (bs);           
01705         return (true);
01706         }
01707 
01708     if ((**ht).fllocaltable) {
01709         
01710         setemptystring (bspath);
01711         
01712         if ((**ht).prevhashtable == nil) // not a stack frame, has a path
01713             if (!langexternalgetquotedpath (ht, emptystring, bspath))
01714                 return (false);
01715         }
01716     else  {
01717         
01718         if (langgetspecialtable (bs, &htable) && (htable == ht)) /*"root", etc.*/
01719             return (true);
01720         
01721         if (!langexternalgetquotedpath (ht, emptystring, bspath))
01722             return (false);
01723         }
01724     
01725     if (!isemptystring (bs)) {
01726         
01727         langexternalbracketname (bs);
01728         
01729         if (!isemptystring (bspath))
01730             pushchar ('.', bspath);
01731         }
01732     
01733     insertstring (bspath, bs);
01734     
01735     return (true);
01736     } /*getaddresspath*/
01737 
01738 
01739 static boolean addresstostring (tyvaluerecord *val) {
01740     
01741     register tyvaluerecord *v = val;
01742     bigstring bspath;
01743     
01744     if (!getaddresspath (*v, bspath))
01745         return (false);
01746     
01747     releaseheaptmp ((Handle) (*v).data.addressvalue);
01748     
01749     return (setstringvalue (bspath, v));
01750     } /*addresstostring*/
01751 
01752 
01753 static boolean binarytoscalar (tyvaluerecord *val, tyvaluetype type) {
01754     
01755     /*
01756     5.0a22 dmb: handle any-endian
01757     */
01758 
01759     register tyvaluerecord *v = val;
01760     register Handle h = (*v).data.binaryvalue;
01761     tyvaluerecord scalarval;
01762     long size;
01763     long x;
01764     
01765     scalarval.valuetype = type;
01766     
01767     if (!langgetvalsize (scalarval, &size))
01768         return (false);
01769     
01770     if (gethandlesize (h) - sizeof (OSType) != (unsigned long) size) {
01771         
01772         langlongparamerror (binarycoerceerror, size);
01773         
01774         return (false);
01775         }
01776     
01777     x = 0; /*clear all bytes*/
01778     
01779     moveleft (*h + sizeof (OSType), &x, size);
01780     
01781     /*
01782     if (!(*v).fl.tmpdata)
01783     */
01784         releaseheaptmp (h);
01785     
01786     initvalue (v, type);
01787     
01788     (*v).data.longvalue = x;
01789 
01790     /*
01791     switch (size) {
01792         
01793         case 1:
01794             (*v).data.chvalue = *(byte *)&x;
01795             break;
01796         case 2:
01797             (*v).data.intvalue = conditionalshortswap (*(short *)&x);
01798             break;
01799         case 4:
01800         default:
01801             (*v).data.longvalue = conditionallongswap (x);
01802             break;
01803         }
01804     */
01805 
01806     return (true);
01807     } /*binarytoscalar*/
01808 
01809 
01810 boolean coercebinaryval (tyvaluerecord *val, tyvaluetype type, long size, tyvaluetype binarytype) {
01811     
01812     /*
01813     change the type of the given binary value to type.  if the size 
01814     parameter is greater than zero, require that the current value be 
01815     that size before doing the coersion
01816     
01817     2.1b3 dmb: added 'type' parameter for binarytype validity checking
01818     */
01819     
01820     register tyvaluerecord *v = val;
01821     OSType typeid;
01822     
01823     if (size > 0) { /*specific size required*/
01824         
01825         if (gethandlesize ((*v).data.binaryvalue) - sizeof (OSType) != (unsigned long) size) {
01826             
01827             langlongparamerror (binarycoerceerror, size);
01828             
01829             return (false);
01830             }
01831         }
01832     
01833     if (binarytype != novaluetype) { /*specific type required*/
01834         
01835         typeid = langgettypeid (binarytype);
01836         
01837         if (getbinarytypeid ((*v).data.binaryvalue) != typeid) {
01838             
01839             langostypeparamerror (binarytypecoerceerror, typeid);
01840             
01841             return (false);
01842             }
01843         }
01844     
01845     copyvaluedata (v); /*make sure we own handle*/
01846     
01847     pullfromhandle ((*v).data.binaryvalue, 0L, sizeof (typeid), &typeid);
01848     
01849     (*v).valuetype = type;
01850     
01851     return (true);
01852     } /*coercebinaryval*/
01853 
01854 
01855 boolean langcoerceerror (tyvaluerecord *val, tyvaluetype valuetype) {
01856     
01857     bigstring bstype1, bstype2;
01858     
01859     langgettypestring ((*val).valuetype, bstype1);
01860     
01861     langgettypestring (valuetype, bstype2);
01862     
01863     lang2paramerror (coercionnotpossibleerror, bstype1, bstype2);
01864     
01865     return (true);
01866     } /*langcoerceerror*/
01867 
01868 
01869 static boolean getbinarynumber (Handle x, long *n) {
01870     
01871     /*
01872     return a numeric interpretation of the binary handle.
01873     
01874     we're allowed to munge the handle; the caller will be disposing it.
01875     */
01876     
01877     register long ctbytes;
01878     
01879     ctbytes = gethandlesize (x) - sizeof (OSType);
01880     
01881     switch(ctbytes) {
01882         
01883         case 1:
01884             *n = ((*(char **) x) [4]);
01885             
01886             break;
01887         
01888         case 2:
01889             *n = conditionalshortswap ((*(short **) x) [2]);
01890             
01891             break;
01892         
01893         case 4:
01894             *n = conditionallongswap ((*(long **) x) [1]);
01895             
01896             break;
01897         
01898         default:
01899             return (false);
01900         }
01901     
01902     return (true);
01903     } /*getbinarynumber*/
01904 
01905 
01906 
01907 boolean coercetoboolean (tyvaluerecord *v) {
01908     
01909     /*
01910     2/7/92 dmb: binary to boolean is now true when non-empty, except when 
01911     it's the size of a boolean.
01912     
01913     2.1b4 dmb: handle filespec values
01914     */
01915     
01916     register boolean fl;
01917     
01918     switch ((*v).valuetype) {
01919         
01920         case booleanvaluetype:
01921             return (true);
01922         
01923         case novaluetype:
01924             if (flinhibitnilcoercion)
01925                 return (false);
01926             
01927             fl = false;
01928             
01929             break;
01930         
01931         case charvaluetype:
01932             fl = (*v).data.chvalue != 0;
01933             
01934             break;
01935         
01936         case intvaluetype:
01937             fl = (*v).data.intvalue != 0;
01938             
01939             break;
01940         
01941         case longvaluetype:
01942         case datevaluetype:
01943         case ostypevaluetype:
01944         case fixedvaluetype:
01945             fl = (*v).data.longvalue != 0;
01946             
01947             break;
01948         
01949         case enumvaluetype:
01950             fl = (*v).data.enumvalue != 0 && (*v).data.enumvalue != 'fals';
01951         
01952             break;
01953         
01954         case directionvaluetype:
01955             fl = (*v).data.dirvalue != nodirection;
01956             
01957             break;
01958         
01959         case addressvaluetype:
01960             if (!addresstostring (v))
01961                 return (false);
01962             
01963             /*no break; fall thru to string coersion*/
01964         
01965         case stringvaluetype:
01966             return (stringtoboolean (v));
01967         
01968         case singlevaluetype:
01969             fl = (*v).data.singlevalue != 0.0;
01970             
01971             break;
01972         
01973         case doublevaluetype:
01974             fl = **(*v).data.doublevalue != 0.0;
01975             
01976             break;
01977         
01978         case binaryvaluetype: {
01979             long n;
01980             register Handle x = (*v).data.binaryvalue;
01981             
01982             if (getbinarynumber (x, &n))
01983                 fl = n != 0;
01984             else
01985                 fl = gethandlesize (x) > sizeof (OSType);
01986             
01987             releaseheaptmp (x);
01988             
01989             break;
01990             }
01991         
01992         case filespecvaluetype: {
01993             bigstring bs;
01994 
01995             filegetfilename(*(*v).data.filespecvalue, bs); // 3/7/97 dmb
01996 
01997             fl = !isemptystring (bs);
01998             }
01999     //      fl = !isemptystring ((**(*v).data.filespecvalue).name);
02000             
02001             break;
02002         
02003         case listvaluetype:
02004         case recordvaluetype:
02005             return (coercelistvalue (v, booleanvaluetype));
02006         
02007         default:
02008             langerror (booleancoerceerror);
02009             
02010             return (false);
02011         } /*switch*/
02012     
02013     setbooleanvalue (fl, v);
02014     
02015     return (true);
02016     } /*coercetoboolean*/
02017 
02018 
02019 static boolean longrangeerror (double f) {
02020     
02021     bigstring bs;
02022     
02023     if ((f > 2147483647.0) || (f < -2147483648.0)) {
02024         
02025         floattostring (f, bs);
02026         
02027         langparamerror (floattolongerror, bs);
02028         
02029         return (true);
02030         }
02031     
02032     return (false);
02033     } /*longrangeerror*/
02034 
02035 
02036 boolean coercetolong (tyvaluerecord *v) {
02037     
02038     /*
02039     12/22/92 dmb: must releaseheaptmp when coercing binary type
02040     
02041     3.0.2 dmb: range check when coercing floats
02042     */
02043     
02044     register long x;
02045     register double f;
02046     
02047     switch ((*v).valuetype) {
02048         
02049         case longvaluetype:
02050             return (true);
02051         
02052         case novaluetype:
02053             if (flinhibitnilcoercion)
02054                 return (false);
02055             
02056             x = (long) 0;
02057             
02058             break;
02059         
02060         case booleanvaluetype:
02061             x = (long) (*v).data.flvalue;
02062             
02063             break;
02064         
02065         case charvaluetype:
02066             x = (long) (*v).data.chvalue;
02067             
02068             break;
02069         
02070         case intvaluetype:
02071             x = (long) (*v).data.intvalue;
02072             
02073             break;
02074         
02075         case directionvaluetype:
02076             x = (long) (*v).data.dirvalue;
02077             
02078             break;
02079         
02080         case datevaluetype:
02081             x = (long) (*v).data.datevalue;
02082             
02083             break;
02084         
02085         case stringvaluetype:
02086             return (stringtolong (v));
02087         
02088         case ostypevaluetype:
02089         case pointvaluetype:
02090             x = (long) (*v).data.ostypevalue;
02091             
02092             break;
02093 
02094 #ifdef MACVERSION       
02095         case fixedvaluetype:
02096             x = (long) FixRound ((*v).data.fixedvalue);
02097             
02098             break;
02099 #endif
02100             
02101         case singlevaluetype:
02102             f = (*v).data.singlevalue;
02103             
02104             if (longrangeerror (f))
02105                 return (false);
02106             
02107             x = (long) f;
02108             
02109             break;
02110         
02111         case doublevaluetype:
02112             f = **(*v).data.doublevalue;
02113             
02114             if (longrangeerror (f))
02115                 return (false);
02116             
02117             x = (long) f;
02118             
02119             break;
02120         
02121         case binaryvaluetype: {
02122             long n;
02123             register Handle h = (*v).data.binaryvalue;
02124             
02125             if (!getbinarynumber (h, &n))
02126                 return (binarytoscalar (v, longvaluetype));
02127             
02128             x = n;
02129             
02130             releaseheaptmp (h);
02131             
02132             break;
02133             }
02134         
02135         case listvaluetype:
02136         case recordvaluetype:
02137             return (coercelistvalue (v, longvaluetype));
02138         
02139         default:
02140             langerror (longcoerceerror);
02141             
02142             return (false);
02143         } /*switch*/
02144     
02145     return (setlongvalue (x, v));
02146     } /*coercetolong*/
02147 
02148 
02149 static boolean coercetolongfortype (tyvaluerecord *v, tyvaluetype type) {
02150     
02151     boolean fl;
02152     
02153     disablelangerror ();
02154     
02155     fl = coercetolong (v);
02156     
02157     enablelangerror ();
02158     
02159     if (!fl)
02160         langcoerceerror (v, type);
02161     
02162     return (fl);
02163     } /*coercetolongfortype*/
02164 
02165 
02166 boolean coercetoint (tyvaluerecord *v) {
02167     
02168     /*
02169     4/26/96 4.0b7 dmb: special case novaluetype since flinhibitnilcoercion can't
02170     pass though coercetolongfortype
02171     */
02172     
02173     register long x;
02174     
02175     switch ((*v).valuetype) {
02176         
02177         case intvaluetype:
02178             return (true);
02179         
02180         case novaluetype:
02181             if (flinhibitnilcoercion)
02182                 return (false);
02183             
02184             x = 0;
02185             
02186             break;
02187         
02188         case binaryvaluetype: {
02189             long n;
02190             register Handle h = (*v).data.binaryvalue;
02191             
02192             if (!getbinarynumber (h, &n))
02193                 return (binarytoscalar (v, intvaluetype));
02194             
02195             x = n;
02196             
02197             releaseheaptmp (h);
02198             
02199             break;
02200             }
02201         
02202         case stringvaluetype:
02203             if (!stringtolong (v))
02204                 return (false);
02205             
02206             x = (*v).data.longvalue;
02207             
02208             break;
02209         
02210         case listvaluetype:
02211         case recordvaluetype:
02212             return (coercelistvalue (v, intvaluetype));
02213         
02214         default:
02215             if (!coercetolongfortype (v, intvaluetype))
02216                 return (false);
02217             
02218             x = (*v).data.longvalue;
02219         }
02220     
02221     if (x > intinfinity) {
02222         
02223         if (x == longinfinity) /*the one exception to the rule*/
02224         
02225             x = intinfinity; /*trade the long version of infinity for the short version*/
02226             
02227         else {
02228             
02229             langlongparamerror (inttoolargeerror, x);
02230             
02231             return (false);
02232             }
02233         }
02234     
02235     if (x < intminusinfinity) {
02236         
02237         langlongparamerror (inttoosmallerror, x);
02238         
02239         return (false);
02240         }
02241     
02242     return (setintvalue ((short) x, v));
02243     } /*coercetoint*/
02244 
02245 
02246 static boolean coercetochar (tyvaluerecord *v) {
02247     
02248     register long x;
02249     
02250     switch ((*v).valuetype) {
02251         
02252         case charvaluetype:
02253             return (true);
02254         
02255         case novaluetype:
02256             if (flinhibitnilcoercion)
02257                 return (false);
02258             
02259             x = (long) '0';
02260             
02261             break;
02262         
02263         case booleanvaluetype:
02264             x = (long) (*v).data.flvalue;
02265             
02266             break;
02267         
02268         case intvaluetype:
02269             x = (long) (*v).data.intvalue;
02270             
02271             break;
02272         
02273         case stringvaluetype:
02274             return (stringtochar (v));
02275         
02276         case longvaluetype:
02277             x = (long) (*v).data.longvalue;
02278             
02279             break;  
02280             
02281         case directionvaluetype:
02282             x = (long) (*v).data.dirvalue;
02283             
02284             break;
02285         
02286         case binaryvaluetype:
02287             return (binarytoscalar (v, charvaluetype));
02288         
02289         case listvaluetype:
02290         case recordvaluetype:
02291             return (coercelistvalue (v, charvaluetype));
02292         
02293         default:
02294             langerror (charcoerceerror);
02295             
02296             return (false);
02297         } /*switch*/
02298     
02299     if ((x < 0) || (x > 255)) {
02300         
02301         langlongparamerror (charoutofrangeerror, x);
02302         
02303         return (false);
02304         }
02305     
02306     setcharvalue ((byte) x, v);
02307     
02308     return (true);
02309     } /*coercetochar*/
02310 
02311 
02312 static boolean coercetodirection (tyvaluerecord *v) {
02313     
02314     register tydirection x;
02315     
02316     switch ((*v).valuetype) {
02317         
02318         case directionvaluetype:
02319             return (true);
02320         
02321         case novaluetype:
02322             if (flinhibitnilcoercion)
02323                 return (false);
02324             
02325             x = (tydirection) nodirection;
02326             
02327             break;
02328         
02329         case longvaluetype:
02330         case ostypevaluetype:
02331             x = (tydirection) (*v).data.longvalue;
02332             
02333             break;
02334             
02335         case datevaluetype:
02336             x = (tydirection) (*v).data.datevalue;
02337             
02338             break;
02339         
02340         case booleanvaluetype:
02341             x = (tydirection) (*v).data.flvalue;
02342             
02343             break;
02344         
02345         case charvaluetype:
02346             x = (tydirection) (*v).data.chvalue;
02347             
02348             break;
02349         
02350         case intvaluetype:
02351             x = (tydirection) (*v).data.intvalue;
02352             
02353             break;
02354             
02355         case stringvaluetype:
02356             return (stringtodirection (v));
02357         
02358         case binaryvaluetype:
02359             return (binarytoscalar (v, directionvaluetype));
02360         
02361         case listvaluetype:
02362         case recordvaluetype:
02363             return (coercelistvalue (v, directionvaluetype));
02364         
02365         default:
02366             langcoerceerror (v, directionvaluetype);
02367             
02368             return (false);
02369         } /*switch*/
02370     
02371     if (!validdirection (x)) {
02372         
02373         langerror (invaliddirectionerror);
02374         
02375         return (false);
02376         }
02377     
02378     setdirectionvalue (x, v);
02379     
02380     return (true);
02381     } /*coercetodirection*/
02382     
02383 
02384 static boolean coercetodate (tyvaluerecord *v) {
02385     
02386     /*
02387     9/13/91 dmb: use new stringtotime to coerce from string
02388     */
02389     
02390     register long x;
02391     
02392     switch ((*v).valuetype) {
02393         
02394         case datevaluetype:
02395             return (true);
02396         
02397         case novaluetype: {
02398             if (flinhibitnilcoercion)
02399                 return (false);
02400             
02401             x = timenow ();
02402             
02403             break;
02404             }
02405         
02406         case longvaluetype:
02407         case ostypevaluetype:
02408             x = (*v).data.longvalue;
02409             
02410             break;
02411         
02412         case charvaluetype:
02413             x = (long) (*v).data.chvalue;
02414             
02415             break;
02416         
02417         case booleanvaluetype:
02418             x = (long) (*v).data.flvalue;
02419             
02420             break;
02421         
02422         case intvaluetype:
02423             x = (long) (*v).data.intvalue;
02424             
02425             break;
02426             
02427         case directionvaluetype:
02428             x = (long) (*v).data.dirvalue;
02429             
02430             break;
02431         
02432         case stringvaluetype: {
02433             bigstring bs;
02434             unsigned long ltime;
02435             
02436             pullstringvalue (v, bs);
02437             
02438             if (!stringtotime (bs, &ltime)) {
02439                 
02440                 langerror (datecoerceerror);
02441                 
02442                 return (false);
02443                 }
02444             
02445             x = ltime;
02446             
02447             break;
02448             }
02449         
02450         case binaryvaluetype:
02451             return (binarytoscalar (v, datevaluetype));
02452         
02453         case listvaluetype:
02454         case recordvaluetype:
02455             return (coercelistvalue (v, datevaluetype));
02456         
02457         default:
02458             langerror (datecoerceerror);
02459             
02460             return (false);
02461         } /*switch*/
02462     
02463     setdatevalue (x, v);
02464     
02465     return (true);
02466     } /*coercetodate*/
02467 
02468 
02469 boolean coercetoostype (tyvaluerecord *v) {
02470     
02471     register OSType x;
02472     
02473     switch ((*v).valuetype) {
02474         
02475         case ostypevaluetype:
02476             return (true);
02477         
02478         case novaluetype:
02479             if (flinhibitnilcoercion)
02480                 return (false);
02481             
02482             x = (OSType) '\?\?\?\?';
02483             
02484             break;
02485         
02486         case longvaluetype:
02487         case enumvaluetype:
02488             x = (OSType) (*v).data.longvalue;
02489             
02490             break;
02491         
02492         case directionvaluetype:
02493             x = (OSType) (*v).data.dirvalue;
02494             
02495             break;
02496         
02497         case datevaluetype:
02498             x = (OSType) (*v).data.datevalue;
02499             
02500             break;
02501         
02502         case booleanvaluetype:
02503             x = (OSType) (*v).data.flvalue;
02504             
02505             break;
02506         
02507         case charvaluetype:
02508             x = (OSType) (*v).data.chvalue;
02509             
02510             break;
02511         
02512         case intvaluetype:
02513             x = (OSType) (*v).data.intvalue;
02514             
02515             break;
02516         
02517         case stringvaluetype:
02518             return (langstringtoostype (v));
02519         
02520         case binaryvaluetype:
02521             return (binarytoscalar (v, ostypevaluetype));
02522         
02523         case listvaluetype:
02524         case recordvaluetype:
02525             return (coercelistvalue (v, ostypevaluetype));
02526         
02527         default:
02528             langcoerceerror (v, ostypevaluetype);
02529             
02530             return (false);
02531         } /*switch*/
02532     
02533     setostypevalue (x, v);
02534     
02535     return (true);
02536     } /*coercetoostype*/
02537 
02538 
02539 static boolean coercetopoint (tyvaluerecord *v) {
02540     
02541     register Point x;
02542     
02543     switch ((*v).valuetype) {
02544         
02545         case pointvaluetype:
02546             return (true);
02547         
02548         case novaluetype:
02549             if (flinhibitnilcoercion)
02550                 return (false);
02551             
02552             x.h = x.v = 0;
02553             
02554             break;
02555         
02556         case ostypevaluetype:
02557         case longvaluetype:
02558             x = *(Point *) &(*v).data.longvalue;
02559             
02560             break;
02561         
02562         case stringvaluetype:
02563             return (stringtopoint (v));
02564         
02565         case binaryvaluetype:
02566             return (binarytoscalar (v, pointvaluetype));
02567         
02568         case listvaluetype:
02569         case recordvaluetype:
02570             return (coercelistvalue (v, pointvaluetype));
02571         
02572         default:
02573             langcoerceerror (v, pointvaluetype);
02574             
02575             return (false);
02576         } /*switch*/
02577     
02578     setpointvalue (x, v);
02579     
02580     return (true);
02581     } /*coercetopoint*/
02582 
02583 
02584 static boolean newheaprecordvalue (long size, tyvaluetype type, tyvaluerecord *val) {
02585     
02586     Handle x;
02587     
02588     if (!newclearhandle (size, &x))
02589         return (false);
02590     
02591     return (setheapvalue (x, type, val));
02592     } /*newheaprecordvalue*/
02593 
02594 
02595 static boolean coercetorect (tyvaluerecord *v) {
02596     
02597     switch ((*v).valuetype) {
02598         
02599         case rectvaluetype:
02600             return (true);
02601         
02602         case novaluetype:
02603             if (flinhibitnilcoercion)
02604                 return (false);
02605             
02606             return (newheaprecordvalue (sizeof (Rect), rectvaluetype, v));
02607         
02608         case stringvaluetype:
02609             return (stringtorect (v));
02610         
02611         case binaryvaluetype:
02612             return (coercebinaryval (v, rectvaluetype, sizeof (Rect), novaluetype));
02613         
02614         case listvaluetype:
02615         case recordvaluetype:
02616             return (coercelistvalue (v, rectvaluetype));
02617         
02618         default:
02619             langcoerceerror (v, rectvaluetype);
02620             
02621             return (false);
02622         } /*switch*/
02623     } /*coercetorect*/
02624 
02625 
02626 boolean coercetorgb (tyvaluerecord *v) {
02627     
02628     switch ((*v).valuetype) {
02629         
02630         case rgbvaluetype:
02631             return (true);
02632         
02633         case novaluetype:
02634             if (flinhibitnilcoercion)
02635                 return (false);
02636             
02637             return (newheaprecordvalue (sizeof (RGBColor), rgbvaluetype, v));
02638         
02639         case stringvaluetype:
02640             return (stringtorgb (v));
02641         
02642         case binaryvaluetype:
02643             return (coercebinaryval (v, rgbvaluetype, sizeof (RGBColor), novaluetype));
02644         
02645         case listvaluetype:
02646         case recordvaluetype:
02647             return (coercelistvalue (v, rgbvaluetype));
02648         
02649         default:
02650             langcoerceerror (v, rgbvaluetype);
02651             
02652             return (false);
02653         } /*switch*/
02654     } /*coercetorgb*/
02655 
02656 
02657 static boolean coercetopattern (tyvaluerecord *v) {
02658 #ifdef MACVERSION   
02659     switch ((*v).valuetype) {
02660         
02661         case patternvaluetype:
02662             return (true);
02663         
02664         case novaluetype:
02665             if (flinhibitnilcoercion)
02666                 return (false);
02667             
02668             return (newheaprecordvalue (sizeof (Pattern), patternvaluetype, v));
02669         
02670         case stringvaluetype:
02671             return (stringtopattern (v));
02672         
02673         case binaryvaluetype:
02674             return (coercebinaryval (v, patternvaluetype, sizeof (Pattern), novaluetype));
02675         
02676         case listvaluetype:
02677         case recordvaluetype:
02678             return (coercelistvalue (v, patternvaluetype));
02679         
02680         default:
02681             langcoerceerror (v, patternvaluetype);
02682             
02683             return (false);
02684         } /*switch*/
02685 #endif
02686 
02687 #ifdef WIN95VERSION
02688     return (false);
02689 #endif
02690     } /*coercetopattern*/
02691 
02692 
02693 static boolean coercetofixed (tyvaluerecord *v) {
02694 #ifdef MACVERSION   
02695     /*
02696     6/29/92 dmb: added support for single & double types
02697     
02698     4/26/96 4.0b7 dmb: special case novaluetype since flinhibitnilcoercion can't
02699     pass though coercetolongfortype
02700     */
02701     
02702     Fixed x;
02703     
02704     switch ((*v).valuetype) {
02705         
02706         case fixedvaluetype:
02707             return (true);
02708         
02709         case novaluetype:
02710             if (flinhibitnilcoercion)
02711                 return (false);
02712             
02713             x = 0;
02714             
02715             break;
02716         
02717         /*
02718         case stringvaluetype:
02719             return (stringtofixed (v));
02720         */
02721         
02722         case singlevaluetype:
02723             x = (Fixed) (long) ((*v).data.singlevalue * 65536.0);
02724             
02725             break;
02726         
02727         case doublevaluetype:
02728             x = (Fixed) (long) (**(*v).data.doublevalue * 65536.0);
02729             
02730             releaseheaptmp ((Handle) (*v).data.doublevalue);
02731             
02732             break;
02733         
02734         case binaryvaluetype:
02735             return (binarytoscalar (v, fixedvaluetype));
02736         
02737         case listvaluetype:
02738         case recordvaluetype:
02739             return (coercelistvalue (v, fixedvaluetype));
02740         
02741         default:
02742             if (!coercetolongfortype (v, fixedvaluetype))
02743                 return (false);
02744             
02745             if (!coercetoint (v)) /*may generate range-checking error*/
02746                 return (false);
02747             
02748             x = FixRatio ((*v).data.intvalue, 1);
02749             
02750             break;
02751         } /*switch*/
02752     
02753     return (setfixedvalue (x, v));
02754 #endif
02755 
02756 #ifdef WIN95VERSION
02757     langparamerror (unimplementedverberror, bsfunctionname);
02758 
02759     return (false);
02760 #endif
02761     } /*coercetofixed*/
02762 
02763 
02764 static boolean coercetosingle (tyvaluerecord *v) {
02765     
02766     /*
02767     6/29/92 dmb: added support for non-trucated fixed->float coercion
02768     
02769     4/26/96 4.0b7 dmb: special case novaluetype since flinhibitnilcoercion can't
02770     pass though coercetolongfortype
02771     */
02772     
02773     float x;
02774     
02775     switch ((*v).valuetype) {
02776         
02777         case singlevaluetype:
02778             return (true);
02779         
02780         case doublevaluetype:
02781             x = (float) **(*v).data.doublevalue;
02782             
02783             break;
02784         
02785         case novaluetype:
02786             if (flinhibitnilcoercion)
02787                 return (false);
02788             
02789             x = (float) 0.0;
02790             
02791             break;
02792         
02793         case fixedvaluetype:
02794             x = (float) ((*v).data.longvalue / 65536.0);
02795             
02796             break;
02797         
02798         case stringvaluetype: {
02799             double d;
02800             bigstring bs;
02801             
02802             pullstringvalue (v, bs);
02803             
02804             if (!stringtofloat (bs, &d)) {
02805                 
02806                 langparamerror (floatcoerceerror, bs);
02807                 
02808                 return (false);
02809                 }
02810             
02811             x = (float) d;
02812             
02813             break;
02814             }
02815         
02816         case binaryvaluetype:
02817             return (binarytoscalar (v, singlevaluetype));
02818         
02819         case listvaluetype:
02820         case recordvaluetype:
02821             return (coercelistvalue (v, singlevaluetype));
02822         
02823         default:
02824             if (!coercetolongfortype (v, singlevaluetype))
02825                 return (false);
02826             
02827             x = (float) (*v).data.longvalue;
02828             
02829             break;
02830         } /*switch*/
02831     
02832     disposevaluerecord (*v, true);
02833     
02834     return (setsinglevalue (x, v));
02835     } /*coercetosingle*/
02836 
02837 
02838 static boolean coercetodouble (tyvaluerecord *v) {
02839     
02840     /*
02841     3/5/92 dmb: added missing break statement in singlevaluetype case, fixing bus error
02842     
02843     6/29/92 dmb: added support for non-trucated fixed->double coercion
02844     
02845     12/21/92 dmb: added case for datetype to preserve unsigned-ness
02846     
02847     4/26/96 4.0b7 dmb: special case novaluetype since flinhibitnilcoercion can't
02848     pass though coercetolongfortype
02849     */
02850     
02851     double x;
02852     
02853     switch ((*v).valuetype) {
02854         
02855         case doublevaluetype:
02856             return (true);
02857         
02858         case singlevaluetype:
02859             x = (*v).data.singlevalue;
02860             
02861             break;
02862         
02863         case novaluetype:
02864             if (flinhibitnilcoercion)
02865                 return (false);
02866             
02867             x = 0.0;
02868             
02869             break;
02870         
02871         case stringvaluetype: {
02872             bigstring bs;
02873             
02874             pullstringvalue (v, bs);
02875             
02876             if (!stringtofloat (bs, &x)) {
02877                 
02878                 langparamerror (floatcoerceerror, bs);
02879                 
02880                 return (false);
02881                 }
02882             
02883             break;
02884             }
02885         
02886         case fixedvaluetype:
02887             x = (double) (*v).data.longvalue / 65536.0;
02888             
02889             break;
02890         
02891         case datevaluetype:
02892             x = (double) (*v).data.datevalue;
02893             
02894             break;
02895         
02896         case binaryvaluetype:
02897 #if noextended
02898         {
02899             long double lx;
02900             extended80 x80;
02901 
02902             /*first do type & length checking, resulting in x80 value in v*/
02903 
02904                 if (!coercebinaryval (v, doublevaluetype, sizeof (extended80), novaluetype))
02905                 return (false);
02906 
02907             /*now convert to actual double value*/
02908 
02909 #ifdef WIN95VERSION
02910             memmove (&x80, *((*v).data.doublevalue), sizeof (x80));
02911 
02912             convertFromMacExtended (&lx, &x80);
02913 #else
02914             x80 = (**(extended80 **) (*v).data.doublevalue);
02915 
02916             safex80told (&x80, &lx);
02917 #endif
02918             return (setdoublevalue (lx, v));
02919         }
02920 #else
02921 
02922             return (coercebinaryval (v, doublevaluetype, sizeof (double), novaluetype));
02923 
02924             #endif
02925         
02926         case listvaluetype:
02927         case recordvaluetype:
02928             return (coercelistvalue (v, doublevaluetype));
02929         
02930         default:
02931             if (!coercetolongfortype (v, doublevaluetype))
02932                 return (false);
02933             
02934             x = (*v).data.longvalue;
02935             
02936             break;
02937         } /*switch*/
02938     
02939     disposevaluerecord (*v, true);
02940     
02941     return (newheapvalue (&x, sizeof (x), doublevaluetype, v));
02942     } /*coercetodouble*/
02943 
02944 
02945 static unsigned char hexchartonum (unsigned char ch) {
02946 
02947     if ((ch >= 'a') && (ch <= 'z')) /*DW 10/13/95 -- fix for toys.parseArgs*/
02948         ch -= 32;
02949 
02950     if ((ch >= '0') && (ch <= '9'))
02951         ch = ch - '0';
02952     else
02953         ch = (ch - 'A') + 10;
02954     
02955     return (ch);
02956     } /*hexchartonum*/
02957 
02958 static void decode (bigstring bs) {
02959     unsigned long ixtext, lentext;
02960     unsigned char *p;
02961 
02962     p = (unsigned char *) stringbaseaddress (bs);
02963 
02964     lentext = stringlength (bs);
02965 
02966     ixtext = 0;
02967 
02968     while (true) {
02969 
02970         if (ixtext >= lentext)
02971             break;
02972 
02973         switch (*p) {
02974 
02975             case '%': {
02976                 unsigned char ch1 = *(p + 1), ch2 = *(p + 2);
02977 
02978                 /*{Str255 s; s [0] = 3; s [1] = '%'; s [2] = ch1; s [3] = ch2; DebugStr (s);}*/
02979 
02980                 *p = (hexchartonum (ch1) * 16) + hexchartonum (ch2);
02981                 
02982                 moveleft (p + 3, p + 1, lentext - ixtext - 3);
02983 
02984                 lentext -= 2;
02985 
02986                 break;
02987                 }
02988 
02989             case '+':
02990                 *p = ' ';
02991 
02992                 break;
02993             } /*switch*/
02994 
02995         p++;
02996 
02997         ixtext++;
02998         } /*while*/
02999 
03000     setstringlength (bs, lentext);
03001     } /*decode*/
03002 
03003 
03004 boolean coercetofilespec (tyvaluerecord *v) {
03005     
03006     /*
03007     2.1b2 dmb: don't enforce any particular size when coercing from binary; 
03008     filespecs are now variable-length
03009     
03010     2.1b3 dmb: coerce zero to nil filespec
03011     
03012     2.1b12 dmb: changed string->filespec error message to be filenotfounderror
03013     */
03014     
03015     bigstring bs;
03016     byte fileurl [] = "\x08" "file:///";
03017     tyfilespec fs;
03018     
03019     switch ((*v).valuetype) {
03020         
03021         case filespecvaluetype:
03022             return (true);
03023         
03024         case novaluetype:
03025             if (flinhibitnilcoercion)
03026                 return (false);
03027             
03028             clearbytes (&fs, sizeof (fs));
03029             
03030             break;
03031         
03032         case longvaluetype:
03033             if ((*v).data.longvalue == 0)
03034                 clearbytes (&fs, sizeof (fs));
03035             else
03036                 langcoerceerror (v, filespecvaluetype);
03037             
03038             break;
03039         
03040         case stringvaluetype:
03041             pullstringvalue (v, bs);
03042                 
03043             if (equaltextidentifiers (stringbaseaddress(bs), stringbaseaddress(fileurl), stringlength(fileurl) )) {
03044                 
03045                 #ifdef WIN95VERSION
03046                 short ix = 0;
03047                 #endif
03048                 
03049                 /* Convert string to standard file string.*/
03050                 deletestring (bs, 1, stringlength (fileurl));
03051                 
03052                 decode (bs);
03053 
03054                 #ifdef MACVERSION
03055                     stringreplaceall ('/', ':', bs);
03056                 #endif
03057                 #ifdef WIN95VERSION
03058                     if (scanstring ('/', bs, &ix)) {
03059                         if (getstringcharacter(bs, ix-2) != ':')
03060                             midinsertstring ("\x01" ":", bs, ix);
03061                         }
03062 
03063                     stringreplaceall ('/', '\\', bs);
03064                 #endif
03065                 }
03066             
03067             if (!pathtofilespec (bs, &fs)) {
03068                 
03069                 filenotfounderror (bs);
03070                 
03071                 /*
03072                 langparamerror (filespeccoerceerror, bs);
03073                 */
03074                 
03075                 return (false);
03076                 }
03077             
03078             break;
03079         
03080         case binaryvaluetype:
03081             return (coercebinaryval (v, filespecvaluetype, 0L, filespecvaluetype));
03082         
03083         case listvaluetype:
03084         case recordvaluetype:
03085             return (coercelistvalue (v, filespecvaluetype));
03086         
03087         case aliasvaluetype:
03088             if (!aliastofilespec ((AliasHandle) (*v).data.aliasvalue, &fs))
03089                 return (false);
03090             
03091             break;
03092         
03093         case objspecvaluetype:
03094             return (objspectofilespec (v));
03095         
03096         default:
03097             langcoerceerror (v, filespecvaluetype);
03098             
03099             return (false);
03100         } /*switch*/
03101     
03102     disposevaluerecord (*v, true);
03103     
03104     return (newheapvalue (&fs, sizeof (fs), filespecvaluetype, v)); 
03105     } /*coercetofilespec*/
03106 
03107 
03108 static void  bigvaltostring (tyvaluerecord *v, bigstring bs) {
03109     
03110     /*
03111     7.0b59 PBS: fixed overflow bug by making bsval larger.
03112     A string such as "12345 characters" would cause an overflow of one byte.
03113     */
03114 
03115     //byte bsval [16];
03116     byte bsval [32];
03117     
03118     hashgettypestring (*v, bs);
03119     
03120     pushchar (':', bs);
03121     pushchar (' ', bs);
03122     
03123     hashgetvaluestring (*v, bsval);
03124     
03125     pushstring (bsval, bs);
03126     } /*bigvaltostring*/
03127 
03128 
03129 boolean coercetostring (tyvaluerecord *val) {
03130     
03131     /*
03132     8/10/92 dmb: added flcoerceexternaltostring flag to prevent external-to-string 
03133     coercion except when explicitly requested by stringfunc in langverbs.c
03134     
03135     2.1b3 dmb: don't ignore return value from objspectostring
03136     
03137     4.1b4 dmb: if flcoerceexternaltostring is not enabled, create a 
03138     reasonable display string for externals
03139     */
03140     
03141     register tyvaluerecord *v = val;
03142     bigstring bs;
03143     Handle h;
03144     
03145     if (!langheapallocated (v, &h))
03146         h = nil;
03147     
03148     switch ((*v).valuetype) {
03149         
03150         case stringvaluetype:
03151             return (true);
03152         
03153         case novaluetype:
03154             if (flinhibitnilcoercion)
03155                 return (false);
03156             
03157             setemptystring (bs);
03158             
03159             break;
03160         
03161         /*
03162         case passwordvaluetype:
03163             (*v).valuetype = stringvaluetype;
03164             
03165             return (true);
03166         */
03167         
03168         case addressvaluetype:
03169             return (addresstostring (v));
03170         
03171         case booleanvaluetype:
03172             if ((*v).data.flvalue)
03173                 copystring (bstrue, bs);
03174             else
03175                 copystring (bsfalse, bs);
03176             
03177             break;
03178             
03179         case charvaluetype:
03180             setstringwithchar ((*v).data.chvalue, bs);
03181             
03182             break;
03183         
03184         case intvaluetype:
03185             shorttostring ((*v).data.intvalue, bs);
03186             
03187             break;
03188         
03189         case longvaluetype:
03190             numbertostring ((*v).data.longvalue, bs);
03191             
03192             break;
03193         
03194         case ostypevaluetype:
03195         case enumvaluetype:
03196             ostypetostring ((*v).data.ostypevalue, bs);
03197             
03198             break;
03199         
03200         case directionvaluetype:
03201             dirtostring ((*v).data.dirvalue, bs);
03202             
03203             break;
03204         
03205         case datevaluetype:
03206             timedatestring ((*v).data.datevalue, bs);
03207             
03208             break;
03209         
03210         case fixedvaluetype: {
03211             double x = (double) (*v).data.longvalue / 65536;
03212             
03213             floattostring (x, bs);
03214             
03215             /*
03216             shorttostring (FixRound ((*v).data.fixedvalue), bs);
03217             */
03218             
03219             break;
03220             }
03221         
03222         case singlevaluetype:
03223             floattostring ((*v).data.singlevalue, bs);
03224             
03225             break;
03226         
03227         case doublevaluetype:
03228             floattostring (**(*v).data.doublevalue, bs);
03229             
03230             break;
03231         
03232         case pointvaluetype:
03233             pointtostring ((*v).data.pointvalue, bs);
03234             
03235             break;
03236         
03237         case rectvaluetype:
03238             recttostring (**(*v).data.rectvalue, bs);
03239             
03240             break;
03241         
03242         case rgbvaluetype:
03243             rgbtostring (**(*v).data.rgbvalue, bs);
03244             
03245             break;
03246         
03247         case patternvaluetype:
03248             patterntostring (**(*v).data.patternvalue, bs);
03249             
03250             break;
03251         
03252         case objspecvaluetype:
03253             if (!objspectostring ((*v).data.objspecvalue, bs))
03254                 return (false);
03255             
03256             break;
03257         
03258         case aliasvaluetype:
03259             aliastostring ((*v).data.aliasvalue, bs);
03260             
03261             break;
03262         
03263         case filespecvaluetype: {
03264 
03265             tyfilespec fs;
03266             
03267             #if TARGET_API_MAC_CARBON == 1
03268             
03269                 fs.vRefNum = (**(*v).data.filespecvalue).vRefNum;
03270         
03271                 fs.parID = (**(*v).data.filespecvalue).parID;
03272         
03273                 copystring ((**(*v).data.filespecvalue).name, fs.name);
03274                 
03275             #else
03276             
03277                 fs = **(*v).data.filespecvalue;
03278                         
03279             #endif
03280             
03281             filespectopath (&fs, bs);
03282             
03283             break;
03284             }
03285         
03286         case binaryvaluetype:
03287             if (!copyvaluedata (v))
03288                 return (false);
03289             
03290             stripbinarytypeid ((*v).data.binaryvalue);
03291             
03292             (*v).valuetype = stringvaluetype;
03293             
03294             return (true);
03295         
03296         case listvaluetype:
03297         case recordvaluetype:
03298             return (coercelistvalue (v, stringvaluetype));
03299         
03300         case codevaluetype:
03301             bigvaltostring (v, bs);
03302             
03303             break;
03304             
03305         case externalvaluetype:
03306             if (!flcoerceexternaltostring) {
03307                 
03308                 /* 4.1b4 dmb*/
03309                 /*
03310                 langbadexternaloperror (badexternaloperationerror, *v);
03311                 return (false);
03312                 */
03313                 bigvaltostring (v, bs);
03314                 
03315                 break;
03316                 }
03317             
03318             if (!newemptyhandle (&h))
03319                 return (false);
03320             
03321             if (!langexternalpacktotext ((hdlexternalhandle) (*v).data.externalvalue, h)) {
03322                 
03323                 disposehandle (h);
03324                 
03325                 return (false);
03326                 }
03327             
03328             disposevaluerecord (*v, true);
03329             
03330             return (setheapvalue (h, stringvaluetype, v));
03331         
03332         default:
03333             langerror (stringcoerceerror);
03334             
03335             return (false);
03336         } /*switch*/
03337     
03338     disposevaluerecord (*v, true);
03339     
03340     return (setstringvalue (bs, v));
03341     } /*coercetostring*/
03342 
03343 
03344 boolean coercetoaddress (tyvaluerecord *v) {
03345     
03346     /*
03347     9/23/92 dmb: use new objspectoaddress for special obj specifier handling
03348     */
03349     
03350     register tyvaluetype type = (*v).valuetype;
03351     bigstring bs;
03352     boolean fl;
03353     
03354     if (type == addressvaluetype)
03355         return (true);
03356     
03357     disablelangerror ();
03358     
03359     if (type == objspecvaluetype) /*special case; don't want use string representation*/
03360         fl = objspectoaddress (v);
03361     else
03362         fl = coercetostring (v) && stringtoaddress (v);
03363     
03364     enablelangerror ();
03365     
03366     if (!fl) {
03367         
03368         coercetostring (v);
03369         
03370         pullstringvalue (v, bs);
03371         
03372         langparamerror (addresscoerceerror, bs);
03373         
03374         return (false);
03375         }
03376     
03377     return (true);
03378     } /*coercetoaddress*/
03379 
03380 
03381 boolean coercetobinary (tyvaluerecord *val) {
03382     
03383     /*
03384     12/24/91 dmb: added special case for coercing null objspec
03385     */
03386     
03387     register tyvaluerecord *v = val;
03388     OSType typeid;
03389     
03390     typeid = langgettypeid ((*v).valuetype);
03391     
03392     switch ((*v).valuetype) {
03393         
03394         case binaryvaluetype:
03395             return (true);
03396         
03397         case novaluetype:
03398             if (flinhibitnilcoercion)
03399                 return (false);
03400             
03401             if (!setstringvalue (emptystring, v))
03402                 return (false);
03403             
03404             break;
03405         
03406         #if noextended
03407             
03408             case doublevaluetype: {
03409                 Handle x;
03410                 
03411                 if (!langpackvalue (*v, &x, HNoNode))
03412                     return (false);
03413                 
03414                 return (setheapvalue (x, binaryvaluetype, v));
03415                 }
03416         
03417         #else
03418         
03419             case doublevaluetype:
03420             
03421         #endif
03422         
03423         #ifndef oplanglists
03424             case listvaluetype:
03425             case recordvaluetype:
03426         #endif
03427         case stringvaluetype:
03428         case passwordvaluetype:
03429         case rectvaluetype:
03430         case patternvaluetype:
03431         case rgbvaluetype:
03432         case filespecvaluetype:
03433         case aliasvaluetype:
03434             break;
03435         
03436         #ifdef oplanglists
03437             case listvaluetype:
03438             case recordvaluetype: {
03439                 Handle x;
03440                 
03441                 if (!langpackvalue (*v, &x, HNoNode))
03442                     return (false);
03443                 
03444                 return (setheapvalue (x, binaryvaluetype, v));
03445                 }
03446         #endif
03447         
03448         case objspecvaluetype:
03449             if ((*v).data.objspecvalue == nil) { /*null spec; special case*/
03450                 
03451                 if (!setstringvalue (zerostring, v))
03452                     return (false);
03453                 
03454                 typeid = 'null';
03455                 }
03456             
03457             break;
03458         
03459         default: {
03460                 Handle x;
03461                 
03462                 if (!langpackvalue (*v, &x, HNoNode))
03463                     return (false);
03464                 
03465                 return (setheapvalue (x, binaryvaluetype, v));
03466                 }
03467             
03468             langerror (cantcoercetobinaryerror);
03469             
03470             return (false);
03471         } /*switch*/
03472     
03473     memtodisklong (typeid);
03474 
03475     if (!insertinhandle ((*v).data.binaryvalue, 0L, &typeid, sizeof (typeid)))
03476         return (false);
03477     
03478     (*v).valuetype = binaryvaluetype;
03479     
03480     (*v).fltmpdata = 0;
03481     
03482     return (true);
03483     } /*coercetobinary*/
03484 
03485 /*
03486 boolean truevalue (tyvaluerecord val) { //6.2b15 AR: removed because the return value of coercetoboolean can't be ignored
03487     
03488     coercetoboolean (&val);
03489     
03490     return (val.data.flvalue);
03491     }*/ /*truevalue*/
03492 
03493 
03494 boolean coercevalue (tyvaluerecord *val, tyvaluetype valuetype) {
03495     
03496     /*
03497     coerce the indicated valuerecord to the indicated type, if possible.
03498     
03499     return true if it worked.
03500     
03501     2.1b2 dmb: added coercion to notype
03502     */
03503     
03504     register tyvaluerecord *v = val;
03505     
03506     switch (valuetype) {
03507         
03508         case novaluetype:
03509             disposevaluerecord (*v, true);
03510             
03511             initvalue (v, novaluetype);
03512             
03513             return (true);
03514         
03515         case booleanvaluetype:
03516             return (coercetoboolean (v));
03517             
03518         case charvaluetype:
03519             return (coercetochar (v));
03520         
03521         case intvaluetype:
03522             return (coercetoint (v));
03523         
03524         case longvaluetype:
03525             return (coercetolong (v));
03526         
03527         case directionvaluetype:
03528             return (coercetodirection (v));
03529         
03530         case ostypevaluetype:
03531             return (coercetoostype (v));
03532         
03533         case enumvaluetype:
03534             if (!coercetoostype (v))
03535                 return (false);
03536             
03537             (*v).valuetype = enumvaluetype;
03538             
03539             return (true);
03540         
03541         case stringvaluetype:
03542             return (coercetostring (v));
03543         
03544         case addressvaluetype:
03545             return (coercetoaddress (v));
03546         
03547         case datevaluetype:
03548             return (coercetodate (v));
03549         
03550         case fixedvaluetype:
03551             return (coercetofixed (v));
03552         
03553         case singlevaluetype:
03554             return (coercetosingle (v));
03555         
03556         case doublevaluetype:
03557             return (coercetodouble (v));
03558         
03559         case pointvaluetype:
03560             return (coercetopoint (v));
03561         
03562         case rectvaluetype:
03563             return (coercetorect (v));
03564         
03565         case rgbvaluetype:
03566             return (coercetorgb (v));
03567         
03568         case patternvaluetype:
03569             return (coercetopattern (v));
03570         
03571         case filespecvaluetype:
03572             return (coercetofilespec (v));
03573         
03574         case aliasvaluetype:
03575             return (coercetoalias (v));
03576         
03577         case objspecvaluetype:
03578             return (coercetoobjspec (v));
03579         
03580         case binaryvaluetype:
03581             return (coercetobinary (v));
03582         
03583         case listvaluetype:
03584         case recordvaluetype:
03585             return (coercetolist (v, valuetype));
03586         
03587         default:
03588             langcoerceerror (v, valuetype);
03589             
03590             return (false);
03591         } /*switch*/
03592     
03593     return (true);
03594     } /*coercevalue*/
03595 
03596 
03597 static short coercionweight (tyvaluetype type) {
03598     
03599     /*
03600     9/22/92 dmb: return the relative weight associated with the given 
03601     value type. 
03602     
03603     the coercion weight determines the result type when two dissimilar 
03604     values are involved in a binary operation such as addition or 
03605     subtraction.
03606     
03607     note that in many cases there are ties, and the first operand will 
03608     end up determining the result type.
03609     
03610     12/11/92 dmb: added case for novaluetype
03611     
03612     4/14/93 dmb: weight records heavier than lists (forcing error if list non-empty)
03613     
03614     2.1b6 dmb: strings weigh in heavier than objspecs
03615     */
03616     
03617     switch (type) {
03618         
03619         case novaluetype:
03620             return (0);
03621         
03622         case booleanvaluetype:
03623             return (1);
03624         
03625         case intvaluetype:
03626         case tokenvaluetype:
03627             return (2);
03628         
03629         case directionvaluetype:
03630         case charvaluetype:
03631         case longvaluetype:
03632         case ostypevaluetype:
03633         case pointvaluetype:
03634             return (3);
03635         
03636         case datevaluetype:
03637             return (4);
03638         
03639         case fixedvaluetype:
03640         case singlevaluetype:
03641             return (5);
03642         
03643         case doublevaluetype:
03644             return (7);
03645         
03646         case rectvaluetype:
03647         case patternvaluetype:
03648         case rgbvaluetype:
03649         case filespecvaluetype:
03650         case aliasvaluetype:
03651         case addressvaluetype:
03652         case externalvaluetype:
03653             return (8);
03654         
03655         case objspecvaluetype:
03656             return (9);
03657         
03658         case stringvaluetype:
03659         case passwordvaluetype:
03660             return (10);
03661         
03662         case binaryvaluetype:
03663             return (11);
03664         
03665         case listvaluetype:
03666             return (12);
03667         
03668         case recordvaluetype:
03669             return (13);
03670         
03671         default:
03672             return (1);
03673         }
03674     } /*coercionweight*/
03675 
03676 
03677 boolean coercetypes (tyvaluerecord *v1, tyvaluerecord *v2) {
03678     
03679     /*
03680     the caller wants to do a binary operation with the two valuerecords.
03681     
03682     we convert/coerce the types of the two so they are the same type on
03683     exit, with converted data.
03684     
03685     return false if the two types are incompatible, ie no coersion is 
03686     possible.
03687     
03688     3/6/91 dmb: if v2 is a complex type (heap allocated), and v1 is a scalar 
03689     (not heap allocated), try to coerce to the complex type, instead of the 
03690     first type.  this ensures that msg (x + " secs.") will work without 
03691     explicit casting.
03692     
03693     5/30/91 dmb: use new langheaptype function.  also, check for same type
03694     
03695     9/22/92 dmb: use new coercionweight function instead of langheaptype; it 
03696     offers more granularity, and is written specifically to serve this routine
03697     
03698     2004-12-30 SMD: now extern instead of static
03699     */
03700     
03701     register tyvaluetype t1 = (*v1).valuetype;
03702     register tyvaluetype t2 = (*v2).valuetype;
03703     
03704     if (t1 == t2) /*easy case; short circuit*/
03705         return (true);
03706     
03707     if (t1 == externalvaluetype) {
03708         
03709         langbadexternaloperror (badexternaloperationerror, *v1);
03710         
03711         return (false);
03712         }
03713     
03714     if (t2 == externalvaluetype) {
03715         
03716         langbadexternaloperror (badexternaloperationerror, *v2);
03717         
03718         return (false);
03719         }
03720     
03721     if (coercionweight (t2) > coercionweight (t1))
03722         return (coercevalue (v1, t2));
03723     
03724     return (coercevalue (v2, t1));
03725     } /*coercetypes*/
03726 
03727 
03728 static boolean langgettableval (hdlhashtable htable, bigstring bsname, hdlhashtable *hval) {
03729     
03730     boolean fl;
03731     
03732     if (htable == nil)
03733         return (false);
03734     
03735     pushhashtable (htable);
03736     
03737     fl = langexternalgettable (bsname, hval);
03738     
03739     pophashtable ();
03740     
03741     return (fl);
03742     } /*langgettableval*/
03743 
03744 
03745 boolean langgetidentifier (hdltreenode htree, bigstring bs) {
03746     
03747     /*
03748     call this guy if you are at a node which should contain an identifier, the name
03749     of something in a symbol table.
03750     
03751     we allow the user to bracket a name like this ["ct" + "seconds"] so he can construct
03752     the name of the variable at runtime.  above this level, this feature is transparent.
03753     
03754     dmb 4.1b2: added call to releaseheaptmp to avoid overflow
03755     */
03756     
03757     register hdltreenode h = htree;
03758     tyvaluerecord val;      
03759     
03760     switch ((**h).nodetype) {
03761     
03762         case identifierop:
03763             pullstringvalue (&(**h).nodeval, bs);
03764         
03765             return (true);
03766         
03767         case bracketop: 
03768             //I need to look at this code, there are stale handles here
03769             if (!evaluatetree ((**h).param1, &val))
03770                 return (false);
03771             
03772             if (!coercetostring (&val))
03773                 return (false);
03774             
03775             pullstringvalue (&val, bs);
03776             
03777             releaseheaptmp ((Handle) val.data.stringvalue);
03778         
03779             return (true);
03780         
03781         default:
03782             langlongparamerror (unexpectedopcodeerror, (long) (**h).nodetype);
03783         } /*switch*/
03784     
03785     return (false);
03786     } /*langgetidentifier*/
03787 
03788 
03789 typedef boolean (*tysearchpathcallback) (hdlhashtable, bigstring, hdlhashtable *);
03790 
03791 
03792 static boolean langsearchpathvisit (tysearchpathcallback visit, bigstring bsname, hdlhashtable *htable) {
03793     
03794     /*
03795     look in the paths table for addresses of tables to look in.
03796     
03797     call the visit routine for each table pointed to in the paths table.
03798     we pass along bsname and htable for convenience; we never look at them
03799     ourself.
03800     
03801     return true when a visit routine returns true; return false when an 
03802     error occurs or when we run out of addresses
03803     
03804     4/3/92 dmb: added check for unresolved address
03805 
03806     5.1b21 dmb: handle guest databases via filewindowtable
03807     */
03808     
03809     register hdlhashtable ht = pathstable;
03810     register hdlhashnode nomad;
03811     hdlhashtable hsearch;
03812     bigstring bs;
03813     
03814     if (ht == nil)
03815         return (false);
03816     
03817     nomad = (**ht).hfirstsort;
03818     
03819     while (nomad != nil) {
03820         
03821         /*
03822         val = (**nomad).val;
03823         */
03824         
03825         if ((**nomad).val.valuetype != addressvaluetype) /*not an address*/
03826             goto next;
03827         
03828         if ((**nomad).flunresolvedaddress)
03829             if (!hashresolvevalue (ht, nomad))
03830                 goto next;
03831         
03832         if (!getaddressvalue ((**nomad).val, &hsearch, bs)) /*address error*/
03833             goto next;
03834         
03835         if (!langgettableval (hsearch, bs, &hsearch)) /*not the address of a table*/
03836             goto next;
03837         
03838         if ((*visit) (hsearch, bsname, htable))
03839             return (true);
03840         
03841         next:
03842         
03843         if (fllangerror)
03844             break;
03845         
03846         nomad = (**nomad).sortedlink;
03847         } /*while*/
03848     
03849     if (filewindowtable != nil) {
03850         
03851         for (nomad = (**filewindowtable).hfirstsort; nomad != nil; nomad = (**nomad).sortedlink)
03852             if (langexternalvaltotable ((**nomad).val, &hsearch, nomad))
03853                 if ((*visit) (hsearch, bsname, htable))
03854                     return (true);
03855         }
03856 
03857     return (false);
03858     } /*langsearchpathvisit*/
03859 
03860 
03861 static boolean langgettableitemname (hdlhashtable htable, tyvaluerecord *valindex, bigstring bsname) {
03862     
03863     /*
03864     3.0.2 dmb: don't reuse valindex when calling hashgetiteminfo. we don't want to 
03865     change caller's index to be the value of the cell itself!
03866     
03867     5.0a23 dmb: don't ask hashgetiteminfo for the node's value. An error resolving
03868     the node leads to a bogus message
03869     */
03870     
03871     register tyvaluerecord *v = valindex;
03872     
03873     if ((*v).valuetype == stringvaluetype)  {
03874         
03875         pullstringvalue (v, bsname);
03876         
03877         releaseheaptmp ((Handle) (*v).data.stringvalue);
03878         }
03879     else {
03880         register long ix;
03881         
03882         if (!coercetolong (v))
03883             return (false);
03884         
03885         ix = (*v).data.longvalue;
03886         
03887         if ((ix <= 0) || !hashgetiteminfo (htable, ix - 1, bsname, nil)) {
03888             
03889             langlongparamerror (tabletoosmallerror, (long) ix);
03890             
03891             return (false);
03892             }
03893         }
03894     
03895     return (true);
03896     } /*langgettableitemname*/
03897 
03898 
03899 boolean langgetdotparams (hdltreenode htree, hdlhashtable *htable, bigstring bsname) {
03900     
03901     /*
03902     we get a "dot param" pair from the indicated node.  we return a handle to 
03903     a hashtable that's supposed to have a value with the indicated name.
03904     
03905     if all we find is a string node, we return with the table set to nil, this
03906     implies that we should use the current hashtable, whatever that might mean.
03907     
03908     this routine is recursive, so it can process a whole structure of dot-ops.
03909     
03910     2/5/91 dmb: it helps if we look in the handler table automatically
03911     
03912     2/6/91 dmb: for array references, why not resolve to the hash name here, 
03913     so no one else has to know about the "$n" encoding?  as it stands, things 
03914     can break when an attempt to make a full path is made.
03915     
03916     5.0.2b6 dmb: if we can't resolve a name to a table, try looking it up in 
03917     local chain, context free.  first change in a long time!
03918     */
03919     
03920     register hdltreenode h = htree;
03921     register tytreetype nodetype = (**h).nodetype;
03922     hdlhashtable hsubtable;
03923     register boolean fl;
03924     tyvaluerecord val;
03925     
03926     *htable = nil; /*default, in case a table isn't specified*/
03927     
03928     langseterrorline (h); /*set globals for error reporting*/
03929     
03930     switch (nodetype) {
03931         
03932         case identifierop:
03933         case bracketop:
03934             return (langgetidentifier (h, bsname));
03935         
03936         case dereferenceop:
03937             if (!evaluatetree ((**h).param1, &val))
03938                 return (false);
03939             
03940             if (!coercetoaddress (&val)) /*might recurse via langexpandtodotparams*/
03941                 return (false);
03942             
03943             return (getaddressvalue (val, htable, bsname));
03944         
03945         case dotop:
03946         case arrayop: /*only arrays & dots allowed past here*/
03947             break;
03948         
03949         default:
03950             langlongparamerror (unexpectedopcodeerror, (long) nodetype);
03951             
03952             return (false);
03953         }
03954     
03955     if (!langgetdotparams ((**h).param1, &hsubtable, bsname)) /*recurse*/
03956         return (false);
03957     
03958     if (hsubtable == nil) { /*we're at the very first table in the dot list*/
03959         
03960         if (langgetspecialtable (bsname, htable)) /*translate "root" to roottable, etc.*/
03961             goto L1;
03962         
03963         if (langexternalgettable (bsname, htable)) /*found bsname in current context*/
03964             goto L1;
03965         
03966         if (fllocaldotparamsonly)
03967             fl = false;
03968         else {
03969             
03970             fl = langsearchpathvisit (&langgettableval, bsname, htable); /*check user paths*/
03971             
03972             if (!fl) { // about to fail; last ditch effort for local paths
03973                 
03974                 flfindanyspecialsymbol = true;
03975                 
03976                 fl = langexternalgettable (bsname, htable);
03977                 
03978                 flfindanyspecialsymbol = false;
03979                 }
03980             }
03981         }
03982     else
03983         fl = langgettableval (hsubtable, bsname, htable);
03984     
03985     if (!fl) {
03986     
03987         langparamerror (nosuchtableerror, bsname);
03988         
03989         return (false);
03990         }
03991     
03992     L1: /*deal with param2 here*/
03993     
03994     if (nodetype == arrayop) { /*param2 is an index*/
03995         
03996         tyvaluerecord valindex;
03997         
03998         if (!evaluatetree ((**h).param2, &valindex))
03999             return (false);
04000         
04001         return (langgettableitemname (*htable, &valindex, bsname));
04002         }
04003     
04004     return (langgetidentifier ((**h).param2, bsname));
04005     } /*langgetdotparams*/
04006 
04007 
04008 boolean langexpandtodotparams (bigstring bs, hdlhashtable *htable, bigstring bsname) {
04009     
04010     /*
04011     1/14/91 dmb: bs should be the path to an object in the database, a 
04012     value in the symbol table.  to locate it, we compile the string 
04013     and try to evaluate the code as a dot param pair
04014     */
04015     
04016     Handle htext;
04017     hdltreenode hmodule;
04018     boolean fl;
04019     unsigned long savelines;
04020     unsigned short savechars;
04021     
04022     if (!newtexthandle (bs, &htext))
04023         return (false);
04024     
04025     savelines = ctscanlines;
04026     
04027     savechars = ctscanchars;
04028     
04029     fl = langcompiletext (htext, false, &hmodule); /*always disposes htext*/
04030     
04031     if (fl) {
04032         
04033         register hdltreenode h = (**hmodule).param1; /*copy into register*/
04034         
04035         if (!langgetdotparams (h, htable, bsname)) { /*error occurred*/
04036             
04037             fl = false; /*make sure we return false*/
04038             
04039             if (!langerrorenabled ()) { /*call has errors disabled -- try to provide bsname*/
04040                 
04041                 if ((**h).nodetype == dotop) {
04042                     
04043                     h = (**h).param2;
04044                     
04045                     if ((**h).nodetype == identifierop)
04046                         langgetidentifier (h, bsname);
04047                     }
04048                 }
04049             }
04050         
04051         langdisposetree (hmodule);
04052         }
04053     
04054     ctscanlines = savelines;
04055     
04056     ctscanchars = savechars;
04057     
04058     return (fl);
04059     } /*langexpandtodotparams*/
04060 
04061 
04062 boolean langtablelookup (hdlhashtable intable, bigstring bsname, hdlhashtable *htable) {
04063     
04064     /*
04065     if bsname exists in intable, set htable to intable and return true.
04066     
04067     9/14/92 dmb: don't set *htable unless we find bsname
04068     */
04069     
04070     if (intable == nil)
04071         return (false);
04072     
04073     if (!hashtablesymbolexists (intable, bsname))
04074         return (false);
04075     
04076     *htable = intable; /*don't set this on failure*/
04077     
04078     return (true);
04079     } /*langtablelookup*/
04080 
04081 
04082 boolean langsearchpathlookup (bigstring bs, hdlhashtable *htable) {
04083     
04084     /*
04085     2/2/91 dmb: factored code: our identifier search path.
04086     
04087     look in the current symbol chain first, then in the handlers table, 
04088     then in the user table.  finally, check for a special table name.
04089     
04090     if it's found, return true with htable set to the containing table. 
04091     otherwise, set htable to currenthashtable and return false
04092     
04093     9/14/92 dmb: on failure, only set *htable to current hashtable if 
04094     it wasn't already set (by langfindsymbol)
04095     */
04096     
04097     hdlhashnode hnode;
04098     
04099     if (langfindsymbol (bs, htable, &hnode)) /*found it in local chain*/
04100         return (true);
04101     
04102     /*
04103     if (langtablelookup (handlertable, bs, htable))
04104         return (true);
04105     
04106     if (langtablelookup (iacgluetable, bs, htable))
04107         return (true);
04108     
04109     if (langtablelookup (usertable, bs, htable))
04110         return (true);
04111     */
04112     
04113     if (langgetspecialtable (bs, htable))
04114         return (true);
04115     
04116     if (langsearchpathvisit (&langtablelookup, bs, htable))
04117         return (true);
04118     
04119     if (langtablelookup (filewindowtable, bs, htable)) // 5.0d16 dmb
04120         return (true);
04121     
04122     if (*htable == nil) { /*wasn't set to "with" table by langfindsymbol*/
04123         
04124         *htable = currenthashtable; /*undeclared variables assumed to be local*/
04125         }
04126     
04127     return (false); /*not found*/
04128     } /*langsearchpathlookup*/
04129 
04130 
04131 boolean langgetdottedsymbolval (hdltreenode htree, hdlhashtable *htable, bigstring bs, tyvaluerecord *val, hdlhashnode * hnode) {
04132     
04133     /*
04134     the caller wants the value of the variable indicated by htree, which could be
04135     a dotted id.  we return the table it was found in, in case the caller also wants
04136     to set the value of the symbol.
04137     
04138     2/5/91 dmb: use searchpathlookup before calling langgetsymbolval so we can 
04139     find things in usertable and handlerstable
04140     
04141     4/17/91 dmb: use langsymbolreference to save code & handle "root"
04142     */
04143     
04144     register hdlhashtable *ht = htable;
04145     
04146     if (!langgetdotparams (htree, ht, bs))
04147         return (false);
04148     
04149     if (*ht == nil)
04150         langsearchpathlookup (bs, ht); /*always sets ht*/
04151     
04152     return (langsymbolreference (*ht, bs, val, hnode));
04153     } /*langgetdottedsymbolval*/
04154 
04155 
04156 #if oldarrays
04157 
04158 static boolean langsetdottedsymbolval (hdlhashtable htable, bigstring bs, tyvaluerecord val) {
04159     
04160     register hdlhashtable ht = htable;
04161     register boolean fl;
04162     
04163     if (ht != nil)
04164         pushhashtable (ht);
04165         
04166     fl = langsetsymbolval (bs, val);
04167     
04168     if (ht != nil)
04169         pophashtable ();
04170         
04171     return (fl);
04172     } /*langsetdottedsymbolval*/
04173 
04174 #endif
04175 
04176 
04177 boolean langhashtablelookup (hdlhashtable htable, const bigstring bs, tyvaluerecord *vreturned, hdlhashnode *hnode) {
04178     
04179     /*
04180     a simple wrapper for hashtablelookup: this code was replicated all over the place
04181     
04182     6.1d4 AR: created for better error reporting in the kernelized webserver.
04183     */
04184 
04185     if (!hashtablelookup (htable, bs, vreturned, hnode)) {
04186         
04187         langparamerror (unknownidentifiererror, bs);
04188         
04189         return (false);
04190         }
04191     
04192     return (true);
04193     } /*langhashtablelookup*/
04194 
04195 
04196 boolean langlookupstringvalue (hdlhashtable ht, bigstring bs, bigstring bsval) {
04197     
04198     /*
04199     a generic piece of code: look up the string value, with coercion and errors
04200 
04201     6.1d3 AR: moved from langhtml.c to langvalue.c
04202     */
04203     
04204     tyvaluerecord val;
04205     hdlhashnode hnode;
04206     
04207     if (!langhashtablelookup (ht, bs, &val, &hnode))
04208         return (false);
04209     
04210     if (val.valuetype != stringvaluetype)
04211         if (!copyvaluerecord (val, &val) || !coercetostring (&val))
04212             return (false);
04213     
04214     pullstringvalue (&val, bsval);
04215     
04216     return (true);
04217     } /*langlookupstringvaluecoerce*/
04218 
04219 
04220 
04221 boolean langlookupaddressvalue (hdlhashtable ht, bigstring bs, tyaddress *addressval) {
04222     
04223     /*
04224     a generic piece of code: look up the address value, with errors
04225     
04226     5.1.4 dmb: copy the value before coercing it
04227 
04228     6.1d3 AR: moved from langhtml.c to langvalue.c
04229     */
04230     
04231     tyvaluerecord val;
04232     hdlhashnode hnode;
04233     
04234     if (!langhashtablelookup (ht, bs, &val, &hnode))
04235         return (false);
04236     
04237     if (val.valuetype != addressvaluetype)
04238         if (!copyvaluerecord (val, &val) || !coercetoaddress (&val))
04239             return (false);
04240     
04241     return (getaddressvalue (val, &(*addressval).ht, (*addressval).bs));
04242     } /*langlookupaddressvalue*/
04243 
04244 
04245 boolean langlookuplongvalue (hdlhashtable ht, bigstring bs, long *x) {
04246     
04247     /*
04248     6.1d4 AR: look up the long value, with errors
04249     */
04250     
04251     tyvaluerecord val;
04252     hdlhashnode hnode;
04253     
04254     if (!langhashtablelookup (ht, bs, &val, &hnode))
04255         return (false);
04256         
04257     if (val.valuetype != longvaluetype)
04258         if (!copyvaluerecord (val, &val) || !coercetolong (&val))
04259             return (false);
04260     
04261     *x = val.data.longvalue;
04262     
04263     return (true);
04264     } /*langlookuplongvalue*/
04265 
04266 
04267 boolean langlookupbooleanvalue (hdlhashtable ht, bigstring bs, boolean *fl) {
04268     
04269     /*
04270     6.1d2 AR: look up the boolean value, with errors
04271     
04272     6.1d3 AR: moved from langhtml.c to langvalue.c
04273     */
04274     
04275     tyvaluerecord val;
04276     hdlhashnode hnode;
04277     
04278     if (!langhashtablelookup (ht, bs, &val, &hnode))
04279         return (false);
04280         
04281     if (val.valuetype != booleanvaluetype)
04282         if (!copyvaluerecord (val, &val) || !coercetoboolean (&val))
04283             return (false);
04284     
04285     *fl = val.data.flvalue;
04286     
04287     return (true);
04288     } /*langlookupbooleanvalue*/
04289 
04290 
04291 boolean langtablecopyvalue (hdlhashtable hsource, hdlhashtable hdest, bigstring bs) {
04292         
04293     tyvaluerecord val;
04294     Handle hpacked;
04295     boolean fl;
04296     hdlhashnode hnode;
04297 
04298     assert (hsource != nil);
04299     
04300     assert (hdest != nil);
04301     
04302     if (!langhashtablelookup (hsource, bs, &val, &hnode))
04303         return (false);
04304     
04305     if (!langpackvalue (val, &hpacked, hnode)) /*error packing -- probably out of memory*/
04306         return (false);
04307     
04308     fl = langunpackvalue (hpacked, &val);
04309     
04310     disposehandle (hpacked);
04311     
04312     if (!fl)
04313         return (false);
04314     
04315     if (!hashtableassign (hdest, bs, val)) {
04316     
04317         disposevaluerecord (val, true);
04318         
04319         return (false);
04320         }
04321 
04322     return (true);
04323     } /*langtablecopyvalue*/
04324 
04325 
04326 
04327 static boolean indexparam (hdltreenode hfirst, short pnumber, hdltreenode *h) {
04328     
04329     /*
04330     starting with hfirst param, step down pnumber - 1 times and return
04331     a handle to the parameter tree.
04332     
04333     return false if there aren't that many parameters in the list.
04334     */
04335     
04336     register hdltreenode nomad = hfirst;
04337     register short ctloops = pnumber;
04338     
04339     while (nomad != nil) { /*haven't fallen off end of list*/
04340         
04341         if (--ctloops <= 0)
04342             break;
04343         
04344         nomad = (**nomad).link;
04345         } /*for*/
04346     
04347     *h = nomad;
04348     
04349     return (ctloops <= 0); /*true if we traversed the number requested -- even zero*/
04350     } /*indexparam*/
04351 
04352 
04353 static boolean getparam (hdltreenode hfirst, short pnumber, hdltreenode *h) {
04354     
04355     /*
04356     return a handle to the pnumber'th parameter starting with hfirst as 
04357     parameter number 1.  if not found display an error dialog box.
04358     */
04359     
04360     boolean fllastparam = flnextparamislast;
04361     
04362     flnextparamislast = false; /*must be reset every time*/
04363     
04364     if (!indexparam (hfirst, pnumber, h)) {
04365         
04366         if (flparamerrorenabled) {
04367         
04368             if (isemptystring (bsfunctionname)) /*a tokenized function*/
04369         
04370                 gettokenname (bsfunctionname); /*convert functiontoken to its name*/
04371             
04372             langparamerror (notenoughparameterserror, bsfunctionname);
04373             }
04374         
04375         return (false);
04376         }
04377     
04378     if (fllastparam) { /*caller is requiring that this be the last paramater*/
04379         
04380         hdltreenode hextra;
04381         
04382         if (indexparam (hfirst, pnumber + 1, &hextra)) {
04383             
04384             if (isemptystring (bsfunctionname)) /*a tokenized function*/
04385             
04386                 gettokenname (bsfunctionname); /*convert functiontoken to its name*/
04387             
04388             langparamerror (toomanyparameterserror, bsfunctionname);
04389             
04390             return (false);
04391             }
04392         }
04393     
04394     return (true);
04395     } /*getparam*/
04396 
04397 
04398 boolean langcheckparamcount (hdltreenode hfirst, short pexpected) {
04399     
04400     /*
04401     make sure there are the correct number of parameters provided by 
04402     trying to get the last one.
04403     */
04404     
04405     hdltreenode hparam;
04406     
04407     flnextparamislast = true; /*we asserting that this must be the last one*/
04408     
04409     return (getparam (hfirst, pexpected, &hparam));
04410     } /*langcheckparamcount*/
04411 
04412 
04413 short langgetparamcount (hdltreenode hfirst) {
04414     
04415     register hdltreenode x = hfirst;
04416     register short ct = 0;
04417     
04418     while (x != nil) {
04419         
04420         ct++;
04421         
04422         x = (**x).link;
04423         } /*while*/
04424         
04425     return (ct);
04426     } /*langgetparamcount*/
04427 
04428 
04429 static boolean evaluateparam (hdltreenode hparam, tyvaluerecord *vparam) {
04430 
04431     /*
04432     2.1b2 dmb: broke out to be shared w/new paramlist stuff
04433     */
04434     
04435     bigstring bssave;
04436     
04437     copystring (bsfunctionname, bssave);
04438     
04439     if (!evaluatetree (hparam, vparam))
04440         return (false);
04441     
04442     langseterrorline (hparam); /*restore to param before caller attempts coercion*/
04443     
04444     copystring (bssave, bsfunctionname); /*restore name too*/
04445     
04446     return (true);
04447     } /*evaluateparam*/
04448 
04449 
04450 boolean evaluatereadonlyparam (hdltreenode hparam, tyvaluerecord *vparam) {
04451 
04452     /*
04453     5.0.2b18 dmb: generalized getreadonlytextvalue; this is broadly useful.
04454     
04455     5.0.2b19 dmb: handle constop
04456     */
04457     
04458     bigstring bssave;
04459     hdlhashtable htable = nil;
04460     bigstring bs;
04461     tyvaluerecord val;
04462     hdlhashnode hnode;
04463     
04464     copystring (bsfunctionname, bssave);
04465     
04466     switch ((**hparam).nodetype) {
04467     
04468         case constop:
04469             *vparam = (**hparam).nodeval;
04470             
04471             break;
04472         
04473         case identifierop:  // use idvalue w/out the final copyvaluerecord
04474         case bracketop:
04475             if (!langgetidentifier (hparam, bs))
04476                 return (false);
04477             
04478             if (!langsearchpathlookup (bs, &htable))
04479                 ;
04480             
04481             break;
04482         
04483         case dotop:  // use dotvalue w/out the copyvaluerecord
04484             if (!langgetdotparams (hparam, &htable, bs))
04485                 return (false);
04486             
04487             break;
04488         
04489         case dereferenceop: // use dereferencevalue w/out the copy
04490             if (!evaluatetree ((**hparam).param1, &val))
04491                 return (false);
04492             
04493             if (!coercetoaddress (&val))
04494                 return (false);
04495             
04496             if (!getaddressvalue (val, &htable, bs))
04497                 return (false);
04498             
04499             if (htable == nil)
04500                 langsearchpathlookup (bs, &htable);
04501             
04502             break;
04503         
04504         default:
04505             if (!evaluatetree (hparam, vparam))
04506                 return (false);
04507             
04508             break;
04509         }
04510     
04511     if (htable != nil)
04512         if (!langsymbolreference (htable, bs, vparam, &hnode))
04513             return (false);
04514     
04515     langseterrorline (hparam); /*restore to param before caller attempts coercion*/
04516     
04517     copystring (bssave, bsfunctionname); /*restore name too*/
04518     
04519     return (true);
04520     } /*evaluatereadonlyparam*/
04521 
04522 
04523 boolean getparamvalue (hdltreenode hfirst, short pnum, tyvaluerecord *vreturned) {
04524 
04525     /*
04526     hfirst points to the first parameter in a function's parameter list.
04527     the caller wants the value of pnum'th parameter.
04528     
04529     7/30/91 dmb: added langseterrorline call in case the parameter is a function 
04530     call and changes it.  otherwise, coercion error would yeild a bogus position.
04531     */
04532     
04533     hdltreenode hparam;
04534     
04535     if (!getparam (hfirst, pnum, &hparam))
04536         return (false);
04537     
04538     return (evaluateparam (hparam, vreturned));
04539     } /*getparamvalue*/
04540 
04541 
04542 boolean getreadonlyparamvalue (hdltreenode hfirst, short pnum, tyvaluerecord *vreturned) {
04543 
04544     /*
04545     5.0.2b18 dmb: new routine. may return non-temp values. be careful how you use it!
04546     
04547     2003-04-28 AR: declared global so it could be used in langregexp.c
04548     */
04549     
04550     hdltreenode hparam;
04551     
04552     if (!getparam (hfirst, pnum, &hparam))
04553         return (false);
04554     
04555     return (evaluatereadonlyparam (hparam, vreturned));
04556     } /*getreadonlyparamvalue*/
04557 
04558 
04559 boolean getoptionalparam (hdltreenode hfirst, short *ctconsumed, short *ctpositional, bigstring bsparam, hdltreenode *h) {
04560 
04561     /*
04562     get the next optional parameter. ctpositional is the number of positional parameters
04563     that have been found. ctconsumed is the total number of parameters that have been 
04564     found.
04565     
04566     on error, return false. if the parameter doesns't exist, set h to nil and return true.
04567     
04568     our error checking isn't as good as langaddfuncparams, because we don't have a 
04569     list of all of the needed parameters. if a named parameter is provided that doesn't
04570     match any requested name, ctconsumed will be less than the param count, so the error 
04571     will be "too many parameters".
04572     */
04573     
04574     hdltreenode nomad;
04575     hdltreenode hparam = nil;
04576     bigstring bsname;
04577     short ctskip = *ctpositional;
04578     boolean fllastparam = flnextparamislast;
04579     
04580     flnextparamislast = false; /*must be reset every time*/
04581     
04582     for (nomad = hfirst; nomad != nil; nomad = (**nomad).link) { //walk the entire list
04583         
04584         if (--ctskip >= 0) //not an  potentially optional parameter
04585             continue;
04586         
04587         if ((**nomad).nodetype != fieldop) { //parameter given by position
04588             
04589             hparam = nomad;
04590             
04591             ++*ctpositional;
04592             
04593             ++*ctconsumed;
04594             
04595             break;
04596             }
04597         
04598         if (!langgetidentifier ((**nomad).param1, bsname))
04599             return (false);
04600         
04601         if (equalidentifiers (bsname, bsparam)) { //parameter given by name
04602             
04603             hparam = (**nomad).param2;
04604             
04605             ++*ctconsumed;
04606             
04607             break;
04608             }
04609         }
04610     
04611     if (fllastparam) {
04612     
04613         if (!langcheckparamcount (hfirst, *ctconsumed))
04614             return (false);
04615         }
04616     
04617     *h = hparam;
04618     
04619     return (true);
04620     } /*getoptionalparam*/
04621 
04622 
04623 boolean getoptionalparamvalue (hdltreenode hfirst, short *ctconsumed, short *ctpositional, bigstring bsparam, tyvaluerecord *vreturned) {
04624 
04625     /*
04626     get the next optional parameter. ctpositional is the number of positional parameters
04627     that have been found. ctconsumed is the total number of parameters that have been 
04628     found.
04629     
04630     the value of vreturned on entry is the default, and indicates the type of value being sought.
04631     
04632     on error, return false. if the parameter doesns't exist, don't touch vreturned
04633     and return true.
04634     
04635     our error checking isn't as good as langaddfuncparams, because we don't have a 
04636     list of all of the needed parameters. if a named parameter is provided that doesn't
04637     match any requested name, ctconsumed will be less than the param count, so the error 
04638     will be "too many parameters".
04639     */
04640     
04641     hdltreenode hparam = nil;
04642     tyvaluetype ptype = (*vreturned).valuetype;
04643     
04644     if (!getoptionalparam (hfirst, ctconsumed, ctpositional, bsparam, &hparam))
04645         return (false);
04646     
04647     if (hparam == nil) //param not provided, don't touch param value
04648         return (true);
04649     
04650     return (evaluateparam (hparam, vreturned) && coercevalue (vreturned, ptype));
04651     } /*getoptionalparamvalue*/
04652 
04653 
04654 boolean getoptionaladdressparam (hdltreenode hfirst, short *ctconsumed, short *ctpositional, bigstring bsparam, hdlhashtable *ht, bigstring bsname) {
04655     
04656     /*
04657     Get an optional parameter that is expected to be an address value.
04658     If the param is not specified or if it is nil, we don't return anything.
04659     
04660     2006-03-10 aradke: transplanted from langregexp.c
04661     */
04662     
04663     tyvaluerecord vparam;
04664     
04665     setaddressvalue (nil, emptystring, &vparam);
04666 
04667     if (!getoptionalparamvalue (hfirst, ctconsumed, ctpositional, bsparam, &vparam))
04668         return (false);
04669     
04670     return (getaddressvalue (vparam, ht, bsname));
04671     } /*getoptionaladdressparam*/
04672 
04673 
04674 boolean getoptionaltableparam (hdltreenode hfirst, short *ctconsumed, short *ctpositional, bigstring bsparam, hdlhashtable *htable) {
04675     
04676     /*
04677     Get an optional parameter that is expected to be the address of a table.
04678     If the param is not specified or if it is nil, we don't return anything.
04679     If the param is a valid address, we make sure a table exists at the
04680     indicated location and return a handle to it.
04681 
04682     2006-03-10 aradke: transplanted from langregexp.c
04683     */
04684     
04685     hdlhashtable ht;
04686     bigstring bsname;
04687     
04688     if (!getoptionaladdressparam (hfirst, ctconsumed, ctpositional, bsparam, &ht, bsname))
04689         return (false);
04690     
04691     if (ht == nil && isemptystring (bsname))
04692         return (true);
04693     
04694     if (!langassignnewtablevalue  (ht, bsname, htable))
04695         return (false);
04696 
04697     return (true);
04698     } /*getoptionaltableparam*/
04699 
04700 
04701 boolean getaddressparam (hdltreenode hfirst, short pnum, tyvaluerecord *val) {
04702     
04703     if (!getparamvalue (hfirst, pnum, val))
04704         return (false);
04705     
04706     return (coercetoaddress (val));
04707     } /*getaddressparam*/
04708 
04709 
04710 boolean getvarparam (hdltreenode hfirst, short pnum, hdlhashtable *htable, bigstring bsname) {
04711     
04712     /*
04713     8/20/91 dmb: a bold new implementation...
04714     
04715     we want to go soft on the @ operator, so users can type edit (x) instead of 
04716     edit (@x), etc.; we want to make the '@' optional for built-in functions.  also, 
04717     there are verbs where we take values by address to reduce memory overhead: unpack, 
04718     wp.unpacktext, and op.unpacktext (as of right now).
04719     
04720     so, instead of evaluating the parameters and trying do coerce it to an address, 
04721     we take things more slowly.  first, we check for a valid lhs expressiong by try 
04722     to get dotparams from the tree.  if that works, we check the value at that db 
04723     location.  if it exists and is an address, we use it.  otherwise, we use the 
04724     dotparam pair as the address.
04725     
04726     since this looseness can cause problems if the address of an address value makes 
04727     sense, or if coercion (say, from string) is desired, not everyone will use this 
04728     version.
04729     
04730     note that we need to try the dotparam method before the traditional method, to 
04731     avoid making copies of binaries or coercing externals to strings if the address 
04732     operator is indeed missing.
04733     */
04734     
04735     tyvaluerecord val;
04736     
04737 #ifndef version5orgreater
04738     hdltreenode hparam;
04739     boolean fl;
04740     
04741 
04742     /*dmb 8/20/91*/
04743     
04744     if (!getparam (hfirst, pnum, &hparam))
04745         return (false);
04746     
04747     disablelangerror ();
04748     
04749     fl = langgetdottedsymbolval (hparam, htable, bsname, &val);
04750     
04751     enablelangerror ();
04752     
04753     if (fl) {
04754         
04755         if (val.valuetype == stringvaluetype) { /*see if string is an address*/
04756             
04757             hdlhashtable ht2;
04758             bigstring bs2;
04759             
04760             disablelangerror ();
04761             
04762             fl = copyvaluerecord (val, &val) && stringtoaddress (&val) && getaddressvalue (val, &ht2, bs2);
04763             
04764             enablelangerror ();
04765             
04766             if (fl && (ht2 != nil) && (ht2 != currenthashtable)) { /*string was valid, non-local adr*/
04767                 
04768                 *htable = ht2;
04769                 
04770                 copystring (bs2, bsname);
04771                 }
04772             
04773             return (true);
04774             }
04775         
04776         if (val.valuetype != addressvaluetype) /*not an address object; use it's adr*/
04777             return (true);
04778         }
04779     else
04780     
04781         /*end 8/20/91*/
04782 #endif
04783         
04784         if (!getaddressparam (hfirst, pnum, &val))
04785             return (false);
04786     
04787     if (!getaddressvalue (val, htable, bsname))
04788         return (false);
04789     
04790     if (*htable == nil) { /*no table specified in getdotparams*/
04791         
04792         langsearchpathlookup (bsname, htable);
04793         }
04794     
04795     return (true);
04796     } /*getvarparam*/
04797 
04798 
04799 boolean getbooleanparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04800     
04801     if (!getparamvalue (hfirst, pnum, v))
04802         return (false);
04803         
04804     return (coercetoboolean (v));
04805     } /*getbooleanparam*/
04806     
04807     
04808 boolean getcharparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04809     
04810     if (!getparamvalue (hfirst, pnum, v))
04811         return (false);
04812         
04813     return (coercetochar (v));
04814     } /*getcharparam*/
04815     
04816     
04817 boolean getintparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04818     
04819     if (!getparamvalue (hfirst, pnum, v))
04820         return (false);
04821         
04822     return (coercetoint (v));
04823     } /*getintparam*/
04824 
04825 
04826 boolean getlongparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04827     
04828     if (!getparamvalue (hfirst, pnum, v))
04829         return (false);
04830         
04831     return (coercetolong (v));
04832     } /*getlongparam*/
04833     
04834     
04835 boolean getdateparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04836     
04837     if (!getparamvalue (hfirst, pnum, v))
04838         return (false);
04839         
04840     return (coercetodate (v));
04841     } /*getdateparam*/
04842 
04843 
04844 boolean getstringparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04845     
04846     if (!getparamvalue (hfirst, pnum, v))
04847         return (false);
04848         
04849     return (coercetostring (v));
04850     } /*getstringparam*/
04851 
04852 
04853 boolean getdirectionparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04854     
04855     if (!getparamvalue (hfirst, pnum, v))
04856         return (false);
04857         
04858     return (coercetodirection (v));
04859     } /*getdirectionparam*/
04860 
04861 
04862 boolean getostypeparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04863     
04864     if (!getparamvalue (hfirst, pnum, v))
04865         return (false);
04866         
04867     return (coercetoostype (v));
04868     } /*getostypeparam*/
04869 
04870 
04871 boolean getpointparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04872     
04873     if (!getparamvalue (hfirst, pnum, v))
04874         return (false);
04875     
04876     return (coercetopoint (v));
04877     } /*getpointparam*/
04878 
04879 
04880 boolean getrectparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04881     
04882     if (!getparamvalue (hfirst, pnum, v))
04883         return (false);
04884     
04885     return (coercetorect (v));
04886     } /*getrectparam*/
04887 
04888 
04889 boolean getrgbparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04890     
04891     if (!getparamvalue (hfirst, pnum, v))
04892         return (false);
04893     
04894     return (coercetorgb (v));
04895     } /*getrgbparam*/
04896 
04897 
04898 boolean getpatternparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04899     
04900     if (!getparamvalue (hfirst, pnum, v))
04901         return (false);
04902     
04903     return (coercetopattern (v));
04904     } /*getpatternparam*/
04905 
04906 
04907 boolean getfixedparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04908     
04909     if (!getparamvalue (hfirst, pnum, v))
04910         return (false);
04911     
04912     return (coercetofixed (v));
04913     } /*getfixedparam*/
04914 
04915 
04916 boolean getsingleparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04917     
04918     if (!getparamvalue (hfirst, pnum, v))
04919         return (false);
04920     
04921     return (coercetosingle (v));
04922     } /*getsingleparam*/
04923 
04924 
04925 boolean getdoubleparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04926     
04927     if (!getparamvalue (hfirst, pnum, v))
04928         return (false);
04929     
04930     return (coercetodouble (v));
04931     } /*getdoubleparam*/
04932 
04933 
04934 boolean getfilespecparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04935     
04936     if (!getparamvalue (hfirst, pnum, v))
04937         return (false);
04938     
04939     return (coercetofilespec (v));
04940     } /*getfilespecparam*/
04941 
04942 
04943 boolean getaliasparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04944     
04945     if (!getparamvalue (hfirst, pnum, v))
04946         return (false);
04947     
04948     return (coercetoalias (v));
04949     } /*getaliasparam*/
04950 
04951 
04952 boolean getobjspecparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04953     
04954     hdltreenode hparam;
04955     
04956     if (!getparam (hfirst, pnum, &hparam))
04957         return (false);
04958     
04959     if (isobjspectree (hparam))
04960         return (evaluateobjspec (hparam, v));
04961     
04962     if (!getparamvalue (hfirst, pnum, v))
04963         return (false);
04964     
04965     return (coercetoobjspec (v));
04966     } /*getobjspecparam*/
04967 
04968 
04969 boolean getbinaryparam (hdltreenode hfirst, short pnum, tyvaluerecord *v) {
04970     
04971     if (!getparamvalue (hfirst, pnum, v))
04972         return (false);
04973     
04974     return (coercetobinary (v));
04975     } /*getbinaryparam*/
04976 
04977 
04978 boolean getvarvalue (hdltreenode hfirst, short pnum, hdlhashtable *htable, bigstring bsname, tyvaluerecord *val, hdlhashnode * hnode) {
04979     
04980     if (!getvarparam (hfirst, pnum, htable, bsname))
04981         return (false);
04982     
04983     #ifdef version5orgreater
04984         if (isemptystring (bsname) && ((***htable).fllocaltable))
04985             return (setnilvalue (val));
04986     #endif
04987     
04988     return (langsymbolreference (*htable, bsname, val, hnode));
04989     } /*getvarvalue*/
04990 
04991 
04992 boolean getstringvalue (hdltreenode hfirst, short pnum, bigstring bs) {
04993     
04994     /*
04995     carefully get a string value for the parameter.  if it needed to be coerced to
04996     a string we must release the string.  otherwise the system chews memory as 
04997     non-strings are coerced to strings.
04998     
04999     we'll need a routine like this for every type that is heap-allocated.
05000     
05001     5.0.2b18 dmb: try getting readonly text
05002     */
05003     
05004     tyvaluerecord v;
05005     
05006     if (!getreadonlyparamvalue (hfirst, pnum, &v))
05007         return (false);
05008     
05009     if (v.valuetype == stringvaluetype) { /*already a string, easy case*/
05010         
05011         pullstringvalue (&v, bs);
05012         
05013         return (true);
05014         }
05015     
05016     if (!v.fltmpstack && !copyvaluerecord (v, &v))
05017         return (false);
05018     
05019     if (!coercetostring (&v))
05020         return (false);
05021     
05022     pullstringvalue (&v, bs); /*copy from the heap into the stack*/
05023     
05024     releaseheaptmp ((Handle) v.data.stringvalue); /*the secret of our success*/
05025     
05026     return (true);
05027     } /*getstringvalue*/
05028 
05029 
05030 boolean gettextvalue (hdltreenode hfirst, short pnum, Handle *textval) {
05031     
05032     /*
05033     get a string handle for the parameter.  don't make a copy
05034     */
05035     
05036     tyvaluerecord v;
05037     
05038     if (!getstringparam (hfirst, pnum, &v))
05039         return (false);
05040     
05041     *textval = v.data.stringvalue;
05042     
05043     return (true);
05044     } /*gettextvalue*/
05045 
05046 
05047 boolean getexempttextvalue (hdltreenode hfirst, short pnum, Handle *textval) {
05048     
05049     /*
05050     return a string handle parameter that is free & clear.
05051     
05052     the caller must make sure that the handle is either disposed or consumed 
05053     in some way.
05054     */
05055     
05056     tyvaluerecord v;
05057     
05058     if (!getstringparam (hfirst, pnum, &v))
05059         return (false);
05060     
05061     if (!exemptfromtmpstack (&v)) /*wasn't found in current temp stack*/
05062         return (copyhandle (v.data.stringvalue, textval));
05063     
05064     *textval = v.data.stringvalue;
05065     
05066     return (true);
05067     } /*getexempttextvalue*/
05068 
05069 
05070 boolean getreadonlytextvalue (hdltreenode hfirst, short pnum, Handle *textval) {
05071     
05072     /*
05073     5.0.2b17 dmb: new routine.
05074     
05075     return a string handle parameter that may still be attached to an odb cell.
05076     
05077     the caller must make sure that the handle is copied if it is to be modified
05078     in any way. it must not be disposed.
05079     
05080     the point of this routine is speed -- avoiding extra copying
05081     */
05082     
05083     tyvaluerecord val;
05084     
05085     if (!getreadonlyparamvalue (hfirst, pnum, &val))
05086         return (false);
05087     
05088     if (val.valuetype != stringvaluetype) {
05089     
05090         if (!val.fltmpstack && !copyvaluerecord (val, &val))
05091             return (false);
05092         
05093         if (!coercetostring (&val))
05094             return (false);
05095         }
05096     
05097     *textval = val.data.stringvalue;
05098     
05099     return (true);
05100     } /*getreadonlytextvalue*/
05101 
05102 
05103 boolean getbooleanvalue (hdltreenode hfirst, short pnum, boolean *flval) {
05104     
05105     tyvaluerecord val;
05106     
05107     if (!getbooleanparam (hfirst, pnum, &val)) 
05108         return (false);
05109         
05110     *flval = val.data.flvalue;
05111     
05112     return (true);
05113     } /*getbooleanvalue*/
05114 
05115 
05116 boolean getcharvalue (hdltreenode hfirst, short pnum, char *chval) {
05117     
05118     tyvaluerecord val;
05119     
05120     if (!getcharparam (hfirst, pnum, &val)) 
05121         return (false);
05122     
05123     *chval = val.data.chvalue;
05124     
05125     return (true);
05126     } /*getcharvalue*/
05127 
05128 
05129 boolean getintvalue (hdltreenode hfirst, short pnum, short *intval) {
05130     
05131     tyvaluerecord val;
05132     
05133     if (!getintparam (hfirst, pnum, &val)) 
05134         return (false);
05135         
05136     *intval = val.data.intvalue;
05137     
05138     return (true);
05139     } /*getintvalue*/
05140 
05141 
05142 boolean getlongvalue (hdltreenode hfirst, short pnum, long *lval) {
05143     
05144     tyvaluerecord val;
05145     
05146     if (!getlongparam (hfirst, pnum, &val)) 
05147         return (false);
05148         
05149     *lval = val.data.longvalue;
05150     
05151     return (true);
05152     } /*getlongvalue*/
05153 
05154 
05155 boolean getdirectionvalue (hdltreenode hfirst, short pnum, tydirection *dirval) {
05156     
05157     tyvaluerecord val;
05158     
05159     if (!getdirectionparam (hfirst, pnum, &val))
05160         return (false);
05161         
05162     *dirval = val.data.dirvalue;
05163     
05164     return (true);
05165     } /*getdirectionvalue*/
05166 
05167 
05168 boolean getdatevalue (hdltreenode hfirst, short pnum, unsigned long *dateval) {
05169     
05170     tyvaluerecord val;
05171     
05172     if (!getdateparam (hfirst, pnum, &val)) 
05173         return (false);
05174     
05175     *dateval = val.data.datevalue;
05176     
05177     return (true);
05178     } /*getdatevalue*/
05179 
05180 
05181 boolean getostypevalue (hdltreenode hfirst, short pnum, OSType *typeval) {
05182     
05183     tyvaluerecord val;
05184     
05185     if (!getostypeparam (hfirst, pnum, &val))
05186         return (false);
05187     
05188     *typeval = val.data.ostypevalue;
05189     
05190     return (true);
05191     } /*getostypevalue*/
05192 
05193 
05194 boolean getfilespecvalue (hdltreenode hfirst, short pnum, tyfilespec *fsval) {
05195     
05196     tyvaluerecord val;
05197     
05198     if (!getfilespecparam (hfirst, pnum, &val))
05199         return (false);
05200         
05201     #if TARGET_API_MAC_CARBON == 1
05202     
05203         (*fsval).vRefNum = (**val.data.filespecvalue).vRefNum;
05204         (*fsval).parID = (**val.data.filespecvalue).parID;
05205         
05206         copystring ((**val.data.filespecvalue).name, (*fsval).name);
05207     
05208     #else
05209 
05210         *fsval = **val.data.filespecvalue;
05211     
05212     #endif
05213     
05214     return (true);
05215     } /*getfilespecvalue*/
05216 
05217 
05218 boolean getpointvalue (hdltreenode hfirst, short pnum, Point *ptval) {
05219     
05220     tyvaluerecord val;
05221     
05222     if (!getpointparam (hfirst, pnum, &val))
05223         return (false);
05224     
05225     *ptval = val.data.pointvalue;
05226     
05227     return (true);
05228     } /*getpointvalue*/
05229 
05230 
05231 boolean getrectvalue (hdltreenode hfirst, short pnum, Rect *rectval) {
05232     
05233     tyvaluerecord val;
05234     
05235     if (!getrectparam (hfirst, pnum, &val))
05236         return (false);
05237     
05238     *rectval = **val.data.rectvalue;
05239     
05240     return (true);
05241     } /*getrectvalue*/
05242 
05243 
05244 boolean getrgbvalue (hdltreenode hfirst, short pnum, RGBColor *rgbval) {
05245     
05246     tyvaluerecord val;
05247     
05248     if (!getrgbparam (hfirst, pnum, &val))
05249         return (false);
05250     
05251     *rgbval = **val.data.rgbvalue;
05252     
05253     return (true);
05254     } /*getrgbvalue*/
05255 
05256 
05257 boolean getbinaryvalue (hdltreenode hfirst, short pnum, boolean flreadonly, Handle *x) {
05258     
05259     /*
05260     get the indicated binary parameter value.  by convention, we expect 
05261     binary parameters to be passed by address, so this implementation 
05262     differs from other getxxxvalue routines.
05263     
05264     if flreadonly is true, the caller doesn't plan to modify or consume the 
05265     value in any way, so a copy should only be made if necessary for coersion.
05266     */
05267     
05268     tyvaluerecord val;
05269     hdlhashtable htable;
05270     bigstring bsname;
05271     hdlhashnode hnode;
05272     
05273     if (!getvarvalue (hfirst, pnum, &htable, bsname, &val, &hnode))
05274         return (false);
05275     
05276     if ((!flreadonly) || (val.valuetype != binaryvaluetype)) {
05277         
05278         if (!copyvaluerecord (val, &val))
05279             return (false);
05280         
05281         if (!coercetobinary (&val))
05282             return (false);
05283         }
05284     
05285     *x = val.data.binaryvalue;
05286     
05287     return (true);
05288     } /*getbinaryvalue*/
05289 
05290 
05291 boolean langsetbooleanvarparam (hdltreenode hfirst, short pnum, boolean fl) {
05292     
05293     hdlhashtable htable;
05294     bigstring bsname;
05295     tyvaluerecord val;
05296     
05297     if (!getvarparam (hfirst, pnum, &htable, bsname))
05298         return (false);
05299     
05300     setbooleanvalue (fl, &val);
05301     
05302     return (langsetsymboltableval (htable, bsname, val));
05303     } /*langsetbooleanvarparam*/
05304 
05305 
05306 boolean langsetlongvarparam (hdltreenode hfirst, short pnum, long n) {
05307     
05308     hdlhashtable htable;
05309     bigstring bsname;
05310     tyvaluerecord val;
05311     
05312     if (!getvarparam (hfirst, pnum, &htable, bsname))
05313         return (false);
05314     
05315     setlongvalue (n, &val);
05316     
05317     return (langsetsymboltableval (htable, bsname, val));
05318     } /*langsetlongvarparam*/
05319 
05320 
05321 boolean langsetstringvarparam (hdltreenode hfirst, short pnum, bigstring bsset) {
05322     
05323     hdlhashtable htable;
05324     bigstring bsname;
05325     tyvaluerecord val;
05326     
05327     if (!getvarparam (hfirst, pnum, &htable, bsname))
05328         return (false);
05329     
05330     setstringvalue (bsset, &val);
05331     
05332     return (hashtableassign (htable, bsname, val));
05333     } /*langsetstringvarparam*/
05334 
05335 
05336 boolean setintvarparam (hdltreenode hfirst, short pnum, short n) {
05337     
05338     hdlhashtable htable;
05339     bigstring bsname;
05340     tyvaluerecord val;
05341     
05342     if (!getvarparam (hfirst, pnum, &htable, bsname))
05343         return (false);
05344     
05345     setintvalue (n, &val);
05346     
05347     return (langsetsymboltableval (htable, bsname, val));
05348     } /*setintvarparam*/
05349 
05350 
05351 #if lazythis_optimization
05352     static int ctlazythis = 0;
05353 #endif
05354 
05355 boolean idvalue (hdltreenode htree, tyvaluerecord *val) {
05356     
05357     /*
05358     trade in an identifier for a value.  return false if the identifier 
05359     isn't defined.
05360     
05361     2/11/91 dmb: must lookup in search path
05362     
05363     8/15/92 dmb: check idvaluecallback for fileloop
05364 
05365     11/13/01 dmb: added lazy with evaluation
05366     */
05367     
05368     bigstring bs;
05369     hdlhashtable htable;
05370     hdlhashnode hnode;
05371     
05372     /*
05373     if (langcallbacks.idvaluecallback != nil) {
05374         
05375         if ((*langcallbacks.idvaluecallback) (htree, val))
05376             return (true);
05377         
05378         if (fllangerror)
05379             return (false);
05380         }
05381     */
05382     
05383     if (!langgetidentifier (htree, bs))
05384         return (false);
05385     
05386     if (!langsearchpathlookup (bs, &htable)) {
05387 
05388         #if lazythis_optimization
05389         
05390         if (equalidentifiers (bs, STR_this)) { /*PBS 05/12/01, dmb 11/14/01*/
05391         
05392             ctlazythis++;
05393 
05394             if (langgetthisaddress (&htable, bs)) {
05395         
05396                 setaddressvalue (htable, bs, val);
05397             
05398                 return (true);
05399                 }
05400             }
05401         #endif
05402         }
05403     
05404     if (!langsymbolreference (htable, bs, val, &hnode))
05405         return (false);
05406     
05407     return (copyvaluerecord (*val, val));
05408     } /*idvalue*/
05409 
05410 
05411 boolean dotvalue (hdltreenode h, tyvaluerecord *val) {
05412     
05413     /*
05414     h may be a tree node of type "dotop".  we return a value from an external
05415     symbol table.
05416     
05417     4/17/91 dmb: use langsymbolreference to save code & handle "root"
05418     
05419     6/11/92 dmb: check for objspec trees
05420     */
05421     
05422     bigstring bsvarname;
05423     hdlhashtable htable;
05424     boolean flerrornode = (h == herrornode);
05425     hdlhashnode hnode;
05426     
05427     if (isobjspectree (h))
05428         return (evaluateobjspec (h, val));
05429     
05430     if (!langgetdotparams (h, &htable, bsvarname))
05431         return (false);
05432     
05433     assert (htable != nil);
05434 
05435     if (flerrornode)
05436         langseterrorline (h);
05437     
05438     if (!langsymbolreference (htable, bsvarname, val, &hnode))
05439         return (false);
05440     
05441     return (copyvaluerecord (*val, val));
05442     } /*dotvalue*/
05443 
05444 
05445 boolean addressofvalue (hdltreenode htree, tyvaluerecord *val) {
05446     
05447     /*
05448     2/2/91 dmb: unfortunatly, paths have two problems as addresses.  first, 
05449     they're really inefficient:  we have to do a full path search to 
05450     generate the string, and then have to invoke the compiler, build a 
05451     code tree, and evaluate the code tree to get back to dotparams.  the 
05452     second problem is that, except when running under the debugger, local 
05453     tables don't have names and aren't linked into the database, so full 
05454     paths can't be generated and names at different scope levels can't be 
05455     distinguished.
05456     
05457     the solution is to just keep the indentifier name as a string, and 
05458     stash the hashtable handle into the value record instead of relying on 
05459     a full path.  this should be reliable and much, much faster.  the only 
05460     down side is that address values now only have run-time life; after 
05461     that, only the identifier name survives.  the same problem exists in 
05462     normal, compiled languages -- memory addresses don't survive program 
05463     launches.  note, however, that casting still provides the functionality 
05464     of saving addresses in the database, i.e. address ("scratchpad.x") does 
05465     what you want it to do.
05466     */
05467     
05468     hdlhashtable htable;
05469     bigstring bsname;
05470     
05471     if (!langgetdotparams (htree, &htable, bsname))
05472         return (false);
05473     
05474     if ((htable == nil) && !equalstrings (bsname, nameroottable))
05475         langsearchpathlookup (bsname, &htable);
05476     
05477     return (setaddressvalue (htable, bsname, val));
05478     } /*addressofvalue*/
05479 
05480 
05481 boolean dereferencevalue (hdltreenode htree, tyvaluerecord *val) {
05482     
05483     hdlhashtable htable;
05484     bigstring bs;
05485     hdlhashnode hnode;
05486     
05487     if (!evaluatetree (htree, val))
05488         return (false);
05489     
05490     if (!coercetoaddress (val))
05491         return (false);
05492     
05493     if (!getaddressvalue (*val, &htable, bs))
05494         return (false);
05495     
05496     if (!langsymbolreference (htable, bs, val, &hnode))
05497         return (false);
05498     
05499     return (copyvaluerecord (*val, val));
05500     } /*dereferencevalue*/
05501 
05502 
05503 static boolean getvalidstringindex (tyvaluerecord *vstring, bigstring bsname, tyvaluerecord *vindex, long *idx) {
05504     
05505     /*
05506     2.1b3 dmb: if string is a binary, account for binary subtype
05507     */
05508     
05509     register long ix;
05510     register long ixmax;
05511     
05512     if (!coercetolong (vindex))
05513         return (false);
05514     
05515     ix = (*vindex).data.longvalue;
05516     
05517     ixmax = gethandlesize ((*vstring).data.stringvalue);
05518     
05519     if ((*vstring).valuetype == binaryvaluetype) /*skip binary subtype*/
05520         ixmax -= sizeof (OSType);
05521     
05522     if (ix < 1 || ix > ixmax) {
05523         
05524         langarrayreferror (arrayindexerror, bsname, vstring, vindex);
05525         
05526         return (false);
05527         }
05528     
05529     if ((*vstring).valuetype == binaryvaluetype) /*skip binary subtype*/
05530         ix += sizeof (OSType);
05531     
05532     *idx = ix;
05533     
05534     return (true);
05535     } /*getvalidstringindex*/
05536 
05537 
05538 static boolean stringassignvalue (tyvaluerecord *varray, bigstring bsname, tyvaluerecord *vindex, tyvaluerecord *vassign) {
05539     
05540     /*
05541     varray is an actual dbvalue, not a temp value.
05542     
05543     bsname is passed for error reporting only.
05544 
05545     5.0.2b21 dmb: must copy vassign before coercing it.
05546     */
05547     
05548     Handle hstring;
05549     long ix;
05550     tyvaluerecord vchar;
05551     
05552     if (!getvalidstringindex (varray, bsname, vindex, &ix))
05553         return (false);
05554     
05555     if (!copyvaluerecord (*vassign, &vchar) || !coercetochar (&vchar))
05556         return (false);
05557     
05558     hstring = (*varray).data.stringvalue;
05559     
05560     (*hstring) [ix - 1] = vchar.data.chvalue; /*changes actual string*/
05561     
05562     return (true);
05563     } /*stringassignvalue*/
05564 
05565 
05566 static boolean stringarrayvalue (tyvaluerecord *varray, bigstring bsname, tyvaluerecord *vindex, tyvaluerecord *vreturned) {
05567     
05568     Handle hstring;
05569     long ix;
05570     
05571     if (!getvalidstringindex (varray, bsname, vindex, &ix))
05572         return (false);
05573     
05574     hstring = (*varray).data.stringvalue;
05575     
05576     return (setcharvalue ((*hstring) [ix - 1], vreturned));
05577     } /*stringarrayvalue*/
05578 
05579 
05580 static boolean stringdeletevalue (tyvaluerecord *varray, bigstring bsname, tyvaluerecord *vindex) {
05581     
05582     long ix;
05583     
05584     if (!getvalidstringindex (varray, bsname, vindex, &ix))
05585         return (false);
05586     
05587     return (pullfromhandle ((*varray).data.stringvalue, ix - 1, 1L, nil));
05588     } /*stringdeletevalue*/
05589 
05590 
05591 static boolean tablearrayvalue (tyvaluerecord *varray, bigstring bsname, tyvaluerecord *vindex, tyvaluerecord *val) {
05592     
05593     /*
05594     get the value from the table in varray specified by the vindex.  update 
05595     bsname to the name of that value. (initially, it's the name of the table 
05596     itself.)
05597     */
05598     
05599     hdlhashtable htable;
05600     bigstring stringindex;
05601     long intindex;
05602     hdlhashnode hnode;
05603     
05604     if (!langexternalvaltotable (*varray, &htable, HNoNode)) {
05605         
05606         langarrayreferror (arraynottableerror, bsname, varray, nil);
05607         
05608         return (false);
05609         }
05610     
05611     if ((*vindex).valuetype == stringvaluetype) {
05612     
05613         boolean fl;
05614         
05615         pullstringvalue (vindex, stringindex);
05616         
05617         pushhashtable (htable);
05618         
05619         fl = langgetsymbolval (stringindex, val, &hnode);
05620         
05621         pophashtable ();
05622         
05623         if (!fl) {
05624             
05625             langarrayreferror (arraystringindexerror, bsname, varray, vindex);
05626             
05627             return (false);
05628             }
05629         
05630         copystring (stringindex, bsname);
05631         }
05632     else {
05633         if (!coercetolong (vindex))
05634             return (false);
05635         
05636         intindex = (*vindex).data.longvalue;
05637         
05638         if ((intindex <= 0) || !hashgetiteminfo (htable, intindex - 1, bsname, val)) {
05639             
05640             langarrayreferror (arrayindexerror, bsname, varray, vindex);
05641             
05642             return (false);
05643             }
05644         }
05645     
05646     return (true);
05647     } /*tablearrayvalue*/
05648 
05649 
05650 #define maxarraystack 7
05651 
05652 
05653 typedef struct tyarrayspec {
05654     
05655     tyvaluerecord varray; /*the array containing the retrieved value (which may itself be an array)*/
05656     
05657     tyvaluerecord vindex; /*the index into varray that the retrieved value came from*/
05658     } tyarrayspec;
05659 
05660 
05661 typedef struct tyarraystack {
05662     
05663     short topstack;
05664     
05665     tyarrayspec element [maxarraystack];
05666     } tyarraystack;
05667 
05668 
05669 
05670 static boolean parsearrayreference (hdltreenode htree, tyarraystack *pstack, hdlhashtable *htable, bigstring bsname, tyvaluerecord *val) {
05671     
05672     /*
05673     3.0.2 dmb: see comment in assignordeletearrayvalue. we recurse until we get 
05674     to the root of the array reference, at which point htable & bsname are set by 
05675     langgetdottedsymbolval.
05676     
05677     when the parent array is a table, we don't retrieve the actual node value, not 
05678     a copy. This allows us to directly modify the value instead of having to assign 
05679     back into the table later. if the caller is just getting the value, it will make 
05680     a copy itself.
05681     
05682     as we evaluate each level, we store the array/index information into pstack, so  
05683     that our caller can update the values if desired. (otherwise it can pass nil.)
05684     anything we put into the srraystack must be protected from garbage collection. 
05685     any call to evaluatetree might call a function, which empties the temp stack.
05686     
05687     3.0.2b3 make retrieval of actual val optional by accepting nil for val.  this is 
05688     necessary to allow nameOf and assignment to work with non-existant items
05689     
05690     5.0b17: if the value was a tmp, use pushtmpstackvalue to make sure it goes back
05691     */
05692     
05693     tyvaluerecord varray;
05694     tyvaluerecord vindex;
05695     register short top = 0;
05696     boolean fltmp;
05697     boolean fl;
05698     hdlhashnode hnode;
05699     
05700     if ((**htree).nodetype != arrayop) {
05701         
05702         assert (val != nil);
05703         
05704         return (langgetdottedsymbolval (htree, htable, bsname, val, &hnode));
05705         }
05706     
05707     if (!evaluatetree ((**htree).param2, &vindex))
05708         return (false);
05709     
05710     fltmp = exemptfromtmpstack (&vindex); /*protect index while we recurse*/
05711     
05712     fl = parsearrayreference ((**htree).param1, pstack, htable, bsname, &varray); /*recurse*/
05713     
05714     if (fltmp)
05715         pushtmpstackvalue (&vindex);
05716     
05717     if (!fl)
05718         return (false);
05719     
05720     if (pstack != nil) { /*need to record array reference*/
05721         
05722         top = (*pstack).topstack;
05723         
05724         if (top == maxarraystack) {
05725             
05726             langerror (tmpstackoverflowerror); /*the message for this error fits*/
05727             
05728             return (false);
05729             }
05730         
05731         (*pstack).element [top].varray = varray;
05732         }
05733     
05734     if (val != nil) { /*need to retrieve value*/
05735         
05736         switch (varray.valuetype) { /*note: vindex may be coerced within this switch*/
05737             
05738             case stringvaluetype:
05739                 fl = stringarrayvalue (&varray, bsname, &vindex, val);
05740                 
05741                 break;
05742             
05743             case binaryvaluetype:
05744                 if (!stringarrayvalue (&varray, bsname, &vindex, val))
05745                     return (false);
05746                 
05747                 fl = coercetoint (val);
05748                 
05749                 break;
05750             
05751             case listvaluetype:
05752             case recordvaluetype:
05753                 fl = listarrayvalue (&varray, bsname, &vindex, val);
05754                 
05755                 break;
05756             
05757             case externalvaluetype:
05758                 fl = tablearrayvalue (&varray, bsname, &vindex, val);
05759                 
05760                 break;
05761             
05762             default:
05763                 langarrayreferror (arraynottableerror, bsname, &varray, nil);
05764                 
05765                 return (false);
05766             }
05767         
05768         if (!fl)
05769             return (false);
05770         }
05771     
05772     if (pstack != nil) {
05773         
05774         (*pstack).element [top].vindex = vindex;
05775         
05776         (*pstack).topstack++; /*actually accept new stack element*/
05777         }
05778     
05779     return (true);
05780     } /*parsearrayreference*/
05781 
05782 
05783 static boolean setarrayelement (tyvaluerecord *varray, tyvaluerecord *vindex, tyvaluerecord *vassign, bigstring bsname, boolean fljustdirtytable) {
05784     
05785     /*
05786     assign the value in vassign to the vindex element of varray. if assigning 
05787     into a table, make sure to remove value from temp stack
05788     */
05789     
05790     boolean fl;
05791     hdlhashtable htable;
05792     
05793     switch ((*varray).valuetype) {
05794         
05795         case stringvaluetype:
05796         case binaryvaluetype:
05797             if (vassign == nil)
05798                 fl = stringdeletevalue (varray, bsname, vindex);
05799             else
05800                 fl = stringassignvalue (varray, bsname, vindex, vassign);
05801             
05802             break;
05803         
05804         case listvaluetype:
05805         case recordvaluetype:
05806             if (vassign == nil)
05807                 fl = listdeletevalue (varray, bsname, vindex);
05808             else
05809                 fl = listassignvalue (varray, bsname, vindex, vassign);
05810             
05811             break;
05812         
05813         case externalvaluetype:
05814             if (!langexternalvaltotable (*varray, &htable, HNoNode)) {
05815                 
05816                 langarrayreferror (arraynottableerror, bsname, varray, nil);
05817                 
05818                 return (false);
05819                 }
05820             
05821             if (!langgettableitemname (htable, vindex, bsname))
05822                 return (false);
05823             
05824             if (fljustdirtytable) {
05825                 
05826                 langsymbolchanged (htable, bsname, HNoNode, true);
05827                 
05828                 fl = true;
05829                 }
05830             else {
05831                 
05832                 pushhashtable (htable);
05833                 
05834                 if (vassign == nil)
05835                     fl = hashdelete (bsname, true, true);
05836                 else
05837                     fl = langsetsymbolval (bsname, *vassign);
05838                 
05839                 pophashtable ();
05840                 
05841                 if (fl && vassign)
05842                     exemptfromtmpstack (vassign);
05843                 }
05844             
05845             break;
05846         
05847         default:
05848             langarrayreferror (arraynottableerror, bsname, varray, nil);
05849             
05850             return (false);
05851         }
05852     
05853     return (fl);
05854     } /*setarrayelement*/
05855 
05856 
05857 static boolean assignordeletearrayvalue (register hdltreenode h, tyvaluerecord *vassign, tytreetype op, tyvaluerecord *vold, tyvaluerecord *vnew) {
05858     
05859     /*
05860     3.0.2 dmb: now I see why I didn't get this into 3.0. Very hairy. One key 
05861     complication: array indexes must only be evaluated once, in case they 
05862     contain expressions with side effects. Since sub-elements aren't directly 
05863     addressable, we must maintain a list of subarrays and subindexes so that once 
05864     we've retrieved the smallest element that is referred to, we can assign 
05865     back into all of the containing arrays. I can't see how to do this with 
05866     straight recursion, but it looks like a stack will do the trick.
05867     
05868     when assigning back into parent arrays, as soon as we hit a non-temp value, 
05869     we're modifying an actual table value and just need to mark its parent as 
05870     dirty. we don't need to continue dirtying the parents of that table, so 
05871     we can stop the traversal once we've done so.
05872     
05873     3.0.2b3: don't try to retrieve element value unless we're modifying it.
05874     
05875     5.0b17: if the value was a tmp, use pushtmpstackvalue to make sure it goes back
05876     
05877     5.0.2b14 dmb: to support modifyassignvalue, we must notice when the result of
05878     an addition or subtraction is heap allocated, but not on the temp stack. in that
05879     case, we modified the first operand (the LHS) directly, and must not hashassign
05880     the result.
05881     */
05882     
05883     tyvaluerecord *varray;
05884     tyvaluerecord velement;
05885     tyarraystack arraystack = {0};
05886     hdlhashtable htable;
05887     bigstring bsname;
05888     boolean fljustdirtytable = false;
05889     register short top;
05890     boolean flincdec = (op == addop) || (op == subtractop);
05891     boolean fltmp;
05892     boolean fl;
05893     tyvaluerecord *vref = nil;
05894     
05895     if (flincdec)
05896         vref = &velement;
05897     
05898     fltmp = (vassign != nil) && exemptfromtmpstack (vassign);
05899     
05900     fl = parsearrayreference (h, &arraystack, &htable, bsname, vref);
05901     
05902     if (fltmp)
05903         pushtmpstackvalue (vassign);
05904     
05905     if (!fl)
05906         return (false);
05907     
05908     if (flincdec) {
05909         
05910         if (vold)
05911             *vold = velement;
05912         
05913         // 5.0.2b14 dmb - not anymore: copyvaluerecord (velement, &velement); /*make sure it's a temp*/
05914         
05915         if (op == addop)
05916             fl = addvalue (velement, *vassign, vassign);
05917         else
05918             fl = subtractvalue (velement, *vassign, vassign);
05919         
05920         if (!fl)
05921             return (false);
05922         
05923         if (vnew)
05924             *vnew = *vassign;
05925         
05926         fljustdirtytable = langheapallocated (vassign, nil) && !(*vassign).fltmpstack; // 5.0.2b14
05927         }
05928     
05929     top = arraystack.topstack;
05930     
05931     while (--top >= 0) { /*descend the stack, assigning subelements into their parent arrays*/
05932         
05933         varray = &arraystack.element [top].varray;
05934         
05935         if (!setarrayelement (varray, &arraystack.element [top].vindex, vassign, bsname, fljustdirtytable))
05936             return (false);
05937         
05938         if ((*varray).valuetype == externalvaluetype) /*we just assigned to or dirtied a table*/
05939             break;
05940         
05941         fljustdirtytable = true; /*we're updating an actual value; don't need to assign to table*/
05942         
05943         vassign = varray; /*this array will become an element of the parent array*/
05944         }
05945     
05946     langsymbolchanged (htable, bsname, HNoNode, true);
05947     
05948     return (true);
05949     } /*assignordeletearrayvalue*/
05950 
05951 
05952 static boolean assignordeletevalue (register hdltreenode hlhs, tyvaluerecord *vassign, tytreetype op, tyvaluerecord *vold, tyvaluerecord *vnew) {
05953     
05954     /*
05955     2.1b2 dmb: common code; delete item if vassign is nil
05956     
05957     3.0.2 dmb: new feature, our caller passes on opcode which might be addop. in that 
05958     case, we add vassign to the existing value, and return both the old and new value 
05959     in vold and vnew. right now we're using this to implement ++ and --. in the future, 
05960     this will make implementing += and -= trivial, and *= and /= pretty easy too.
05961     
05962     4.1b4 dmb: added fllangexternalvalueprotect flag to disable protection
05963     
05964     5.0a18 dmb: generate error if lhs is undefined; must declare variables
05965     
05966     5.0.2b10 dmb: don't dup vassign if it's already a temp
05967 
05968     5.0.2b11 dmb: don't keep table pushed during addvalue call
05969 
05970     5.0.2b13 dmb: undid b10 change; crashes string.innerCaseName.
05971     */
05972     
05973     hdlhashtable htable;
05974     bigstring bsname;
05975     hdlhashnode hnode;
05976     tyvaluerecord vtmp;
05977     boolean fl = false;
05978     
05979     if (vassign != nil) {
05980         
05981         if (fllangexternalvalueprotect && (*vassign).valuetype == externalvaluetype) { /*4.1b4 dmb*/
05982             
05983             langbadexternaloperror (externalassignerror, *vassign);
05984             
05985             return (false);
05986             }
05987         
05988         if (!(*vassign).fltmpstack && !copyvaluerecord (*vassign, vassign))
05989             return (false);
05990         }
05991     
05992     if ((**hlhs).nodetype == arrayop) { /*may be array into object other than a table*/
05993         
05994         return (assignordeletearrayvalue (hlhs, vassign, op, vold, vnew));
05995         }
05996     
05997     if (!langgetdotparams (hlhs, &htable, bsname))
05998         return (false);
05999     
06000     if (htable == nil)
06001         langsearchpathlookup (bsname, &htable); /*12/18/92*/
06002     
06003     assert (htable != nil);
06004     
06005     switch (op) {
06006         
06007         case noop: /*delete*/
06008             return (hashtabledelete (htable, bsname));
06009         
06010         case assignop:
06011             pushhashtable (htable);
06012 
06013             fl = langsetsymbolval (bsname, *vassign);
06014             
06015             pophashtable ();
06016             
06017             if (!fl)
06018                 return (false);
06019             
06020             exemptfromtmpstack (vassign); /*save value from being garbage collected*/
06021             
06022             return (true);
06023         
06024         case addop:
06025         case subtractop:
06026             pushhashtable (htable);
06027 
06028             fl = langfindsymbol (bsname, &htable, &hnode);
06029             
06030             pophashtable ();
06031             
06032             if (!fl) {
06033                                 
06034                 if (equalstrings (bsname, nameroottable)) {
06035                 
06036                     bigstring bstype;
06037                     
06038                     langexternaltypestring ((hdlexternalhandle) rootvariable, bstype);
06039                     
06040                     lang2paramerror (badexternalassignmenterror, bstype, bsname);
06041                     }
06042                 else
06043                     langparamerror (unknownidentifiererror, bsname);
06044                 
06045                 return (false);
06046                 }
06047             
06048             vtmp = (**hnode).val;
06049             
06050             if (vold)
06051                 *vold = vtmp;
06052             
06053             if (op == addop)
06054                 fl = addvalue (vtmp, *vassign, &vtmp);
06055             else
06056                 fl = subtractvalue (vtmp, *vassign, &vtmp);
06057             
06058             if (!fl)
06059                 return (false);
06060             
06061             exemptfromtmpstack (&vtmp);
06062             
06063             assert (!vtmp.fltmpstack);
06064 
06065             (**hnode).val = vtmp;
06066             
06067             langsymbolchanged (htable, bsname, hnode, true); /*value changed*/
06068             
06069             if (vnew)
06070                 *vnew = vtmp;
06071             
06072             return (true);
06073 
06074         default:
06075             langlongparamerror (unexpectedopcodeerror, (long) op);
06076 
06077             return (false);
06078         }
06079     } /*assignordeletevalue*/
06080 
06081 
06082 boolean assignvalue (register hdltreenode hlhs, tyvaluerecord vrhs) {
06083     
06084     /*
06085     3/11/91 dmb: disallow externalvaluetype assignments
06086     
06087     10/8/91 dmb: set can clear new fllanghashassignprotect flag to avoid 
06088     destructive assignment.
06089     
06090     12/26/91 dmb: don't exempt from temp stack until assignment is sucessful
06091     
06092     12/18/92 dmb: do a searchpathlookup when htable is nil; otherwise, can't 
06093     assign to a non-dotted id in paths table
06094     
06095     2.1b2 dmb: do binary values too
06096     */
06097     
06098     boolean fl;
06099     
06100     fllanghashassignprotect = true;
06101     
06102     fl = assignordeletevalue (hlhs, &vrhs, assignop, nil, nil);
06103     
06104     fllanghashassignprotect = false;
06105     
06106     return (fl);
06107     } /*assignvalue*/
06108 
06109 
06110 boolean deletevalue (hdltreenode hdel, tyvaluerecord *vreturned) {
06111     
06112     /*
06113     2.1b2 dmb: new routine to handle array-based deletions
06114     */
06115     
06116     if (!assignordeletevalue (hdel, nil, noop, nil, nil))
06117         return (false);
06118     
06119     return (setbooleanvalue (true, vreturned));
06120     } /*deletevalue*/
06121 
06122 
06123 boolean modifyassignvalue (register hdltreenode hlhs, tyvaluerecord vrhs, tytreetype modifyop, tyvaluerecord *vassigned, boolean flneednewcopy) {
06124     
06125     /*
06126     5.0.2b10 dmb: new routine for +=, -=, *=, /=. Currently, only += is generated, 
06127     as a compiler optimization (not a supported operator).
06128     
06129     if flneednewcopy is true, caller needs copy of result value to be on the temp stack.
06130     */
06131     
06132     boolean fl;
06133     
06134     fllanghashassignprotect = true;
06135     
06136     fl = assignordeletevalue (hlhs, &vrhs, modifyop, nil, vassigned);
06137     
06138     fllanghashassignprotect = false;
06139     
06140     if (!fl)
06141         return (false);
06142     
06143     if (((*vassigned).valuetype == externalvaluetype) || !flneednewcopy)
06144         return (setbooleanvalue (true, vassigned)); /*could be a local extern*/
06145     else
06146         return ((*vassigned).fltmpstack || copyvaluerecord (*vassigned, vassigned)); /*side-effect of assignment*/
06147     } /*modifyassignvalue*/
06148 
06149 
06150 boolean arrayvalue (hdltreenode h, tyvaluerecord *val) {
06151     
06152     /*
06153     get an array reference.  h's nodetype == arrayop.  the first param must be the
06154     name of an external variable, of type table.
06155     
06156     valindex holds a value which is either a string, or can be coerced to a short.
06157     
06158     if it's a short index, return the value of the nth item in the table, order is
06159     determined by the sort order of the table.  the index is 1-based, the first 
06160     item is number 1.
06161     
06162     if it's a string index, we return the value of the item whose key equals the
06163     string.
06164     
06165     1/25/91 dmb: must return copy, not original
06166     
06167     6/11/92 dmb: check for objspec trees
06168     
06169     2.1b2 dmb: do binary values too
06170     
06171     5.0.2b10 dmb: don't recopy val unnecessarily
06172     */
06173     
06174     hdlhashtable htable;
06175     bigstring bsname;
06176     
06177     if (isobjspectree (h))
06178         return (evaluateobjspec (h, val));
06179     
06180     if (!parsearrayreference (h, nil, &htable, bsname, val))
06181         return (false);
06182     
06183     if (!(*val).fltmpstack)
06184         if (!copyvaluerecord (*val, val))
06185             return (false);
06186     
06187     return (true);
06188     } /*arrayvalue*/
06189 
06190 
06191 boolean incrementvalue (boolean flincr, boolean flpre, hdltreenode hvar, tyvaluerecord *vreturned) {
06192     
06193     /*
06194     implement all four autoincrement operations.  if flincr is true then we add,
06195     if false, we subtract.  if flpre, we do it before determining the returned
06196     value, if false we do the increment or decrement and then return the value.
06197     
06198     7/12/90 DW: allow dotted id's on auto-increment/decrement.
06199     
06200     9/6/91 dmb: work on a copy of the original value; it may be heap-allocated.  
06201     also, must exempt from temp stack before assignment
06202     */
06203     
06204     tyvaluerecord oldval, newval, valauto;
06205     tytreetype op;
06206     register boolean fl;
06207     
06208     setlongvalue (1, &valauto);
06209     
06210     if (flincr)
06211         op = addop;
06212     else
06213         op = subtractop;
06214     
06215     fl = assignordeletevalue (hvar, &valauto, op, &oldval, &newval);
06216     
06217     if (fl) {
06218     
06219         if (flpre)
06220             fl = copyvaluerecord (newval, vreturned);
06221         else
06222             fl = copyvaluerecord (oldval, vreturned);
06223         }
06224     
06225     return (fl);
06226     } /*incrementvalue*/
06227 
06228 
06229 boolean idstringvalue (hdlhashtable htable, bigstring bsvarname, bigstring bsvalue) {
06230     
06231     /*
06232     7/30/91 dmb: rewrote; used to trash original value
06233     */
06234     
06235     tyvaluerecord val;
06236     boolean fl;
06237     hdlhashnode hnode;
06238     
06239     setemptystring (bsvalue);
06240     
06241     pushhashtable (htable);
06242     
06243     fl = langgetsymbolval (bsvarname, &val, &hnode);
06244     
06245     pophashtable ();
06246     
06247     if (!fl)
06248         return (false);
06249     
06250     if (!copyvaluerecord (val, &val))
06251         return (false);
06252     
06253     if (!coercetostring (&val))
06254         return (false);
06255     
06256     pullstringvalue (&val, bsvalue);
06257     
06258     return (true);
06259     } /*idstringvalue*/
06260 
06261 
06262 boolean addvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06263     
06264     /*
06265     7/16/92 dmb: added special case for adding two characters together 
06266     to form a string
06267     
06268     2.1b2 dmb: special case for filespec on lhs, don't coerce types
06269     
06270     5.0a23 dmb: use pushhandle, not concathandles for string and binary addition
06271                 added special case for novaluetype
06272     
06273     5.0 dmb: since we throw away v1 and v2, let's see where we can boost
06274     performance by adding directly to v1 and making that the return value.
06275     */
06276     
06277     register boolean fl = true;
06278     tyvaluetype v2type = v2.valuetype;
06279     
06280     if (v2.valuetype == novaluetype) {
06281     
06282         *vreturned = v1;
06283         
06284         return (true);
06285         }
06286     
06287     if (v1.valuetype == novaluetype) {
06288         
06289         *vreturned = v2;
06290         
06291         return (true);
06292         }
06293     
06294     if (v1.valuetype != filespecvaluetype) {
06295         
06296         if (!coercetypes (&v1, &v2)) {
06297             
06298             disposevalues (&v1, &v2);
06299             
06300             return (false);
06301             }
06302         }
06303     
06304     initvalue (vreturned, v1.valuetype);
06305     
06306     switch (v1.valuetype) {
06307         
06308         case booleanvaluetype:
06309             (*vreturned).data.flvalue = v1.data.flvalue || v2.data.flvalue;
06310             
06311             break;
06312         
06313         case charvaluetype:
06314             if (v2type == charvaluetype) { /*special case: adding two character together*/
06315                 byte s [4];
06316                 
06317                 setstringwithchar (v1.data.chvalue, s);
06318                 
06319                 pushchar (v2.data.chvalue, s);
06320                 
06321                 fl = setstringvalue (s, vreturned);
06322                 }
06323             else
06324                 (*vreturned).data.chvalue = v1.data.chvalue + v2.data.chvalue;
06325             
06326             break;
06327         
06328         case intvaluetype:
06329             (*vreturned).data.intvalue = v1.data.intvalue + v2.data.intvalue;
06330             
06331             break;
06332         
06333         case longvaluetype: 
06334         case ostypevaluetype:
06335             (*vreturned).data.longvalue = v1.data.longvalue + v2.data.longvalue;
06336             
06337             break;
06338             
06339         case directionvaluetype:
06340             (*vreturned).data.dirvalue = (tydirection) ((short) v1.data.dirvalue + (short) v2.data.dirvalue);
06341             
06342             break;
06343         
06344         case datevaluetype:
06345             (*vreturned).data.datevalue = v1.data.datevalue + v2.data.datevalue;
06346             
06347             break;
06348         
06349     #ifdef MACVERSION
06350         case fixedvaluetype:
06351             (*vreturned).data.fixedvalue = v1.data.fixedvalue + v2.data.fixedvalue;
06352             
06353             break;
06354     #endif
06355         
06356         case singlevaluetype:
06357             (*vreturned).data.singlevalue = v1.data.singlevalue + v2.data.singlevalue;
06358             
06359             break;
06360         
06361         case doublevaluetype:
06362             fl = setdoublevalue (**v1.data.doublevalue + **v2.data.doublevalue, vreturned);
06363             
06364             break;
06365         
06366         case stringvaluetype: {
06367             #ifdef version5orgreater
06368                 fl = pushhandle (v2.data.stringvalue, v1.data.stringvalue);
06369                 
06370                 if (!fl)
06371                     break;
06372                 
06373                 *vreturned = v1;
06374                 
06375                 v1.valuetype = novaluetype;
06376             #else
06377                 Handle x;
06378                 
06379                 fl = concathandles (v1.data.stringvalue, v2.data.stringvalue, &x);
06380                 
06381                 if (!fl)
06382                     break;
06383                 
06384                 fl = setheapvalue (x, stringvaluetype, vreturned);
06385             #endif
06386             
06387             break;
06388             }
06389         
06390         case binaryvaluetype: {
06391             #ifdef version5orgreater
06392                 stripbinarytypeid (v2.data.binaryvalue);
06393                 
06394                 fl = pushhandle (v2.data.binaryvalue, v1.data.binaryvalue);
06395                 
06396                 if (!fl)
06397                     break;
06398                 
06399                 setbinarytypeid (v1.data.binaryvalue, '\?\?\?\?');
06400                 
06401                 *vreturned = v1;
06402                 
06403                 v1.valuetype = novaluetype;
06404             #else
06405                 Handle x;
06406                 
06407                 stripbinarytypeid (v1.data.binaryvalue);
06408             
06409                 stripbinarytypeid (v2.data.binaryvalue);
06410                 
06411                 fl = concathandles (v1.data.binaryvalue, v2.data.binaryvalue, &x);
06412                 
06413                 if (!fl)
06414                     break;
06415                 
06416                 fl = setbinaryvalue (x, '\?\?\?\?', vreturned);
06417             #endif
06418             
06419             break;
06420             }
06421         
06422         case filespecvaluetype:
06423             return (filespecaddvalue (&v1, &v2, vreturned));
06424         
06425         case listvaluetype:
06426         case recordvaluetype:
06427             fl = listaddvalue (&v1, &v2, vreturned);
06428             
06429             break;
06430         
06431         default:
06432             langerror (additionnotpossibleerror);
06433             
06434             fl = false; /*addition is not defined*/
06435             
06436             break;
06437         } /*switch*/
06438     
06439     disposevalues (&v1, &v2);
06440     
06441     return (fl);
06442     } /*addvalue*/
06443     
06444     
06445 boolean subtractvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06446     
06447     /*
06448     2.1b2 dmb: special case for filespec on lhs, don't coerce types
06449     */
06450     
06451     register boolean fl = true;
06452     
06453     if (v1.valuetype != filespecvaluetype) {
06454         
06455         if (!coercetypes (&v1, &v2)) {
06456             
06457             disposevalues (&v1, &v2);
06458             
06459             return (false);
06460             }
06461         }
06462     
06463     initvalue (vreturned, v1.valuetype);
06464     
06465     switch (v1.valuetype) {
06466         
06467         case booleanvaluetype:
06468             (*vreturned).data.flvalue = v1.data.flvalue - v2.data.flvalue;
06469             
06470             break;
06471         
06472         case charvaluetype:
06473             (*vreturned).data.chvalue = v1.data.chvalue - v2.data.chvalue;
06474             
06475             break;
06476         
06477         case intvaluetype:
06478             (*vreturned).data.intvalue = v1.data.intvalue - v2.data.intvalue;
06479             
06480             break;
06481         
06482         case longvaluetype: 
06483         case ostypevaluetype:
06484             (*vreturned).data.longvalue = v1.data.longvalue - v2.data.longvalue;
06485             
06486             break;
06487             
06488         case directionvaluetype:
06489             (*vreturned).data.dirvalue = (tydirection) ((short) v1.data.dirvalue - (short) v2.data.dirvalue);
06490             
06491             break;
06492             
06493         case datevaluetype:
06494             (*vreturned).data.datevalue = v1.data.datevalue - v2.data.datevalue;
06495             
06496             break;
06497 #ifdef MACVERSION       
06498         case fixedvaluetype:
06499             (*vreturned).data.fixedvalue = v1.data.fixedvalue - v2.data.fixedvalue;
06500             
06501             break;
06502 #endif      
06503         case singlevaluetype:
06504             (*vreturned).data.singlevalue = v1.data.singlevalue - v2.data.singlevalue;
06505             
06506             break;
06507         
06508         case doublevaluetype:
06509             fl = setdoublevalue (**v1.data.doublevalue - **v2.data.doublevalue, vreturned);
06510             
06511             break;
06512         
06513         case stringvaluetype: {
06514             #ifdef version5orgreater
06515                 long ix;
06516                 
06517                 ix = searchhandle (v1.data.stringvalue, v2.data.stringvalue, 0, longinfinity);
06518                 
06519                 if (ix >= 0)
06520                     pullfromhandle (v1.data.stringvalue, ix, gethandlesize (v2.data.stringvalue), nil);
06521                 
06522                 *vreturned = v1;
06523                 
06524                 v1.valuetype = novaluetype;
06525             #else
06526                 Handle x;
06527                 long ix;
06528                 
06529                 fl = copyhandle (v1.data.stringvalue, &x);
06530                 
06531                 if (!fl)
06532                     break;
06533                 
06534                 ix = searchhandle (x, v2.data.stringvalue, 0, longinfinity);
06535                 
06536                 if (ix >= 0)
06537                     pullfromhandle (x, ix, gethandlesize (v2.data.stringvalue), nil);
06538                 
06539                 fl = setheapvalue (x, stringvaluetype, vreturned);
06540             #endif
06541             
06542             break;
06543             
06544             }
06545         
06546         case filespecvaluetype:
06547             return (filespecsubtractvalue (&v1, &v2, vreturned));
06548         
06549         case listvaluetype:
06550         case recordvaluetype:
06551             fl = listsubtractvalue (&v1, &v2, vreturned);
06552             
06553             break;
06554         
06555         default:
06556             langerror (subtractionnotpossibleerror);
06557             
06558             fl = false; /*subtraction is not defined*/
06559             
06560             break;
06561         } /*switch*/
06562     
06563     disposevalues (&v1, &v2);
06564     
06565     return (fl);
06566     } /*subtractvalue*/
06567     
06568     
06569 boolean multiplyvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06570     
06571     register boolean fl = true;
06572     
06573     if (!coercetypes (&v1, &v2)) {
06574         
06575         disposevalues (&v1, &v2);
06576         
06577         return (false);
06578         }
06579     
06580     initvalue (vreturned, v1.valuetype);
06581     
06582     switch (v1.valuetype) {
06583         
06584         case booleanvaluetype:
06585             (*vreturned).data.flvalue = v1.data.flvalue * v2.data.flvalue;
06586             
06587             break;
06588         
06589         case charvaluetype:
06590             (*vreturned).data.chvalue = v1.data.chvalue * v2.data.chvalue;
06591             
06592             break;
06593         
06594         case intvaluetype:
06595             (*vreturned).data.intvalue = v1.data.intvalue * v2.data.intvalue;
06596             
06597             break;
06598         
06599         case longvaluetype: 
06600             (*vreturned).data.longvalue = v1.data.longvalue * v2.data.longvalue;
06601             
06602             break;
06603             
06604         case directionvaluetype:
06605             (*vreturned).data.dirvalue = (tydirection) ((short) v1.data.dirvalue * (short) v2.data.dirvalue);
06606             
06607             break;
06608             
06609         case datevaluetype:
06610             (*vreturned).data.datevalue = v1.data.datevalue * v2.data.datevalue;
06611             
06612             break;
06613 #ifdef MACVERSION       
06614         case fixedvaluetype:
06615             (*vreturned).data.fixedvalue = FixMul (v1.data.fixedvalue, v2.data.fixedvalue);
06616             
06617             break;
06618 #endif
06619             
06620         case singlevaluetype:
06621             (*vreturned).data.singlevalue = v1.data.singlevalue * v2.data.singlevalue;
06622             
06623             break;
06624         
06625         case doublevaluetype:
06626             fl = setdoublevalue (**v1.data.doublevalue * **v2.data.doublevalue, vreturned);
06627             
06628             break;
06629         
06630         default:
06631             langerror (multiplicationnotpossibleerror);
06632             
06633             fl = false; /*multiplication is not defined*/
06634             
06635             break;
06636         } /*switch*/
06637     
06638     disposevalues (&v1, &v2);
06639         
06640     return (fl);
06641     } /*multiplyvalue*/
06642 
06643 
06644 static boolean nonzerovalue (tyvaluerecord val) {
06645     
06646     /*
06647     9/17/91 dmb: pulled code from dividevalue so it can be shared by modvalue
06648     */
06649     
06650     register long denom;
06651     
06652     switch (val.valuetype) {
06653         
06654         case booleanvaluetype:
06655             denom = val.data.flvalue;
06656             
06657             break;
06658         
06659         case charvaluetype:
06660             denom = val.data.chvalue;
06661             
06662             break;
06663             
06664         case intvaluetype:
06665             denom = val.data.intvalue;
06666             
06667             break;
06668             
06669         case longvaluetype: 
06670             denom = val.data.longvalue;
06671             
06672             break;
06673         
06674         case directionvaluetype:
06675             denom = val.data.dirvalue;
06676             
06677             break;
06678             
06679         case datevaluetype:
06680             denom = val.data.datevalue;
06681             
06682             break;
06683         
06684         case singlevaluetype:
06685             denom = (val.data.singlevalue == 0.0? 0 : 1); /*avoid rounding errors*/
06686             
06687             break;
06688         
06689         case doublevaluetype:
06690             denom = (**val.data.doublevalue == 0.0? 0 : 1); /*avoid rounding errors*/
06691             
06692             break;
06693         
06694         default:
06695             denom = 1; /*not zero*/
06696         } /*switch*/
06697     
06698     if (denom == 0) {
06699         
06700         langerror (dividebyzeroerror);
06701         
06702         return (false);
06703         }
06704     
06705     return (true);
06706     } /*nonzerovalue*/
06707 
06708 
06709 boolean dividevalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06710     
06711     register boolean fl = true;
06712     
06713     if (!coercetypes (&v1, &v2)) {
06714         
06715         disposevalues (&v1, &v2);
06716         
06717         return (false);
06718         }
06719     
06720     if (!nonzerovalue (v2)) {
06721         
06722         disposevalues (&v1, &v2);
06723         
06724         return (false);
06725         }
06726     
06727     initvalue (vreturned, v1.valuetype);
06728     
06729     switch (v1.valuetype) {
06730         
06731         case booleanvaluetype:
06732             (*vreturned).data.flvalue = v1.data.flvalue / v2.data.flvalue;
06733             
06734             break;
06735         
06736         case charvaluetype:
06737             (*vreturned).data.chvalue = v1.data.chvalue / v2.data.chvalue;
06738             
06739             break;
06740             
06741         case intvaluetype:
06742             (*vreturned).data.intvalue = v1.data.intvalue / v2.data.intvalue;
06743             
06744             break;
06745             
06746         case longvaluetype:
06747             (*vreturned).data.longvalue = v1.data.longvalue / v2.data.longvalue;
06748             
06749             break;
06750             
06751         case directionvaluetype:
06752             (*vreturned).data.dirvalue = (tydirection) ((short) v1.data.dirvalue / (short) v2.data.dirvalue);
06753             
06754             break;
06755             
06756         case datevaluetype:
06757             (*vreturned).data.datevalue = v1.data.datevalue / v2.data.datevalue;
06758             
06759             break;
06760         
06761         case singlevaluetype:
06762             (*vreturned).data.singlevalue = v1.data.singlevalue / v2.data.singlevalue;
06763             
06764             break;
06765         
06766         case doublevaluetype:
06767             fl = setdoublevalue (**v1.data.doublevalue / **v2.data.doublevalue, vreturned);
06768             
06769             break;
06770         
06771         default:
06772             langerror (divisionnotpossibleerror);
06773             
06774             fl = false; /*division is not defined*/
06775             
06776             break;
06777         } /*switch*/
06778     
06779     disposevalues (&v1, &v2);
06780         
06781     return (fl);
06782     } /*dividevalue*/
06783 
06784 
06785 boolean modvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06786     
06787     /*
06788     9/17/91 dmb: check modulus for zero
06789     */
06790     
06791     register boolean fl = true;
06792     
06793     if (!coercetypes (&v1, &v2)) {
06794         
06795         disposevalues (&v1, &v2);
06796         
06797         return (false);
06798         }
06799     
06800     if (!nonzerovalue (v2)) {
06801         
06802         disposevalues (&v1, &v2);
06803         
06804         return (false);
06805         }
06806     
06807     initvalue (vreturned, v1.valuetype);
06808     
06809     switch (v1.valuetype) {
06810         
06811         case booleanvaluetype:
06812             (*vreturned).data.flvalue = v1.data.flvalue % v2.data.flvalue;
06813             
06814             break;
06815         
06816         case charvaluetype:
06817             (*vreturned).data.chvalue = v1.data.chvalue % v2.data.chvalue;
06818             
06819             break;
06820         
06821         case intvaluetype:
06822             (*vreturned).data.intvalue = v1.data.intvalue % v2.data.intvalue;
06823             
06824             break;
06825         
06826         case longvaluetype: 
06827             (*vreturned).data.longvalue = v1.data.longvalue % v2.data.longvalue;
06828             
06829             break;
06830         
06831         case directionvaluetype:
06832             (*vreturned).data.dirvalue = (tydirection) ((short) v1.data.dirvalue % (short) v2.data.dirvalue);
06833             
06834             break;
06835         
06836         case datevaluetype:
06837             (*vreturned).data.datevalue = v1.data.datevalue % v2.data.datevalue;
06838             
06839             break;
06840         
06841         default:
06842             langerror (modulusnotpossibleerror);
06843             
06844             fl = false; /*modulus operation is not defined*/
06845             
06846             break;
06847         } /*switch*/
06848     
06849     disposevalues (&v1, &v2);
06850     
06851     return (fl);
06852     } /*modvalue*/
06853 
06854 
06855 boolean EQvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06856     
06857     /*
06858     12/21/92 dmb: added case for novaluetype
06859     
06860     2.1b3 dmb: if values can't be coerced, vreturned is false but don't generate 
06861     an error
06862     */
06863     
06864     boolean flcomparable;
06865     boolean fl = true;
06866     
06867     initvalue (vreturned, booleanvaluetype);
06868     
06869     disablelangerror ();
06870     
06871     flcomparable = coercetypes (&v1, &v2);
06872     
06873     enablelangerror ();
06874     
06875     if (!flcomparable) {
06876         
06877         disposevalues (&v1, &v2);
06878         
06879         return (true);
06880         }
06881     
06882     switch (v1.valuetype) {
06883         
06884         case novaluetype:
06885             (*vreturned).data.flvalue = true;
06886             
06887             break;
06888         
06889         case booleanvaluetype:
06890             (*vreturned).data.flvalue = v1.data.flvalue == v2.data.flvalue;
06891             
06892             break;
06893         
06894         case charvaluetype:
06895             (*vreturned).data.flvalue = v1.data.chvalue == v2.data.chvalue;
06896             
06897             break;
06898             
06899         case intvaluetype:
06900         case tokenvaluetype:
06901             (*vreturned).data.flvalue = v1.data.intvalue == v2.data.intvalue;
06902             
06903             break;
06904         
06905         case longvaluetype:
06906         case ostypevaluetype:
06907         case pointvaluetype:
06908         case fixedvaluetype:
06909         case singlevaluetype:
06910         case enumvaluetype:
06911             (*vreturned).data.flvalue = v1.data.longvalue == v2.data.longvalue;
06912             
06913             break;
06914             
06915         case directionvaluetype:
06916             (*vreturned).data.flvalue = v1.data.dirvalue == v2.data.dirvalue;
06917             
06918             break;
06919             
06920         case datevaluetype:
06921             (*vreturned).data.flvalue = v1.data.datevalue == v2.data.datevalue;
06922             
06923             break;
06924         
06925         case addressvaluetype: {
06926             bigstring bs1, bs2;
06927             hdlhashtable ht1, ht2;
06928             
06929             if (!getaddressvalue (v1, &ht1, bs1))
06930                 return (false);
06931             
06932             if (!getaddressvalue (v2, &ht2, bs2))
06933                 return (false);
06934             
06935             (*vreturned).data.flvalue = (ht1 == ht2) && equalidentifiers (bs1, bs2);
06936             
06937             break;
06938             }
06939         
06940         case listvaluetype:
06941         case recordvaluetype:
06942             fl = listcomparevalue (&v1, &v2, EQop, vreturned);
06943             
06944             break;
06945         
06946         case stringvaluetype:
06947         case binaryvaluetype:
06948         case doublevaluetype:
06949         case rectvaluetype:
06950         case rgbvaluetype:
06951         case patternvaluetype:
06952         case aliasvaluetype:
06953         case objspecvaluetype:
06954             (*vreturned).data.flvalue = equalhandles ((Handle) v1.data.binaryvalue, (Handle) v2.data.binaryvalue);
06955             
06956             break;
06957         
06958         case filespecvaluetype:
06959             (*vreturned).data.flvalue = equalfilespecs (*v1.data.filespecvalue, *v2.data.filespecvalue);
06960             
06961             break;
06962         
06963         default:
06964             langerror (comparisonnotpossibleerror);
06965             
06966             fl = false;
06967             
06968             break;
06969         } /*switch*/
06970     
06971     disposevalues (&v1, &v2);
06972     
06973     return (fl);
06974     } /*EQvalue*/
06975 
06976 
06977 boolean NEvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06978 
06979     if (!EQvalue (v1, v2, vreturned)) 
06980         return (false);
06981     
06982     (*vreturned).data.flvalue = !(*vreturned).data.flvalue;
06983     
06984     return (true);
06985     } /*NEvalue*/
06986     
06987     
06988 boolean GTvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
06989     
06990     /*
06991     1/25/93 dmb: added case for novaluetype
06992     */
06993     
06994     boolean fl = true;
06995     
06996     if (!coercetypes (&v1, &v2)) {
06997         
06998         disposevalues (&v1, &v2);
06999         
07000         return (false);
07001         }
07002     
07003     initvalue (vreturned, booleanvaluetype);
07004     
07005     switch (v1.valuetype) {
07006         
07007         case novaluetype:
07008             (*vreturned).data.flvalue = false;
07009             
07010             break;
07011         
07012         case booleanvaluetype:
07013             (*vreturned).data.flvalue = v1.data.flvalue > v2.data.flvalue;
07014                     
07015             break;
07016         
07017         case charvaluetype:
07018             (*vreturned).data.flvalue = v1.data.chvalue > v2.data.chvalue;
07019                     
07020             break;
07021                     
07022         case intvaluetype:
07023         case tokenvaluetype:
07024             (*vreturned).data.flvalue = v1.data.intvalue > v2.data.intvalue;
07025                     
07026             break;
07027         
07028         case longvaluetype:
07029         case ostypevaluetype:
07030         case fixedvaluetype:
07031             (*vreturned).data.flvalue = v1.data.longvalue > v2.data.longvalue;
07032                     
07033             break;
07034         
07035         case directionvaluetype:
07036             (*vreturned).data.flvalue = (short) v1.data.dirvalue > (short) v2.data.dirvalue;
07037             
07038             break;
07039             
07040         case datevaluetype:
07041             (*vreturned).data.flvalue = timegreaterthan (v1.data.datevalue, v2.data.datevalue);
07042             
07043             break;
07044         
07045         case singlevaluetype:
07046             (*vreturned).data.flvalue = v1.data.singlevalue > v2.data.singlevalue;
07047             
07048             break;
07049         
07050         case doublevaluetype:
07051             (*vreturned).data.flvalue = **v1.data.doublevalue > **v2.data.doublevalue;
07052             
07053             break;
07054         
07055         case stringvaluetype:
07056             (*vreturned).data.flvalue = comparehandles (v1.data.stringvalue, v2.data.stringvalue) == 1;
07057             
07058             break;
07059         
07060         default:
07061             langerror (comparisonnotpossibleerror);
07062             
07063             fl = false; /*operation is not defined*/
07064             
07065             break;
07066         } /*switch*/
07067     
07068     disposevalues (&v1, &v2);
07069     
07070     return (fl);
07071     } /*GTvalue*/
07072 
07073 
07074 boolean LEvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
07075 
07076     if (!GTvalue (v1, v2, vreturned)) 
07077         return (false);
07078     
07079     (*vreturned).data.flvalue = !(*vreturned).data.flvalue;
07080     
07081     return (true);
07082     } /*LEvalue*/
07083     
07084     
07085 boolean LTvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
07086     
07087     /*
07088     1/25/93 dmb: added case for novaluetype
07089     */
07090     
07091     boolean fl = true;
07092     
07093     if (!coercetypes (&v1, &v2)) {
07094         
07095         disposevalues (&v1, &v2);
07096         
07097         return (false);
07098         }
07099     
07100     initvalue (vreturned, booleanvaluetype);
07101     
07102     switch (v1.valuetype) {
07103         
07104         case novaluetype:
07105             (*vreturned).data.flvalue = false;
07106             
07107             break;
07108         
07109         case booleanvaluetype:
07110             (*vreturned).data.flvalue = v1.data.flvalue < v2.data.flvalue;
07111                     
07112             break;
07113         
07114         case charvaluetype:
07115             (*vreturned).data.flvalue = v1.data.chvalue < v2.data.chvalue;
07116                     
07117             break;
07118         
07119         case intvaluetype:
07120         case tokenvaluetype:
07121             (*vreturned).data.flvalue = v1.data.intvalue < v2.data.intvalue;
07122                     
07123             break;
07124         
07125         case longvaluetype:
07126         case ostypevaluetype:
07127         case fixedvaluetype:
07128             (*vreturned).data.flvalue = v1.data.longvalue < v2.data.longvalue;
07129                     
07130             break;
07131             
07132         case directionvaluetype:
07133             (*vreturned).data.flvalue = (short) v1.data.dirvalue < (short) v2.data.dirvalue;
07134             
07135             break;
07136             
07137         case datevaluetype:
07138             (*vreturned).data.flvalue = timelessthan (v1.data.datevalue, v2.data.datevalue);
07139                     
07140             break;
07141         
07142         case singlevaluetype:
07143             (*vreturned).data.flvalue = v1.data.singlevalue < v2.data.singlevalue;
07144             
07145             break;
07146         
07147         case doublevaluetype:
07148             (*vreturned).data.flvalue = **v1.data.doublevalue < **v2.data.doublevalue;
07149             
07150             break;
07151         
07152         case stringvaluetype:
07153             (*vreturned).data.flvalue = comparehandles (v1.data.stringvalue, v2.data.stringvalue) == -1;
07154             
07155             break;
07156         
07157         default:
07158             langerror (comparisonnotpossibleerror);
07159             
07160             fl = false; /*operation is not defined*/
07161             
07162             break;
07163         } /*switch*/
07164     
07165     disposevalues (&v1, &v2);
07166         
07167     return (fl);
07168     } /*LTvalue*/
07169 
07170 
07171 boolean GEvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
07172 
07173     if (!LTvalue (v1, v2, vreturned)) 
07174         return (false);
07175     
07176     (*vreturned).data.flvalue = !(*vreturned).data.flvalue;
07177     
07178     return (true);
07179     } /*GEvalue*/
07180 
07181 
07182 static boolean stringcomparevalue (tyvaluerecord *v1, tyvaluerecord *v2, tytreetype op, tyvaluerecord *vreturned) {
07183 
07184     register Handle h1, h2;
07185     long ixstart = 0;
07186     long ixlimit = longinfinity;
07187     long result;
07188     
07189     initvalue (vreturned, booleanvaluetype);
07190     
07191     if (!coercetostring (v1))
07192         return (false);
07193     
07194     if (!coercetostring (v2))
07195         return (false);
07196     
07197     h1 = (*v1).data.stringvalue;
07198     
07199     h2 = (*v2).data.stringvalue;
07200     
07201     if (op == beginswithop) {
07202         ixlimit = gethandlesize (h2);
07203         }
07204     else if (op == endswithop) {
07205         ixstart = gethandlesize (h1) - gethandlesize (h2);
07206         }
07207     
07208     result = searchhandle (h1, h2, ixstart, ixlimit);
07209     
07210     (*vreturned).data.flvalue = result >= 0;
07211     
07212     return (true);
07213     } /*stringcomparevalue*/
07214 
07215 
07216 static boolean specialcomparisonvalue (register tyvaluerecord *v1, register tyvaluerecord *v2, tytreetype op, tyvaluerecord *vreturned) {
07217     
07218     switch ((*v1).valuetype) {
07219         
07220         case listvaluetype:
07221         case recordvaluetype:
07222             if (!coercetypes (v1, v2))
07223                 return (false);
07224             
07225             return (listcomparevalue (v1, v2, op, vreturned));
07226         
07227         default:
07228             return (stringcomparevalue (v1, v2, op, vreturned));
07229         }
07230     } /*specialcomparisonvalue*/
07231 
07232 
07233 boolean beginswithvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
07234     
07235     return (specialcomparisonvalue (&v1, &v2, beginswithop, vreturned));
07236     } /*beginswithvalue*/
07237 
07238 
07239 boolean endswithvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
07240 
07241     return (specialcomparisonvalue (&v1, &v2, endswithop, vreturned));
07242     } /*endswithvalue*/
07243 
07244 
07245 boolean containsvalue (tyvaluerecord v1, tyvaluerecord v2, tyvaluerecord *vreturned) {
07246 
07247     return (specialcomparisonvalue (&v1, &v2, containsop, vreturned));
07248     } /*containsvalue*/
07249 
07250 
07251 boolean andandvalue (tyvaluerecord v1, hdltreenode hp2, tyvaluerecord *vreturned) {
07252     
07253     /*
07254     9/4/91 dmb: take code tree for second parameter to allow short-circuit 
07255     evaluation
07256     
07257     6.2b15 AR: Call coercetoboolean directly instead of the now defunct truevalue
07258     */
07259     
07260     tyvaluerecord v2;
07261     boolean fl;
07262     
07263     if (!coercetoboolean (&v1))
07264         return (false);
07265     
07266     if (!v1.data.flvalue) /*no need to check param 2*/
07267         fl = false;
07268     else {
07269         
07270         if (!evaluatetree (hp2, &v2))
07271             return (false);
07272         
07273         if (!coercetoboolean (&v2))
07274             return (false);
07275         
07276         fl = v2.data.flvalue;
07277         }
07278     
07279     return (setbooleanvalue (fl, vreturned));
07280     } /*andandvalue*/
07281 
07282 
07283 boolean ororvalue (tyvaluerecord v1, hdltreenode hp2, tyvaluerecord *vreturned) {
07284     
07285     /*
07286     9/4/91 dmb: take code tree to second parameter to allow short-circuit 
07287     evaluation
07288     
07289     6.2b15 AR: Call coercetoboolean directly instead of the now defunct truevalue
07290     */
07291     
07292     tyvaluerecord v2;
07293     boolean fl;
07294     
07295     if (!coercetoboolean (&v1))
07296         return (false);
07297 
07298     if (v1.data.flvalue) /*no need to check param 2*/
07299         fl = true;  
07300     else {
07301         
07302         if (!evaluatetree (hp2, &v2))
07303             return (false);
07304         
07305         if (!coercetoboolean (&v2))
07306             return (false);
07307 
07308         fl = v2.data.flvalue;
07309         }
07310     
07311     return (setbooleanvalue (fl, vreturned));
07312     } /*ororvalue*/
07313     
07314     
07315 boolean unaryminusvalue (tyvaluerecord v1, tyvaluerecord *vreturned) {
07316     
07317     register boolean fl = true;
07318     
07319     initvalue (vreturned, v1.valuetype);
07320     
07321     switch (v1.valuetype) {
07322         
07323         case booleanvaluetype:
07324             (*vreturned).data.flvalue = -v1.data.flvalue;
07325             
07326             break;
07327             
07328         case charvaluetype:
07329             (*vreturned).data.chvalue = -v1.data.chvalue;
07330             
07331             break;
07332             
07333         case intvaluetype:
07334             (*vreturned).data.intvalue = -v1.data.intvalue;
07335             
07336             break;
07337             
07338         case longvaluetype:
07339             (*vreturned).data.longvalue = -v1.data.longvalue;
07340             
07341             break;
07342 #ifdef MACVERSION       
07343         case fixedvaluetype:
07344             (*vreturned).data.fixedvalue = -v1.data.fixedvalue;
07345 #endif      
07346         case singlevaluetype:
07347             (*vreturned).data.singlevalue = -v1.data.singlevalue;
07348             
07349             break;
07350         
07351         case doublevaluetype:
07352             fl = setdoublevalue (-**v1.data.doublevalue, vreturned);
07353             
07354             break;
07355         
07356         default:
07357             langerror (unaryminusnotpossibleerror);
07358             
07359             fl = false; /*unary minus is not defined*/
07360             
07361             break;
07362         } /*switch*/
07363     
07364     disposevalues (&v1, nil);
07365     
07366     return (fl);
07367     } /*unaryminusvalue*/
07368 
07369 
07370 boolean notvalue (tyvaluerecord v1, tyvaluerecord *vreturned) {
07371     
07372     /*
07373     7/10/91 dmb: rewrote to coerce to boolean, rather than applying the 
07374     boolean not operation on each oringal value type.  less code, and 
07375     more eliable.
07376     */
07377     
07378     if (!coercetoboolean (&v1))
07379         return (false);
07380     
07381     return (setbooleanvalue (!v1.data.flvalue, vreturned));
07382     } /*notvalue*/
07383 
07384 
07385 static boolean sizefunc (hdltreenode hparam1, tyvaluerecord *vreturned) {
07386     
07387     tyvaluerecord v;
07388     long size;
07389     
07390     flnextparamislast = true;
07391     
07392     if (!getreadonlyparamvalue (hparam1, 1, &v))
07393         return (false);
07394     
07395     if (!langgetvalsize (v, &size)) {
07396         
07397         langerror (cantsizeerror); 
07398             
07399         return (false);
07400         }
07401     
07402     return (setlongvalue (size, vreturned));
07403     } /*sizefunc*/
07404 
07405 
07406 static boolean typefunc (hdltreenode hparam1, tyvaluerecord *vreturned) {
07407     
07408     tyvaluerecord v;
07409     
07410     flnextparamislast = true;
07411     
07412     if (!getreadonlyparamvalue (hparam1, 1, &v))
07413         return (false);
07414     
07415     if (v.valuetype == externalvaluetype)
07416         v.valuetype = (tyvaluetype) (outlinevaluetype + langexternalgettype (v));
07417     
07418     setostypevalue (langgettypeid (v.valuetype), vreturned);
07419     
07420     return (true);
07421     } /*typefunc*/
07422 
07423 
07424 static boolean namefunc (hdltreenode hparam1, tyvaluerecord *vreturned) {
07425     
07426     /*
07427     2.1b2 dmb: added support for getting name of record items
07428     
07429     3.0.2b3: don't try to retrieve array value when we're indexing by name; 
07430     just use name in that case
07431     
07432     5.0.2b8 dmb: if the named item exists, extract its true name to fix case.
07433     */
07434     
07435     register hdltreenode hp1 = hparam1;
07436     hdlhashtable htable;
07437     bigstring bsvarname;
07438     tyvaluerecord valarray;
07439     tyvaluerecord valindex;
07440     tyvaluerecord valitem;
07441     hdlhashnode hn;
07442     bigstring bsname;
07443     
07444     if (!langcheckparamcount (hp1, 1))
07445         return (false);
07446     
07447     disablelangerror (); /*any error will result in a null return*/
07448     
07449     if (langgetdotparams (hp1, &htable, bsname)) { // 5.0.2: make sure name has original case if item exists
07450         
07451         if ((htable != nil) && hashtablelookupnode (htable, bsname, &hn))
07452             gethashkey (hn, bsname);
07453         }
07454     else { /*try something else*/
07455         
07456         setemptystring (bsname); /*default return, override dotparam remnant*/
07457         
07458         if ((**hp1).nodetype == arrayop) { /*may be array into record*/
07459             
07460             #if oldarrays
07461                 
07462                 if (!getarrayandindex (hp1, &htable, bsvarname, &valarray, &valindex))
07463                     goto exit;
07464             
07465             #else
07466             
07467                 tyarraystack arraystack = {0};
07468                 short parent;
07469                 
07470                 if (!parsearrayreference (hp1, &arraystack, &htable, bsvarname, nil))
07471                     goto exit;
07472                 
07473                 parent = arraystack.topstack - 1;
07474                 
07475                 valarray = arraystack.element [parent].varray;
07476                 
07477                 valindex = arraystack.element [parent].vindex;
07478 
07479             #endif
07480             
07481             if (valarray.valuetype != recordvaluetype)
07482                 goto exit;
07483             
07484             #ifdef oplanglists
07485                 switch (valindex.valuetype) {
07486                     
07487                     case ostypevaluetype:
07488                         ostypetostring (valindex.data.ostypevalue, bsname);
07489                         break;
07490                     
07491                     case stringvaluetype:
07492                         pullstringvalue (&valindex, bsname);
07493                         break;
07494                     
07495                     default:
07496                         if (!coercetolong (&valindex))
07497                             goto exit;
07498                         
07499                         if (!langgetlistitem (&valarray, valindex.data.longvalue, bsname, &valitem))
07500                             goto exit;
07501                         
07502                         disposevaluerecord (valitem, true);
07503                         
07504                         break;
07505                     }
07506             #else
07507                 if (valindex.valuetype == ostypevaluetype)
07508                     key = valindex.data.ostypevalue;
07509                 
07510                 else {
07511                     
07512                     if (!coercetolong (&valindex))
07513                         goto exit;
07514                     
07515                     if (!langgetlistitem (&valarray, valindex.data.longvalue, &key, &valitem))
07516                         goto exit;
07517                     
07518                     disposevaluerecord (valitem, true);
07519                     }
07520                 
07521                 ostypetostring (key, bsname);
07522             #endif
07523             }
07524         }
07525     
07526     exit:
07527     
07528     enablelangerror ();
07529     
07530     return (setstringvalue (bsname, vreturned));
07531     } /*namefunc*/
07532 
07533 
07534 static boolean parentfunc (hdltreenode hparam1, tyvaluerecord *vreturned) {
07535     
07536     /*
07537     4.0b7 4/26/96 dmb: new verb
07538     
07539     5.0d19 dmb: special-case file window table as nil parent
07540 
07541     5.0b7 dmb: deal with items in locally-created table
07542     
07543     5.0.2 dmb: we now call findinparenttable, which encorporated our patentsearch 
07544     functionality. the table's parenthashtable is maintained for better performance
07545     */
07546     
07547     register hdltreenode hp1 = hparam1;
07548     hdlhashtable htable = nil;
07549     bigstring bsname;
07550     boolean flnoparent;
07551     
07552     if (!langcheckparamcount (hp1, 1))
07553         return (false);
07554     
07555     disablelangerror (); /*any error will result in a null return*/
07556     
07557     if (!langgetdotparams (hp1, &htable, bsname)) { /*need to try something else*/
07558         
07559         if ((**hp1).nodetype == arrayop) { /*may be array into record*/
07560         
07561             parsearrayreference (hp1, nil, &htable, bsname, nil);
07562             }
07563         }
07564     
07565     enablelangerror ();
07566     
07567     if (htable == nil) {
07568     
07569         if (!equalstrings (bsname, nameroottable))  // leave it nil if we're at root
07570             langsearchpathlookup (bsname, &htable);
07571         }
07572     
07573     setemptystring (bsname);
07574     
07575     if (htable == nil || htable == filewindowtable)
07576         flnoparent = true;
07577     else
07578         flnoparent = !findinparenttable (htable, &htable, bsname); // 5.0.2b13 dmb;
07579     
07580     /*
07581     else {
07582         if ((**htable).fllocaltable) {
07583             
07584             flnoparent = true;
07585             
07586             for (h = currenthashtable; h != nil; h = (**h).prevhashtable) {
07587                 
07588                 if (parentsearch (h, htable, true, &htable, bsname)) {
07589                     
07590                     flnoparent = false;
07591                     
07592                     break;
07593                     }
07594                 }
07595             }
07596         else
07597             flnoparent = !parentsearch (roottable, htable, true, &htable, bsname);
07598         }
07599     */
07600     
07601     if (flnoparent)
07602         return (setstringvalue (bsname, vreturned));
07603     else
07604         return (setaddressvalue (htable, bsname, vreturned));
07605     } /*parentfunc*/
07606 
07607 
07608 static boolean indexfunc (hdltreenode hparam1, tyvaluerecord *vreturned) {
07609     
07610     /*
07611     6.1d7 AR: Started implementation of indexOf verb.
07612     */
07613     
07614     register hdltreenode hp1 = hparam1;
07615     hdlhashtable htemp, htable = nil;
07616     bigstring bsname, bstemp;
07617     register hdlhashnode nomad;
07618     long ix = 0;
07619     
07620     if (!langcheckparamcount (hp1, 1))
07621         return (false);
07622     
07623     disablelangerror ();
07624 
07625     if (!langgetdotparams (hp1, &htable, bsname))
07626         goto exit;
07627 
07628     if (htable == nil && !equalstrings (bsname, nameroottable)) // leave it nil if we're at root
07629         langsearchpathlookup (bsname, &htable);
07630     
07631     if (htable == nil || htable == filewindowtable || !findinparenttable (htable, &htemp, bstemp))
07632         goto exit;
07633 
07634     nomad = (**htable).hfirstsort;
07635 
07636     while (nomad != nil) {
07637 
07638         ix++;
07639         
07640         if (equalidentifiers (bsname, (**nomad).hashkey)) /*search is over*/
07641             goto exit;
07642         
07643         nomad = (**nomad).sortedlink;
07644         } /*while*/
07645 
07646     ix = 0; /*not found*/
07647 
07648 exit:
07649             
07650     enablelangerror ();
07651 
07652     return (setlongvalue (ix, vreturned));
07653     } /*indexfunc*/
07654 
07655 
07656 #define infrontierprocess() (iscurrentapplication (langipcself))
07657 
07658 static boolean tablefindnode (hdlhashtable intable, hdlhashnode fornode, hdlhashtable *foundintable, bigstring foundname) {
07659 
07660     register hdlhashtable ht = intable;
07661     register hdlhashnode x;
07662     register short i;
07663     tyvaluerecord val;
07664     register hdlexternalvariable hv;
07665     
07666     for (i = 0; i < ctbuckets; i++) {
07667         
07668         x = (**ht).hashbucket [i];
07669         
07670         while (x != nil) { /*chain through the hash list*/
07671             
07672             if (x == fornode) { /*bravo!  we found it...*/
07673                 
07674                 *foundintable = ht;
07675                 
07676                 gethashkey (x, foundname);
07677                 
07678                 return (true);
07679                 }
07680             
07681             val = (**x).val;
07682             
07683             if (val.valuetype != externalvaluetype) 
07684                 goto nextx;
07685                 
07686             hv = (hdlexternalvariable) val.data.externalvalue;
07687             
07688             if ((**hv).id != idtableprocessor)
07689                 goto nextx;
07690             
07691             if (tablefindnode ((hdlhashtable) (**hv).variabledata, fornode, foundintable, foundname))
07692                 return (true); /*unwind recursion*/
07693                 
07694             nextx:
07695             
07696             x = (**x).hashlink; /*advance to next node in chain*/
07697             } /*while*/
07698         } /*for*/
07699         
07700     return (false);
07701     } /*tablefindnode*/
07702 
07703 
07704 static boolean kernelerrorroutine (long scripterrorrefcon, long lnum, short charnum, hdlhashtable *htable, bigstring bsname) {
07705 #pragma unused(lnum, charnum)
07706     /*
07707     display an error for a system script -- a handler, agent or startup script.
07708     
07709     called back from langerror.c.  we receive a handle to the table node that
07710     made the error, and we zoom out a window that displays the attached script,
07711     in text mode, with the character cursor pointing to line number lnum at
07712     offset charnum -- the exact spot where the error occured, we hope...
07713     
07714     2/4/91 dmb: allow hdlheadrecords to end up here too
07715     
07716     4.0b8 dmb: if caller provides non-null htable, don't show error, just return 
07717     its location. bsname better be non-null too!
07718 
07719     4/7/97 dmb: handle standalone scripts
07720     */
07721     
07722     register hdlhashnode h = (hdlhashnode) scripterrorrefcon;
07723     
07724     if (h == nil) /*defensive driving*/
07725         return (false);
07726     
07727     if (htable != nil) { /*caller wants table, name*/
07728         
07729         return (tablefindnode (efptable, h, htable, bsname));
07730         }
07731     
07732     return (false);
07733     } /*kernelerrorroutine*/
07734 
07735 
07736 boolean kernelfunctionvalue (hdlhashtable htable, bigstring bsverb, hdltreenode hparam1, tyvaluerecord *vreturned) {
07737     
07738     /*
07739     9/23/91 dmb: make sure langerrors don't go unnoticed
07740     
07741     2.1b1(?) dmb: this is the bottleneck where we potentially execute the 
07742     verb via an appleevent if necessary. if the kernel table says its verbs 
07743     require a window, we call the value routine with the actual token and 
07744     nil parameters. if it returns true, that tokens needs to be interpreted 
07745     while Frontier is the active process.
07746     */
07747     
07748     register boolean fl;
07749     register hdlhashtable ht = htable;
07750     langvaluecallback valueroutine;
07751     bigstring bserror;
07752     hdlhashnode hnode;
07753     tyvaluerecord val;
07754     boolean flprofiling = currentprocess && (**currentprocess).flprofiling;
07755     
07756     valueroutine = (**ht).valueroutine;
07757     
07758     assert (valueroutine != nil); /*this was checked at compile time in pushkernelcall*/
07759     
07760     fl = hashtablelookupnode (ht, bsverb, &hnode); /*get the token value*/
07761     
07762     if (fl)
07763         val = (**hnode).val;
07764     
07765     if (!valueroutine || !fl || (val.valuetype != tokenvaluetype)) { /*should never happen; preflighted at compile time*/
07766         
07767         langparamerror (notefperror, bsverb);
07768         
07769         return (false);
07770         }
07771     
07772 #if isFrontier && (MACVERSION || RABTEMPOUT)
07773     if ((**ht).flverbsrequirewindow && !infrontierprocess ()) { /*verb may need to be run in frontier process*/
07774         
07775         if ((*valueroutine) (val.data.tokenvalue, nil, nil, nil)) /*yup*/
07776             return (langipckernelfunction (ht, bsverb, hparam1, vreturned));
07777         }
07778 #endif  
07779     setemptystring (bserror);
07780     
07781     if (flprofiling) {
07782         
07783         if (!langpusherrorcallback (kernelerrorroutine, (long) hnode))
07784             return (false);
07785         }
07786     
07787     fl = (*valueroutine) (val.data.tokenvalue, hparam1, vreturned, bserror);
07788     
07789     if (!fl && !isemptystring (bserror)) {
07790         
07791         setparseparams (bsverb, nil, nil, nil); /*insert verb name if called for*/
07792         
07793         parseparamstring (bserror);
07794         
07795         langerrormessage (bserror);
07796         }
07797     
07798     if (flprofiling)
07799         langpoperrorcallback ();
07800     
07801     return (fl && !fllangerror);
07802     } /*kernelfunctionvalue*/
07803 
07804 
07805 static boolean kernelcall (hdltreenode hcode, hdltreenode hparam1, tyvaluerecord *vreturned) {
07806     
07807     register hdltreenode h = hcode;
07808     hdlhashtable htable;
07809     bigstring bsverb;
07810     
07811     h = (**h).param1;
07812     
07813     assert ((**h).nodetype == kernelop);
07814     
07815     getaddressvalue ((**h).nodeval, &htable, bsverb);
07816     
07817     return (kernelfunctionvalue (htable, bsverb, hparam1, vreturned));
07818     } /*kernelcall*/
07819 
07820 
07821 static boolean langaddlocalsymbols (hdltreenode hnamelist, hdlhashtable htable, short *ctuninitialized) {
07822     
07823     /*
07824     add the names in hnamelist to the indicated table.  
07825     
07826     2.1b2 dmb: this code could be generalized to be shared with langaddlocals
07827     but error reporting is slightly different, and we're not calling the 
07828     debugger. the main issue w/error reporting is that the source code of the 
07829     handler itself is not pushed yet.
07830     
07831     4.1b4 dmb: added fllangexternalvalueprotect flag to disable protection
07832     
07833     4.1b5 dmb: push root table and choin to it so that addresses are resolved properly
07834     */
07835     
07836     register hdltreenode nomad = hnamelist;
07837     tyvaluerecord val;
07838     bigstring bs;
07839     boolean fl = false;
07840     
07841     *ctuninitialized = 0;
07842     
07843     pushhashtable (roottable);  /*4.1b5 dmb: need root table to resolve addresses properly*/
07844     
07845     chainhashtable (htable);    /*we chain to root to isolate evaluation from caller's context*/
07846     
07847     while (true) { /*step through name list, inserting each into symbol table*/
07848         
07849         if (nomad == nil) { /*reached the end of the names list*/
07850             
07851             fl = true;
07852             
07853             break;
07854             }
07855         
07856         if ((**nomad).nodetype == assignlocalop) {
07857             
07858             if (!evaluateparam ((**nomad).param2, &val))
07859                 break;
07860             
07861             if (fllangexternalvalueprotect && val.valuetype == externalvaluetype) {  /*4.1b4 dmb*/
07862                 
07863                 langbadexternaloperror (externalassignerror, val);
07864                 
07865                 break;
07866                 }
07867             
07868             if (!langgetidentifier ((**nomad).param1, bs))
07869                 break;
07870             }
07871         else {
07872             
07873             initvalue (&val, novaluetype);
07874             
07875             val.data.longvalue = -1; /*make this discernable from a nil assignment*/
07876             
07877             if (!langgetidentifier (nomad, bs))
07878                 break;
07879             
07880             ++*ctuninitialized;
07881             }
07882         
07883         val.flformalval = true; /*value isn't from actual parameter*/
07884         
07885         if (!hashassign (bs, val)) /*error creating new symbol*/
07886             break;
07887         
07888         exemptfromtmpstack (&val); /*it's been successfully added to local table*/
07889         
07890         cleartmpstack (); /*dealloc all outstanding temporary values*/  
07891         
07892         nomad = (**nomad).link; /*advance to next name in list*/
07893         } /*while*/
07894     
07895     unchainhashtable ();    /*4.1b5 dmb: now we're chained to root; see above*/
07896     
07897     pophashtable ();
07898     
07899     return (fl);
07900     } /*langaddlocalsymbols*/
07901 
07902 
07903 static boolean langaddfuncparams (hdltreenode hformal, hdltreenode hactual, hdlhashtable htable) {
07904     
07905     /*
07906     2.1b2 dmb: broke out of langfunccall and updated to support named 
07907     parameters. syntactically, a parameter list consists of zero or more 
07908     unnamed parameters followed by zero or more named parameters; they 
07909     can't be intermixed.
07910     
07911     as discused in langfunccall's header comment, htable must not be pushed 
07912     while evaluating parameter values.
07913     */
07914     
07915     register hdltreenode hf = hformal;
07916     register hdltreenode ha = hactual;
07917     bigstring bsname;
07918     tyvaluerecord val;
07919     tyvaluerecord vexists;
07920     boolean fl = false;
07921     short ctunassigned = 0;
07922     hdlhashnode hnode;
07923     
07924     while (true) {
07925         
07926         if (ha == nil) { /*ran out of actual parameters*/
07927         
07928             if (hf != nil) { /*there are still formal parameters waiting*/
07929                 
07930                 if (!langaddlocalsymbols (hf, htable, &ctunassigned))
07931                     break;
07932                 }
07933             
07934             if (ctunassigned == 0) /*everything worked out nicely*/
07935                 fl = true;
07936             else
07937                 langparamerror (notenoughparameterserror, bsfunctionname);
07938             
07939             break;
07940             }
07941         
07942         if ((**ha).nodetype == fieldop) { /*all following params will also be fields*/
07943             
07944             if (hf != nil) { /*must be first fieldop*/
07945                 
07946                 if (!langaddlocalsymbols (hf, htable, &ctunassigned))
07947                     break;
07948                 
07949                 hf = nil; /*all remaining formal parameters have been added*/
07950                 }
07951             
07952             if (!langgetidentifier ((**ha).param1, bsname))
07953                 break;
07954             
07955             if (!hashtablelookup (htable, bsname, &vexists, &hnode)) { /*no such parameter*/
07956                 
07957                 langseterrorline (ha);
07958                 
07959                 lang2paramerror (unknownparametererror, bsfunctionname, bsname);
07960                 
07961                 break;
07962                 }
07963             
07964             if (!vexists.flformalval) { /*already been assigned an actual value*/
07965             
07966                 langseterrorline (ha);
07967                 
07968                 lang2paramerror (duplicateparametererror, bsfunctionname, bsname);
07969                 
07970                 break;
07971                 }
07972             
07973             if ((vexists.valuetype == novaluetype) && (vexists.data.longvalue == -1))
07974                 --ctunassigned;
07975             
07976             if (!evaluateparam ((**ha).param2, &val))
07977                 break;
07978             }
07979         else {
07980             
07981             if (hf == nil) { /*ran out of parameters in the declaration*/
07982                 
07983                 langparamerror (toomanyparameterserror, bsfunctionname);
07984                 
07985                 break;
07986                 }
07987             
07988             if ((**hf).nodetype == assignlocalop) {
07989                 
07990                 if (!langgetidentifier ((**hf).param1, bsname))
07991                     break;
07992                 }
07993             else {
07994                 
07995                 if (!langgetidentifier (hf, bsname))
07996                     break;
07997                 }
07998             
07999             if (!evaluateparam (ha, &val))
08000                 break;
08001             
08002             hf = (**hf).link; /*advance to the next parameter name*/
08003             }
08004         
08005         if (fllangexternalvalueprotect && val.valuetype == externalvaluetype) {  /*4.1b4 dmb*/
08006             
08007             langbadexternaloperror (externalgetvalueerror, val);
08008             
08009             break;
08010             }
08011         
08012         val.flformalval = false; /*make sure it's clear*/
08013         
08014         if (!hashtableassign (htable, bsname, val)) /*assignment goes into the local table*/
08015             break;
08016         
08017         exemptfromtmpstack (&val); /*make sure it doesn't get released automatically*/
08018         
08019         ha = (**ha).link; /*advance to the next parameter value*/
08020         } /*while*/
08021     
08022     return (fl);
08023     } /*langaddfuncparams*/
08024 
08025 
08026 static boolean binaryfunctionvalue (hdlhashnode hnode, bigstring bsname, hdltreenode hparam1, tyvaluerecord *vreturned) {
08027     
08028     /*
08029     2.1b3 dmb: the OSA subroutine calling support strongly motivated making 
08030     binary values directly callable in general.  here's the first cut.
08031     */
08032     
08033     tyvaluerecord v = (**hnode).val;
08034     
08035     switch (getbinarytypeid (v.data.binaryvalue)) {
08036         
08037         case 'XCMD':
08038         case 'XFCN':
08039             break;
08040         
08041         case 'UCMD':
08042             break;
08043         
08044     #ifdef flcomponent
08045         default:
08046             return (evaluateosascript (&v, hparam1, bsname, vreturned));
08047     #endif
08048         }
08049     
08050     langparamerror (notfunctionerror, bsname);
08051     
08052     return (false);
08053     } /*binaryfunctionvalue*/
08054 
08055 
08056 boolean langfunctioncall (hdltreenode hcallernode, hdlhashtable htable, hdlhashnode hnode, bigstring bsname, hdltreenode hcode, hdltreenode hparam1, tyvaluerecord *vreturned) {
08057     
08058     /*
08059     run the code pointed to by hcode.  hparam1 points at the first parameter to
08060     the handler.
08061     
08062     a rather lengthy comment describing the format of a module:
08063     
08064     suppose this is the source for the module:
08065         
08066         on aaa (bbb)
08067             msg (bbb)
08068             
08069     this is what the code tree looks like:
08070     
08071         module op
08072             module op
08073                 tree for "msg (bbb)"
08074                 proc op
08075                     id
08076                         "aaa"
08077                     id
08078                         "bbb"
08079                         
08080     7/9/90 DW: the doubling up of moduleops only occurs for handlers that appear
08081     inside their own scripts, as implemented in the global handler table.  for
08082     a local handler, there is only one level of moduleops.
08083     
08084     2/15/91 dmb: parameter values must be evaluated in the original table so 
08085     that undeclared variables passed by address are created in the right place.
08086     
08087     9/23/91 dmb: fixed problem reporting errors when evaluating parameters, due to 
08088     the fact that too much of our new context was already set up.  the best thing 
08089     to do is to avoid pushing a new stack frame and the new source code until after 
08090     all parameters have been evaluated.  to permit this, magictable handling is now 
08091     at a deeper level -- in newhashtable and landpushlocalchain, so we can allocate 
08092     a locals table here while deferring the pushing of a local chain until later 
08093     (in evaluatelist).
08094     
08095     also, added hcallernode parameter so that a special debugger call can be made 
08096     after all parameters have been evaluated.  this way, if the user steps into a 
08097     function call in the parameter list, he can step out to the original call 
08098     instead of getting lost.
08099     
08100     xxx 9/24/92 dmb: manage ctlocks & fldisposewhenunlocked flags in code's hash node
08101     
08102     4.1b3 dmb: added call to new langseterrorcallbackline for stack tracing (on error)
08103     */
08104     
08105     register hdltreenode hname;
08106     register boolean fl;
08107     hdlhashtable hlocaltable;
08108 #if (version5orgreater && defined (flcomponent))
08109     tyvaluerecord osacode;
08110 #endif
08111     
08112     #if version5orgreater   // do special case checking here, not in langrunhandlercode
08113         
08114         if (hcode == nil) { /*can only be a kernel call -- or an error*/
08115             
08116             if ((**hnode).val.valuetype == binaryvaluetype)
08117                 return (binaryfunctionvalue (hnode, bsname, hparam1, vreturned));
08118             
08119             return (kernelfunctionvalue (htable, bsname, hparam1, vreturned));
08120             }
08121         
08122         if ((**(**hcode).param1).nodetype == kernelop)
08123             return (kernelcall (hcode, hparam1, vreturned));
08124         
08125         #ifdef flcomponent
08126             
08127             if (isosascriptnode (hcode, &osacode)) {
08128                 
08129                 if (!langpushsourcecode (htable, hnode, bsname))
08130                     return (false);
08131                 
08132                 // 5.0a18 dmb: this probably isn't adequate for osa execution
08133                 langsetthisvalue (currenthashtable, htable, bsname);
08134                 
08135                 fl = evaluateosascript (&osacode, hparam1, bsname, vreturned);
08136                 
08137                 langpopsourcecode ();
08138                 
08139                 return (fl);
08140                 }
08141             
08142         #endif // flcomponent
08143         
08144     #endif // version5orgreater
08145     
08146     bundle { /*safely navigate to get the name of the 1st formal param*/
08147         
08148         register hdltreenode hp2 = (**hcode).param2;
08149         
08150         if (hp2 == nil) /*no formal params*/
08151             hname = nil;
08152         else
08153             hname = (**hp2).param2; /*point at the name of the 1st param*/
08154         }
08155     
08156     if (!newhashtable (&hlocaltable)) /*new table for the function when it runs*/
08157         return (false);
08158     
08159     (**hlocaltable).fllocaltable = true; // 5.1.4: set now so pre-assignments know scope
08160     
08161     #ifdef flnewfeatures
08162     
08163     langseterrorcallbackline ();
08164     
08165     #endif
08166     
08167     fl = langaddfuncparams (hname, hparam1, hlocaltable);
08168     
08169     if (fl && hcallernode)
08170         fl = langdebuggercall (hcallernode); /*user killed the script*/
08171     
08172     if (fl)
08173         fl = langpushsourcecode (htable, hnode, bsname);
08174     
08175     if (fl && !(**htable).fllocaltable)
08176         fl = langsetthisvalue (hlocaltable, htable, bsname);
08177     
08178     if (!fl) {
08179         
08180         disposehashtable (hlocaltable, false);
08181         
08182         return (false);
08183         }
08184     
08185     hmagictable = hlocaltable; /*evaluatelist uses this as its local symbol table*/
08186     
08187     /*
08188     ++(**hn).ctlocks;
08189     */
08190     
08191     fl = evaluatelist ((**hcode).param1, vreturned);
08192     
08193     flreturn = false; /*if he return-d to get out, we've gone far enough*/
08194     
08195     langpopsourcecode ();
08196     
08197     /*
08198     if (--(**hn).ctlocks == 0) {
08199         
08200         if ((**hn).fldisposewhenunlocked)
08201             disposehashnode (hn, ?, ?);
08202         }
08203     */
08204     
08205     return (fl);
08206     } /*langfunctioncall*/
08207 
08208 
08209 #if version5orgreater
08210 
08211 static boolean isentrypoint (hdltreenode hcode, bigstring bsname, bigstring bsprocname) {
08212     
08213     /*
08214     5.0b10 dmb: need to return any found proc name in bsidentifier, for
08215     error reporting
08216     */
08217 
08218     if ((**hcode).nodetype == moduleop) { // it's a proc, or a wrapper
08219         
08220         hdltreenode hp2 = (**hcode).param2;
08221         
08222         if (hp2 && ((**hp2).nodetype == procop)) { // it's a proc, an eligable entrypoint
08223             
08224             if (bsname == nil) // no name specified, no match needed
08225                 return (true);
08226             
08227             if (langgetidentifier ((**hp2).param1, bsprocname)) {
08228                 
08229                 if (equalidentifiers (bsprocname, bsname))
08230                     return (true);
08231                 }
08232             }
08233         }
08234 
08235     return (false);
08236     } /*isentrypoint*/
08237 
08238 
08239 static hdltreenode langgetentrypoint (hdltreenode hcode, bigstring bsname, hdlhashtable htable, hdlhashnode hnode) {
08240 
08241     /*
08242     skip over extra level of modularity that exists in external 
08243     handle calls.
08244     
08245     see comment in langfunctioncall
08246     
08247     5/28/91 dmb: only skip level when the module name is the same as the 
08248     indicated external name (the name of the script in the database).  if no 
08249     name is given, no match is required
08250     
08251     11/25/91 dmb: use langgetidentifier to handle entrypoints that are 
08252     bracketed expressions.
08253     
08254     2/13/92 dmb: treat entrypoint name mismatch as an error if that's all
08255     there is in the module.  added htable/hnode parameters so that errors can be 
08256     reported nicely
08257     
08258     3/19/97 dmb: if there is more than one top-level module, look at them 
08259     all for a match
08260     */
08261     
08262     hdltreenode hp1;
08263     hdltreenode hp2 = nil;
08264     boolean foundbody = false;
08265     bigstring bsidentifier;
08266     
08267     if (isentrypoint (hcode, bsname, bsidentifier))
08268         return (hcode);
08269 
08270     for (hp1 = (**hcode).param1; hp1 != nil; hp1 = (**hp1).link) {
08271     
08272         switch ((**hp1).nodetype) {
08273             
08274             case noop:
08275                 break;
08276             
08277             case moduleop:
08278                 if (hp2)
08279                     foundbody = true; // multiple modules, treat as having body (for error reporting)
08280                 
08281                 if (isentrypoint (hp1, bsname, bsidentifier))
08282                     return (hp1);
08283                 
08284                 hp2 = (**hp1).param2; // remember, for error reporting
08285                 
08286                 break;
08287             
08288             default:
08289                 foundbody = true;
08290                 
08291                 break;
08292             }
08293         }
08294     
08295     if (!foundbody && hp2) { // only found one or more modules with mis-matched hnames
08296         
08297         langpushsourcecode (htable, hnode, bsfunctionname); /*point user at bad script...*/
08298         
08299         langseterrorline ((**hp2).param1); /*...rather than the call to it*/
08300         
08301         lang2paramerror (badentrypointnameerror, bsname, bsidentifier);
08302         
08303         langpopsourcecode ();
08304         
08305         return (nil);
08306         }
08307     
08308     return (hcode);
08309     } /*langgetentrypoint*/
08310 
08311 #else
08312 
08313 static hdltreenode langgetentrypoint (hdltreenode hcode, bigstring bsname, hdlhashtable htable, hdlhashnode hnode) {
08314 
08315     /*
08316     skip over extra level of modularity that exists in external 
08317     handle calls.
08318     
08319     see comment in langfunctioncall
08320     
08321     5/28/91 dmb: only skip level when the module name is the same as the 
08322     indicated external name (the name of the script in the database).  if no 
08323     name is given, no match is required
08324     
08325     11/25/91 dmb: use langgetidentifier to handle entrypoints that are 
08326     bracketed expressions.
08327     
08328     2/13/92 dmb: treat entrypoint name mismatch as an error if that's all
08329     there is in the module.  added htable/hnode parameters so that errors can be 
08330     reported nicely
08331     */
08332     
08333     register hdltreenode hp1 = (**hcode).param1;
08334     
08335     while (hp1 && (**hp1).nodetype == noop) /*skip over comments, blank lines*/
08336         hp1 = (**hp1).link;
08337     
08338     if (hp1 && (**hp1).nodetype == moduleop) { /*skip one level of modularity*/
08339         
08340         register hdltreenode hp2 = (**hp1).param2; /*should be procop*/
08341         bigstring bsidentifier;
08342         
08343         assert (hp2 && ((**hp2).nodetype == procop));
08344         
08345         if (bsname == nil)
08346             return (hp1);
08347         
08348         if (langgetidentifier ((**hp2).param1, bsidentifier)) {
08349             
08350             if (equalidentifiers (bsidentifier, bsname))
08351                 return (hp1);
08352             
08353             if ((**hp1).link == nil) { /*nothing left; this is a bug*/
08354                 
08355                 langpushsourcecode (htable, hnode, bsfunctionname); /*point user at bad script...*/
08356                 
08357                 langseterrorline ((**hp2).param1); /*...rather than the call to it*/
08358                 
08359                 lang2paramerror (badentrypointnameerror, bsname, bsidentifier);
08360                 
08361                 langpopsourcecode ();
08362                 
08363                 return (nil);
08364                 }
08365             }
08366         }
08367     
08368     return (hcode);
08369     } /*langgetentrypoint*/
08370 
08371 #endif // version5orgreater
08372 
08373 
08374 #if 0
08375 
08376 boolean langgetlocalhandlercode (bigstring bs, hdltreenode *hcode) {
08377     
08378     hdlhashtable htable;
08379     tyvaluerecord val;
08380     
08381     if (!langgetsymbolval (bs, &val)) /*not found in local chain*/
08382         return (false);
08383     
08384     if (val.valuetype != codevaluetype) /*not a local handler*/
08385         return (false);
08386     
08387     *hcode = val.data.codevalue;
08388     
08389     return (true);
08390     } /*langgetlocalhandlercode*/
08391 
08392 #endif
08393 
08394 
08395 boolean langgetnodecode (hdlhashtable ht, bigstring bs, hdlhashnode hnode, hdltreenode *hcode) {
08396 
08397     tyvaluerecord val = (**hnode).val;
08398     
08399     switch (val.valuetype) {
08400         
08401         case externalvaluetype: /*might be a script*/
08402             
08403             if (!langexternalvaltocode (val, hcode)) // error; not a code node
08404                 return (false);
08405             
08406             if (*hcode == nil) { /*it needs to be compiled*/
08407                 
08408                 if (!(*langcallbacks.scriptcompilecallback) (hnode, hcode)) /*error compiling the script*/
08409                     return (false);
08410                 
08411                 langseterrorline (herrornode);  /*4.1b4 dmb: compiling screws up the line/char globals*/
08412                 }
08413             
08414             break; /*get entry point*/
08415             
08416         case codevaluetype: /*probably a local handler*/
08417             
08418             *hcode = val.data.codevalue; /*easy case*/
08419             
08420             break; /*get entry point*/
08421         
08422         case tokenvaluetype: /*probably a kernel call*/
08423             
08424             if ((**ht).valueroutine == nil) // error; not a kernel table
08425                 return (false);
08426             
08427             *hcode = nil; /*special case*/
08428             
08429             return (true); /*we're done*/
08430         
08431         case binaryvaluetype:
08432             
08433             *hcode = nil; /*special case*/
08434             
08435             return (true); /*we're done*/
08436         
08437         default: /*symbol is defined, but it isn't code or a script*/
08438             return (false);
08439         }
08440     
08441     *hcode = langgetentrypoint (*hcode, bs, ht, hnode);
08442     
08443     return (true);
08444     } /*langgetnodecode*/
08445 
08446 
08447 static boolean langgethandlercode (hdlhashtable intable, hdltreenode hnamenode, hdltreenode *hcode, hdlhashtable *htable, hdlhashnode *hnode) {
08448     
08449     /*
08450     hnamenode points to the name of the handler to be executed.  it could be a 
08451     dotop -- in which case it's the name-path to a handler.
08452     
08453     if it names a real node, and it's of type script, we return a handle to the
08454     code to be executed.
08455     
08456     1/7/90 dmb: we no longer want to generate any errors if we can't find 
08457     the specified script, so we can be called again to look somewhere else.  
08458     however, once we find the script, we should call langerror if an error 
08459     is encountered, so our caller will know not to try again.
08460     
08461     10/4/91 dmb: last-minute quick-fix for an n-squared performance problem. 
08462     langhandlercall does something the language doesn't usually do: it will 
08463     resolve a reference to an object whose table has the same name as a table 
08464     ahead of it in the search path.  this allows the user to add to the builtin 
08465     tables by adding their own version locally; verbs will be found in whichever 
08466     table they're in.  However, the behavior isn't supported language-wide, and 
08467     it would be messy to do so. (because in general we need for langgetdotparams 
08468     resolve non-existant addresses, and quickly.)  Anyway, since this routine is 
08469     called from a searchpathvisit, we want to inhibit langgetdotparams from doing 
08470     its searchpathvisit -- except for the first time, when we're called in the 
08471     current scope.  the fllocaldotparamsonly is set for this purpose.
08472     
08473     4/8/93 dmb: allow for codevalue case that isn't a local handler
08474     
08475     2.1b9 dmb: scan for entry point into local handlers; they may have 
08476     been created by script.getCode
08477     
08478     3/19/97 dmb: moved code extracting code into new langgetnodecode.
08479     */
08480     
08481     register hdlhashtable ht;
08482     bigstring bs;
08483     register boolean fl;
08484     
08485     setemptystring (bs);
08486     
08487     disablelangerror (); /*no dialog if an error is encountered*/
08488     
08489     if (intable != currenthashtable) /*not being called for default scope*/
08490         fllocaldotparamsonly = true;
08491     
08492     pushhashtable (intable);
08493     
08494     fl = langgetdotparams (hnamenode, htable, bs);
08495     
08496     pophashtable ();
08497     
08498     fllocaldotparamsonly = false;
08499     
08500     if (!isemptystring (bs)) {
08501         
08502         if (fl || isemptystring (bsfunctionname)) /*copy into global even on error*/
08503             copystring (bs, bsfunctionname);
08504         }
08505     
08506     enablelangerror ();
08507     
08508     if (!fl) 
08509         return (false);
08510     
08511     ht = *htable; /*move into register*/
08512     
08513     if (ht == nil) { /*no table specified*/
08514         
08515         pushhashtable (intable);
08516         
08517         fl = langfindsymbol (bs, htable, hnode);
08518         
08519         pophashtable ();
08520         
08521         if (!fl) /*not found in specified chain -- no error*/
08522             return (false);
08523         
08524         ht = *htable; /*update register*/
08525         }
08526     else {
08527         
08528         pushhashtable (ht); /*it was a dotted name, look in the indicated table*/
08529         
08530         fl = hashlookupnode (bs, hnode);
08531         
08532         pophashtable ();
08533         
08534         if (!fl) { /*not found in specified table -- this is not an error (yet)*/
08535             
08536             /*
08537             langparamerror (unknownfunctionerror, bs);
08538             */
08539             
08540             return (false);
08541             }
08542         }
08543     
08544     /*we've found the table entry, now let's try to get some code out of it*/
08545     
08546     if (!langgetnodecode (ht, bs, *hnode, hcode)) {
08547         
08548         langparamerror (notfunctionerror, bs);
08549         
08550         return (false);
08551         }
08552     
08553     return (true);
08554     } /*langgethandlercode*/
08555 
08556 
08557 static struct { /*handler info for visit routine*/
08558     
08559     hdltreenode htree; /*code tree specifying handler code node*/
08560     
08561     hdlhashnode hnode; /*hash node containing code*/
08562     
08563     hdltreenode hcode; /*handler code itself*/
08564     } handlercode;
08565 
08566 
08567 static boolean langgethandlervisit (hdlhashtable intable, bigstring bs, hdlhashtable *htable) {
08568 #pragma unused(bs)
08569     return (langgethandlercode (intable, handlercode.htree, &handlercode.hcode, htable, &handlercode.hnode));
08570     } /*langgethandlervisit*/
08571 
08572 
08573 boolean langhandlercall (hdltreenode htree, hdltreenode hparam1, tyvaluerecord *vreturned) {
08574     
08575     /*
08576     first try to find the handler in the local chain of symbol tables.
08577     
08578     then look in the all tables in the search path.
08579     
08580     then look in the kernel table.
08581     
08582     then give up.
08583     
08584     1/7/90: see comment in langgethandlercode.  no longer disablelangerror around 
08585     calls to it.
08586     
08587     10/3/91 dmb: support having the kernel table in the paths table; don't 
08588     assume found code is non-nil
08589     
08590     2/13/92 dmb: check fllangerror after getting handler code
08591     
08592     2.1b5 dmb: need to push source when evaluating an osa script
08593     
08594     3.0a dmb: before generating an error for an unknown function, give landipc 
08595     a chance to handle it using the subroutine event mechanism.
08596 
08597     5.0b11 dmb: added another big band-aid for bracked expressions. they can't work
08598     with the existing logic, because the bracketed expression needs full scoping, but
08599     then calling the result of the expression also needs full scoping. so I added a 
08600     special case, after all else has failed. it couldprobably just as well go first.
08601 
08602     really, this entire routine,along of gethandlercode, should be rewritten to just
08603     evaluate htree, then call it. whatever is needed to maintain its current ability
08604     to find a second table satifying the dotparams should be added to the general 
08605     search path mechanism.
08606     */
08607     
08608     hdltreenode hcode;
08609     hdlhashtable htable;
08610     hdlhashnode hnode;
08611     // boolean fl;
08612     // tyvaluerecord osacode;
08613     
08614     setemptystring (bsfunctionname); /*must initialize for langgethandlercode error logic*/
08615     
08616     if (langgethandlercode (currenthashtable, htree, &hcode, &htable, &hnode)) /*found it in root structure*/
08617         goto runhandler;
08618     
08619     if (fllangerror) /*found it, but error getting code*/
08620         return (false);
08621     
08622     handlercode.htree = htree;
08623     
08624     if (langsearchpathvisit (&langgethandlervisit, nil, &htable)) {
08625         
08626         hcode = handlercode.hcode;
08627         
08628         hnode = handlercode.hnode;
08629         
08630         goto runhandler;
08631         }
08632     
08633     if (langgethandlercode (efptable, htree, &hcode, &htable, &hnode)) {
08634         
08635         assert (hcode == nil); /*see special case in gethandlercode*/
08636         
08637         goto runhandler;
08638         }
08639     
08640     #ifdef version5orgreater
08641         if ((**htree).nodetype == dotop) { // 8.0.4 dmb: handle remote functions for SCNS
08642             
08643             if (langisremotefunction (htree))
08644                 return (langremotefunctioncall (htree, hparam1, vreturned));
08645             }
08646 
08647         if ((**htree).nodetype == bracketop) { // 5.0b11 dmb: fixed calling bracketed expresssions
08648             bigstring bs;
08649             
08650             if (langgetidentifier (htree, bs)) {
08651                 
08652                 if (langsearchpathlookup (bs, &htable)) {
08653                     
08654                     hashtablelookupnode (htable, bs, &hnode);
08655                     
08656                     if (!langgetnodecode (htable, bs, hnode, &hcode)) {
08657                         
08658                         langparamerror (notfunctionerror, bs);
08659                         
08660                         return (false);
08661                         }
08662 
08663                     copystring (bs, bsfunctionname);
08664 
08665                     goto runhandler;
08666                     }
08667                 }
08668             }
08669             
08670     #endif
08671 
08672     #if isFrontier && MACVERSION
08673         if (langipchandlercall (htree, bsfunctionname, hparam1, vreturned)) /*3.0a*/
08674             return (true);
08675     #endif
08676     
08677     langparamerror (unknownfunctionerror, bsfunctionname);
08678     
08679     return (false);
08680     
08681     runhandler:
08682     
08683     if (fllangerror)
08684         return (false);
08685     
08686     return (langfunctioncall (htree, htable, hnode, bsfunctionname, hcode, hparam1, vreturned));
08687     } /*langrunhandlercode*/
08688 
08689 
08690 static boolean builtinvalue (tyfunctype token, hdltreenode hparam1, tyvaluerecord *vreturned) {
08691     
08692     /*
08693     4/2/93 dmb: syscrashfunc: takes optional string param.
08694     
08695     2.1b2 dmb: broke this out of functionvalue so we don't share stack 
08696     space with handler calls
08697     */
08698     
08699     register tyvaluerecord *v = vreturned;
08700     register hdltreenode hp1 = hparam1;
08701     
08702     setbooleanvalue (true, v);
08703     
08704     setemptystring (bsfunctionname);
08705     
08706     functiontoken = token; /*set global*/
08707     
08708     switch (token) {
08709         
08710         case sizeoffunc:
08711             return (sizefunc (hp1, v));
08712         
08713         case typeoffunc:
08714             return (typefunc (hp1, v));
08715         
08716         case nameoffunc:
08717             return (namefunc (hp1, v));
08718         
08719         case parentoffunc:
08720             return (parentfunc (hp1, v));
08721 
08722         case indexoffunc:
08723             return (indexfunc (hp1, v));
08724         
08725         case definedfunc: {
08726             tyvaluerecord val;
08727             
08728             if (!langcheckparamcount (hp1, 1))
08729                 return (false);
08730             
08731             disablelangerror (); /*any error will result in false return*/
08732             
08733             (*v).data.flvalue = getreadonlyparamvalue (hp1, 1, &val);
08734             
08735             enablelangerror ();
08736             
08737             return (true);
08738             }
08739         
08740         case packfunc:
08741             return (langpackverb (hp1, v));
08742         
08743         case unpackfunc:
08744             return (langunpackverb (hp1, v));
08745 #if isFrontier && (MACVERSION || RABNOTIMPEMENTED)
08746         case appleeventfunc:
08747             return (langipcmessage (hp1, normalmsg, v));
08748         
08749         case findereventfunc:
08750             return (langipcmessage (hp1, noreplymsg, v));
08751         
08752         case complexeventfunc:
08753             return (langipccomplexmessage (hp1, v));
08754         
08755         case tableeventfunc:
08756             return (langipctablemessage (hp1, v));
08757 #endif      
08758         case objspecfunc:
08759             flnextparamislast = true;
08760             
08761             return (getobjspecparam (hp1, 1, v));
08762         
08763         case setobjspecfunc:
08764             return (setobjspecverb (hp1, v));
08765         
08766 #ifdef MACVERSION
08767         case gestaltfunc: {
08768             OSType selector;
08769             long result;
08770             
08771             flnextparamislast = true;
08772             
08773             if (!getostypevalue (hp1, 1, &selector))
08774                 return (false);
08775             
08776             if (!gestalt (selector, &result))
08777                 result = -1;
08778             
08779             return (setlongvalue (result, v));
08780             }
08781 #endif
08782             
08783         case syscrashfunc: {
08784             
08785             bigstring bs;
08786             
08787             flparamerrorenabled = false;
08788             
08789             if (getstringvalue (hp1, 1, bs))
08790                 DebugStr (bs);
08791             else
08792                 Debugger ();
08793             
08794             flparamerrorenabled = true;
08795             
08796             return (true);
08797             }
08798         
08799         #if isFrontier && !flruntime
08800         
08801         case myMooffunc: {
08802             short ticksbetweenframes;
08803             long totalticks = 0;
08804             
08805             if (!getintvalue (hp1, 1, &ticksbetweenframes))
08806                 return (false);
08807             
08808             if (langgetparamcount (hp1) > 1) {
08809                 
08810                 flnextparamislast = true;
08811                 
08812                 if (!getlongvalue (hp1, 2, &totalticks))
08813                     return (false);
08814                 }
08815             
08816             shellblockevents ();
08817             
08818             (*v).data.flvalue = myMoof (ticksbetweenframes, totalticks);
08819             
08820             shellpopevents ();
08821             
08822             return (true);
08823             }
08824         
08825         #endif
08826         
08827             default:
08828                 /* do nothing */
08829                 break;
08830                 
08831         } /*switch*/
08832     
08833     #ifdef fldebug
08834     
08835     langerrormessage (STR_Internal_error_unimplemented_function_call);
08836     
08837     #endif
08838     
08839     setbooleanvalue (false, v);
08840     
08841     return (false);
08842     } /*builtinvalue*/
08843 
08844 
08845 boolean functionvalue (hdltreenode htree, hdltreenode hparam1, tyvaluerecord *vreturned) {
08846     
08847     /*
08848     call the function and return the value it returns.
08849     
08850     hparam1 points at the first parameter to the function being called.
08851     */
08852     
08853     tyvaluerecord val = (**htree).nodeval;
08854     
08855     if (((**htree).nodetype == dotop) || (val.valuetype != tokenvaluetype))
08856         return (langhandlercall (htree, hparam1, vreturned));
08857     else
08858         return (builtinvalue ((tyfunctype) val.data.tokenvalue, hparam1, vreturned));
08859     } /*functionvalue*/
08860 
08861 
08862 
08863 

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