langops.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langops.c 1260 2006-04-13 06:13:10Z sethdill $    */
00003 
00004 /******************************************************************************
00005 
00006     UserLand Frontier(tm) -- High performance Web content management,
00007     object database, system-level and Internet scripting environment,
00008     including source code editing and debugging.
00009 
00010     Copyright (C) 1992-2004 UserLand Software, Inc.
00011 
00012     This program is free software; you can redistribute it and/or modify
00013     it under the terms of the GNU General Public License as published by
00014     the Free Software Foundation; either version 2 of the License, or
00015     (at your option) any later version.
00016 
00017     This program is distributed in the hope that it will be useful,
00018     but WITHOUT ANY WARRANTY; without even the implied warranty of
00019     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00020     GNU General Public License for more details.
00021 
00022     You should have received a copy of the GNU General Public License
00023     along with this program; if not, write to the Free Software
00024     Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
00025 
00026 ******************************************************************************/
00027 
00028 #include "frontier.h"
00029 #include "standard.h"
00030 
00031 #include "memory.h"
00032 #include "ops.h"
00033 #include "strings.h"
00034 #include "cursor.h"
00035 #include "db.h"
00036 #include "file.h"
00037 #include "font.h"
00038 #include "resources.h"
00039 #include "lang.h"
00040 #include "langinternal.h"
00041 #include "langexternal.h"
00042 #include "langsystem7.h"
00043 #include "tableinternal.h"
00044 #include "tablestructure.h"
00045 #include "process.h"
00046 #include "oplist.h"
00047 
00048 
00049 
00050 
00051 #define minstackspace 0x0800
00052 
00053 
00054 boolean flstackoverflow = false;
00055 
00056 boolean flfindanyspecialsymbol = false; /*see langfindsymbol*/
00057 
00058 //short flextendedsymbolsearch = true; /*see langgetsymbolval*/
00059 
00060 
00061 
00062 typedef struct tytypeinfo {
00063     
00064     OSType id;
00065     
00066     byte *bsname;
00067     } tytypeinfo;
00068 
00069 
00070 static tytypeinfo typeinfo [ctvaluetypes] = {
00071     
00072     {'\?\?\?\?', STR_unknown},
00073     
00074     {'char', STR_char},
00075     
00076     {'shor', STR_int},
00077     
00078     {'long', STR_long},
00079     
00080     {'bad1', STR_unused1}, /*8/13*/
00081     
00082     {'data', STR_binary},
00083     
00084     {'bool', STR_boolean},
00085     
00086     {'tokn', STR_token},
00087     
00088     {'date', STR_date},
00089     
00090     {'addr', STR_address},
00091     
00092     {'code', STR_compiled_code},
00093     
00094     {'exte', STR_double},
00095     
00096     {'TEXT', STR_string}, /*8/13*/
00097     
00098     {'xtrn', STR_external},
00099     
00100     {'dir ', STR_direction},
00101     
00102     {'bad2', STR_unused2}, /*9/17/91*/
00103     
00104     {'type', STR_string4},
00105     
00106     {'bad3', STR_unused3},
00107     
00108     {'QDpt', STR_point},
00109     
00110     {'qdrt', STR_rect},
00111     
00112     {'tptn', STR_pattern},
00113     
00114     {'cRGB', STR_rgb}, /*12/11/92 dmb*/
00115     
00116     {'fixd', STR_fixed},
00117     
00118     {'sing', STR_single},
00119     
00120     {'doub', STR_double},
00121     
00122     {'obj ', STR_objspec},
00123     
00124     {'fss ', STR_filespec},
00125     
00126     {'alis', STR_alias},
00127     
00128     {'enum', STR_enumerator},
00129     
00130     {'list', STR_list},
00131     
00132     {'reco', STR_record},
00133     
00134     /*
00135     the following value types, outline - pictvaluetype, are never used directly.
00136     the value would actually be externalvaluetype; these are for flattening 
00137     external types into a typevaluetype
00138     */
00139     
00140     {'optx', STR_outline},
00141     
00142     {'wptx', STR_wptext},
00143     
00144     #ifdef fliowa
00145     
00146     {'intf', STR_interface},
00147     
00148     #else
00149     
00150     {'head', STR_headline},
00151     
00152     #endif
00153     
00154     {'tabl', STR_table},
00155     
00156     {'scpt', STR_script},
00157     
00158     {'mbar', BIGSTRING (STR_menubar)},
00159     
00160     {'pict', STR_picture}
00161     
00162     };
00163 
00164 
00165 boolean langgettypestring (tyvaluetype type, bigstring bs) {
00166     
00167     boolean fl = true;
00168     
00169     if ((type < novaluetype) || (type >= ctvaluetypes)) {
00170         
00171         type = novaluetype;
00172         
00173         fl = false;
00174         }
00175     
00176     copystring ((ptrstring) typeinfo [type].bsname, bs);
00177     
00178     return (fl);
00179     } /*langgettypestring*/
00180 
00181 
00182 tyvaluetype langgettype (tyvaluerecord val) {
00183 
00184     /*
00185     6.2b5 AR
00186     */
00187 
00188     tyvaluetype type = val.valuetype;
00189     
00190     if ((type < novaluetype) || (type >= ctvaluetypes))
00191         return (uninitializedvaluetype);
00192     
00193     if (type == externalvaluetype)
00194         type = (tyvaluetype) (outlinevaluetype + langexternalgettype (val));
00195     
00196     return (type);
00197     }/*langgettype*/
00198     
00199     
00200 OSType langgettypeid (tyvaluetype type) {
00201     
00202     if ((type < novaluetype) || (type >= ctvaluetypes))
00203         return ((OSType) 0);
00204     
00205     return (typeinfo [type].id);
00206     } /*langgettypeid*/
00207 
00208 
00209 tyvaluetype langgetvaluetype (OSType ostypeid) {
00210     
00211     /*
00212     3/2/92 dmb: added check for old 'doub' value of doublevaluetype
00213     
00214     12/11/92 dmb: added backward compatibility check for rgb values
00215     */
00216     
00217     register tyvaluetype type;
00218     
00219     for (type = novaluetype;  type < ctvaluetypes;  ++type)
00220         if (typeinfo [type].id == ostypeid)
00221             return (type);
00222     
00223     if (ostypeid == 'RGB ') /*12/11/92 dmb*/
00224         return (rgbvaluetype);
00225     
00226     return ((tyvaluetype) -1);
00227     } /*langgetvaluetype*/
00228 
00229 
00230 boolean langgoodbinarytype (tyvaluetype type) {
00231     
00232     /*
00233     11/6/92 dmb: need this to qualify iac values & other binary vals
00234     
00235     return true if the binary type can be coerced into a normal scalar value
00236     */
00237     
00238     if ((type < novaluetype) || (type >= outlinevaluetype)) /*outside of good range*/
00239         return (false);
00240     
00241     switch (type) {
00242         
00243         case oldstringvaluetype:
00244         case tokenvaluetype:
00245         case codevaluetype:
00246         case externalvaluetype:
00247         case passwordvaluetype:
00248         case unused2valuetype:
00249         case olddoublevaluetype:
00250             return (false);
00251         
00252         default:
00253             return (true);
00254         }
00255     } /*langgoodbinarytype*/
00256 
00257 
00258 boolean langheaptype (tyvaluetype type) {
00259     
00260     /*
00261     return true if the value is heap-allocated.
00262     
00263     11/4/90 DW: return true if it's an external type.
00264     
00265     2/15/91 dmb: return true if it's a binary value
00266     
00267     5/21/91 dmb: added a bunch of new heap-allocated values.
00268     */
00269     
00270     switch (type) {
00271         
00272         case stringvaluetype:
00273         case passwordvaluetype:
00274         case addressvaluetype:
00275         case rectvaluetype:
00276         case patternvaluetype:
00277         case rgbvaluetype:
00278         case objspecvaluetype:
00279         case filespecvaluetype:
00280         case aliasvaluetype:
00281         case doublevaluetype:
00282         case binaryvaluetype:
00283         case listvaluetype:
00284         case recordvaluetype:
00285         case externalvaluetype:
00286         case codevaluetype:
00287             return (true);
00288         
00289         default:
00290             return (type >= outlinevaluetype); /*virtual external types are heap-allocated*/
00291         } /*switch*/
00292     } /*langheaptype*/
00293 
00294 
00295 boolean langscalartype (tyvaluetype type) {
00296     
00297     return (!langheaptype (type));
00298     } /*langscalartype*/
00299 
00300 
00301 boolean langheapallocated (tyvaluerecord *val, Handle *heaphandle) {
00302     
00303     /*
00304     return true if the value is heap-allocated.  if so, *heaphandle points to 
00305     the heap memory allocated for the value.
00306 
00307     5.0.1 dmb: allow heaphandle to be nil, in case caller doesn't need it
00308     */
00309     
00310     assert (val != nil);
00311     
00312     if (!langheaptype ((*val).valuetype))
00313         return (false);
00314     
00315     if (heaphandle != nil)
00316         *heaphandle = (*val).data.binaryvalue;
00317     
00318     return (true);
00319     } /*langheapallocated*/
00320 
00321 
00322 void langgetwithvaluename (short n, bigstring bswith) {
00323     
00324     /*
00325     8/31/92 dmb: return the name for the nth with value for a stack frame.
00326     
00327     n should be 1-based.
00328     */
00329     
00330     bigstring bsint;
00331     
00332     copystring (STR_with, bswith);
00333     
00334     numbertostring (n, bsint);
00335     
00336     if (stringlength (bsint) < 2)
00337         pushchar ('0', bswith);
00338     
00339     pushstring (bsint, bswith);
00340     } /*langgetwithvaluename*/
00341 
00342 
00343 boolean langfindsymbol (const bigstring bs, hdlhashtable *htable, hdlhashnode *hnode) {
00344     
00345     /*
00346     search through the stack of symbol tables until you find one that has the
00347     symbol named by bs defined.
00348     
00349     return with handles to the table it was found in and the hash node that
00350     holds the value of the symbol.
00351     
00352     2/12/92 dmb: implemented lexicalrefcon check to prevent dangerous dynamic 
00353     scoping possibilities.  specifically, we're preventing a script from accessing 
00354     the local variables in a stack frame that comes from another script object.
00355     
00356     8/7/92 dmb: make sure currenthashtable isn't nil before setting refcon
00357     
00358     9/14/92 dmb: set htable to the innermost valid with table or local table 
00359     encountered so that new symbols can be placed there by default. also, fixed  
00360     with handling so that tables are visited in the right order -- last to first
00361     
00362     12/18/92 dmb: removed a bit of functionality for the safety of our users: don't 
00363     allow "with" statement to create context for assigning undeclared values.
00364     
00365     3.0.2 dmb: to be a "special" symbol that can be seen across lexical scope, bs 
00366     must now end with an '_' as well as start with one. This excludes the default 
00367     container for object model expressions, while retaining the current target.
00368     
00369     3.0.3 dmb: sadly, while the above change worked fine, we _sometimes_ need to 
00370     include the default container in a context-free (lexically-independent) fashion.
00371     so, we introduce the flfindanyspecialsymbol global. in the default (false) case, 
00372     we require the trailing underscore. if set to true (temporarily), we'll treat 
00373     any indentifier that starts with an underscore specially.
00374     
00375     5.0.2b6 dmb: caller who sets flfindanyspecialsymbol is asserting that whatever 
00376     is being searched for is a special symbol of sorts, whatever its name might be.
00377     so don't require it to start with an underscore. so, flspecialsymbol really 
00378     means just "context free"
00379     */
00380     
00381     register hdlhashtable h = currenthashtable;
00382     register long refcon;
00383     register long lexrefcon;
00384     register boolean flspecialsymbol = false;
00385     register short n;
00386     
00387     *htable = nil;
00388     
00389     *hnode = nil;
00390     
00391     if (h == nil)
00392         return (false);
00393     
00394     /*maybe treat as context-free*/
00395     flspecialsymbol = flfindanyspecialsymbol || ((bs [1] == '_') && (lastchar (bs) == '_'));
00396     
00397     refcon = (**h).lexicalrefcon;
00398     
00399     while (true) { /*chain through each linked hash table*/
00400         
00401         if (h == nil)  /*symbol not defined*/
00402             return (false);
00403 
00404         //assert (validhandle ((Handle) h));
00405         
00406         lexrefcon = (**h).lexicalrefcon;
00407         
00408         if ((!(**h).fllocaltable) || flspecialsymbol || (refcon == 0) || (lexrefcon == refcon) || (lexrefcon == 0)) {
00409             
00410             if (hashtablelookupnode (h, bs, hnode)) { /*symbol is defined in htable*/
00411                 
00412                 *htable = h;
00413                 
00414                 return (true);
00415                 }
00416             
00417             for (n = (**h).ctwithvalues; n > 0; --n) { /*scan with values*/
00418                 
00419                 tyvaluerecord valwith;
00420                 hdlhashtable hwith;
00421                 bigstring bswith;
00422                 hdlhashnode hnode2;
00423                 
00424                 langgetwithvaluename (n, bswith);
00425                 
00426                 if (!hashtablelookup (h, bswith, &valwith, &hnode2)) /*missing with value; keep going*/
00427                     continue;
00428                 
00429                 if (!getaddressvalue (valwith, &hwith, bswith)) /*error*/
00430                     return (false);
00431                 
00432                 if (!isemptystring (bswith)) { // not encoded as expected
00433                     
00434                     if (!hashtablelookup (hwith, bswith, &valwith, &hnode2))
00435                         return (false);
00436 
00437                     if (!langexternalvaltotable (valwith, &hwith, hnode2))
00438                         return (false);
00439                     }
00440 
00441                 if (hashtablelookupnode (hwith, bs, hnode)) { /*found symbol*/
00442                     
00443                     *htable = hwith;
00444                     
00445                     return (true);
00446                     }
00447                 
00448                 /*12/18/92 dmb
00449                 if (*htable == nil) /%this is the innermost with value -- return to caller%/
00450                     *htable = hwith;
00451                 */
00452                 }
00453             
00454             if (*htable == nil) /*this is the innermost local table -- return to caller*/
00455                 *htable = h;
00456             }
00457         
00458         h = (**h).prevhashtable;
00459         } /*while*/
00460     } /*langfindsymbol*/
00461 
00462 
00463 /*
00464 boolean langfindexternalwindow (const bigstring bs, Handle *hdata) {
00465     
00466     /%
00467     7.21.97 dmb: see if the string specifies a standalong window that has data
00468     %/
00469     
00470     hdlwindowinfo hinfo;
00471 
00472     if (flextendedsymbolsearch > 0 && 
00473         shellfindnamedwindow (bs, &hinfo) && 
00474         (**hinfo).parentwindow == nil)
00475         
00476         return (shellgetexternaldata (hinfo, hdata));
00477     
00478     return (false);
00479     } /%langfindexternalwindow%/
00480 */
00481 
00482 
00483 boolean langgetsymbolval (const bigstring bs, tyvaluerecord *vreturned, hdlhashnode *hnode) {
00484     
00485     /*
00486     6/13/91 dmb: moved special-case check for root table in from langsymbolreference
00487     
00488     2003-05-18 AR: Disabled special check for fllocaltable to prevent the address of a value
00489     in a local table to resolve to the root table if the value is actually named "root".
00490     This could potentially cause top-level tables in Frontier.root to be overwritten unintentionally.
00491     It's not clear what purpose this check was meant to serve in the first place.
00492     */
00493     
00494     hdlhashtable htable;
00495 //  hdlhashnode hnode;
00496     
00497     if (langfindsymbol (bs, &htable, hnode)) {
00498         
00499         *vreturned = (***hnode).val;
00500         
00501         return (true);
00502         }
00503     
00504     if (equalstrings (bs, nameroottable)) {
00505         
00506         if ((currenthashtable == roottable) || (currenthashtable == nil) /* || ((**currenthashtable).fllocaltable) */) {
00507             
00508             setexternalvalue (rootvariable, vreturned);
00509             
00510             return (true);
00511             }
00512         }
00513     
00514     return (false);
00515     } /*langgetsymbolval*/
00516 
00517 
00518 boolean langsetsymbolval (const bigstring bs, tyvaluerecord val) {
00519     
00520     /*
00521     if the symbol is defined in one of the chain of symbol tables, then
00522     assign the value.
00523     
00524     if the symbol isn't defined anywhere, create a new symbol with the
00525     name in the most global symbol table.  this is where automatic 
00526     declaration of variables is implemented.
00527     
00528     7/10/90 DW: instead of allocating automatic variables in the most-
00529     global table, allocate them in the most-local table.  see comment
00530     at the head of evaluatelist.
00531     
00532     9/14/92 dmb: see comment in langfindsymbol; if htable is non-nil, it 
00533     is now valid even when false is returned.
00534     
00535     5.0a18 dmb: require declarations! (if user's pref is set)
00536     */
00537     
00538     hdlhashtable htable;
00539     hdlhashnode hnode;
00540     
00541     if (false && langgetuserflag (idrequiredeclarationsscript, false)) {
00542     
00543         if (langfindsymbol (bs, &htable, &hnode) || (htable != nil)) { /*name is defined, or with statement set table*/
00544             
00545             return (hashtableassign (htable, bs, val));
00546             }
00547         
00548         langparamerror (unknownidentifiererror, bs);
00549         
00550         return (false);
00551         }
00552     else {
00553     
00554         if (langfindsymbol (bs, &htable, &hnode) || (htable != nil)) { /*name is defined, or with statement set table*/
00555             
00556             return (hashtableassign (htable, bs, val));
00557             }
00558         
00559         return (hashassign (bs, val));
00560         }
00561     } /*langsetsymbolval*/
00562 
00563 
00564 boolean langsetsymboltableval (hdlhashtable htable, const bigstring bs, tyvaluerecord val) {
00565     
00566     boolean fl;
00567     
00568     pushhashtable (htable);
00569     
00570     fl = langsetsymbolval (bs, val);
00571     
00572     pophashtable ();
00573     
00574     return (fl);
00575     } /*langsetsymboltableval*/
00576 
00577 
00578 boolean langsetstringval (const bigstring bsname, const bigstring bsval) {
00579     
00580     tyvaluerecord val;
00581     Handle htext;
00582     
00583     initvalue (&val, stringvaluetype);
00584     
00585     if (!newtexthandle (bsval, &htext))
00586         return (false);
00587     
00588     val.data.stringvalue = htext;
00589     
00590     if (!langsetsymbolval (bsname, val)) {
00591         
00592         disposehandle (htext);
00593         
00594         return (false);
00595         }
00596     
00597     return (true);
00598     } /*langsetstringval*/
00599 
00600 
00601 boolean langsetbinaryval (hdlhashtable htable, const bigstring bsname, Handle x) {
00602     
00603     tyvaluerecord val;
00604     
00605     initvalue (&val, binaryvaluetype);
00606     
00607     val.data.binaryvalue = x;
00608     
00609     if (!langsetsymboltableval (htable, bsname, val)) {
00610         
00611         disposehandle (x);
00612         
00613         return (false);
00614         }
00615     
00616     return (true);
00617     } /*langsetbinaryval*/
00618 
00619 
00620 boolean langassigntextvalue (hdlhashtable ht, bigstring bs, Handle h) {
00621 
00622     /*
00623     6.1d4 AR: efficient way to do this operation; no tmpstack overhead.
00624     */
00625     
00626     tyvaluerecord val;
00627     
00628     assert (h != nil);
00629     
00630     initvalue (&val, stringvaluetype);
00631 
00632     val.data.stringvalue = h;
00633 
00634     if (!hashtableassign (ht, bs, val))
00635         return (false);
00636         
00637     return (true);
00638     } /*hashtableassignstringhandle*/
00639 
00640 
00641 
00642 boolean langassignstringvalue (hdlhashtable ht, const bigstring bs, const bigstring bsval) {
00643     
00644     /*
00645     efficient way to do this operation; no tmpstack overhead.
00646     
00647     note: very similar to langsetstringval, but w/out the symbol lookup logic
00648     */
00649     
00650     tyvaluerecord val;
00651     Handle htext;
00652     
00653     initvalue (&val, stringvaluetype);
00654     
00655     if (!newtexthandle (bsval, &htext))
00656         return (false);
00657     
00658     val.data.stringvalue = htext;
00659     
00660     if (!hashtableassign (ht, bs, val)) {
00661         
00662         disposehandle (htext);
00663         
00664         return (false);
00665         }
00666     
00667     return (true);
00668     } /*langassignstringvalue*/
00669 
00670 
00671 boolean langassignbooleanvalue (hdlhashtable ht, const bigstring bs, boolean flval) {
00672     
00673     /*
00674     could be useful...
00675     */
00676     
00677     tyvaluerecord val;
00678     
00679     setbooleanvalue (flval, &val);
00680     
00681     return (hashtableassign (ht, bs, val));
00682     } /*langassignbooleanvalue*/
00683 
00684 
00685 boolean langassigncharvalue (hdlhashtable ht, const bigstring bs, unsigned char ch) {
00686     
00687     /*
00688     might as well!
00689     */
00690     
00691     tyvaluerecord val;
00692     
00693     setcharvalue (ch, &val);
00694     
00695     return (hashtableassign (ht, bs, val));
00696     } /*langassigncharvalue*/
00697 
00698 
00699 boolean langassignlongvalue (hdlhashtable ht, const bigstring bs, long x) {
00700     
00701     /*
00702     might as well!
00703     */
00704     
00705     tyvaluerecord val;
00706     
00707     setlongvalue (x, &val);
00708     
00709     return (hashtableassign (ht, bs, val));
00710     } /*langassignbooleanvalue*/
00711 
00712 
00713 boolean langassignaddressvalue (hdlhashtable ht, const bigstring bs, const tyaddress *adr) {
00714     
00715     /*
00716     efficient way to do this operation; no tmpstack overhead.
00717     
00718     6.1d4 AR: Modified to no longer use tmpstack (which it did, previously)
00719     by cribbing some code from setaddressvalue.
00720     */
00721     
00722     tyvaluerecord val;
00723     hdlstring hstring;
00724     
00725     if (!newheapstring ((*adr).bs, &hstring))
00726         return (false);
00727     
00728     if (!enlargehandle ((Handle) hstring, sizeof ((*adr).ht), (void *) &(*adr).ht)) {
00729 
00730         disposehandle ((Handle) hstring);
00731 
00732         return (false);
00733         }
00734     
00735     initvalue (&val, addressvaluetype);
00736     
00737     val.data.addressvalue = hstring;
00738     
00739     if (!hashtableassign (ht, bs, val)) {
00740         
00741         disposevaluerecord (val, false);
00742         
00743         return (false);
00744         }
00745     
00746     return (true);
00747     } /*langassignaddressvalue*/
00748 
00749 
00750 boolean langassignnewtablevalue (hdlhashtable ht, const bigstring bs, hdlhashtable *newtable) {
00751     
00752     /*
00753     create a new, empty table and assign it to the given table/name in the database
00754     */
00755     
00756     tyvaluerecord val;
00757     
00758     if (!tablenewtablevalue (newtable, &val))
00759         return (false);
00760     
00761     if (!hashtableassign (ht, bs, val)) {
00762         
00763         disposevaluerecord (val, false);
00764         
00765         return (false);
00766         }
00767     
00768     (***newtable).fllocaltable = (**ht).fllocaltable;
00769     
00770     return (true);
00771     } /*langassignnewtablevalue*/
00772 
00773 
00774 boolean langsuretablevalue (hdlhashtable ht, const bigstring bs, hdlhashtable *htable) {
00775 
00776     /*
00777     5.1.4 dmb: if the cell has a table, return it. otherwise, create a new table,
00778     assign it, and return it.
00779     */
00780     
00781     tyvaluerecord val;
00782     hdlhashnode hnode;
00783     
00784     if (hashtablelookup (ht, bs, &val, &hnode))
00785         if (langexternalvaltotable (val, htable, hnode))
00786             return (true);
00787     
00788     return (langassignnewtablevalue  (ht, bs, htable));
00789     } /*langsuretablevalue*/
00790 
00791 
00792 #ifndef odbengine
00793 
00794 boolean langgetvalsize (tyvaluerecord v, long *size) {
00795     
00796     /*
00797     4/26/93 dmb: count tree nodes
00798     
00799     2.1b3 dmb: expand filespec to string to avoid breaking 2.0 scripts
00800     */
00801     
00802     register long x;
00803     
00804     switch (v.valuetype) {
00805         
00806         case addressvaluetype: {
00807             bigstring bs;
00808             
00809             getaddresspath (v, bs);
00810             
00811             x = stringlength (bs);
00812             
00813             break;
00814             }
00815             
00816         case booleanvaluetype:
00817             x = longsizeof (v.data.flvalue);
00818             
00819             break;
00820             
00821         case charvaluetype:
00822             x = longsizeof (v.data.chvalue);
00823             
00824             break;
00825         
00826         case intvaluetype:
00827             x = longsizeof (v.data.intvalue);
00828             
00829             break;
00830         
00831         case longvaluetype:
00832         case ostypevaluetype:
00833         case enumvaluetype:
00834         
00835             x = longsizeof (v.data.longvalue);
00836             
00837             break;
00838         
00839         case directionvaluetype:
00840             x = longsizeof (v.data.dirvalue);
00841             
00842             break;
00843         
00844         case tokenvaluetype:
00845             x = longsizeof (v.data.tokenvalue);
00846             
00847             break;
00848         
00849         case pointvaluetype:
00850             x = longsizeof (v.data.pointvalue);
00851             
00852             break;
00853         
00854         case datevaluetype:
00855             x = longsizeof (v.data.datevalue);
00856             
00857             break;
00858         
00859         case fixedvaluetype:
00860             x = longsizeof (v.data.fixedvalue);
00861             
00862             break;
00863         
00864         case singlevaluetype:
00865             x = longsizeof (v.data.singlevalue);
00866             
00867             break;
00868         
00869         case filespecvaluetype: {
00870             bigstring bs;
00871             
00872             if (filespectopath (*v.data.filespecvalue, bs))
00873                 x = stringlength (bs);
00874             else
00875                 x = gethandlesize ((Handle) v.data.filespecvalue);
00876             
00877             break;
00878             }
00879         
00880         #if defined(__powerc) || defined(WIN95VERSION)
00881         
00882             case doublevaluetype:
00883                 x = sizeof (extended80);
00884                 
00885                 break;
00886             
00887         #else
00888                 case doublevaluetype:
00889         #endif
00890         
00891         case stringvaluetype:
00892         case passwordvaluetype:
00893         case rectvaluetype:
00894         case patternvaluetype:
00895         case rgbvaluetype:
00896         case objspecvaluetype:
00897         case aliasvaluetype:
00898             x = gethandlesize (v.data.binaryvalue);
00899             
00900             break;
00901         
00902         case binaryvaluetype:
00903             x = gethandlesize (v.data.binaryvalue) - sizeof (OSType); /*don't count key*/
00904             
00905             break;
00906         
00907         case listvaluetype:
00908         case recordvaluetype: {
00909             long listsize;
00910             
00911             if (!langgetlistsize (&v, &listsize))
00912                 return (false);
00913             
00914             x = listsize;
00915             
00916             break;
00917             }
00918         
00919         case codevaluetype:
00920             x = langcounttreenodes (v.data.codevalue);
00921             
00922             break;
00923         
00924         case externalvaluetype: {
00925             long externalsize;
00926             
00927             if (!langexternalgetvalsize (v, &externalsize))
00928                 return (false);
00929             
00930             x = externalsize;
00931             
00932             break;
00933             }
00934             
00935         default:
00936             return (false);
00937         } /*switch*/
00938     
00939     *size = x;
00940     
00941     return (true);
00942     } /*langgetvalsize*/
00943 
00944 #endif
00945 
00946 boolean langgetstringlist (short id, bigstring bs) {
00947     
00948     return (getstringlist (langinterfacelist, id, bs));
00949     } /*langgetstringlist*/
00950 
00951 
00952 boolean langgetmiscstring (short id, bigstring bs) {
00953     
00954     return (getstringlist (langmiscstringlist, id, bs));
00955     } /*langgetmiscstring*/
00956 
00957 
00958 boolean langcheckstacklimit (tystackid idstack, short topstack, short maxstack) {
00959     
00960     /*
00961     make sure that the stack isn't full.  if it is, generate a langerror
00962     */
00963     
00964     bigstring bsstack;
00965     
00966     if (topstack < maxstack)
00967         return (true);
00968     
00969     getstringlist (langstacklist, idstack, bsstack);
00970     
00971     langparamerror (stackoverflowerror, bsstack);
00972     
00973     return (false);
00974     } /*langcheckstacklimit*/
00975 
00976 #if !odbengine
00977 boolean langcheckstackspace (void) {
00978     
00979     /*
00980     9/30/92 dmb: moved stack detection code here so it can be called when needed
00981     
00982     3.0.1 dmb: use new processstackspace instead of StackSpace trap
00983     */
00984     
00985 #if !flruntime
00986     if (processstackspace () < minstackspace) {
00987         
00988         flstackoverflow = true; /*flag for reporting when it's safe*/
00989         
00990         return (false);
00991         }
00992 #endif  
00993     return (true);
00994     } /*langcheckstackspace*/
00995 #endif
00996 
00997 void langbadexternaloperror (short errornum, tyvaluerecord externalval) {
00998     
00999     bigstring bstype;
01000     bigstring bsscriptextra;
01001     
01002     langexternaltypestring ((hdlexternalhandle) externalval.data.externalvalue, bstype);
01003     
01004     if (langexternalgettype (externalval) == idscriptprocessor)
01005         langgetstringlist (useparenthesisstring, bsscriptextra);
01006     else
01007         langgetstringlist (useaddressoperatorstring, bsscriptextra);
01008     
01009     lang2paramerror (errornum, bstype, bsscriptextra);
01010     } /*langbadexternaloperror*/
01011 
01012 #if !odbengine
01013 void langarrayreferror (short stringnum, bigstring bsname, const tyvaluerecord *valarray, tyvaluerecord *valindex) {
01014     
01015     /*
01016     valindex is nil, the error is trying to treat valarray as an array in the 1st place.
01017     
01018     otherwise, it's a bad name or item number
01019     */
01020     
01021     bigstring bstype;
01022     bigstring bsindex;
01023     
01024     hashgettypestring (*valarray, bstype);
01025     
01026     if (valindex == nil) {
01027         
01028         stringnum = arraynottableerror;
01029         
01030         setemptystring (bsindex);
01031         }
01032     else {
01033         switch ((*valindex).valuetype) {
01034             
01035             case intvaluetype:
01036             case longvaluetype:
01037                 stringnum = arrayindexerror;
01038                 
01039                 break;
01040             
01041             default:
01042                 stringnum= arraystringindexerror;
01043             }
01044         
01045         coercetostring (valindex);
01046         
01047         pullstringvalue (valindex, bsindex);
01048         }
01049 
01050     if (bsname == nil)
01051         lang3paramerror (stringnum, emptystring, bstype, bsindex);
01052     else
01053         lang3paramerror (stringnum, bsname, bstype, bsindex);
01054 
01055     } /*langarrayreferror*/
01056 #endif
01057 
01058 
01059 boolean langgetuserflag (short idscript, boolean fldefault) {
01060     
01061     /*
01062     5.0a18 dmb: make sure table globals are set up; fixed crashing bug.
01063     */
01064     
01065     bigstring bspref;
01066     hdlhashtable htable;
01067     bigstring bs;
01068     tyvaluerecord val;
01069     boolean fl;
01070     hdlhashnode hnode;
01071     
01072     if (roottable == nil)
01073         return (fldefault);
01074     
01075     getsystemtablescript (idscript, bspref);
01076     
01077     disablelangerror ();
01078     
01079     pushhashtable (roottable);
01080     
01081     if (
01082         langexpandtodotparams (bspref, &htable, bs) && 
01083     
01084         hashtablelookup (htable, bs, &val, &hnode) &&
01085         
01086         copyvaluerecord (val, &val) && coercetoboolean (&val)
01087         )
01088         
01089         fl = val.data.flvalue;
01090     else
01091         fl = fldefault;
01092     
01093     pophashtable ();
01094     
01095     enablelangerror ();
01096     
01097     return (fl);
01098     } /*langgetuserflag*/
01099 
01100 
01101 boolean langsetuserflag (short idscript, boolean fl) {
01102     
01103     /*
01104     5.0a21 dmb: might as well provide the matching set routine
01105     */
01106     
01107     bigstring bspref, bsignore;
01108     
01109     if (roottable == nil)
01110         return (false);
01111     
01112     getsystemtablescript (idscript, bspref);
01113     
01114     pushchar ('=', bspref);
01115     
01116     if (fl)
01117         pushstring (bstrue, bspref);
01118     else
01119         pushstring (bsfalse, bspref);
01120     
01121     return (langrunstringnoerror (bspref, bsignore));
01122     } /*langsetuserflag*/
01123 
01124 
01125 boolean langgetthisaddress (hdlhashtable *htable, bigstring bsthis) {
01126     
01127     /*
01128     5.0a18 dmb: find the current lexical address. right now, we're sticking 
01129     this in stack frames when necessary. but we could also make "this" a magic 
01130     value that is calculated when referenced; idvalue would call this function
01131     */
01132     
01133     register hdlerrorstack hs = langcallbacks.scripterrorstack;
01134     tyerrorrecord *pe;
01135     
01136     if ((hs == nil) || ((**hs).toperror == 0))
01137         return (false);
01138     
01139     pe = &(**hs).stack [(**hs).toperror - 1];
01140     
01141     if ((*pe).errorcallback == nil)
01142         return (false);
01143     
01144     return ((*(*pe).errorcallback) ((*pe).errorrefcon, 0, 0, htable, bsthis));
01145     } /*langgetthisaddress*/
01146 
01147 
01148 boolean langsetthisvalue (hdlhashtable hlocaltable, hdlhashtable htable, bigstring bsname) {
01149     
01150     /*
01151     5.0a18 dmb: new feature: this. it remains to be seen whether or not
01152     we're setting it whereever we need it. another alternative is to 
01153     calculate it when refererenced, in idvalue, based on the errorcallback
01154     stack
01155     */
01156     
01157     #ifdef version5orgreater
01158 
01159     tyvaluerecord val;
01160     
01161     if (!setaddressvalue (htable, bsname, &val))
01162         return (false);
01163     
01164     if (!hashtableassign (hlocaltable, STR_this, val))
01165         return (false);
01166         
01167     exemptfromtmpstack (&val);
01168 
01169     #endif
01170 
01171     return (true);
01172     } /*langsetthisvalue*/
01173 
01174 
01175 boolean langbuildnamelist (hdltreenode htree, hdllistrecord hlist) {
01176     
01177     /*
01178     5.0.2b8 dmb: new routine. recursively build an ordered list of 
01179     names from the dotparams in the code tree. similar, but more 
01180     limited, than langgetdotparams
01181     */
01182     
01183     bigstring bsname;
01184     
01185     switch ((**htree).nodetype) {
01186         
01187         case identifierop:
01188         case bracketop:
01189             if (!langgetidentifier (htree, bsname))
01190                 return (false);
01191             
01192             return (langpushliststring (hlist, bsname));
01193         
01194         case dotop:
01195             if (!langbuildnamelist ((**htree).param1, hlist))
01196                 return (false);
01197             
01198             if (!langgetidentifier ((**htree).param2, bsname))
01199                 return (false);
01200             
01201             return (langpushliststring (hlist, bsname));
01202         
01203         default:
01204             langlongparamerror (unexpectedopcodeerror, (**htree).nodetype);
01205             
01206             return (false);
01207         }       
01208     } /*buildnamelist*/
01209 
01210 
01211 boolean langfastaddresstotable (hdlhashtable hstart, bigstring bsaddress, hdlhashtable *htable) {
01212     
01213     /*
01214     5.0.2 dmb: super-fast lookup of a table, given a simple path starting from the
01215     given table. no periods are allowed in any item name; no square brackets are used.
01216     */
01217     
01218     tyvaluerecord val;
01219     short i;
01220     bigstring bs;
01221     hdlhashtable ht = hstart;
01222     hdlhashnode hnode;
01223     
01224     for (i = 1; nthword (bsaddress, i, '.', bs); ++i) {
01225         
01226         if (!hashtablelookup (ht, bs, &val, &hnode) || !langexternalvaltotable (val, &ht, hnode)) {
01227             
01228             langparamerror (nosuchtableerror, bs);
01229             
01230             return (false);
01231             }
01232         }
01233     
01234     *htable = ht;
01235     
01236     return (true);
01237     } /*langfastaddresstotable*/
01238 
01239 
01240 boolean langvaltocode (tyvaluerecord *vcode, hdltreenode *hcode) {
01241 
01242     /*
01243     02/04/02 dmb: get a script code value. Can be a local script code value,
01244     or the code of a script. no copies are made. hcode may even be nil; a 
01245     true return just confirms that the value _can_ be called as a script.
01246     */
01247 
01248 //  boolean fl;
01249 
01250     if ((*vcode).valuetype == codevaluetype) {
01251 
01252         *hcode = (*vcode).data.codevalue;
01253 
01254         return (true);
01255         }
01256     else {
01257 
01258         return (langexternalvaltocode (*vcode, hcode));
01259         }
01260     } /*langvaltocode*/
01261 
01262 
01263 boolean langfollowifaddressvalue (tyvaluerecord *v) {
01264 
01265     /*
01266     1/15/02 dmb: new function. return true if we successfully follow an addres.
01267     */
01268 
01269     hdlhashtable ht;
01270     bigstring bs;
01271     hdlhashnode hnode;
01272     boolean fl;
01273 
01274     if ((*v).valuetype != addressvaluetype)
01275         return (false);
01276 
01277     if (!getaddressvalue ((*v), &ht, bs))
01278         return (false);
01279 
01280     disablelangerror ();
01281 
01282     fl = langhashtablelookup (ht, bs, v, &hnode);
01283 
01284     enablelangerror ();
01285 
01286     return (fl);
01287     } /*langfollowifaddressvalue*/
01288 
01289 
01290 
01291 
01292 

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