langtree.c

Go to the documentation of this file.
00001 
00002 /*  $Id: langtree.c 1291 2006-04-17 15:09:49Z hasseily $    */
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 "error.h"
00032 #include "memory.h"
00033 #include "lang.h"
00034 #include "langinternal.h"
00035 #include "tablestructure.h"
00036 #include "byteorder.h"  /* 2006-04-08 aradke: endianness conversion macros */
00037 
00038 
00039 typedef struct tydisktreenode {
00040 
00041 #ifdef SWAP_BYTE_ORDER
00042     short nodetype; /*low byte will coincide with MAC enum*/
00043 #else
00044     tytreetype nodetype; /*add, subtract, if, etc.*/
00045 #endif
00046 
00047     long nodevalsize;
00048     
00049     short lnum; /*which line number in the source was this node generated from?*/
00050     
00051     short charnum; /*at what character offset? max is 255*/
00052     
00053     short paraminfo;
00054     
00055     /*
00056     byte ctparams; //number of params actually allocated, max is 4
00057     
00058     byte hasparam1; //is param1 not nil?
00059     
00060     byte hasparam2;
00061     
00062     byte hasparam3;
00063     
00064     byte hasparam4;
00065     
00066     byte haslink; //is there another node linked to this one?
00067     */
00068     } tydisktreenode, *ptrdisktreenode, **hdldisktreenode;
00069 
00070 typedef enum tydisktreenodeparaminfo {
00071 
00072 #ifdef SWAP_BYTE_ORDER
00073     ctparams_mask = 0x00f0,
00074     ctparams_1 = 0x0010,
00075     hasparam1_mask = 0x0008,
00076     hasparam2_mask = 0x0004,
00077     hasparam3_mask = 0x0002,
00078     hasparam4_mask = 0x0001,
00079     haslink_mask = 0x8000
00080 #else
00081     ctparams_mask = 0xf000,
00082     ctparams_1 = 0x1000,
00083     hasparam1_mask = 0x0800,
00084     hasparam2_mask = 0x0400,
00085     hasparam3_mask = 0x0200,
00086     hasparam4_mask = 0x0100,
00087     haslink_mask = 0x0080
00088 #endif
00089     } tydisktreenodeparaminfo;
00090 
00091 
00092 typedef struct tydisktreerec {
00093     
00094     short version;
00095     
00096     long ctnodes;
00097     
00098     long flags; /*currently unused*/
00099     
00100     byte waste [8];
00101     
00102     tydisktreenode nodes [];
00103     } tydisktreerec, *ptrdisktreerec, **hdldisktreerec;
00104 
00105 
00106 typedef struct tyOLD42disktreenode {
00107 
00108     #ifdef __BIG_ENDIAN__
00109     tytreetype nodetype; /*add, subtract, if, etc.*/
00110     #endif
00111     #ifdef __LITTLE_ENDIAN__
00112     short nodetype;
00113     #endif
00114 
00115     long nodevalsize;
00116     
00117     short lnum; /*which line number in the source was this node generated from?*/
00118     
00119     short charnum; /*at what character offset? max is 255*/
00120     
00121     byte ctparams : 4; /*number of params actually allocated, max is 4*/
00122     
00123     byte hasparam1 : 1; /*is param1 not nil?*/
00124     
00125     byte hasparam2 : 1;
00126     
00127     byte hasparam3 : 1;
00128     
00129     byte hasparam4 : 1;
00130     
00131     byte haslink : 1; /*is there another node linked to this one?*/
00132     
00133     byte unused : 7; /*a little room for expansion*/
00134     } tyOLD42disktreenode, *ptrOLD42disktreenode, **hdlOLD42disktreenode;
00135 
00136 
00137 #ifdef fldebug
00138 
00139     static long cttreenodes = 0;
00140 
00141 #endif
00142 
00143 
00144 
00145 #define treenodeallocator true
00146 
00147 #define treenodeblocksize 1024
00148 
00149 
00150 typedef struct tytreenodeblock {
00151     
00152     ptrtreenode pnode; // points to next field, simulating handle
00153     
00154     tytreenode node;
00155     } tytreenodeblock, *ptrtreenodeblock;
00156 
00157 
00158 #ifdef WIN95VERSION
00159     
00160 static CRITICAL_SECTION treenodesection;
00161 
00162 static boolean treenodesectioninitialized = false;
00163 
00164 static void _entercriticaltreenodesection (void) {
00165 
00166     if (!treenodesectioninitialized) {
00167 
00168         InitializeCriticalSection (&treenodesection);
00169 
00170         treenodesectioninitialized = true;
00171         }
00172     
00173     EnterCriticalSection (&treenodesection);
00174     }
00175 
00176 static void _leavecriticaltreenodesection (void) {
00177 
00178     LeaveCriticalSection (&treenodesection);
00179     }
00180 
00181 #else
00182 
00183 #define _entercriticaltreenodesection()
00184 
00185 #define _leavecriticaltreenodesection()
00186 
00187 #endif
00188 
00189 
00190 static hdltreenode hfirstfreetreenode = nil;
00191 
00192 
00193 static boolean alloctreenodeblock (hdltreenode *hfirstfreenode) {
00194     
00195     ptrtreenodeblock pblock, p, pend;
00196     hdltreenode hprev;
00197     
00198     pblock = (ptrtreenodeblock) malloc (sizeof (tytreenodeblock) * treenodeblocksize);
00199     
00200     if (pblock == nil) {
00201         
00202         memoryerror ();
00203         
00204         return (false);
00205         }
00206     
00207     clearbytes (pblock, sizeof (tytreenodeblock) * treenodeblocksize);
00208     
00209     for (hprev = nil, p = pblock, pend = p + treenodeblocksize; p < pend; ++p) {
00210         
00211         (*p).node.link = hprev; // free list is reverse order within block for easy coding
00212         
00213         (*p).pnode = &(*p).node; // pointer to this is a handle to real tree node
00214         
00215         hprev = &(*p).pnode;
00216         }
00217     
00218     *hfirstfreenode = hprev;
00219     
00220     return (true);
00221     } /*alloctreenodeblock*/
00222 
00223 
00224 static boolean alloctreenode (hdltreenode *hnode) {
00225 
00226     hdltreenode h;
00227     
00228     _entercriticaltreenodesection();
00229     
00230     if (hfirstfreetreenode == nil)
00231         if (!alloctreenodeblock (&hfirstfreetreenode)) {
00232         
00233             _leavecriticaltreenodesection();
00234             
00235             return (false);
00236             }
00237     
00238     h = hfirstfreetreenode;
00239     
00240     hfirstfreetreenode = (**h).link; // remove from free list
00241     
00242     (**h).link = nil;   // zero non-zero fields
00243     
00244     *hnode = h;
00245     
00246     _leavecriticaltreenodesection();
00247     
00248     return (true);
00249     } /*alloctreenode*/
00250 
00251 
00252 static void freetreenode (hdltreenode hnode) {
00253 
00254     clearbytes (*hnode, sizeof (tytreenode));
00255     
00256     _entercriticaltreenodesection();
00257 
00258     (**hnode).link = hfirstfreetreenode;
00259     
00260     hfirstfreetreenode = hnode;
00261     
00262     _leavecriticaltreenodesection();
00263     } /*freetreenode*/
00264 
00265 
00266 boolean langvisitcodetree (hdltreenode htree, langtreevisitcallback visit, ptrvoid refcon) {
00267     
00268     /*
00269     10/23/91 dmb: visit the entire code tree, links and children last
00270     
00271     we only all the visit routine for non-nil nodes
00272     
00273     for now, we ignore visit's return value, visit everything, and return true.
00274     
00275     4/7/93 dmb: change order of visiting, and now pay attention to callback's
00276     return value. use a while loop instead of linear recursion for the links.
00277     */
00278     
00279     register hdltreenode h;
00280     register short ctparams;
00281     
00282     for (h = htree; h != nil; h = (**h).link) {
00283         
00284         if (!(*visit) (h, refcon))
00285             return (false);
00286         
00287         ctparams = (**h).ctparams;
00288         
00289         if (ctparams == 0)
00290             continue;
00291         
00292         if (!langvisitcodetree ((**h).param1, visit, refcon))
00293             return (false);
00294         
00295         if (ctparams == 1)
00296             continue;
00297         
00298         if (!langvisitcodetree ((**h).param2, visit, refcon))
00299             return (false);
00300         
00301         if (ctparams == 2)
00302             continue;
00303         
00304         if (!langvisitcodetree ((**h).param3, visit, refcon))
00305             return (false);
00306         
00307         if (ctparams == 3)
00308             continue;
00309         
00310         if (!langvisitcodetree ((**h).param4, visit, refcon))
00311             return (false);
00312         }
00313     
00314     return (true);
00315     } /*langvisitcodetree*/
00316 
00317 
00318 static boolean counttreenodevisit (hdltreenode hnode, ptrvoid refcon) {
00319 #pragma unused (hnode)
00320 
00321     short *ctnodes = (short *) refcon;
00322     
00323     ++*ctnodes;
00324     
00325     return (true);
00326     } /*counttreenodevisit*/
00327 
00328 
00329 short langcounttreenodes (hdltreenode hnode) {
00330     
00331     short cttreenodesvisited = 0;
00332     
00333     langvisitcodetree (hnode, &counttreenodevisit, &cttreenodesvisited);
00334     
00335     return (cttreenodesvisited);
00336     } /*langcounttreenodes*/
00337             
00338 
00339 boolean langdisposetree (hdltreenode htree) {
00340 
00341     /*
00342     5.7.97 dmb: protect herrornode global
00343     */
00344 
00345     register hdltreenode h = htree;
00346     register short ctparams;
00347     
00348     if (h == nil)
00349         return (true);
00350 
00351     if (h == herrornode)
00352         herrornode = NULL;
00353     
00354     #ifdef fldebug
00355     
00356     --cttreenodes;
00357     
00358     #endif
00359     
00360     langdisposetree ((**h).link);
00361     
00362     ctparams = (**h).ctparams;
00363     
00364     if (ctparams == 0)
00365         goto exit;
00366         
00367     langdisposetree ((**h).param1);
00368     
00369     if (ctparams == 1)
00370         goto exit;
00371         
00372     langdisposetree ((**h).param2);
00373     
00374     if (ctparams == 2)
00375         goto exit;
00376         
00377     langdisposetree ((**h).param3);
00378     
00379     if (ctparams == 3)
00380         goto exit;
00381         
00382     langdisposetree ((**h).param4);
00383     
00384     exit:
00385     
00386     disposevaluerecord ((**h).nodeval, false);
00387     
00388     #ifndef treenodeallocator
00389         disposehandle ((Handle) h);
00390     #else
00391         freetreenode (h);
00392     #endif
00393     
00394     return (true);
00395     } /*langdisposetree*/
00396 
00397 
00398 static boolean equaltrees (hdltreenode h1, hdltreenode h2) {
00399     
00400     short ctparams;
00401     tyvaluetype valuetype;
00402     
00403     if ((h1 == nil) && (h2 == nil))
00404         return (true);
00405 
00406     if ((h1 == nil) || (h2 == nil))
00407         return (false);
00408 
00409     ctparams = (**h1).ctparams;
00410     
00411     if (ctparams != (**h2).ctparams)
00412         return (false);
00413     
00414     if ((**h1).nodetype != (**h2).nodetype)
00415         return (false);
00416     
00417     valuetype = (**h1).nodeval.valuetype;
00418 
00419     if (valuetype != (**h2).nodeval.valuetype)
00420         return (false);
00421     
00422     if (valuetype != novaluetype) {
00423         
00424         if (langheaptype (valuetype)) {
00425             
00426             if (!equalhandles ((**h1).nodeval.data.stringvalue, (**h2).nodeval.data.stringvalue))
00427                 return (false);
00428             }
00429         else {
00430             return (false); // we're not concerned with scalar value nodes
00431             }
00432         }
00433     
00434     if (!equaltrees ((**h1).link, (**h2).link))
00435         return (false);
00436     
00437     switch (ctparams) {
00438         
00439         case 4:
00440             if (!equaltrees ((**h1).param4, (**h2).param4))
00441                 return (false);
00442             // cascade
00443 
00444         case 3:
00445             if (!equaltrees ((**h1).param3, (**h2).param3))
00446                 return (false);
00447             // cascade
00448 
00449         case 2:
00450             if (!equaltrees ((**h1).param2, (**h2).param2))
00451                 return (false);
00452 
00453         case 1:
00454             if (!equaltrees ((**h1).param1, (**h2).param1))
00455                 return (false);
00456 
00457         case 0:
00458         default:
00459             return (true);
00460         }
00461     } /*equaltrees*/
00462 
00463 
00464 static boolean langnewtreenode (hdltreenode *hnode, short ctparams) {
00465     
00466     /*
00467     allocate a new tree node.
00468     
00469     8/29/90 DW: added ctparams to optimize node size.  we only allocate room for
00470     the indicated number of parameter handles.  the four slots must be declared
00471     at the end of the treenode struct.
00472     */
00473     
00474     register hdltreenode h;
00475     //register long ctbytes;
00476     
00477     #ifdef fldebug
00478     
00479     ++cttreenodes;
00480     
00481     #endif
00482     
00483     #ifndef treenodeallocator
00484         ctbytes = longsizeof (tytreenode) - ((4 - ctparams) * longsizeof (Handle));
00485         
00486         if (!newclearhandle (ctbytes, (Handle *) hnode)) {
00487             
00488             *hnode = nil;
00489             
00490             return (false);
00491             }
00492     #else
00493         if (!alloctreenode (hnode)) {
00494         
00495             *hnode = nil;
00496             
00497             return (false);
00498             }
00499     #endif
00500     
00501     h = *hnode; /*copy into register*/
00502     
00503     (**h).lnum = ctscanlines;
00504     
00505     (**h).charnum = ctscanchars;
00506     
00507     (**h).ctparams = ctparams;
00508     
00509     return (true);
00510     } /*langnewtreenode*/
00511 
00512 
00513 static boolean pushvalue (tytreetype op, tyvaluerecord val, hdltreenode *hreturned) {
00514     
00515     /*
00516     12/26/91 dmb: dispose value when newtreenode fails
00517     */
00518     
00519     register hdltreenode h;
00520     
00521     if (!langnewtreenode (hreturned, 0)) {
00522         
00523         disposevaluerecord (val, false);
00524         
00525         return (false);
00526         }
00527     
00528     h = *hreturned; /*copy into register*/
00529     
00530     (**h).nodetype = op;
00531     
00532     (**h).nodeval = val;
00533     
00534     return (true);
00535     } /*pushvalue*/
00536     
00537 
00538 boolean newconstnode (tyvaluerecord val, hdltreenode *hreturned) {
00539     
00540     return (pushvalue (constop, val, hreturned));
00541     } /*newconstnode*/
00542     
00543 
00544 boolean newidnode (tyvaluerecord val, hdltreenode *hreturned) {
00545     
00546     return (pushvalue (identifierop, val, hreturned));
00547     } /*newidnode*/
00548     
00549 
00550 boolean pushquadruplet (tytreetype op, hdltreenode hp1, hdltreenode hp2, hdltreenode hp3, hdltreenode hp4, hdltreenode *hreturned) {
00551     
00552     register hdltreenode h;
00553     
00554     if (!langnewtreenode (hreturned, 4)) {
00555         
00556         langdisposetree (hp1); /*we must consume it*/
00557         
00558         langdisposetree (hp2);
00559         
00560         langdisposetree (hp3);
00561         
00562         langdisposetree (hp4);
00563         
00564         return (false);
00565         }
00566         
00567     h = *hreturned; /*copy into register*/
00568     
00569     (**h).nodetype = op;
00570     
00571     (**h).param1 = hp1;
00572     
00573     (**h).param2 = hp2;
00574     
00575     (**h).param3 = hp3;
00576     
00577     (**h).param4 = hp4;
00578     
00579     return (true);
00580     } /*pushquadruplet*/
00581     
00582     
00583 boolean pushtriplet (tytreetype op, hdltreenode hp1, hdltreenode hp2, hdltreenode hp3, hdltreenode *hreturned) {
00584     
00585     register hdltreenode h;
00586     
00587     if (!langnewtreenode (hreturned, 3)) {
00588         
00589         langdisposetree (hp1); /*we must consume it*/
00590         
00591         langdisposetree (hp2);
00592         
00593         langdisposetree (hp3);
00594         
00595         return (false);
00596         }
00597         
00598     h = *hreturned; /*copy into register*/
00599     
00600     (**h).nodetype = op;
00601     
00602     (**h).param1 = hp1;
00603     
00604     (**h).param2 = hp2;
00605     
00606     (**h).param3 = hp3;
00607     
00608     return (true);
00609     } /*pushtriplet*/
00610     
00611     
00612 boolean pushbinaryoperation (tytreetype op, hdltreenode hp1, hdltreenode hp2, hdltreenode *hreturned) {
00613     
00614     /*
00615     5.0a19 dmb: first cut at compiler-time assignment optimizations:
00616 
00617     1: x = x + y  =>  x += y
00618     
00619     later:
00620     2: x = x - y  =>  x -= y
00621     3: x = string.delete (x, y, z) => string.xdelete (@x, y, z)
00622     4: x = string.mid (x, y, z)    => string.xmid (@x, y, z)
00623     5: x = string.popleading (x, y) => string.xpopleading (@x, y)
00624     6. x = string.replace (x, y, z) => string.xreplace[all] (@x, y, z)
00625     7. x = string.upp[low]er (x)    => string.xupp[low]er (@x)
00626     */
00627 
00628     register hdltreenode h;
00629     
00630     if (!langnewtreenode (hreturned, 2)) {
00631         
00632         langdisposetree (hp1); /*we must consume it*/
00633         
00634         langdisposetree (hp2);
00635         
00636         return (false);
00637         }
00638     
00639     #ifdef version5orgreater
00640     
00641     if (op == assignop) { // look for assignment optimizations when rhs includes lhs
00642         
00643         h = hp2;
00644 
00645         switch ((**h).nodetype) {
00646         
00647             case addop:
00648                 if (equaltrees (hp1, (**h).param1)) { // turn + into +=
00649 
00650                     op = addvalueop;
00651                     
00652                     hp2 = (**h).param2;
00653                     
00654                     (**h).param2 = nil;
00655 
00656                     langdisposetree (h);
00657                     }
00658                 
00659                 break;
00660             
00661             case subtractop:
00662                 if (equaltrees (hp1, (**h).param1)) { // turn - into -=
00663 
00664                     op = subtractvalueop;
00665                     
00666                     hp2 = (**h).param2;
00667                     
00668                     (**h).param2 = nil;
00669 
00670                     langdisposetree (h);
00671                     }
00672                 
00673                 break;
00674             
00675             default:
00676                 /* do nothing */
00677                 break;
00678             }
00679         }
00680 
00681     #endif
00682 
00683     h = *hreturned; /*copy into register*/
00684     
00685     (**h).nodetype = op;
00686     
00687     (**h).param1 = hp1;
00688     
00689     (**h).param2 = hp2;
00690     
00691     return (true);
00692     } /*pushbinaryoperation*/
00693     
00694     
00695 boolean pushunaryoperation (tytreetype op, hdltreenode hp1, hdltreenode *hreturned) {
00696     
00697     register hdltreenode h;
00698     
00699     if (!langnewtreenode (hreturned, 1)) {
00700         
00701         langdisposetree (hp1); /*we must consume it*/
00702         
00703         return (false);
00704         }
00705     
00706     h = *hreturned; /*copy into register*/
00707     
00708     (**h).nodetype = op;
00709     
00710     (**h).param1 = hp1;
00711     
00712     return (true);
00713     } /*pushunaryoperation*/
00714 
00715 
00716 boolean pushoperation (tytreetype op, hdltreenode *hreturned) {
00717     
00718     if (!langnewtreenode (hreturned, 0))
00719         return (false);
00720     
00721     (**(*hreturned)).nodetype = op;
00722     
00723     return (true);
00724     } /*pushoperation*/
00725 
00726 
00727 boolean pushloop (hdltreenode hp1, hdltreenode hp2, hdltreenode hp3, hdltreenode *hreturned) {
00728     
00729     return (pushquadruplet (loopop, hp1, hp2, hp3, nil, hreturned));
00730     } /*pushloop*/
00731 
00732 
00733 boolean pushloopbody (hdltreenode hp4, hdltreenode hlist) {
00734     
00735     register hdltreenode h = hlist;
00736     
00737     (**h).param4 = hp4;
00738     
00739     return (true);
00740     } /*pushloopbody*/
00741 
00742 
00743 boolean pushunarystatementlist (hdltreenode hp1, hdltreenode hlist) {
00744     
00745     register hdltreenode h = hlist;
00746     
00747     (**h).param1 = hp1;
00748     
00749     return (true);
00750     } /*pushunarystatementlist*/
00751 
00752 
00753 boolean pushtripletstatementlists (hdltreenode hp2, hdltreenode hp3, hdltreenode hlist) {
00754     
00755     /*
00756     add the statement lists to the previously-created triplet.
00757     
00758     the triplet was created earlier so that the line/character position 
00759     information could be meaningful.
00760     
00761     since the triplet was created with unassigned parameters set to 
00762     nil, we only set non-nil parameters.  this is more than an optimization; 
00763     it adds flexibility so that for some callers (like fileloop), one 
00764     of these parameters can already be set
00765     */
00766     
00767     register hdltreenode h = hlist;
00768     
00769     if (hp2)
00770         (**h).param2 = hp2;
00771     
00772     if (hp3)
00773         (**h).param3 = hp3;
00774     
00775     return (true);
00776     } /*pushtripletstatementlists*/
00777 
00778 
00779 boolean pushfunctioncall (hdltreenode hp1, hdltreenode hp2, hdltreenode *hreturned) {
00780     
00781     /*
00782     hp1 represents the name of the function call.  hp2 represents the parameter
00783     list (it can be nil, indicating a function taking no parameters).
00784     
00785     before pushing the name onto the code tree, first see if it's a built-in
00786     function.  if so, substitute the tokennumber for the built-in.
00787     
00788     note: since we always call pushbinaryoperation, we consume both parameters.
00789     
00790     7/8/90 DW: only do the optimization if hp1 is a simple, undotted string.
00791     this has been a bug lurking in here for a long, long time!  it took the 
00792     whole day of splitting the baby to find this one.  thank you.
00793     
00794     7/8/90 DW: wishful thinking.  this really was a problem, but the nasty
00795     behavior continues...
00796     
00797     7/10/90 DW: turns out we were disposing of an already-disposed-of handle
00798     in scripts.c.
00799     */
00800     
00801     register hdltreenode h = hp1; /*we do a lot of work on this guy*/
00802     register Handle hstring;
00803     register boolean fl;
00804     bigstring bs;
00805     tyvaluerecord val;
00806     hdlhashnode hnode;
00807     
00808     if ((**h).nodetype != identifierop) /*more complex than an ID, skip optimization*/
00809         goto L1;
00810     
00811     assert ((**h).nodeval.valuetype == stringvaluetype);
00812     
00813     /*
00814     if ((**h).nodeval.valuetype != stringvaluetype) /%skip optimization%/
00815         goto L1;
00816     */
00817     
00818     hstring = (**h).nodeval.data.stringvalue;
00819     
00820     texthandletostring (hstring, bs); /*get the identifier name*/
00821     
00822     fl = hashtablelookup (hbuiltinfunctions, bs, &val, &hnode); /*check the built-in functions*/
00823     
00824     if (fl && (val.valuetype == tokenvaluetype)) { /*a pre-defined built-in*/
00825         
00826         disposehandle ((Handle) hstring); /*don't need the string*/
00827         
00828         (**h).nodeval = val; /*replace with token value*/
00829         }
00830     
00831     L1:
00832     
00833     return (pushbinaryoperation (functionop, h, hp2, hreturned));
00834     } /*pushfunctioncall*/
00835 
00836 
00837 boolean pushkernelcall (hdltreenode hp1, hdltreenode *hreturned) {
00838     
00839     /*
00840     7/18/91 dmb: resolve the efp reference immediately, both for 
00841     performance and to catch errors at compile time.  we stick the 
00842     resolved token in a constant node that becomes the one parameter 
00843     in the kernel code tree.
00844     
00845     8/21/91 dmb: langvalue now supports calling kernel code directly, with 
00846     kernelfunctionvalue, which doesn't work off the the code tree.  so there's 
00847     no point in stashing sway  the token value, which was kind of a waste of 
00848     memory anyway. 
00849     
00850     5.7.97 dmb: protect herrornode global
00851     */
00852     
00853     register hdltreenode h = hp1;
00854     register boolean fl;
00855     hdlhashtable htable;
00856     bigstring bs;
00857     tyvaluerecord val;
00858     boolean flerrornodewasset;
00859     hdlhashnode hnode;
00860     
00861     assert ((**h).nodetype == dotop);
00862     
00863     pushhashtable (efptable);
00864     
00865     fl = langgetdotparams (h, &htable, bs);
00866     
00867     pophashtable ();
00868     
00869     if (!fl)
00870         return (false);
00871     
00872     fl = (**htable).valueroutine != nil;
00873     
00874     if (fl)
00875         fl = hashtablelookup (htable, bs, &val, &hnode);
00876     
00877     if (!fl || (val.valuetype != tokenvaluetype)) { /*didn't get the token value*/
00878         
00879         langparamerror (notefperror, bs);
00880         
00881         return (false);
00882         }
00883     
00884     if (!setaddressvalue (htable, bs, &val))
00885         return (false);
00886     
00887     exemptfromtmpstack (&val); /*pushvalue will consume it on failure*/
00888     
00889     if (!pushvalue (kernelop, val, hreturned))
00890         return (false);
00891     
00892     /*
00893     if (!newconstnode (val, &htokenparam))
00894         return (false);
00895     
00896     if (!pushunaryoperation (kernelop, htokenparam, hreturned))
00897         return (false);
00898     
00899     if (!setaddressvalue (htable, bs, &val))
00900         return (false);
00901     
00902     (***hreturned).nodeval = val;
00903     */
00904     
00905     flerrornodewasset = herrornode != NULL;
00906     
00907     langdisposetree (h); /*don't need the tree anymore*/
00908 
00909     if (flerrornodewasset  && (herrornode == NULL)) // it was pointing to our old code
00910         herrornode = *hreturned;
00911     
00912     return (true);
00913     } /*pushkernelcall*/
00914 
00915 
00916 boolean pushfunctionreference (tyvaluerecord val, hdltreenode *htree) {
00917     
00918     /*
00919     code factored from dialog callbacks and ipc handlers
00920     
00921     val should be an address value, the address of the function to be called.
00922     
00923     we build a code tree for the function reference -- just the address 
00924     dereferenced.  this corresponds to hp1 in pushfunctioncall
00925     */
00926     
00927     hdltreenode haddress;
00928     
00929     exemptfromtmpstack (&val); /*will be disposed along w/code tree*/
00930     
00931     if (!newconstnode (val, &haddress))
00932         return (false);
00933     
00934     if (!pushunaryoperation (dereferenceop, haddress, htree))
00935         return (false);
00936     
00937     return (true);
00938     } /*pushfunctionreference*/
00939 
00940 
00941 boolean pushlastlink (hdltreenode hnewlast, hdltreenode hlist) {
00942     
00943     /*
00944     hnewlast is a newly parsed object, for example a statement in a statement
00945     list or a parameter expression in a parameter list.
00946     
00947     tack it on at the end of the list headed up by hlist.  we travel from
00948     hlist until we hit nil, then backup and insert hnewlast as the last node
00949     in the list.
00950     
00951     the link field of the treenode is used to connect the list.
00952     
00953     12/9/91 dmb: don't treat nil newlast as an error
00954     */
00955     
00956     register hdltreenode nomad = hlist;
00957     
00958     if ((hnewlast == nil) || (nomad == nil))
00959         return (true);
00960     
00961     while (true) { /*find the end of the list*/
00962         
00963         register hdltreenode nextnomad = (**nomad).link;
00964         
00965         if (nextnomad == nil) { /*found it*/
00966             
00967             (**nomad).link = hnewlast; /*link in at the end of the list*/
00968             
00969             assert ((**hnewlast).link == nil || (**hnewlast).nodetype == fieldop);
00970             
00971             return (true);
00972             }
00973         
00974         nomad = nextnomad; 
00975         } /*while*/
00976     } /*pushlastlink*/
00977 
00978 
00979 #if 0
00980 
00981 boolean pushlastoptionallink (hdltreenode hnewlast, hdltreenode hlist, hdltreenode *hresult) {
00982     
00983     tyvaluerecord val;
00984     
00985     initvalue (&val, novaluetype);
00986     
00987     if (hnewlast == nil) {
00988         
00989         if (!newconstnode (val, &hnewlast))
00990             return (false);
00991         }
00992     
00993     if (hlist == nil) {
00994         
00995         if (!newconstnode (val, &hlist))
00996             return (false);
00997         }
00998     
00999     pushlastlink (hnewlast, hlist);
01000     
01001     *hresult = hlist;
01002     
01003     return (true);
01004     } /*pushlastoptionallink*/
01005 
01006 #endif
01007 
01008 
01009 typedef struct packtreeinfo {
01010     
01011     hdldisktreerec hdisktree;
01012     
01013     Handle htreenodevalues;
01014     
01015     long ctvisited;
01016     } typacktreeinfo, *ptrpacktreeinfo;
01017 
01018 
01019 static boolean langpacktreevisit (hdltreenode htree, ptrvoid refcon) {
01020     
01021     /*
01022     4/8/93 dmb: pack a code tree. be careful not to retain value of a modulop 
01023     node, which is really a handle will not persist.
01024     */
01025     
01026     register hdltreenode hn = htree;
01027     ptrpacktreeinfo lpi = (ptrpacktreeinfo) refcon;
01028     register ptrdisktreenode pn;
01029     tyvaluerecord val = (**hn).nodeval;
01030     Handle hpackedval = nil;
01031     short ctparams;
01032     short paraminfo;
01033     
01034     /*first pack value, which can move memory*/
01035     
01036     if ((val.valuetype != novaluetype) && ((**hn).nodetype != moduleop)) {
01037         
01038         if (!langpackvalue ((**hn).nodeval, &hpackedval, HNoNode))
01039             return (false);
01040         
01041         if (!pushhandle (hpackedval, (*lpi).htreenodevalues)) {
01042             
01043             disposehandle (hpackedval);
01044             
01045             return (false);
01046             }
01047         }
01048     
01049     pn = &(**(*lpi).hdisktree).nodes [(*lpi).ctvisited++];
01050     
01051     (*pn).nodetype = (**hn).nodetype;
01052     
01053     (*pn).nodevalsize = gethandlesize (hpackedval);
01054     
01055     (*pn).lnum = (**hn).lnum;
01056     
01057     (*pn).charnum = (**hn).charnum;
01058     
01059     ctparams = (**hn).ctparams;
01060     
01061     paraminfo = ctparams * ctparams_1;
01062     
01063     if ((ctparams > 0) && ((**hn).param1 != nil))
01064         paraminfo |= hasparam1_mask;
01065     
01066     if ((ctparams > 1) && ((**hn).param2 != nil))
01067         paraminfo |= hasparam2_mask;
01068     
01069     if ((ctparams > 2) && ((**hn).param3 != nil))
01070         paraminfo |= hasparam3_mask;
01071     
01072     if ((ctparams > 3) && ((**hn).param4 != nil))
01073         paraminfo |= hasparam4_mask;
01074     
01075     if ((**hn).link != nil)
01076         paraminfo |= haslink_mask;
01077     
01078     (*pn).paraminfo = paraminfo;
01079     
01080     memtodisklong ((*pn).nodevalsize);
01081     memtodiskshort ((*pn).lnum);
01082     memtodiskshort ((*pn).charnum);
01083 
01084     disposehandle (hpackedval);
01085     
01086     return (true);
01087     } /*langpacktreevisit*/
01088 
01089 
01090 boolean langpacktree (hdltreenode htree, Handle *hpacked) {
01091     
01092     long ctnodes;
01093     typacktreeinfo info;
01094     
01095     ctnodes = langcounttreenodes (htree);
01096     
01097     if (!newclearhandle (sizeof (tydisktreerec) + ctnodes * sizeof (tydisktreenode), (Handle *) &info.hdisktree))
01098         return (false);
01099     
01100     if (!newemptyhandle (&info.htreenodevalues)) {
01101         
01102         disposehandle ((Handle) info.hdisktree);
01103         
01104         return (false);
01105         }
01106     
01107     (**info.hdisktree).ctnodes = ctnodes;
01108     
01109     info.ctvisited = 0;
01110     
01111     if (!langvisitcodetree (htree, &langpacktreevisit, &info)) {
01112         
01113         disposehandle ((Handle) info.hdisktree);
01114         
01115         disposehandle (info.htreenodevalues);
01116         
01117         return (false);
01118         }
01119     
01120     memtodiskshort ((**info.hdisktree).version);    /*I can not find where this is set*/
01121     memtodisklong ((**info.hdisktree).ctnodes);
01122     memtodisklong ((**info.hdisktree).flags);
01123     
01124     return (mergehandles ((Handle) info.hdisktree, info.htreenodevalues, hpacked));
01125 } /*langpacktree*/
01126 
01127 
01128 static boolean
01129 langunpacktreenode (
01130         tydisktreenode  *rec,
01131         hdltreenode     *hnode,
01132         ptrpacktreeinfo  ppi)
01133 {
01134     /*
01135     unpack a single tree node.
01136     */
01137 
01138     register ptrdisktreenode pn = rec;
01139     register hdltreenode hn;
01140     Handle hpackedval = nil;
01141     tyvaluerecord val;
01142     short ctparams;
01143     
01144     ctparams = ((*pn).paraminfo & ctparams_mask) / ctparams_1;
01145     
01146     if (!langnewtreenode (hnode, ctparams))
01147         return (false);
01148     
01149     hn = *hnode;
01150     
01151     if ((*pn).nodevalsize > 0) {
01152         
01153         if (!newhandle ((*pn).nodevalsize, &hpackedval))
01154             goto error;
01155         
01156         if (!pullfromhandle ((*ppi).htreenodevalues, 0, (*pn).nodevalsize, *hpackedval)) /*does _not_ move memory*/
01157             goto error;
01158         
01159         if (!langunpackvalue (hpackedval, &val))
01160             goto error;
01161         
01162         disposehandle (hpackedval);
01163         
01164         (**hn).nodeval = val;
01165         }
01166     
01167     (**hn).nodetype = (*pn).nodetype;
01168     
01169     (**hn).lnum = (*pn).lnum;
01170     
01171     (**hn).charnum = (*pn).charnum;
01172 
01173     return (true);
01174 
01175 error:
01176     {
01177 #ifndef treenodeallocator
01178         disposehandle ((Handle) *hnode);
01179 #else
01180         freetreenode (*hnode);
01181 #endif
01182         disposehandle (hpackedval);
01183         
01184         return (false);
01185     }
01186 } /*langunpacktreenode*/
01187 
01188 
01189 static boolean
01190 langunpacktreevisit (
01191         hdltreenode     *htree,
01192         ptrpacktreeinfo  ppi)
01193 {
01194     /*
01195     unpack a code tree recursively
01196     */
01197     
01198     register hdltreenode hn = nil;
01199     hdltreenode hfirst = nil;
01200     tydisktreenode rec;
01201     hdltreenode hnode;
01202     
01203     while (true)
01204     {
01205         rec = (**(*ppi).hdisktree).nodes [(*ppi).ctvisited++];
01206         
01207         disktomemlong (rec.nodevalsize);
01208         disktomemshort (rec.lnum);
01209         disktomemshort (rec.charnum);
01210         /* remaining fields are byte values */
01211 
01212         assert ((*ppi).ctvisited <= (**(*ppi).hdisktree).ctnodes);
01213         
01214         if (!langunpacktreenode (&rec, &hnode, ppi))
01215             goto error;
01216         
01217         if (hn == nil) /*first node created*/
01218             hfirst = hnode;
01219         else
01220             (**hn).link = hnode;
01221         
01222         hn = hnode;
01223         
01224         if (rec.paraminfo & hasparam1_mask)
01225         {
01226             if (!langunpacktreevisit (&hnode, ppi))
01227                 goto error;
01228 
01229             (**hn).param1 = hnode;
01230         }
01231 
01232         if (rec.paraminfo & hasparam2_mask)
01233         {
01234             if (!langunpacktreevisit (&hnode, ppi))
01235                 goto error;
01236 
01237             (**hn).param2 = hnode;
01238         }
01239 
01240         if (rec.paraminfo & hasparam3_mask)
01241         {
01242             if (!langunpacktreevisit (&hnode, ppi))
01243                 goto error;
01244 
01245             (**hn).param3 = hnode;
01246         }
01247 
01248         if (rec.paraminfo & hasparam4_mask)
01249         {
01250             if (!langunpacktreevisit (&hnode, ppi))
01251                 goto error;
01252 
01253             (**hn).param4 = hnode;
01254         }
01255         
01256         if ((rec.paraminfo & haslink_mask) == 0)
01257             break;
01258         }
01259     
01260     *htree = hfirst;
01261     
01262     return (true);
01263     
01264     error: {
01265         
01266         langdisposetree (hfirst);
01267         
01268         return (false);
01269         }
01270     } /*langunpacktreevisit*/
01271 
01272 
01273 boolean langunpacktree (Handle hpacked, hdltreenode *htree) {
01274     
01275     /*
01276     unpack a code tree, consuming the packed handle
01277     
01278     2002-11-11 AR: Added asserts to make sure the C compiler chose the
01279     proper byte alignment for the tydisktreenode and tydisktreerec structs.
01280     If it did not, we would end up corrupting any database files we saved.
01281     */
01282     
01283     typacktreeinfo info;
01284     long ctnodes;
01285     boolean fl;
01286     
01287     assert (sizeof (tydisktreenode) == 12);
01288     
01289     assert (sizeof (tydisktreenode) == sizeof (tyOLD42disktreenode));
01290     
01291     assert (sizeof (tydisktreerec) == 18);
01292     
01293     *htree = nil; /*default return*/
01294     
01295     if (!unmergehandles (hpacked, (Handle *) &info.hdisktree, &info.htreenodevalues))
01296         return (false);
01297     
01298     /* platformize the header first */
01299     disktomemshort ((**info.hdisktree).version);
01300     disktomemlong((**info.hdisktree).ctnodes);
01301     disktomemlong((**info.hdisktree).flags);
01302 
01303     info.ctvisited = 0;
01304     
01305     ctnodes = (**info.hdisktree).ctnodes;
01306     
01307     if (ctnodes == 0)
01308         fl = true;
01309     else
01310         fl = langunpacktreevisit (htree, &info);
01311     
01312     assert (info.ctvisited == ctnodes);
01313     
01314     disposehandle ((Handle) info.hdisktree);
01315     
01316     disposehandle (info.htreenodevalues);
01317     
01318     return (fl);
01319     } /*langunpacktree*/
01320 
01321 
01322 boolean langcopytree (hdltreenode hin, hdltreenode *hout) {
01323     
01324     /*
01325     Duplicate the code tree without using langpacktree/langunpacktree
01326     so this verb can be called even when not in control of the lang globals.
01327     */
01328     
01329     Handle hpacked;
01330     
01331     return (langpacktree (hin, &hpacked) && langunpacktree (hpacked, hout));
01332     
01333 /*
01334     register short ctparams;
01335     register hdltreenode h;
01336     hdltreenode hcopy = nil;
01337     hdltreenode hprev = nil;
01338     
01339     *hout = nil;
01340         
01341     for (h = hin; h != nil; hprev = h, h = (**h).link) {
01342         
01343         ctparams = (**h).ctparams;
01344 
01345         if (!langnewtreenode (&hcopy, ctparams))
01346             goto error;
01347         
01348         if (hprev != nil)
01349             (**hprev).link = hcopy;
01350         
01351         if (*hout == nil)
01352             *hout = hcopy;
01353         
01354         //copy stuff
01355 
01356         (**hcopy).nodetype = (**h).nodetype;
01357         
01358         (**hcopy).lnum = (**h).lnum;
01359         
01360         (**hcopy).charnum = (**h).charnum;
01361             
01362         //copy valuerecord
01363         
01364         copyvaluerecord ((**h).nodeval, &(**hcopy).nodeval);
01365         
01366         //copy params
01367         
01368         if (ctparams == 0)
01369             continue;
01370         
01371         if (!langcopytree ((**h).param1, &(**hcopy).param1))
01372             goto error;
01373         
01374         if (ctparams == 1)
01375             continue;
01376             
01377         if (!langcopytree ((**h).param2, &(**hcopy).param2))
01378             goto error;
01379         
01380         if (ctparams == 2)
01381             continue;
01382         
01383         if (!langcopytree ((**h).param3, &(**hcopy).param3))
01384             goto error;
01385         
01386         if (ctparams == 3)
01387             continue;
01388         
01389         if (!langcopytree ((**h).param4, &(**hcopy).param4))
01390             goto error;
01391         }
01392     
01393     return (true);
01394 
01395 error:
01396 
01397     langdisposetree (*hout);
01398     
01399     return (false);
01400 */
01401     }/*langcopytree*/

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