langevaluate.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langevaluate.c 1201 2006-04-05 22:31:38Z karstenw $    */
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 "fileloop.h"
00033 #include "strings.h"
00034 #include "lang.h"
00035 #include "langinternal.h"
00036 #include "langexternal.h"
00037 #include "langsystem7.h"
00038 #include "oplist.h"
00039 #include "ops.h"
00040 #ifdef flcomponent
00041     #include "osacomponent.h"
00042 #endif
00043 
00044 #define fltryerrorstackcode false
00045 
00046 
00047 #ifdef PASCALSTRINGVERSION
00048 byte bscontainername [] = "\x0a" "_container\0";
00049 
00050 static byte nametryerrorval [] = "\x08" "tryerror\0";
00051 
00052 #if fltryerrorstackcode
00053     static byte nametryerrorstackval [] = "\x0d" "tryerrorstack\0";
00054 #endif
00055 
00056 #else
00057 
00058 byte bscontainername [] = "_container";
00059 
00060 static byte nametryerrorval [] = "tryerror";
00061 
00062 #if fltryerrorstackcode
00063     static byte nametryerrorstackval [] = "tryerrorstack";
00064 #endif
00065 
00066 #endif
00067 
00068 void langseterrorline (hdltreenode hnode) {
00069     
00070     /*
00071     the node is about to be executed in some fashion.  if there's an error
00072     in processing it, we want the error to point at the line number in the 
00073     source that it was generated from.
00074     
00075     6/23/92 dmb: added herrornode for script debugger
00076     */
00077     
00078     if (hnode && langerrorenabled ()) { /*no one is blocking error reporting*/
00079         
00080         ctscanlines = (**hnode).lnum; /*set the global*/
00081         
00082         ctscanchars = (**hnode).charnum;
00083         
00084         herrornode = hnode;
00085         }
00086     } /*langseterrorline*/
00087 
00088 
00089 #ifdef fldebug
00090 
00091     #if fldebug > 0
00092     
00093     static boolean validvalue (tyvaluerecord *val) {
00094         
00095         Handle h;
00096         
00097         if (!langheapallocated (val, &h))
00098             return (true); 
00099         
00100         return (validhandle (h));
00101         } /*validvalue*/
00102 
00103 
00104     static boolean leakingmemory (tyvaluerecord *val) {
00105         
00106         /*
00107         1/14/91 dmb: verify that val is in the temp stack if it's heap-allocated
00108         */
00109         
00110         register Handle h;
00111         register short ctloops;
00112         register tyvaluerecord *p;
00113         Handle hcheck;
00114         
00115         if (!langheapallocated (val, &hcheck))
00116             return (false);
00117         
00118         if ((*val).fltmpdata) /*data has never been copied from original*/
00119             return (false);
00120         
00121         if ((*val).valuetype == externalvaluetype)
00122             return (false);
00123         
00124         h = hcheck; /*move into register*/
00125         
00126         if (currenthashtable == nil)
00127             return (true);
00128         
00129         p = (**currenthashtable).tmpstack;
00130         
00131         for (ctloops = (**currenthashtable).cttmpstack; ctloops--; ++p) { /*step through tmpstack*/
00132             
00133             if ((*p).data.binaryvalue == h) { /*found the temp in the stack*/
00134                 
00135                 assert (validvalue (val)); /*make sure it's not already disposed*/
00136                 
00137                 return (false);
00138                 }
00139             } /*while*/
00140         
00141         return (true); /*didn't find it -- it's a leak!*/
00142         } /*leakingmemory*/
00143 
00144     #else
00145     
00146         #define validvalue(v) (true)
00147         #define leakingmemory(v) (false)
00148     
00149     #endif
00150     
00151 #endif
00152 
00153 
00154 static boolean evaluateloop (hdltreenode hloop, tyvaluerecord *valtree) {
00155     
00156     /*
00157     8/20/91 dmb: call the debugger for each loop iteration
00158     */
00159     
00160     register hdltreenode h = hloop;
00161     tyvaluerecord val1;
00162     
00163     while (true) {
00164         
00165         if ((**h).param2 != nil) { /*termination condition is attached*/
00166         
00167             if (!evaluatetree ((**h).param2, &val1))
00168                 return (false);
00169             
00170             assert (!leakingmemory (&val1));
00171             
00172             if (!coercetoboolean (&val1))
00173                 return (false);
00174             
00175             if (!val1.data.flvalue) /*we've reached termination of the loop*/
00176                 return (true);
00177             }
00178             
00179         cleartmpstack (); /*dealloc all outstanding temporary values*/
00180         
00181         flbreak = false;
00182         
00183         flcontinue = false;
00184         
00185         if (!evaluatelist ((**h).param4, valtree))
00186             return (false);
00187         
00188         flcontinue = false;
00189         
00190         assert (!leakingmemory (valtree));
00191         
00192         if (flbreak || flreturn) {
00193             
00194             flbreak = false; /*only good for one level*/
00195             
00196             return (true);
00197             }
00198         
00199         if (!langdebuggercall (h)) /*user killed the script*/
00200             return (false);
00201         
00202         if (!evaluatetree ((**h).param3, valtree)) /*run increment code*/
00203             return (false);
00204         
00205         assert (!leakingmemory (valtree));
00206         } /*while*/
00207     } /*evaluateloop*/
00208 
00209 
00210 static boolean evaluateforloop (hdltreenode hloop, tyvaluerecord val1, tyvaluerecord val2, long inc, tyvaluerecord *valtree) {
00211     
00212     /*
00213     9/26/91 dmb: added "for loop" construct like pascal:
00214         
00215         for counter = x1 to x2
00216             <body>
00217     
00218     initially, I considered generating a standard loop code tree so that 
00219     no special interpretation would be required, but I dropped that for 
00220     two reasons:
00221     
00222     1. since the terminal (counter) would appear in all three loop parameters 
00223     (initialization; condition; termination), it's code tree would have to 
00224     be duplicated twice -- and there is no langcopytree () routine anyway.
00225     
00226     2. given that this is a special-case loop, we can forgo all of the 
00227     looping code's generality and improve performance
00228     
00229     3/6/92 dmb: added inc parameter and support for downto keyword
00230     
00231     4.28.97 dmb: if look terminates naturally, loop counter should be value of 
00232     the statement, as it is with the c-like "loop" construct
00233     
00234     5.0.2b10 dmb: assignvalue takes care of fllanghashassignprotect
00235     */
00236     
00237     register hdltreenode h = hloop;
00238     register hdltreenode hcounter = (**h).param3;
00239     long x1;
00240     long x2;
00241     
00242     if (!coercetolong (&val1))
00243         return (false);
00244     
00245     if (!coercetolong (&val2))
00246         return (false);
00247     
00248     for (x1 = val1.data.longvalue, x2 = val2.data.longvalue; ; x1 += inc) {
00249         
00250         copyvaluerecord (val1, valtree); // 4.28.97 dmb: leave un-incremented loop counter as return value
00251         
00252         if (inc > 0) {
00253             
00254             if (x1 > x2)
00255                 break;
00256             }
00257         else {
00258             
00259             if (x1 < x2)
00260                 break;
00261             }
00262         
00263         setlongvalue (x1, &val1);
00264         
00265         if (!assignvalue (hcounter, val1))
00266             return (false);
00267         
00268         cleartmpstack (); /*dealloc all outstanding temporary values*/
00269         
00270         flbreak = false;
00271         
00272         flcontinue = false;
00273         
00274         if (!evaluatelist ((**h).param4, valtree))
00275             return (false);
00276         
00277         flcontinue = false;
00278         
00279         assert (!leakingmemory (valtree));
00280         
00281         if (flbreak || flreturn) {
00282             
00283             flbreak = false; /*only good for one level*/
00284             
00285             return (true);
00286             }
00287         
00288         if (!langdebuggercall (h)) /*user killed the script*/
00289             return (false);
00290         } /*for*/
00291     
00292     return (true);
00293     } /*evaluateforloop*/
00294 
00295 
00296 static boolean evaluateforinloop (hdltreenode hloop, tyvaluerecord vlist, tyvaluerecord *valtree) {
00297     
00298     /*
00299     3/17/93 dmb: a new loop for list processing:
00300         
00301         for counter in x
00302             <body>
00303     
00304     3/19/93 dmb: make work for tables too.
00305     
00306     4/14/93 dmb: don't try to coerce records to lists; leave them as is.
00307     
00308     4.1b8 dmb: fixed bug when evaluatetree within the loop returns false.
00309     
00310     4.28.97 dmb: put list "counter" value in valtree, so it's the statement value
00311     if nothing is return-d.
00312 
00313     6.1d19 AR: Make work for tables too. (Again?)
00314 
00315     6.1b12 AR: Fixed crashes when trying to loop over root table.
00316     */
00317     
00318     hdlhashtable htable;
00319     register hdltreenode h = hloop;
00320     register long ixlist = 0;
00321     long ctitems;
00322     register hdltreenode hcounter = (**h).param2;
00323     boolean fltable = false;
00324     boolean fl = false;
00325     bigstring bsname;
00326     hdlhashnode hnode;
00327     
00328     if (vlist.valuetype == addressvaluetype) {
00329         
00330         hdlhashtable ht;
00331         bigstring bs;
00332         tyvaluerecord val;
00333 
00334         if (!getaddressvalue (vlist, &ht, bs))
00335             return (false);
00336     
00337         if (ht == nil && langgetspecialtable (bs, &htable))
00338             fltable = true;
00339 
00340         if (!fltable) {
00341 
00342             if (ht == nil && !langsearchpathlookup (bs, &ht)) {
00343                 langparamerror (unknownidentifiererror, bs);
00344                 return (false);
00345                 }
00346         
00347             if (!langhashtablelookup (ht, bs, &val, &hnode))
00348                 return (false);
00349 
00350             if (langexternalvaltotable (val, &htable, hnode))
00351                 fltable = true;
00352             }
00353         }
00354     
00355     if (!fltable) {
00356     
00357         if (vlist.valuetype != recordvaluetype)
00358             if (!coercetolist (&vlist, listvaluetype))
00359                 return (false);
00360         
00361         if (!langgetlistsize (&vlist, &ctitems))
00362             return (false);
00363         
00364         exemptfromtmpstack (&vlist); /*protect our list*/
00365         }
00366     
00367     while (true) {
00368         
00369         if (fltable) {
00370 
00371             if (!hashgetiteminfo (htable, ixlist++, bsname, nil)) { /* 0-based */
00372 
00373                 fl = true;
00374 
00375                 break;
00376                 }
00377 
00378             setaddressvalue (htable, bsname, valtree);
00379             }
00380 
00381         else {
00382 
00383             if (++ixlist > ctitems) { /* 1-based */
00384             
00385                 fl = true;
00386             
00387                 break;
00388                 }
00389         
00390             if (!langgetlistitem (&vlist, ixlist, nil, valtree)) // 4.28.97 dmb: use valtree, not local val
00391                 break;
00392             }
00393         
00394         fl = assignvalue (hcounter, *valtree);
00395         
00396         if (!fl)
00397             break;
00398         
00399         cleartmpstack (); /*dealloc all outstanding temporary values*/
00400         
00401         flbreak = false;
00402         
00403         flcontinue = false;
00404         
00405         fl = evaluatelist ((**h).param4, valtree);
00406         
00407         if (!fl)
00408             break;
00409         
00410         flcontinue = false;
00411         
00412         assert (!leakingmemory (valtree));
00413         
00414         if (flbreak || flreturn) {
00415             
00416             flbreak = false; /*only good for one level*/
00417             
00418             fl = true;
00419             
00420             break;
00421             }
00422         
00423         
00424         if (!langdebuggercall (h)) /*user killed the script*/
00425             break;
00426         } /*for*/
00427     
00428     if (!fltable)
00429         disposetmpvalue (&vlist);
00430     
00431     return (fl);
00432     } /*evaluateforinloop*/
00433 
00434 #if 0 /*support for fileloop file filtering*/
00435 
00436 #include "strings.h"
00437 #include "tableverbs.h"
00438 
00439 
00440 static hdlhashtable hfiletable = nil;
00441 
00442 static hdltreenode hpathtree = nil;
00443 
00444 /*
00445 static hdltreenode hfilecalltree = nil;
00446 */
00447 
00448 static boolean fileidvaluecallback (hdltreenode htree, tyvaluerecord *val) {
00449     
00450     register hdltreenode h = htree;
00451     bigstring bsverb;
00452     
00453     if ((**h).nodetype != identifierop)
00454         return (false);
00455     
00456     langgetidentifier (h, bsverb);
00457     
00458     if (!hashtablesymbolexists (hfiletable, bsverb))
00459         return (false);
00460     
00461     return (kernelfunctionvalue (hfiletable, bsverb, hpathtree, val));
00462     } /*fileidvaluecallback*/
00463 
00464 
00465 static hdltreenode hfiltertree;
00466 
00467 
00468 static boolean fileloopfilter (bigstring bsfolder, bigstring bsfile) {
00469     
00470     /*  
00471     6.2b15 AR: Call coercetoboolean directly instead of the now defunct truevalue
00472     */
00473     
00474     tyvaluerecord val;
00475     boolean fl;
00476     bigstring bspath;
00477     Handle hpath;
00478     
00479     if (hfiletable == nil) { /****need to do 1-time initialization*/
00480         
00481         initvalue (&val, stringvaluetype);
00482         
00483         if (!newconstnode (val, &hpathtree))
00484             return (false);
00485         
00486         findnamedtable (efptable, "\pfile", &hfiletable);
00487         }
00488     
00489     if (isfolderpath (bsfile))
00490         return (true);
00491     
00492     addstrings (bsfolder, bsfile, bspath);
00493     
00494     if (!newtexthandle (bspath, &hpath))
00495         return (false);
00496     
00497     (**hpathtree).nodeval.data.stringvalue = hpath;
00498     
00499     langcallbacks.idvaluecallback = &fileidvaluecallback;
00500     
00501     fl = evaluatetree (hfiltertree, &val);
00502     
00503     cleartmpstack ();
00504     
00505     langcallbacks.idvaluecallback = nil;
00506     
00507     disposehandle (hpath);
00508     
00509     if (!fl)
00510         return (false);
00511     
00512     if (!coercetoboolean (&val))
00513         return (false);
00514     
00515     return (val.data.flvalue);
00516     } /*fileloopfilter*/
00517 
00518 #endif
00519 
00520 static boolean fileloopguts (hdltreenode htree, ptrfilespec fsfolder, bigstring bsidentifier, long ctlevels, tyvaluerecord *valtree) {
00521     /*
00522     the core of fileloop evaluation, now recursive.
00523     
00524     if ctlevels is -1, do one level and process folders just like files.
00525     
00526     if ctlevels is not -1, only process files, and recurse for folders 
00527     to the specified depth
00528     
00529     10/8/92 dmb: break & return must kick out of all levels of recursion (whew!)
00530     */
00531     
00532     register hdltreenode h = htree;
00533     register boolean fl;
00534     tyvaluerecord val;
00535     tyfilespec fs;
00536     boolean flfolder;
00537     Handle hfileloop;
00538     
00539 #ifdef MACVERSION
00540     if (isemptystring ((*fsfolder).name)) /*loop over mounted volumes*/
00541         fl = diskinitloop (nil, &hfileloop);
00542     else
00543 #endif
00544         fl = fileinitloop (fsfolder, nil, &hfileloop);
00545     
00546     if (!fl)
00547         return (false);
00548     
00549     while (filenextloop (hfileloop, &fs, &flfolder)) { /*get the next file in the directory*/
00550         
00551         if ((ctlevels != -1) && flfolder) {
00552             
00553             if (ctlevels > 0) {
00554                 
00555                 fl = fileloopguts (h, &fs, bsidentifier, ctlevels - 1, valtree);
00556                 
00557                 if (!fl)
00558                     break;
00559                 
00560                 if (flbreak || flreturn)
00561                     break;
00562                 }
00563             
00564             continue;
00565             }
00566         
00567         fl = setfilespecvalue (&fs, &val);
00568         
00569         if (!fl)
00570             break;
00571         
00572         fl = langsetsymbolval (bsidentifier, val); /*user program gets the name*/
00573         
00574         if (!fl)
00575             break;
00576         
00577         exemptfromtmpstack (&val);
00578         
00579         cleartmpstack (); /*dealloc all outstanding temporary values*/
00580         
00581         flbreak = false; 
00582         
00583         flcontinue = false;
00584         
00585         fl = evaluatelist ((**h).param3, valtree); /*run the body of the loop once*/
00586         
00587         flcontinue = false;
00588         
00589         if (!fl)
00590             break;
00591         
00592         assert (!leakingmemory (valtree));
00593         
00594         if (flbreak || flreturn)
00595             break;
00596         
00597         fl = langdebuggercall (h);
00598         
00599         if (!fl) /*user killed the script*/
00600             break;
00601         } /*while*/
00602     
00603     fileendloop (hfileloop);
00604     
00605     return (fl);
00606     } /*fileloopguts*/
00607 
00608 
00609 static boolean evaluatefileloop (hdltreenode hloop, tyvaluerecord *valtree) {
00610     
00611     /*
00612     7/9/90 DW: bug -- fileloops leak memory.
00613     
00614     4/24/92 dmb: removed misplaced & redundant leakingmemory check
00615     
00616     10/8/92 dmb: must clear flbreak here so that fileloopguts can leave it set 
00617     while unwinding recursion
00618     */
00619     
00620     register hdltreenode h = hloop;
00621     tyfilespec fsfolder;
00622     bigstring bsidentifier;
00623     tyvaluerecord val;
00624     register hdltreenode hp = (**h).param2;
00625     long ctlevels;
00626     
00627     if (!evaluatetree (hp, &val)) /*the path is the second parameter*/
00628         return (false);
00629     
00630     if (!coercetofilespec (&val))
00631         return (false);
00632     
00633     assert (!leakingmemory (&val));
00634     
00635     #if TARGET_API_MAC_CARBON == 1 /*PBS 10/03/01: fix crashing bug copying filespecs*/
00636     
00637         fsfolder.vRefNum = (**val.data.filespecvalue).vRefNum;
00638         fsfolder.parID = (**val.data.filespecvalue).parID;
00639 
00640         copystring ((**val.data.filespecvalue).name, fsfolder.name);
00641 
00642     #else
00643     
00644         fsfolder = **val.data.filespecvalue;
00645     
00646     #endif
00647     
00648     if (!langgetidentifier ((**h).param1, bsidentifier))
00649         return (false);
00650     
00651     hp = (**h).param4; /*copy into register*/
00652     
00653     if (hp == nil) /*no depth clause*/
00654         ctlevels = -1;
00655     
00656     else {
00657         
00658         if (!evaluatetree (hp, &val))
00659             return (false);
00660         
00661         if (!coercetolong (&val))
00662             return (false);
00663         
00664         ctlevels = val.data.longvalue;
00665         
00666         if (ctlevels <= 0)
00667             return (true);
00668         
00669         --ctlevels;
00670         }
00671     
00672     langseterrorline (h); /*reset error reporting after evaulatetree calls*/
00673     
00674     if (!fileloopguts (h, &fsfolder, bsidentifier, ctlevels, valtree))
00675         return (false);
00676     
00677     flbreak = false; /*good for all levels of single fileloop*/
00678     
00679     return (true);
00680     } /*evaluatefileloop*/
00681 
00682 
00683 static boolean evaluatecase (hdltreenode hcase, tyvaluerecord *valtree) {
00684     
00685     /*
00686     we must evaluate the case expression for each item, because EQvalue disposes of
00687     both values after it is finished doing the comparison.  this may impact the
00688     effect of the case statement if any of the expressions have side-effects.
00689     
00690     12/6/91 dmb: the side effect issue cannot be ignored; changed to code 
00691     pre-evaluate case, and work with a copy for each case item.
00692     
00693     3/6/92 dmb: changed syntax to allow empty statements lists; if match is found w/no 
00694     statements, bump down to next case item that has a statement list to evaluate.
00695     */
00696     
00697     register hdltreenode h = hcase;
00698     register hdltreenode nomad;
00699     tyvaluerecord valcase, valcopy, valitem, valtest;
00700     boolean fl;
00701     
00702     if (!evaluatetree ((**h).param1, &valcase)) /*the case value is the 1st param*/
00703         return (false);
00704     
00705     exemptfromtmpstack (&valcase);
00706     
00707     fl = false; /*assume the worst*/
00708     
00709     nomad = (**h).param2; /*list of cases is the 2nd param*/
00710     
00711     while (true) {
00712         
00713         if (nomad == nil) { /*ran out of case items, execute else part -- if it's here*/
00714             
00715             if ((**h).param3 == nil) /*no else*/
00716                 fl = setbooleanvalue (false, valtree); /*seems like a reasonable return*/
00717             else
00718                 fl = evaluatelist ((**h).param3, valtree);
00719             
00720             break;
00721             }
00722             
00723         if (!copyvaluerecord (valcase, &valcopy)) /*the case value is the 1st param*/
00724             break;
00725         
00726         assert (!leakingmemory (&valcopy));
00727         
00728         if (!evaluatetree ((**nomad).param1, &valitem))
00729             break;
00730         
00731         assert (!leakingmemory (&valitem));
00732         
00733         if (!EQvalue (valcopy, valitem, &valtest)) /*also disposes of both values*/
00734             break;
00735         
00736         if (valtest.data.flvalue) { /*found matching case*/
00737             
00738             while ((**nomad).param2 == nil) { /*find next case item that has a body*/
00739                 
00740                 nomad = (**nomad).link;
00741                 
00742                 if (nomad == nil) { /*no body found to execute*/
00743                     
00744                     fl = setbooleanvalue (true, valtree); /*return true since a match was found*/
00745                     
00746                     goto exit;
00747                     }
00748                 }
00749             
00750             fl = evaluatelist ((**nomad).param2, valtree);
00751             
00752             break;
00753             }
00754         
00755         nomad = (**nomad).link;
00756         
00757         cleartmpstack ();
00758         
00759         assert (!leakingmemory (valtree));
00760         } /*while*/
00761     
00762     exit:
00763     
00764     disposevaluerecord (valcase, false);
00765     
00766     return (fl);
00767     } /*evaluatecase*/
00768     
00769 
00770 /*
00771 static boolean addmodulecontext (hdlhashtable htable, hdlhashnode hnode, bigstring bsname, hdltreenode htree) {
00772     
00773     /%
00774     add all of the top-level locals and modules to the current context
00775     %/
00776     
00777     register hdltreenode h;
00778     register tytreetype op;
00779     tyvaluerecord val;
00780     boolean fl = true;
00781     
00782     if (!langpushsourcecode (htable, hnode, bsname))
00783         return (false);
00784     
00785     for (h = (**htree).param1; h != nil; h = (**h).link) {
00786         
00787         op = (**h).nodetype;
00788         
00789         if ((op == localop) || (op == moduleop)) {
00790             
00791             if (!evaluatetree (h, &val)) {
00792                 
00793                 fl = false;
00794                 
00795                 break;
00796                 }
00797             }
00798         }
00799     
00800     
00801     langpopsourcecode ();
00802     
00803     return (fl);
00804     } /%addmodulecontext%/
00805 */
00806 
00807 
00808 static long langgetlexicalrefcon (void) {
00809     
00810     /*
00811     2/12/92 dmb: a bit of repeated code.  in fact, there may be potential 
00812     external callers of this routine.
00813     
00814     3.0.2 dmb: return -1 if no error callback/refcon has been pushed
00815     */
00816     
00817     register hdlerrorstack hs;
00818 
00819     #if TARGET_API_MAC_CARBON == 1   
00820 
00821         if (langcallbacks.scripterrorstack == nil)
00822             return (-1);
00823     
00824     #endif  
00825         
00826     hs = langcallbacks.scripterrorstack;
00827 
00828     
00829     #if TARGET_API_MAC_CARBON == 1
00830     
00831         if (hs == nil)
00832             return (-1);
00833     
00834         if ((long) (*hs) == -1)
00835             return (-1);
00836     
00837     #endif
00838     
00839     if ((hs == nil) || ((**hs).toperror == 0)) {
00840 
00841         return (-1);
00842         }
00843     else {
00844 
00845         #if TARGET_API_MAC_CARBON == 1
00846         
00847             if ((**hs).stack == nil)
00848                 return (-1);
00849                 
00850             if ((**hs).toperror < 1)
00851                 return (-1);
00852                 
00853             if ((**hs).toperror > cterrorcallbacks)
00854                 return (-1);
00855         #endif
00856         
00857         return ((**hs).stack [(**hs).toperror - 1].errorrefcon);
00858         }
00859     } /*langgetlexicalrefcon*/
00860 
00861 
00862 static boolean evaluatewith (hdltreenode hwith, tyvaluerecord *valtree) {
00863     
00864     /*
00865     evaluate a with block.  hparam1 should be a list of terminals that 
00866     specify tables to add to the search path for the with block.
00867     
00868     8/31/92 dmb: added supports for multiple with items, object specifiers
00869     */
00870     
00871     register hdltreenode h = hwith;
00872     register hdltreenode hterm;
00873     hdlhashtable htable;
00874     bigstring bs;
00875     hdlhashtable hlocaltable;
00876     register hdlhashtable ht;
00877     tyvaluerecord valtable;
00878     tyvaluerecord valwith;
00879     short n = 0;
00880     hdlhashnode hnode;
00881     
00882     if (!newhashtable (&hlocaltable)) /*new table for the function when it runs*/
00883         return (false);
00884     
00885     ht = hlocaltable; /*copy into register*/
00886     
00887     (**ht).fllocaltable = true;  // 5.1.4 dmb: set now so pre-assignments will know locality of table
00888 
00889     (**ht).lexicalrefcon = langgetlexicalrefcon (); /*'with' expressions use local scope*/
00890     
00891     chainhashtable (ht); /*need it in scope to handle multiple items in list*/
00892     
00893     /*populate the local table with path values*/
00894     
00895     for (hterm = (**h).param1; hterm != nil; hterm = (**hterm).link) {
00896         
00897         if (isobjspectree (hterm)) {
00898             
00899             if (!evaluateobjspec (hterm, &valwith))
00900                 goto error;
00901             
00902             copystring (bscontainername, bs);
00903             }
00904         else {
00905             
00906             if (!langgetdottedsymbolval (hterm, &htable, bs, &valtable, &hnode))
00907                 goto error;
00908             
00909             /*
00910             if (langexternalvaltocode (valtable, &hcode)) { /%5/14/93 dmb%/
00911                 
00912                 if (!hashtablelookupnode (htable, bs, &hnode))
00913                     goto error;
00914                 
00915                 if (hcode == nil) {
00916                     
00917                     if (!langcompilescript (hnode, &hcode))
00918                         goto error;
00919                     }
00920                 
00921                 if (!addmodulecontext (htable, hnode, bs, hcode))
00922                     goto error;
00923                 
00924                 continue;
00925                 }
00926             */
00927             
00928             if (!langexternalvaltotable (valtable, &htable, hnode)) {
00929                 
00930                 langparamerror (badwithstatementerror, bs);
00931                 
00932                 goto error;
00933                 }
00934             
00935             if (!setaddressvalue (htable, zerostring, &valwith))
00936                 goto error;
00937             
00938             if (n == 7) { /*maximum value of ctwithvalues*/
00939                 
00940                 langlongparamerror (toomanywithtableserror, n);
00941                 
00942                 goto error;
00943                 }
00944             
00945             langgetwithvaluename (++n, bs);
00946             
00947             (**ht).ctwithvalues = n; /*optimization for langfindsymbol*/
00948             }
00949         
00950         if (!hashtableassign (ht, bs, valwith)) {
00951             
00952             disposevaluerecord (valwith, false);
00953             
00954             goto error;
00955             }
00956         
00957         exemptfromtmpstack (&valwith); /*its in the local table now*/
00958         }
00959     
00960     unchainhashtable ();
00961     
00962     hmagictable = ht; /*evaluatelist uses this as its local symbol table*/
00963     
00964     return (evaluatelist ((**h).param2, valtree));
00965     
00966     error: {
00967         
00968         unchainhashtable ();
00969         
00970         disposehashtable (ht, false);
00971         
00972         return (false);
00973         }
00974     } /*evaluatewith*/
00975 
00976 
00977 Handle tryerror = nil;
00978 
00979 Handle tryerrorstack = nil;  //This code is left in so process.c, etc do not have to change
00980 
00981 
00982 #if fltryerrorstackcode
00983 
00984     static boolean pusherrorstackitem (bigstring bstitle, bigstring bsname, unsigned long errorline, unsigned short errorchar) {
00985     #ifdef NEVER
00986         bigstring bsline, bschar;
00987         long len, offset;
00988         Handle h;
00989         boolean fl;
00990 
00991         numbertostring ((long) errorline, bsline);
00992         numbertostring ((long) errorchar, bschar);
00993         // "{\"" + bstitle + "\",\"" + bsname + "\"," + bsline + "," + bschar + "}"
00994         //  2 + stringlength (bstitle) + 3 + stringlength (bsname) + 2 + stringlength (bsline) + 1 + stringlength (bschar) + 1
00995         len = 2 + stringlength (bstitle) + 3 + stringlength (bsname) + 2 + stringlength (bsline) + 1 + stringlength (bschar) + 1;
00996         
00997         if (! newhandle (len, &h))
00998             return (false);
00999         
01000         moveleft ("{\"", *h, 2);
01001         offset = 2;
01002         moveleft ((ptrstring) stringbaseaddress(bstitle), *h+offset, stringlength(bstitle));
01003         offset += stringlength (bstitle);
01004         moveleft ("\",\"", *h+offset, 3);
01005         offset += 3;
01006         moveleft ((ptrstring) stringbaseaddress(bsname), *h+offset, stringlength(bsname));
01007         offset += stringlength (bsname);
01008         moveleft ("\",", *h+offset, 2);
01009         offset += 2;
01010         moveleft ((ptrstring) stringbaseaddress(bsline), *h+offset, stringlength(bsline));
01011         offset += stringlength (bsline);
01012         moveleft (",", *h+offset, 1);
01013         offset += 1;
01014         moveleft ((ptrstring) stringbaseaddress(bschar), *h+offset, stringlength(bschar));
01015         offset += stringlength (bschar);
01016         moveleft ("}", *h+offset, 1);
01017 
01018         fl = insertinhandle (tryerrorstack, gethandlesize(tryerrorstack), *h, len);
01019         
01020         disposehandle (h);
01021         
01022         return (fl);
01023     #endif      
01024 
01025     #ifdef tryerrorstackusinglists
01026         hdllistrecord hnew;
01027         hdllistrecord htry;
01028         tyvaluerecord val;
01029 
01030         htry = (hdllistrecord) tryerrorstack;
01031 
01032         if (tryerrorstack == nil)
01033             if (! opnewlist (&htry, false))
01034                 return (false);
01035             else
01036                 tryerrorstack = (Handle) htry;
01037 
01038         if (! opnewlist (&hnew, false))
01039             return (false);
01040 
01041         if (! langpushliststring (hnew, bstitle))
01042             goto error;
01043 
01044         if (! langpushliststring (hnew, bsname))
01045             goto error;
01046 
01047         if (! langpushlistlong (hnew, (long)errorline))
01048             goto error;
01049 
01050         if (! langpushlistlong (hnew, (long)errorchar))
01051             goto error;
01052 
01053         if (! setheapvalue ((Handle) hnew, listvaluetype, &val))
01054             goto error;
01055 
01056         if (langpushlistval (htry, nil, &val))
01057             return (true);
01058         
01059         disposevaluerecord (val, false);
01060         return (false);
01061 
01062     error:
01063         opdisposelist (hnew);
01064 
01065         return (false);
01066     #endif
01067     return (true);
01068         } /*pusherrorstackitem*/
01069 
01070 
01071     static boolean langsettryerrorstack () {
01072 
01073         register hdlerrorstack hs = langcallbacks.scripterrorstack;
01074         register short ix;
01075         register short ixtop;
01076         hdlhashtable htable;
01077         hdlwindowinfo hparent;
01078         bigstring bsname;
01079         bigstring bstitle;
01080         tyerrorrecord *pe;
01081         
01082         if (hs == nil)
01083             return (false);
01084         
01085         ixtop = (**hs).toperror;
01086         
01087     //  if (! newtexthandle ("\x01" "{", &tryerrorstack))
01088     //      return (false);
01089         
01090         for (ix = ixtop - 1; ix >= 0; --ix) {
01091             
01092             pe = &(**hs).stack [ix];
01093             
01094             if ((*pe).errorcallback == nil ||
01095                 !(*(*pe).errorcallback) ((*pe).errorrefcon, 0, 0, &htable, bsname)) {
01096             
01097                 langgetstringlist (anomynousthreadstring, bsname); 
01098                 langgetstringlist (anomynousthreadstring, bstitle); 
01099                 }
01100             else {
01101                 if (!langexternalgetfullpath (htable, bsname, bstitle, &hparent))
01102                     langgetstringlist (anomynousthreadstring, bstitle);
01103                 }
01104 
01105             
01106             if (!pusherrorstackitem (bstitle, bsname, (*pe).errorline, (*pe).errorchar)) { /*terminate visit on error*/
01107                 disposehandle (tryerrorstack);
01108                 return (false);
01109                 }
01110                 
01111     //      if (ix > 0)
01112     //          pushtexthandle ("\x01" ",", tryerrorstack);
01113     //      else
01114     //          pushtexthandle ("\x01" "}", tryerrorstack);
01115                 
01116             }
01117             
01118         return (true);
01119         } /*langsettryerrorstack*/
01120 #endif
01121 
01122 static boolean langtryerror (bigstring bsmsg, ptrvoid refcon) {
01123 #pragma unused (refcon)
01124 
01125     /*
01126     6/25/92 dmb: when an error occurs during a try block, we stash it in 
01127     the tryerror handle.  it is later placed in the stack frame of the 
01128     else statement, if it exists, by evaluatelist
01129     */
01130     
01131     assert (tryerror == nil);
01132     
01133     newtexthandle (bsmsg, &tryerror); /*if out of mem, script won't be able to get error*/
01134     
01135     #if fltryerrorstackcode
01136         assert (tryerrorstack == nil);
01137         
01138         langsettryerrorstack();
01139     #endif
01140 
01141     return (true);
01142     } /*langtryerror*/
01143 
01144 
01145 static boolean evaluatetry (hdltreenode htry, tyvaluerecord *valtree) {
01146     
01147     register hdltreenode h = htry;
01148     boolean fl;
01149     langerrormessagecallback savecallback;
01150     
01151     assert (tryerror == nil);
01152 
01153     #if fltryerrorstackcode
01154         assert (tryerrorstack == nil);
01155     #endif
01156     
01157     savecallback = langcallbacks.errormessagecallback;
01158     
01159     langcallbacks.errormessagecallback = &langtryerror;
01160     
01161     fl = evaluatelist ((**h).param2, valtree);
01162     
01163     langcallbacks.errormessagecallback = savecallback;
01164     
01165     if (!fllangerror) {
01166         
01167         assert (tryerror == nil);
01168 
01169         #if fltryerrorstackcode
01170             assert (tryerrorstack == nil);
01171         #endif      
01172 
01173         return (fl); /*might be false if script has been killed*/
01174         }
01175     
01176     fllangerror = false; /*recover*/
01177     
01178     h = (**h).param3;
01179     
01180     if (h == nil) {
01181         
01182         disposehandle (tryerror);
01183         
01184         tryerror = nil;
01185         
01186         #if fltryerrorstackcode
01187             opdisposelist ((hdllistrecord) tryerrorstack);
01188     //      disposehandle (tryerrorstack);
01189             
01190             tryerrorstack = nil;
01191         #endif
01192         
01193         return (true);
01194         }
01195 
01196     //assert (tryerror != nil); //6.1b8 AR: attempt to catch "tryerror not defined" situations
01197     
01198     return (evaluatelist (h, valtree)); /*will take care of tryerror automatically*/
01199     } /*evaluatetry*/
01200 
01201 
01202 static boolean langaddlocals (hdltreenode hnode) {
01203     
01204     /*
01205     add the names in hnamelist to the most-local symbol table.  
01206     
01207     return false if the symbol is already declared in the local table, or 
01208     if there was a memory allocation error.
01209     
01210     1/17/91 dmb: simplified code and moved tmpstack logic from assignlocalop 
01211     clause to bottom of loop, so on error val is still in tmpstack and will 
01212     be disposed later
01213     
01214     xxx 12/11/92 dmb: set unassigned locals to novaluetype, not zero (long). this 
01215     xxx allows them to more easily be used in expressions and yield expected results.
01216     
01217     2.1b2 dmb: added debugger call for local initial assignments
01218     
01219     4.1b4 dmb: added fllangexternalvalueprotect flag to disable protection
01220     
01221     4.28.97 dmb: make sure assignments copy tmpdata
01222     */
01223     
01224     register hdltreenode nomad = (**hnode).param1;
01225     
01226     while (true) { /*step through name list, inserting each into symbol table*/
01227         
01228         tyvaluerecord val;
01229         bigstring bs;
01230         
01231         if (nomad == nil) /*reached the end of the names list*/
01232             return (true);
01233         
01234         if ((**nomad).nodetype == assignlocalop) {
01235             
01236             if (!langdebuggercall (nomad)) /*2.1b2*/
01237                 return (false);
01238             
01239             if (!evaluatetree ((**nomad).param2, &val))
01240                 return (false);
01241             
01242             if (fllangexternalvalueprotect && val.valuetype == externalvaluetype) { /*4.1b4 dmb*/
01243                 
01244                 langbadexternaloperror (externalassignerror, val);
01245                 
01246                 return (false);
01247                 }
01248             
01249             if (!langgetidentifier ((**nomad).param1, bs))
01250                 return (false);
01251             }
01252         else {
01253             
01254             initvalue (&val, novaluetype);
01255             
01256             if (!langgetidentifier (nomad, bs))
01257                 return (false);
01258             }
01259             
01260         if (hashsymbolexists (bs)) { /*multiply-defined symbol*/
01261             
01262             langseterrorline (nomad); /*point right at the offending name*/
01263         
01264             langparamerror (multiplesymbolerror, bs);
01265             
01266             return (false);
01267             }
01268         
01269         // 4.28.97 dmb: do what hashassign does with tmpdata. shouls hashinsert do this?
01270         
01271         if (val.fltmpdata) { /*val doesn't own it's data*/
01272             
01273             if (!copyvaluedata (&val))
01274                 return (false);
01275             
01276             exemptfromtmpstack (&val); /***should wait until success*/
01277             }
01278         
01279         hashsetlocality (&val, true); /*6.2b16 AR*/
01280         
01281         if (!hashinsert (bs, val)) /*error creating new symbol*/
01282             return (false);
01283         
01284         exemptfromtmpstack (&val); /*it's been successfully added to local table*/
01285         
01286         cleartmpstack (); /*dealloc all outstanding temporary values*/  
01287         
01288         nomad = (**nomad).link; /*advance to next name in list*/
01289         } /*while*/
01290     } /*langaddlocals*/
01291 
01292 
01293 static boolean langaddhandler (hdltreenode hnode) {
01294     
01295     /*
01296     add a handler node to the current hashtable.  the structure below hnode
01297     must conform to the structure documented in the comment at the head of
01298     langfunccall.
01299     
01300     2/5/91 dmb: stuff the current scripterrorrefcon into the (otherwise unused) 
01301     nodeval so that the script debugger and error dialog can trace handler 
01302     calls back to their source.  this would otherwise be quite difficult to 
01303     do, since the address of a local handler can be passed around between 
01304     scripts and called from anywhere.  see scriptpushsourcecode in scripts.c.
01305     */
01306     
01307     register hdltreenode h = hnode;
01308     bigstring bs;
01309     tyvaluerecord val;
01310     
01311     if (!langgetidentifier ((**(**h).param2).param1, bs))
01312         return (false);
01313     
01314     if (hashsymbolexists (bs)) { /*name already defined in most-local table*/
01315         
01316         langseterrorline (h); /*point right at the offending name*/
01317         
01318         langparamerror (multiplesymbolerror, bs);
01319         
01320         return (false);
01321         }
01322     
01323     initvalue (&val, codevaluetype);
01324     
01325     val.data.codevalue = h;
01326     
01327     val.fltmpdata = true; /*data belong to code tree*/
01328     
01329     if (!hashinsert (bs, val))
01330         return (false);
01331     
01332     bundle { /*link this code value to the source from whence it came*/
01333         
01334         initvalue (&val, longvaluetype);
01335         
01336         val.data.longvalue = langgetlexicalrefcon ();
01337         
01338         (**h).nodeval = val;
01339         }
01340     
01341     return (true);
01342     } /*langaddhandler*/
01343 
01344 
01345 static boolean needassignmentresult (hdltreenode hp) {
01346     
01347     /*
01348     5.0.2b21 dmb: new rule: we need the result of an assingnment if it's the 
01349     last statement in a body _and_ it's in the outermost scope of the script.
01350     
01351     5.1.1 dmb: removed new rule of 5.0.2b21; too many broken scripts
01352     */
01353     
01354     //register hdlerrorstack hs = langcallbacks.scripterrorstack;
01355     
01356     if ((**hp).link != nil)
01357         return (false);
01358     
01359     /*
01360     if ((hs != nil) && ((**hs).toperror > 1))
01361         return (false);
01362     */
01363     
01364     return (true);
01365     } /*needassignmentresult*/
01366 
01367 
01368 #define newparams
01369 
01370     typedef struct typaraminfo {
01371         
01372         byte evalparam1;
01373         
01374         byte evalparam2;
01375         } typaraminfo;
01376     
01377     #define nope ((byte) -1)
01378     
01379     static typaraminfo paraminfolist [cttreetypes] = {
01380         
01381         {nope, nope},   /*noop*/
01382         
01383         {true, true},   /*addop*/
01384         
01385         {true, true},   /*subtractop*/
01386         
01387         {true, true},   /*multiplyop*/
01388         
01389         {true, true},   /*divideop*/
01390         
01391         {true, true},   /*modop*/
01392         
01393         {nope, nope},   /*identifierop*/
01394         
01395         {nope, nope},   /*constop*/
01396         
01397         {true, nope},   /*unaryop*/
01398         
01399         {true, nope},   /*notop*/
01400         
01401         {false, true},  /*assignop*/
01402         
01403         {false, false}, /*functionop*/
01404         
01405         {true, true},   /*EQop*/
01406         
01407         {true, true},   /*NEop*/
01408         
01409         {true, true},   /*GTop*/
01410         
01411         {true, true},   /*LTop*/
01412         
01413         {true, true},   /*GEop*/
01414         
01415         {true, true},   /*LEop*/
01416         
01417         {true, false},  /*ororop*/
01418         
01419         {true, false},  /*andandop*/
01420         
01421         {false, nope},  /*incrpreop*/ /* ++x */
01422         
01423         {false, nope},  /*incrpostop*/ /* x++ */
01424         
01425         {false, nope},  /*decrpreop*/ /* --x */
01426         
01427         {false, nope},  /*decrpostop*/ /* x-- */
01428         
01429         {true, false},  /*loopop*/
01430         
01431         {false, false}, /*fileloopop*/
01432         
01433         {true, true},   /*forloopop*/
01434         
01435         {nope, nope},   /*breakop*/
01436         
01437         {true, nope},   /*returnop*/
01438         
01439         {false, nope},  /*bundleop*/
01440         
01441         {true, false},  /*ifop*/
01442         
01443         {nope, nope},   /*procop*/
01444         
01445         {false, nope},  /*localop*/
01446         
01447         {false, false}, /*moduleop*/
01448         
01449         {false, false}, /*dotop*/
01450         
01451         {false, false}, /*arrayop*/
01452         
01453         {false, nope},  /*addressofop*/
01454         
01455         {false, nope},  /*dereferenceop*/
01456         
01457         {true, true},   /*assignlocalop*/
01458         
01459         {nope, nope},   /*bracketop*/
01460         
01461         {false, false}, /*caseop*/
01462         
01463         {nope, nope},   /*caseitemop*/ 
01464         
01465         {nope, nope},   /*casebodyop*/
01466         
01467         {nope, nope},   /*kernelop*/
01468         
01469         {nope, nope},   /*continueop*/
01470         
01471         {false, false}, /*withop*/
01472         
01473         {true, true},   /*fordownloopop*/
01474         
01475         {false, false}, /*tryop*/
01476         
01477         {true, true},   /*beginswithop*/
01478         
01479         {true, true},   /*endswithop*/
01480         
01481         {true, true},   /*containsop*/
01482         
01483         {true, true},   /*rangeop*/
01484         
01485         {false, nope},  /*listop*/
01486         
01487         {nope, nope},   /*fieldop*/
01488         
01489         {false, nope},  /*recordop*/
01490         
01491         {true, false},  /*forinloopop*/
01492         
01493         {false, nope},  /*globalop*/
01494         
01495         {true, nope},   /*osascriptop*/
01496         
01497         {false, true},  /*addvalueop*/
01498         
01499         {false, true},  /*subtractvalueop*/
01500         
01501         {false, true},  /*multiplyvalueop*/
01502         
01503         {false, true}   /*dividevalueop*/
01504         };
01505 
01506 
01507 static boolean evaltree (hdltreenode htree, tyvaluerecord *valtree) {
01508     
01509     /*
01510     1/16/91 dmb: set default return value so we don't pass garbage 
01511     back to caller
01512     
01513     2/1/91 dmb: don't call the debugger on a return op.  I'm not sure why 
01514     this was ever done here, but it causes the debugger to step on return 
01515     statements twice.
01516     
01517     2/1/91 dmb: bracketop should be treated just like identifierop.  used 
01518     to be missed, resulting in false return w/no error reported.  added 
01519     unexpected opcode error message in case this happens again.
01520     
01521     9/4/91 dmb: fixed potential memory leak of val1 while evaluating val2. 
01522     also, updated handling of ororop and andandop, which now do short-circuit
01523     evaluation.
01524     
01525     12/26/91 dmb: in assignop, don't set valtree is assignment fails
01526     
01527     5/29/92 dmb: added try statement handling
01528 
01529     5.0b7 dmb: for returnop, actually pust externals on the temp stack.
01530     really, at this point, we should treat externals like any other 
01531     heap-allocated value and use the temp stack all the time, not the 
01532     fltmpdata hack from before we beefed up the temp stack for lists. but
01533     we're too close to shipping to do that now.
01534     
01535     5.0b17 dmb: for assignop, we have the same issue as returnop. but for
01536     this implicit return value, don't copy externs; just return true. also
01537     make sure val1 goes back onto the temp stack if it was there.
01538     
01539     5.0.2b10 dmb: for returnop, don't copy the already-temp val1. for assignop,
01540     only return the value as a side effect if htree is the last in its list.
01541     
01542     5.0.2b12 dmb: don't push external on tmpstack if it's already there
01543     
01544     5.0.2b21 dmb: assignop, returnop check fltmpdata to handle codetype too. probably
01545     don't need to check to externalvaluetype anymore in assignop.
01546     
01547     6.2b15 AR: For ifop, call coercetoboolean directly instead of the now defunct truevalue
01548     */
01549     
01550     register hdltreenode h = htree;
01551     register tytreetype op;
01552     register short ctparams;
01553     tyvaluerecord val1, val2;
01554     
01555     setbooleanvalue (true, valtree); /*default returned value*/
01556     
01557     if (fllangerror) { /*a language error dialog has appeared, unwind*/
01558         
01559         return (false); /*return false, aid in the unwinding process*/
01560         }
01561     
01562     if (h == nil)
01563         return (true);
01564     
01565     op = (**h).nodetype; /*copy into register*/
01566     
01567     ctparams = (**h).ctparams;
01568     
01569     if (ctparams > 0) {
01570         
01571         #ifdef newparams
01572         
01573         typaraminfo info = paraminfolist [op];
01574         
01575         #endif
01576         
01577         initvalue (&val1, novaluetype); /*so we can indiscriminantly pass to tmpstack routines*/
01578         
01579         #ifdef newparams
01580         
01581         if (info.evalparam1)
01582         
01583         #else
01584         
01585         if (evalparam1 (op))
01586         
01587         #endif
01588             {
01589             if (!evaluatetree ((**h).param1, &val1))
01590                 return (false);
01591             
01592             assert (!leakingmemory (&val1));
01593             
01594             if (flreturn)
01595                 return (true);
01596             }
01597         
01598         if (ctparams > 1) {
01599             
01600             #ifdef newparams
01601             
01602             if (info.evalparam2)
01603             
01604             #else
01605             
01606             if (evalparam2 (op))
01607             
01608             #endif
01609                 {
01610                 boolean fl, fltmp;
01611                 
01612                 fltmp = exemptfromtmpstack (&val1); /*if still novaluetype, does nothing*/
01613                 
01614                 fl = evaluatetree ((**h).param2, &val2);
01615                 
01616                 if (fltmp)
01617                     pushtmpstackvalue (&val1); /*5.0b17: use this call to make sure it goes back*/
01618                 
01619                 if (!fl)
01620                     return (false);
01621                 
01622                 assert (!leakingmemory (&val2));
01623                 
01624                 assert (validvalue (&val1));
01625                 
01626                 if (flreturn)
01627                     return (true);
01628                 }
01629             }
01630         }
01631     
01632     langseterrorline (h); /*set globals for error reporting*/
01633     
01634 //printf ("evaltree: op = %d/n", op);
01635     
01636     switch (op) {
01637         
01638         case noop:
01639             return (true); /*noop's are very agreeable*/
01640         
01641         case localop:
01642             return (langaddlocals (h));
01643             
01644         case moduleop:
01645             return (langaddhandler (h));
01646         
01647         case identifierop:
01648         case bracketop:
01649             return (idvalue (h, valtree));
01650         
01651         case dotop:
01652             return (dotvalue (h, valtree));
01653             
01654         case addressofop:
01655             return (addressofvalue ((**h).param1, valtree));
01656         
01657         case dereferenceop:
01658             return (dereferencevalue ((**h).param1, valtree));
01659         
01660         case arrayop:
01661             return (arrayvalue (h, valtree));
01662         
01663         case constop:
01664             return (copyvaluerecord ((**h).nodeval, valtree));
01665             
01666         case assignop:
01667             if (!assignvalue ((**h).param1, val2))
01668                 return (false);
01669             
01670         //  *valtree = val2;
01671         //  
01672         //  return (true);
01673             
01674             if ((val2.valuetype == externalvaluetype) || val2.fltmpdata || !needassignmentresult (h))
01675                 return (setbooleanvalue (true, valtree)); /*could be a local extern*/
01676             else
01677                 return (copyvaluerecord (val2, valtree)); /*side-effect of assignment*/
01678         
01679         case functionop:
01680             return (functionvalue ((**h).param1, (**h).param2, valtree));
01681         
01682         case addop:
01683             return (addvalue (val1, val2, valtree));    
01684         
01685         case subtractop:
01686             return (subtractvalue (val1, val2, valtree));
01687         
01688         case unaryop:
01689             return (unaryminusvalue (val1, valtree));
01690         
01691         case multiplyop:
01692             return (multiplyvalue (val1, val2, valtree));
01693         
01694         case divideop:
01695             return (dividevalue (val1, val2, valtree));
01696         
01697         case addvalueop:            
01698             return (modifyassignvalue ((**h).param1, val2, addop, valtree, needassignmentresult (h)));
01699         
01700         case subtractvalueop:
01701             return (modifyassignvalue ((**h).param1, val2, subtractop, valtree, needassignmentresult (h)));
01702         
01703         case multiplyvalueop:
01704             return (modifyassignvalue ((**h).param1, val2, multiplyop, valtree, needassignmentresult (h)));
01705         
01706         case dividevalueop:
01707             return (modifyassignvalue ((**h).param1, val2, divideop, valtree, needassignmentresult (h)));
01708         
01709         case modop:
01710             return (modvalue (val1, val2, valtree));
01711         
01712         case notop:
01713             return (notvalue (val1, valtree));
01714             
01715         case EQop:
01716             return (EQvalue (val1, val2, valtree));
01717         
01718         case NEop:
01719             return (NEvalue (val1, val2, valtree));
01720             
01721         case GTop:
01722             return (GTvalue (val1, val2, valtree));
01723             
01724         case LTop:
01725             return (LTvalue (val1, val2, valtree));
01726         
01727         case GEop:
01728             return (GEvalue (val1, val2, valtree));
01729         
01730         case LEop:
01731             return (LEvalue (val1, val2, valtree));
01732         
01733         case beginswithop:
01734             return (beginswithvalue (val1, val2, valtree));
01735         
01736         case endswithop:
01737             return (endswithvalue (val1, val2, valtree));
01738         
01739         case containsop:
01740             return (containsvalue (val1, val2, valtree));
01741         
01742         case ororop:
01743             return (ororvalue (val1, (**h).param2, valtree));
01744             
01745         case andandop:
01746             return (andandvalue (val1, (**h).param2, valtree));
01747         
01748         case breakop:
01749             /*
01750             if (!langdebuggercall (h)) /%user killed the script%/
01751                 return (false);
01752             */
01753             
01754             flbreak = true; /*set global*/
01755             
01756             return (true); /*keep surfacing until someone "catches" it*/
01757         
01758         case continueop:
01759             flcontinue = true; /*set global*/
01760             
01761             return (true);
01762         
01763         case withop:
01764             return (evaluatewith (h, valtree));
01765         
01766         case returnop:
01767             /*
01768             if (!langdebuggercall (h)) /%user killed the script%/
01769                 return (false);
01770             */
01771             
01772             flreturn = true; /*set global*/
01773             
01774             if (fllangexternalvalueprotect && val1.valuetype == externalvaluetype) { /*4.1b4 dmb*/
01775                 
01776                 langbadexternaloperror (externalreturnerror, val1); /*10/25*/
01777                 
01778                 return (false);
01779                 }
01780             
01781             #ifdef version5orgreater
01782                 
01783                 *valtree = val1;
01784                 
01785                 if (val1.fltmpdata) {
01786                 
01787                     if (!copyvaluedata (valtree))
01788                         return (false);
01789                     
01790                     if (!(*valtree).fltmpstack)
01791                         pushtmpstackvalue (valtree);
01792                     }
01793             
01794             #else
01795             
01796                 if (!copyvaluerecord (val1, valtree))
01797                     return (false);
01798             
01799             #endif
01800 
01801             if ((*valtree).valuetype == novaluetype) { /*return () -- no value provided*/
01802                 
01803                 setbooleanvalue (true, valtree);
01804                 }
01805             
01806             return (true);
01807         
01808         case bundleop:
01809             return (evaluatelist ((**h).param1, valtree));
01810             
01811         case ifop:      
01812             if (!coercetoboolean (&val1))
01813                 return (false);
01814             
01815             if (val1.data.flvalue) 
01816                 h = (**h).param2;
01817             else 
01818                 h = (**h).param3;
01819             
01820             if (h == nil)
01821                 return (true);
01822                 
01823             return (evaluatelist (h, valtree));
01824             
01825         case caseop:
01826             return (evaluatecase (h, valtree));
01827             
01828         case loopop: 
01829             return (evaluateloop (h, valtree));
01830         
01831         case fileloopop: 
01832             return (evaluatefileloop (h, valtree));
01833         
01834         case forloopop:
01835             return (evaluateforloop (h, val1, val2, 1, valtree));
01836         
01837         case fordownloopop:
01838             return (evaluateforloop (h, val1, val2, -1, valtree));
01839         
01840         case incrpreop:
01841             return (incrementvalue (true, true, (**h).param1, valtree));
01842             
01843         case incrpostop:
01844             return (incrementvalue (true, false, (**h).param1, valtree));
01845             
01846         case decrpreop:
01847             return (incrementvalue (false, true, (**h).param1, valtree));
01848             
01849         case decrpostop:
01850             return (incrementvalue (false, false, (**h).param1, valtree));
01851         
01852         case tryop:
01853             return (evaluatetry (h, valtree));
01854         
01855         case rangeop:
01856             langerror (badrangeoperationerror);
01857             
01858             return (false);
01859         
01860         case fieldop:
01861             langerror (badfieldoperationerror);
01862             
01863             return (false);
01864         
01865         case listop:
01866             return (makelistvalue ((**h).param1, valtree));
01867         
01868         case recordop:
01869             return (makerecordvalue ((**h).param1, false, valtree));
01870         
01871         case forinloopop:
01872             return (evaluateforinloop (h, val1, valtree));
01873         
01874         /*
01875         case globalop:
01876             return (langaddlocals (h, true));
01877         */
01878         
01879         #ifdef flcomponent
01880         case osascriptop:
01881             if (isosascriptnode (h, &val1))
01882                 return (evaluateosascript (&val1, nil, zerostring, valtree));
01883         #endif
01884         
01885         default:
01886             /* do nothing for procop, assignlocalop, caseitemop, casebodyop, kernelop, globalop */
01887             break;
01888         } /*switch*/
01889     
01890     langlongparamerror (unexpectedopcodeerror, (long) op);
01891     
01892     return (false); /*unimplemented opcode*/
01893     } /*evaltree*/
01894 
01895 
01896 boolean evaluatetree (hdltreenode htree, tyvaluerecord *valtree) {
01897     
01898     /*
01899     7/25/92 dmb: added this wrapper to allow fllangerror to be checked 
01900     every time.
01901     
01902     9/1/92 dmb: added stack overflow detection code
01903     */
01904     
01905     if (!langcheckstackspace ())
01906         return (false);
01907     
01908     return (evaltree (htree, valtree) && !fllangerror);
01909     } /*evaluatetree*/
01910 
01911 
01912 #if lazythis_optimization
01913     static int ctdeferredthis = 0;
01914 #endif
01915 
01916 boolean evaluatelist (hdltreenode hfirst, tyvaluerecord *val) {
01917     
01918     /*
01919     this is something like the main-event-loop for CanCoon's interpreter.
01920     
01921     chain through a list of statements, evaluating each one and then advance
01922     to the next.  the value we return is the value generated by the last
01923     statement in the list.
01924     
01925     we allow an external caller to hand us a pre-stuffed symbol table through the
01926     global hmagictable.  we take care of chaining it into the runtime stack, and
01927     releasing it before we exit.  the global is reset to nil, so that it has to
01928     be reset on every use.  
01929     
01930     7/10/90 DW: allocate a local table for every level -- it's really cheap in
01931     time, and also cheap in space.  this allows automatic locals to be reliably
01932     allocated in the local space, and may help in the future in making other
01933     things work.  now there is one table in the chain for every level, even if
01934     there are no local variables or local handlers.
01935     
01936     7/23/90 DW: we have to protect the returned value from being deallocated
01937     as part of the local list's tmp stack.  if it's a string, the caller will
01938     get a garbage handle.  so we move the value from the local tmpstack into
01939     the next-most-global tmpstack.
01940     
01941     9/4/90 DW: Major rewrite -- wrote the Ultimate SuperStresser™ script, and
01942     it works!
01943     
01944     9/4/91 dmb: on break and return, make sure langerror isn't missed
01945     
01946     9/23/91 dmb: magic table handling is now buried a little deeper -- in 
01947     newhashtable.
01948     
01949     2/12/92 dmb: set lexicalrefcon when pushing local frame.  see langfindsymbol
01950     
01951     9/1/92 dmb: added decent stack overflow detection/handling code
01952     
01953     9/27/92 dmb: added languserescaped (false) call inside of loop
01954     
01955     2.1b2 dmb: added langbadexternaloperror check after each evaluatetree
01956 
01957     11/13/01 dmb: try lazy with evaluation
01958     */
01959     
01960     register hdltreenode programcounter = hfirst;
01961     register boolean fl = false;
01962     hdlhashtable hlocals; 
01963     boolean fltmpval;
01964     boolean flhavelocals, flneedlocals, flneedthis;
01965 #if !lazythis_optimization
01966     hdlhashtable hthis;
01967     bigstring bsthis;
01968 #endif
01969 
01970 
01971     setbooleanvalue (false, val); /*default returned value*/
01972     
01973     if (!langcheckstackspace ())
01974         return (false);
01975     
01976     flhavelocals = (**currenthashtable).fllocaltable;
01977     
01978     flneedthis = !flhavelocals && (hmagictable == nil);
01979     
01980     #if fltryerrorstackcode
01981         flneedlocals = !flhavelocals || (hmagictable != nil) || (tryerror != nil) || (tryerrorstack != nil);
01982     #else
01983         flneedlocals = !flhavelocals || (hmagictable != nil) || (tryerror != nil);
01984     #endif
01985 
01986     if (!flneedlocals) { /*pre-scan statement list to see if we need a local frame*/
01987         
01988         register hdltreenode h;
01989         register tytreetype op;
01990         
01991         for (h = programcounter; h != nil; h = (**h).link) {
01992             
01993             op = (**h).nodetype;
01994             
01995             if ((op == localop) || (op == moduleop)) {
01996                 
01997                 flneedlocals = true;
01998                 
01999                 break;
02000                 }
02001             }
02002         }
02003     
02004     if (flneedlocals) {
02005         
02006         if (!langpushlocalchain (&hlocals))
02007             return (false);
02008         
02009         (**hlocals).lexicalrefcon = langgetlexicalrefcon ();
02010         
02011         #ifdef version5orgreater
02012         if (flneedthis) {
02013             #if lazythis_optimization
02014                 ++ctdeferredthis;
02015             #else
02016                 if (langgetthisaddress (&hthis, bsthis))
02017                     langsetthisvalue (hlocals, hthis, bsthis);
02018             #endif
02019             }
02020         #endif
02021         
02022         if (tryerror != nil) {
02023             
02024             tyvaluerecord errorval;
02025             
02026             if (setheapvalue (tryerror, stringvaluetype, &errorval))
02027                 if (hashassign (nametryerrorval, errorval))
02028                     exemptfromtmpstack (&errorval);
02029             
02030             tryerror = nil;
02031             }
02032 
02033         #if fltryerrorstackcode
02034             if (tryerrorstack != nil) {
02035                 
02036                 tyvaluerecord errorval;
02037                 
02038     //          if (setheapvalue (tryerrorstack, listvaluetype, &errorval))
02039                 if (setheapvalue (tryerrorstack, stringvaluetype, &errorval))
02040                     if (hashassign (nametryerrorstackval, errorval))
02041                         exemptfromtmpstack (&errorval);
02042                 
02043                 tryerrorstack = nil;
02044                 }
02045         #endif
02046 
02047         }
02048     else
02049         hlocals = currenthashtable;
02050     
02051     while (true) { /*visit each statement in the statement list*/
02052         
02053         if (fllangerror) /*a language error dialog has appeared, unwind*/
02054             break;
02055         
02056         if (programcounter == nil) { /*reached the end of the list*/
02057             
02058             fl = true; /*don't halt the interpreter*/
02059             
02060             break;
02061             }
02062         
02063         cleartmpstack (); /*dealloc all outstanding temporary values*/
02064         
02065         langseterrorline (programcounter); /*set globals for error reporting*/
02066         
02067         if (languserescaped (false)) /*user killed the script*/
02068             break;
02069         
02070         if (!langdebuggercall (programcounter)) /*user killed the script*/
02071             break;
02072         
02073         if (!evaluatetree (programcounter, val))
02074             break;
02075         
02076         #if defined(fldebug) && (fldebug > 1)
02077             assert (validvalue (val));
02078             
02079             assert (!leakingmemory (val));
02080         #endif
02081         
02082         if (flbreak || flreturn || flcontinue) {
02083             
02084             fl = !fllangerror; /*don't halt the interpreter, except on error*/
02085             
02086             break;
02087             }
02088         
02089         programcounter = (**programcounter).link; /*advance to next statement*/
02090         } /*while*/
02091     
02092     /*
02093     1/31/97 dmb: below is the site of a major osamenusharing bug. It can fail!
02094     I've seen it myself. But it's also been reported by Timothy Paustian 
02095     <paustian@bact.wisc.edu> [About the Frontier menu in Web Warrior], Tattoo Mabonzo K. 
02096     <vip052@pophost.eunet.be> [db.save verb] and at least one more person.
02097 
02098     5.0b18 dmb: if this does trigger, make some attempt to exit cleanly
02099     */
02100     
02101     if (hlocals != currenthashtable) { /*should never happen*/
02102 
02103         assert (hlocals == currenthashtable); /*context change in background destroyed our state*/
02104         
02105         langerror (undefinederror);
02106         
02107         currenthashtable = hlocals;
02108         
02109         fl = false;
02110         }
02111     
02112     /*finished processing list, either natural termination, a break, return or error*/
02113     
02114     assert (!fl || !leakingmemory (val));
02115     
02116     fltmpval = exemptfromtmpstack (val); /*must survive disposing of local table & background task*/
02117     
02118     if (flneedlocals) /*pop the runtime stack*/
02119         
02120         langpoplocalchain (hlocals);
02121     
02122     if (fl) /*give agents a shot while val is exempt from temp*/
02123         
02124         fl = langbackgroundtask (false); /*background task can cause termination*/
02125     
02126     if (fltmpval)
02127         pushtmpstackvalue (val); /*insert into the next-most-global tmpstack*/
02128     
02129     if (!fl) { /*failure of some sort -- return immediately*/
02130         
02131         if (flstackoverflow) { /*error was stack overflow*/
02132             
02133             langcheckstacklimit (idprogramstack, 1, 0); /*report now that stack has been popped a bit */
02134             
02135             flstackoverflow = false; /*it's been reported*/
02136             }
02137         
02138         return (false);
02139         }
02140     
02141     if (languserescaped (true)) /*user pressed cmd-period, unwind recursion -- quickly*/
02142         return (false);
02143     
02144     return (true); /*fell through the bottom of the list*/
02145     } /*evaluatelist*/
02146 
02147 
02148 

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